diff --git a/pres/intro.odp b/pres/intro.odp index f6e3935..17ef78e 100644 Binary files a/pres/intro.odp and b/pres/intro.odp differ diff --git a/psdlag/src/.smhist b/psdlag/src/.smhist new file mode 100644 index 0000000..439f404 --- /dev/null +++ b/psdlag/src/.smhist @@ -0,0 +1,47 @@ +data check.dat +read f 1 +read pow 2 +limits f pow +box +ptype 10 3 +points f pow +quit +data check.dat +read f 1 +read pow 2 +limits f pow +ptype 10 3 +points f pow +box +quit +data check.dat +read f 1 +read pow 2 +limits f pow +box +ptype 10 3 +points f pow +set lgf = log10(f) +set lgf = alog10(f) +set lgf = lg(f) +erase +box +erase +limits lgf pow +points lgf pow +box +erase +limits lgf 0. 3. +box +points lgf pow +quit +data check.dat +read 1 f +read f 1 +read pow 2 +set lgf = lg(f) +limits lgf pow +box +ptype 10 3 +points lgf pow +quit diff --git a/psdlag/src/README b/psdlag/src/README new file mode 100644 index 0000000..f095c4e --- /dev/null +++ b/psdlag/src/README @@ -0,0 +1,32 @@ + + + +To compile, modify the file makefile to so that libdir and incdir point to where +alglib library and header files are installed respectively, then run: make + + +FILES: +- README: this file +- makefile: a make file for compiling +- main.cpp: the main file, that process the input file, print help message if + needed and reads the light curves files. check readLC to see the light curve + format. +- mod.cpp: contains the class mod, which is a base class that uses the likelihood method. This on its own does nothing, but it is meant to be inherited by others, e.g. psd , lag , lag10 + etc ... It is here where the likelihood is calculated, and maximized. + +- psd.cpp: a child class of mod to calculate psds. psd10 is similar by it + calculate the log10 of psd. This is better than calculating the psd directly. + +- lag.cpp: a child class of mod to calculate cross spectra and phase lags. + similar to psd. there is also lag10 that calcualte the log10 of the cross + spectrum plus phase lag. + +- psdlag.cpp: a child class of mod to calculate psd and cross spec and phase + lag at the same time. + +- inc: contains the header files. + +- inc/mod.hpp: the header for mod.cpp. This file has the Mod class also, which + is a class that holds multiple mod's used for fitting multiple light curve + simultaneusly, each mod fits for one light curve, and the total log-likelihood + is the sum of individual likelihood (i.e. product of probabilities) diff --git a/psdlag/src/alglibinternal.cpp b/psdlag/src/alglibinternal.cpp new file mode 100644 index 0000000..4e4bbf7 --- /dev/null +++ b/psdlag/src/alglibinternal.cpp @@ -0,0 +1,15919 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "alglibinternal.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ + + + + +static void tsort_tagsortfastirec(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + /* Real */ ae_vector* bufa, + /* Integer */ ae_vector* bufb, + ae_int_t i1, + ae_int_t i2, + ae_state *_state); +static void tsort_tagsortfastrrec(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* bufa, + /* Real */ ae_vector* bufb, + ae_int_t i1, + ae_int_t i2, + ae_state *_state); +static void tsort_tagsortfastrec(/* Real */ ae_vector* a, + /* Real */ ae_vector* bufa, + ae_int_t i1, + ae_int_t i2, + ae_state *_state); + + + + + + + + + + + + + + + + + + + + +static void hsschur_internalauxschur(ae_bool wantt, + ae_bool wantz, + ae_int_t n, + ae_int_t ilo, + ae_int_t ihi, + /* Real */ ae_matrix* h, + /* Real */ ae_vector* wr, + /* Real */ ae_vector* wi, + ae_int_t iloz, + ae_int_t ihiz, + /* Real */ ae_matrix* z, + /* Real */ ae_vector* work, + /* Real */ ae_vector* workv3, + /* Real */ ae_vector* workc1, + /* Real */ ae_vector* works1, + ae_int_t* info, + ae_state *_state); +static void hsschur_aux2x2schur(double* a, + double* b, + double* c, + double* d, + double* rt1r, + double* rt1i, + double* rt2r, + double* rt2i, + double* cs, + double* sn, + ae_state *_state); +static double hsschur_extschursign(double a, double b, ae_state *_state); +static ae_int_t hsschur_extschursigntoone(double b, ae_state *_state); + + + + +static ae_bool safesolve_cbasicsolveandupdate(ae_complex alpha, + ae_complex beta, + double lnmax, + double bnorm, + double maxgrowth, + double* xnorm, + ae_complex* x, + ae_state *_state); + + +static ae_bool hpccores_hpcpreparechunkedgradientx(/* Real */ ae_vector* weights, + ae_int_t wcount, + /* Real */ ae_vector* hpcbuf, + ae_state *_state); +static ae_bool hpccores_hpcfinalizechunkedgradientx(/* Real */ ae_vector* buf, + ae_int_t wcount, + /* Real */ ae_vector* grad, + ae_state *_state); + + +static void xblas_xsum(/* Real */ ae_vector* w, + double mx, + ae_int_t n, + double* r, + double* rerr, + ae_state *_state); +static double xblas_xfastpow(double r, ae_int_t n, ae_state *_state); + + +static double linmin_ftol = 0.001; +static double linmin_xtol = 100*ae_machineepsilon; +static ae_int_t linmin_maxfev = 20; +static double linmin_stpmin = 1.0E-50; +static double linmin_defstpmax = 1.0E+50; +static double linmin_armijofactor = 1.3; +static void linmin_mcstep(double* stx, + double* fx, + double* dx, + double* sty, + double* fy, + double* dy, + double* stp, + double fp, + double dp, + ae_bool* brackt, + double stmin, + double stmax, + ae_int_t* info, + ae_state *_state); + + +static ae_bool ntheory_isprime(ae_int_t n, ae_state *_state); +static ae_int_t ntheory_modmul(ae_int_t a, + ae_int_t b, + ae_int_t n, + ae_state *_state); +static ae_int_t ntheory_modexp(ae_int_t a, + ae_int_t b, + ae_int_t n, + ae_state *_state); + + +static ae_int_t ftbase_coltype = 0; +static ae_int_t ftbase_coloperandscnt = 1; +static ae_int_t ftbase_coloperandsize = 2; +static ae_int_t ftbase_colmicrovectorsize = 3; +static ae_int_t ftbase_colparam0 = 4; +static ae_int_t ftbase_colparam1 = 5; +static ae_int_t ftbase_colparam2 = 6; +static ae_int_t ftbase_colparam3 = 7; +static ae_int_t ftbase_colscnt = 8; +static ae_int_t ftbase_opend = 0; +static ae_int_t ftbase_opcomplexreffft = 1; +static ae_int_t ftbase_opbluesteinsfft = 2; +static ae_int_t ftbase_opcomplexcodeletfft = 3; +static ae_int_t ftbase_opcomplexcodelettwfft = 4; +static ae_int_t ftbase_opradersfft = 5; +static ae_int_t ftbase_opcomplextranspose = -1; +static ae_int_t ftbase_opcomplexfftfactors = -2; +static ae_int_t ftbase_opstart = -3; +static ae_int_t ftbase_opjmp = -4; +static ae_int_t ftbase_opparallelcall = -5; +static ae_int_t ftbase_maxradix = 6; +static ae_int_t ftbase_updatetw = 16; +static ae_int_t ftbase_recursivethreshold = 1024; +static ae_int_t ftbase_raderthreshold = 19; +static ae_int_t ftbase_ftbasecodeletrecommended = 5; +static double ftbase_ftbaseinefficiencyfactor = 1.3; +static ae_int_t ftbase_ftbasemaxsmoothfactor = 5; +static void ftbase_ftdeterminespacerequirements(ae_int_t n, + ae_int_t* precrsize, + ae_int_t* precisize, + ae_state *_state); +static void ftbase_ftcomplexfftplanrec(ae_int_t n, + ae_int_t k, + ae_bool childplan, + ae_bool topmostplan, + ae_int_t* rowptr, + ae_int_t* bluesteinsize, + ae_int_t* precrptr, + ae_int_t* preciptr, + fasttransformplan* plan, + ae_state *_state); +static void ftbase_ftpushentry(fasttransformplan* plan, + ae_int_t* rowptr, + ae_int_t etype, + ae_int_t eopcnt, + ae_int_t eopsize, + ae_int_t emcvsize, + ae_int_t eparam0, + ae_state *_state); +static void ftbase_ftpushentry2(fasttransformplan* plan, + ae_int_t* rowptr, + ae_int_t etype, + ae_int_t eopcnt, + ae_int_t eopsize, + ae_int_t emcvsize, + ae_int_t eparam0, + ae_int_t eparam1, + ae_state *_state); +static void ftbase_ftpushentry4(fasttransformplan* plan, + ae_int_t* rowptr, + ae_int_t etype, + ae_int_t eopcnt, + ae_int_t eopsize, + ae_int_t emcvsize, + ae_int_t eparam0, + ae_int_t eparam1, + ae_int_t eparam2, + ae_int_t eparam3, + ae_state *_state); +static void ftbase_ftapplysubplan(fasttransformplan* plan, + ae_int_t subplan, + /* Real */ ae_vector* a, + ae_int_t abase, + ae_int_t aoffset, + /* Real */ ae_vector* buf, + ae_int_t repcnt, + ae_state *_state); +static void ftbase_ftapplycomplexreffft(/* Real */ ae_vector* a, + ae_int_t offs, + ae_int_t operandscnt, + ae_int_t operandsize, + ae_int_t microvectorsize, + /* Real */ ae_vector* buf, + ae_state *_state); +static void ftbase_ftapplycomplexcodeletfft(/* Real */ ae_vector* a, + ae_int_t offs, + ae_int_t operandscnt, + ae_int_t operandsize, + ae_int_t microvectorsize, + ae_state *_state); +static void ftbase_ftapplycomplexcodelettwfft(/* Real */ ae_vector* a, + ae_int_t offs, + ae_int_t operandscnt, + ae_int_t operandsize, + ae_int_t microvectorsize, + ae_state *_state); +static void ftbase_ftprecomputebluesteinsfft(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* precr, + ae_int_t offs, + ae_state *_state); +static void ftbase_ftbluesteinsfft(fasttransformplan* plan, + /* Real */ ae_vector* a, + ae_int_t abase, + ae_int_t aoffset, + ae_int_t operandscnt, + ae_int_t n, + ae_int_t m, + ae_int_t precoffs, + ae_int_t subplan, + /* Real */ ae_vector* bufa, + /* Real */ ae_vector* bufb, + /* Real */ ae_vector* bufc, + /* Real */ ae_vector* bufd, + ae_state *_state); +static void ftbase_ftprecomputeradersfft(ae_int_t n, + ae_int_t rq, + ae_int_t riq, + /* Real */ ae_vector* precr, + ae_int_t offs, + ae_state *_state); +static void ftbase_ftradersfft(fasttransformplan* plan, + /* Real */ ae_vector* a, + ae_int_t abase, + ae_int_t aoffset, + ae_int_t operandscnt, + ae_int_t n, + ae_int_t subplan, + ae_int_t rq, + ae_int_t riq, + ae_int_t precoffs, + /* Real */ ae_vector* buf, + ae_state *_state); +static void ftbase_ftfactorize(ae_int_t n, + ae_bool isroot, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state); +static ae_int_t ftbase_ftoptimisticestimate(ae_int_t n, ae_state *_state); +static void ftbase_ffttwcalc(/* Real */ ae_vector* a, + ae_int_t aoffset, + ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static void ftbase_internalcomplexlintranspose(/* Real */ ae_vector* a, + ae_int_t m, + ae_int_t n, + ae_int_t astart, + /* Real */ ae_vector* buf, + ae_state *_state); +static void ftbase_ffticltrec(/* Real */ ae_vector* a, + ae_int_t astart, + ae_int_t astride, + /* Real */ ae_vector* b, + ae_int_t bstart, + ae_int_t bstride, + ae_int_t m, + ae_int_t n, + ae_state *_state); +static void ftbase_fftirltrec(/* Real */ ae_vector* a, + ae_int_t astart, + ae_int_t astride, + /* Real */ ae_vector* b, + ae_int_t bstart, + ae_int_t bstride, + ae_int_t m, + ae_int_t n, + ae_state *_state); +static void ftbase_ftbasefindsmoothrec(ae_int_t n, + ae_int_t seed, + ae_int_t leastfactor, + ae_int_t* best, + ae_state *_state); + + + + + + + + + +/************************************************************************* +This function is used to set error flags during unit tests. When COND +parameter is True, FLAG variable is set to True. When COND is False, +FLAG is unchanged. + +The purpose of this function is to have single point where failures of +unit tests can be detected. + +This function returns value of COND. +*************************************************************************/ +ae_bool seterrorflag(ae_bool* flag, ae_bool cond, ae_state *_state) +{ + ae_bool result; + + + if( cond ) + { + *flag = ae_true; + } + result = cond; + return result; +} + + +/************************************************************************* +Internally calls SetErrorFlag() with condition: + + Abs(Val-RefVal)>Tol*Max(Abs(RefVal),S) + +This function is used to test relative error in Val against RefVal, with +relative error being replaced by absolute when scale of RefVal is less +than S. + +This function returns value of COND. +*************************************************************************/ +ae_bool seterrorflagdiff(ae_bool* flag, + double val, + double refval, + double tol, + double s, + ae_state *_state) +{ + ae_bool result; + + + result = seterrorflag(flag, ae_fp_greater(ae_fabs(val-refval, _state),tol*ae_maxreal(ae_fabs(refval, _state), s, _state)), _state); + return result; +} + + +/************************************************************************* +The function "touches" integer - it is used to avoid compiler messages +about unused variables (in rare cases when we do NOT want to remove these +variables). + + -- ALGLIB -- + Copyright 17.09.2012 by Bochkanov Sergey +*************************************************************************/ +void touchint(ae_int_t* a, ae_state *_state) +{ + + +} + + +/************************************************************************* +The function "touches" real - it is used to avoid compiler messages +about unused variables (in rare cases when we do NOT want to remove these +variables). + + -- ALGLIB -- + Copyright 17.09.2012 by Bochkanov Sergey +*************************************************************************/ +void touchreal(double* a, ae_state *_state) +{ + + +} + + +/************************************************************************* +The function convert integer value to real value. + + -- ALGLIB -- + Copyright 17.09.2012 by Bochkanov Sergey +*************************************************************************/ +double inttoreal(ae_int_t a, ae_state *_state) +{ + double result; + + + result = a; + return result; +} + + +/************************************************************************* +The function calculates binary logarithm. + +NOTE: it costs twice as much as Ln(x) + + -- ALGLIB -- + Copyright 17.09.2012 by Bochkanov Sergey +*************************************************************************/ +double log2(double x, ae_state *_state) +{ + double result; + + + result = ae_log(x, _state)/ae_log(2, _state); + return result; +} + + +/************************************************************************* +This function compares two numbers for approximate equality, with tolerance +to errors as large as max(|a|,|b|)*tol. + + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool approxequalrel(double a, double b, double tol, ae_state *_state) +{ + ae_bool result; + + + result = ae_fp_less_eq(ae_fabs(a-b, _state),ae_maxreal(ae_fabs(a, _state), ae_fabs(b, _state), _state)*tol); + return result; +} + + +/************************************************************************* +This function generates 1-dimensional general interpolation task with +moderate Lipshitz constant (close to 1.0) + +If N=1 then suborutine generates only one point at the middle of [A,B] + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void taskgenint1d(double a, + double b, + ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + double h; + + ae_vector_clear(x); + ae_vector_clear(y); + + ae_assert(n>=1, "TaskGenInterpolationEqdist1D: N<1!", _state); + ae_vector_set_length(x, n, _state); + ae_vector_set_length(y, n, _state); + if( n>1 ) + { + x->ptr.p_double[0] = a; + y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; + h = (b-a)/(n-1); + for(i=1; i<=n-1; i++) + { + if( i!=n-1 ) + { + x->ptr.p_double[i] = a+(i+0.2*(2*ae_randomreal(_state)-1))*h; + } + else + { + x->ptr.p_double[i] = b; + } + y->ptr.p_double[i] = y->ptr.p_double[i-1]+(2*ae_randomreal(_state)-1)*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); + } + } + else + { + x->ptr.p_double[0] = 0.5*(a+b); + y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; + } +} + + +/************************************************************************* +This function generates 1-dimensional equidistant interpolation task with +moderate Lipshitz constant (close to 1.0) + +If N=1 then suborutine generates only one point at the middle of [A,B] + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void taskgenint1dequidist(double a, + double b, + ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + double h; + + ae_vector_clear(x); + ae_vector_clear(y); + + ae_assert(n>=1, "TaskGenInterpolationEqdist1D: N<1!", _state); + ae_vector_set_length(x, n, _state); + ae_vector_set_length(y, n, _state); + if( n>1 ) + { + x->ptr.p_double[0] = a; + y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; + h = (b-a)/(n-1); + for(i=1; i<=n-1; i++) + { + x->ptr.p_double[i] = a+i*h; + y->ptr.p_double[i] = y->ptr.p_double[i-1]+(2*ae_randomreal(_state)-1)*h; + } + } + else + { + x->ptr.p_double[0] = 0.5*(a+b); + y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; + } +} + + +/************************************************************************* +This function generates 1-dimensional Chebyshev-1 interpolation task with +moderate Lipshitz constant (close to 1.0) + +If N=1 then suborutine generates only one point at the middle of [A,B] + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void taskgenint1dcheb1(double a, + double b, + ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + + ae_vector_clear(x); + ae_vector_clear(y); + + ae_assert(n>=1, "TaskGenInterpolation1DCheb1: N<1!", _state); + ae_vector_set_length(x, n, _state); + ae_vector_set_length(y, n, _state); + if( n>1 ) + { + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = 0.5*(b+a)+0.5*(b-a)*ae_cos(ae_pi*(2*i+1)/(2*n), _state); + if( i==0 ) + { + y->ptr.p_double[i] = 2*ae_randomreal(_state)-1; + } + else + { + y->ptr.p_double[i] = y->ptr.p_double[i-1]+(2*ae_randomreal(_state)-1)*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); + } + } + } + else + { + x->ptr.p_double[0] = 0.5*(a+b); + y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; + } +} + + +/************************************************************************* +This function generates 1-dimensional Chebyshev-2 interpolation task with +moderate Lipshitz constant (close to 1.0) + +If N=1 then suborutine generates only one point at the middle of [A,B] + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void taskgenint1dcheb2(double a, + double b, + ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + + ae_vector_clear(x); + ae_vector_clear(y); + + ae_assert(n>=1, "TaskGenInterpolation1DCheb2: N<1!", _state); + ae_vector_set_length(x, n, _state); + ae_vector_set_length(y, n, _state); + if( n>1 ) + { + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = 0.5*(b+a)+0.5*(b-a)*ae_cos(ae_pi*i/(n-1), _state); + if( i==0 ) + { + y->ptr.p_double[i] = 2*ae_randomreal(_state)-1; + } + else + { + y->ptr.p_double[i] = y->ptr.p_double[i-1]+(2*ae_randomreal(_state)-1)*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); + } + } + } + else + { + x->ptr.p_double[0] = 0.5*(a+b); + y->ptr.p_double[0] = 2*ae_randomreal(_state)-1; + } +} + + +/************************************************************************* +This function checks that all values from X[] are distinct. It does more +than just usual floating point comparison: +* first, it calculates max(X) and min(X) +* second, it maps X[] from [min,max] to [1,2] +* only at this stage actual comparison is done + +The meaning of such check is to ensure that all values are "distinct enough" +and will not cause interpolation subroutine to fail. + +NOTE: + X[] must be sorted by ascending (subroutine ASSERT's it) + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool aredistinct(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + double a; + double b; + ae_int_t i; + ae_bool nonsorted; + ae_bool result; + + + ae_assert(n>=1, "APSERVAreDistinct: internal error (N<1)", _state); + if( n==1 ) + { + + /* + * everything is alright, it is up to caller to decide whether it + * can interpolate something with just one point + */ + result = ae_true; + return result; + } + a = x->ptr.p_double[0]; + b = x->ptr.p_double[0]; + nonsorted = ae_false; + for(i=1; i<=n-1; i++) + { + a = ae_minreal(a, x->ptr.p_double[i], _state); + b = ae_maxreal(b, x->ptr.p_double[i], _state); + nonsorted = nonsorted||ae_fp_greater_eq(x->ptr.p_double[i-1],x->ptr.p_double[i]); + } + ae_assert(!nonsorted, "APSERVAreDistinct: internal error (not sorted)", _state); + for(i=1; i<=n-1; i++) + { + if( ae_fp_eq((x->ptr.p_double[i]-a)/(b-a)+1,(x->ptr.p_double[i-1]-a)/(b-a)+1) ) + { + result = ae_false; + return result; + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function checks that two boolean values are the same (both are True +or both are False). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool aresameboolean(ae_bool v1, ae_bool v2, ae_state *_state) +{ + ae_bool result; + + + result = (v1&&v2)||(!v1&&!v2); + return result; +} + + +/************************************************************************* +If Length(X)cntcntcnt0&&n>0 ) + { + if( x->rowscolsrows; + n2 = x->cols; + ae_swap_matrices(x, &oldx); + ae_matrix_set_length(x, m, n, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( iptr.pp_double[i][j] = oldx.ptr.pp_double[i][j]; + } + else + { + x->ptr.pp_double[i][j] = 0.0; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Resizes X and: +* preserves old contents of X +* fills new elements by zeros + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +void imatrixresize(/* Integer */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix oldx; + ae_int_t i; + ae_int_t j; + ae_int_t m2; + ae_int_t n2; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init(&oldx, 0, 0, DT_INT, _state, ae_true); + + m2 = x->rows; + n2 = x->cols; + ae_swap_matrices(x, &oldx); + ae_matrix_set_length(x, m, n, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( iptr.pp_int[i][j] = oldx.ptr.pp_int[i][j]; + } + else + { + x->ptr.pp_int[i][j] = 0; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function checks that length(X) is at least N and first N values from +X[] are finite + + -- ALGLIB -- + Copyright 18.06.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool isfinitevector(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_bool result; + + + ae_assert(n>=0, "APSERVIsFiniteVector: internal error (N<0)", _state); + if( n==0 ) + { + result = ae_true; + return result; + } + if( x->cntptr.p_double[i], _state) ) + { + result = ae_false; + return result; + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function checks that first N values from X[] are finite + + -- ALGLIB -- + Copyright 18.06.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool isfinitecvector(/* Complex */ ae_vector* z, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_bool result; + + + ae_assert(n>=0, "APSERVIsFiniteCVector: internal error (N<0)", _state); + for(i=0; i<=n-1; i++) + { + if( !ae_isfinite(z->ptr.p_complex[i].x, _state)||!ae_isfinite(z->ptr.p_complex[i].y, _state) ) + { + result = ae_false; + return result; + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function checks that size of X is at least MxN and values from +X[0..M-1,0..N-1] are finite. + + -- ALGLIB -- + Copyright 18.06.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool apservisfinitematrix(/* Real */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_bool result; + + + ae_assert(n>=0, "APSERVIsFiniteMatrix: internal error (N<0)", _state); + ae_assert(m>=0, "APSERVIsFiniteMatrix: internal error (M<0)", _state); + if( m==0||n==0 ) + { + result = ae_true; + return result; + } + if( x->rowscolsptr.pp_double[i][j], _state) ) + { + result = ae_false; + return result; + } + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function checks that all values from X[0..M-1,0..N-1] are finite + + -- ALGLIB -- + Copyright 18.06.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool apservisfinitecmatrix(/* Complex */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_bool result; + + + ae_assert(n>=0, "APSERVIsFiniteCMatrix: internal error (N<0)", _state); + ae_assert(m>=0, "APSERVIsFiniteCMatrix: internal error (M<0)", _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( !ae_isfinite(x->ptr.pp_complex[i][j].x, _state)||!ae_isfinite(x->ptr.pp_complex[i][j].y, _state) ) + { + result = ae_false; + return result; + } + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function checks that size of X is at least NxN and all values from +upper/lower triangle of X[0..N-1,0..N-1] are finite + + -- ALGLIB -- + Copyright 18.06.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool isfinitertrmatrix(/* Real */ ae_matrix* x, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j1; + ae_int_t j2; + ae_int_t j; + ae_bool result; + + + ae_assert(n>=0, "APSERVIsFiniteRTRMatrix: internal error (N<0)", _state); + if( n==0 ) + { + result = ae_true; + return result; + } + if( x->rowscolsptr.pp_double[i][j], _state) ) + { + result = ae_false; + return result; + } + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function checks that all values from upper/lower triangle of +X[0..N-1,0..N-1] are finite + + -- ALGLIB -- + Copyright 18.06.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool apservisfinitectrmatrix(/* Complex */ ae_matrix* x, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j1; + ae_int_t j2; + ae_int_t j; + ae_bool result; + + + ae_assert(n>=0, "APSERVIsFiniteCTRMatrix: internal error (N<0)", _state); + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + if( !ae_isfinite(x->ptr.pp_complex[i][j].x, _state)||!ae_isfinite(x->ptr.pp_complex[i][j].y, _state) ) + { + result = ae_false; + return result; + } + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function checks that all values from X[0..M-1,0..N-1] are finite or +NaN's. + + -- ALGLIB -- + Copyright 18.06.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool apservisfiniteornanmatrix(/* Real */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_bool result; + + + ae_assert(n>=0, "APSERVIsFiniteOrNaNMatrix: internal error (N<0)", _state); + ae_assert(m>=0, "APSERVIsFiniteOrNaNMatrix: internal error (M<0)", _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( !(ae_isfinite(x->ptr.pp_double[i][j], _state)||ae_isnan(x->ptr.pp_double[i][j], _state)) ) + { + result = ae_false; + return result; + } + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +Safe sqrt(x^2+y^2) + + -- ALGLIB -- + Copyright by Bochkanov Sergey +*************************************************************************/ +double safepythag2(double x, double y, ae_state *_state) +{ + double w; + double xabs; + double yabs; + double z; + double result; + + + xabs = ae_fabs(x, _state); + yabs = ae_fabs(y, _state); + w = ae_maxreal(xabs, yabs, _state); + z = ae_minreal(xabs, yabs, _state); + if( ae_fp_eq(z,0) ) + { + result = w; + } + else + { + result = w*ae_sqrt(1+ae_sqr(z/w, _state), _state); + } + return result; +} + + +/************************************************************************* +Safe sqrt(x^2+y^2) + + -- ALGLIB -- + Copyright by Bochkanov Sergey +*************************************************************************/ +double safepythag3(double x, double y, double z, ae_state *_state) +{ + double w; + double result; + + + w = ae_maxreal(ae_fabs(x, _state), ae_maxreal(ae_fabs(y, _state), ae_fabs(z, _state), _state), _state); + if( ae_fp_eq(w,0) ) + { + result = 0; + return result; + } + x = x/w; + y = y/w; + z = z/w; + result = w*ae_sqrt(ae_sqr(x, _state)+ae_sqr(y, _state)+ae_sqr(z, _state), _state); + return result; +} + + +/************************************************************************* +Safe division. + +This function attempts to calculate R=X/Y without overflow. + +It returns: +* +1, if abs(X/Y)>=MaxRealNumber or undefined - overflow-like situation + (no overlfow is generated, R is either NAN, PosINF, NegINF) +* 0, if MinRealNumber0 + (R contains result, may be zero) +* -1, if 00 + */ + if( ae_fp_eq(y,0) ) + { + result = 1; + if( ae_fp_eq(x,0) ) + { + *r = _state->v_nan; + } + if( ae_fp_greater(x,0) ) + { + *r = _state->v_posinf; + } + if( ae_fp_less(x,0) ) + { + *r = _state->v_neginf; + } + return result; + } + if( ae_fp_eq(x,0) ) + { + *r = 0; + result = 0; + return result; + } + + /* + * make Y>0 + */ + if( ae_fp_less(y,0) ) + { + x = -x; + y = -y; + } + + /* + * + */ + if( ae_fp_greater_eq(y,1) ) + { + *r = x/y; + if( ae_fp_less_eq(ae_fabs(*r, _state),ae_minrealnumber) ) + { + result = -1; + *r = 0; + } + else + { + result = 0; + } + } + else + { + if( ae_fp_greater_eq(ae_fabs(x, _state),ae_maxrealnumber*y) ) + { + if( ae_fp_greater(x,0) ) + { + *r = _state->v_posinf; + } + else + { + *r = _state->v_neginf; + } + result = 1; + } + else + { + *r = x/y; + result = 0; + } + } + return result; +} + + +/************************************************************************* +This function calculates "safe" min(X/Y,V) for positive finite X, Y, V. +No overflow is generated in any case. + + -- ALGLIB -- + Copyright by Bochkanov Sergey +*************************************************************************/ +double safeminposrv(double x, double y, double v, ae_state *_state) +{ + double r; + double result; + + + if( ae_fp_greater_eq(y,1) ) + { + + /* + * Y>=1, we can safely divide by Y + */ + r = x/y; + result = v; + if( ae_fp_greater(v,r) ) + { + result = r; + } + else + { + result = v; + } + } + else + { + + /* + * Y<1, we can safely multiply by Y + */ + if( ae_fp_less(x,v*y) ) + { + result = x/y; + } + else + { + result = v; + } + } + return result; +} + + +/************************************************************************* +This function makes periodic mapping of X to [A,B]. + +It accepts X, A, B (A>B). It returns T which lies in [A,B] and integer K, +such that X = T + K*(B-A). + +NOTES: +* K is represented as real value, although actually it is integer +* T is guaranteed to be in [A,B] +* T replaces X + + -- ALGLIB -- + Copyright by Bochkanov Sergey +*************************************************************************/ +void apperiodicmap(double* x, + double a, + double b, + double* k, + ae_state *_state) +{ + + *k = 0; + + ae_assert(ae_fp_less(a,b), "APPeriodicMap: internal error!", _state); + *k = ae_ifloor((*x-a)/(b-a), _state); + *x = *x-*k*(b-a); + while(ae_fp_less(*x,a)) + { + *x = *x+(b-a); + *k = *k-1; + } + while(ae_fp_greater(*x,b)) + { + *x = *x-(b-a); + *k = *k+1; + } + *x = ae_maxreal(*x, a, _state); + *x = ae_minreal(*x, b, _state); +} + + +/************************************************************************* +Returns random normal number using low-quality system-provided generator + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +double randomnormal(ae_state *_state) +{ + double u; + double v; + double s; + double result; + + + for(;;) + { + u = 2*ae_randomreal(_state)-1; + v = 2*ae_randomreal(_state)-1; + s = ae_sqr(u, _state)+ae_sqr(v, _state); + if( ae_fp_greater(s,0)&&ae_fp_less(s,1) ) + { + + /* + * two Sqrt's instead of one to + * avoid overflow when S is too small + */ + s = ae_sqrt(-2*ae_log(s, _state), _state)/ae_sqrt(s, _state); + result = u*s; + return result; + } + } + return result; +} + + +/************************************************************************* +Generates random unit vector using low-quality system-provided generator. +Reallocates array if its size is too short. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +void randomunit(ae_int_t n, /* Real */ ae_vector* x, ae_state *_state) +{ + ae_int_t i; + double v; + double vv; + + + ae_assert(n>0, "RandomUnit: N<=0", _state); + if( x->cntptr.p_double[i] = vv; + v = v+vv*vv; + } + } + while(ae_fp_less_eq(v,0)); + v = 1/ae_sqrt(v, _state); + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = x->ptr.p_double[i]*v; + } +} + + +/************************************************************************* +This function is used to increment value of integer variable +*************************************************************************/ +void inc(ae_int_t* v, ae_state *_state) +{ + + + *v = *v+1; +} + + +/************************************************************************* +This function is used to decrement value of integer variable +*************************************************************************/ +void dec(ae_int_t* v, ae_state *_state) +{ + + + *v = *v-1; +} + + +/************************************************************************* +This function performs two operations: +1. decrements value of integer variable, if it is positive +2. explicitly sets variable to zero if it is non-positive +It is used by some algorithms to decrease value of internal counters. +*************************************************************************/ +void countdown(ae_int_t* v, ae_state *_state) +{ + + + if( *v>0 ) + { + *v = *v-1; + } + else + { + *v = 0; + } +} + + +/************************************************************************* +'bounds' value: maps X to [B1,B2] + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +double boundval(double x, double b1, double b2, ae_state *_state) +{ + double result; + + + if( ae_fp_less_eq(x,b1) ) + { + result = b1; + return result; + } + if( ae_fp_greater_eq(x,b2) ) + { + result = b2; + return result; + } + result = x; + return result; +} + + +/************************************************************************* +Allocation of serializer: complex value +*************************************************************************/ +void alloccomplex(ae_serializer* s, ae_complex v, ae_state *_state) +{ + + + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); +} + + +/************************************************************************* +Serialization: complex value +*************************************************************************/ +void serializecomplex(ae_serializer* s, ae_complex v, ae_state *_state) +{ + + + ae_serializer_serialize_double(s, v.x, _state); + ae_serializer_serialize_double(s, v.y, _state); +} + + +/************************************************************************* +Unserialization: complex value +*************************************************************************/ +ae_complex unserializecomplex(ae_serializer* s, ae_state *_state) +{ + ae_complex result; + + + ae_serializer_unserialize_double(s, &result.x, _state); + ae_serializer_unserialize_double(s, &result.y, _state); + return result; +} + + +/************************************************************************* +Allocation of serializer: real array +*************************************************************************/ +void allocrealarray(ae_serializer* s, + /* Real */ ae_vector* v, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + + + if( n<0 ) + { + n = v->cnt; + } + ae_serializer_alloc_entry(s); + for(i=0; i<=n-1; i++) + { + ae_serializer_alloc_entry(s); + } +} + + +/************************************************************************* +Serialization: complex value +*************************************************************************/ +void serializerealarray(ae_serializer* s, + /* Real */ ae_vector* v, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + + + if( n<0 ) + { + n = v->cnt; + } + ae_serializer_serialize_int(s, n, _state); + for(i=0; i<=n-1; i++) + { + ae_serializer_serialize_double(s, v->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +Unserialization: complex value +*************************************************************************/ +void unserializerealarray(ae_serializer* s, + /* Real */ ae_vector* v, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + double t; + + ae_vector_clear(v); + + ae_serializer_unserialize_int(s, &n, _state); + if( n==0 ) + { + return; + } + ae_vector_set_length(v, n, _state); + for(i=0; i<=n-1; i++) + { + ae_serializer_unserialize_double(s, &t, _state); + v->ptr.p_double[i] = t; + } +} + + +/************************************************************************* +Allocation of serializer: Integer array +*************************************************************************/ +void allocintegerarray(ae_serializer* s, + /* Integer */ ae_vector* v, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + + + if( n<0 ) + { + n = v->cnt; + } + ae_serializer_alloc_entry(s); + for(i=0; i<=n-1; i++) + { + ae_serializer_alloc_entry(s); + } +} + + +/************************************************************************* +Serialization: Integer array +*************************************************************************/ +void serializeintegerarray(ae_serializer* s, + /* Integer */ ae_vector* v, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + + + if( n<0 ) + { + n = v->cnt; + } + ae_serializer_serialize_int(s, n, _state); + for(i=0; i<=n-1; i++) + { + ae_serializer_serialize_int(s, v->ptr.p_int[i], _state); + } +} + + +/************************************************************************* +Unserialization: complex value +*************************************************************************/ +void unserializeintegerarray(ae_serializer* s, + /* Integer */ ae_vector* v, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t t; + + ae_vector_clear(v); + + ae_serializer_unserialize_int(s, &n, _state); + if( n==0 ) + { + return; + } + ae_vector_set_length(v, n, _state); + for(i=0; i<=n-1; i++) + { + ae_serializer_unserialize_int(s, &t, _state); + v->ptr.p_int[i] = t; + } +} + + +/************************************************************************* +Allocation of serializer: real matrix +*************************************************************************/ +void allocrealmatrix(ae_serializer* s, + /* Real */ ae_matrix* v, + ae_int_t n0, + ae_int_t n1, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + + if( n0<0 ) + { + n0 = v->rows; + } + if( n1<0 ) + { + n1 = v->cols; + } + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + for(i=0; i<=n0-1; i++) + { + for(j=0; j<=n1-1; j++) + { + ae_serializer_alloc_entry(s); + } + } +} + + +/************************************************************************* +Serialization: complex value +*************************************************************************/ +void serializerealmatrix(ae_serializer* s, + /* Real */ ae_matrix* v, + ae_int_t n0, + ae_int_t n1, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + + if( n0<0 ) + { + n0 = v->rows; + } + if( n1<0 ) + { + n1 = v->cols; + } + ae_serializer_serialize_int(s, n0, _state); + ae_serializer_serialize_int(s, n1, _state); + for(i=0; i<=n0-1; i++) + { + for(j=0; j<=n1-1; j++) + { + ae_serializer_serialize_double(s, v->ptr.pp_double[i][j], _state); + } + } +} + + +/************************************************************************* +Unserialization: complex value +*************************************************************************/ +void unserializerealmatrix(ae_serializer* s, + /* Real */ ae_matrix* v, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n0; + ae_int_t n1; + double t; + + ae_matrix_clear(v); + + ae_serializer_unserialize_int(s, &n0, _state); + ae_serializer_unserialize_int(s, &n1, _state); + if( n0==0||n1==0 ) + { + return; + } + ae_matrix_set_length(v, n0, n1, _state); + for(i=0; i<=n0-1; i++) + { + for(j=0; j<=n1-1; j++) + { + ae_serializer_unserialize_double(s, &t, _state); + v->ptr.pp_double[i][j] = t; + } + } +} + + +/************************************************************************* +Copy integer array +*************************************************************************/ +void copyintegerarray(/* Integer */ ae_vector* src, + /* Integer */ ae_vector* dst, + ae_state *_state) +{ + ae_int_t i; + + ae_vector_clear(dst); + + if( src->cnt>0 ) + { + ae_vector_set_length(dst, src->cnt, _state); + for(i=0; i<=src->cnt-1; i++) + { + dst->ptr.p_int[i] = src->ptr.p_int[i]; + } + } +} + + +/************************************************************************* +Copy real array +*************************************************************************/ +void copyrealarray(/* Real */ ae_vector* src, + /* Real */ ae_vector* dst, + ae_state *_state) +{ + ae_int_t i; + + ae_vector_clear(dst); + + if( src->cnt>0 ) + { + ae_vector_set_length(dst, src->cnt, _state); + for(i=0; i<=src->cnt-1; i++) + { + dst->ptr.p_double[i] = src->ptr.p_double[i]; + } + } +} + + +/************************************************************************* +Copy real matrix +*************************************************************************/ +void copyrealmatrix(/* Real */ ae_matrix* src, + /* Real */ ae_matrix* dst, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + ae_matrix_clear(dst); + + if( src->rows>0&&src->cols>0 ) + { + ae_matrix_set_length(dst, src->rows, src->cols, _state); + for(i=0; i<=src->rows-1; i++) + { + for(j=0; j<=src->cols-1; j++) + { + dst->ptr.pp_double[i][j] = src->ptr.pp_double[i][j]; + } + } + } +} + + +/************************************************************************* +This function searches integer array. Elements in this array are actually +records, each NRec elements wide. Each record has unique header - NHeader +integer values, which identify it. Records are lexicographically sorted by +header. + +Records are identified by their index, not offset (offset = NRec*index). + +This function searches A (records with indices [I0,I1)) for a record with +header B. It returns index of this record (not offset!), or -1 on failure. + + -- ALGLIB -- + Copyright 28.03.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t recsearch(/* Integer */ ae_vector* a, + ae_int_t nrec, + ae_int_t nheader, + ae_int_t i0, + ae_int_t i1, + /* Integer */ ae_vector* b, + ae_state *_state) +{ + ae_int_t mididx; + ae_int_t cflag; + ae_int_t k; + ae_int_t offs; + ae_int_t result; + + + result = -1; + for(;;) + { + if( i0>=i1 ) + { + break; + } + mididx = (i0+i1)/2; + offs = nrec*mididx; + cflag = 0; + for(k=0; k<=nheader-1; k++) + { + if( a->ptr.p_int[offs+k]ptr.p_int[k] ) + { + cflag = -1; + break; + } + if( a->ptr.p_int[offs+k]>b->ptr.p_int[k] ) + { + cflag = 1; + break; + } + } + if( cflag==0 ) + { + result = mididx; + return result; + } + if( cflag<0 ) + { + i0 = mididx+1; + } + else + { + i1 = mididx; + } + } + return result; +} + + +/************************************************************************* +This function is used in parallel functions for recurrent division of large +task into two smaller tasks. + +It has following properties: +* it works only for TaskSize>=2 (assertion is thrown otherwise) +* for TaskSize=2, it returns Task0=1, Task1=1 +* in case TaskSize is odd, Task0=TaskSize-1, Task1=1 +* in case TaskSize is even, Task0 and Task1 are approximately TaskSize/2 + and both Task0 and Task1 are even, Task0>=Task1 + + -- ALGLIB -- + Copyright 07.04.2013 by Bochkanov Sergey +*************************************************************************/ +void splitlengtheven(ae_int_t tasksize, + ae_int_t* task0, + ae_int_t* task1, + ae_state *_state) +{ + + *task0 = 0; + *task1 = 0; + + ae_assert(tasksize>=2, "SplitLengthEven: TaskSize<2", _state); + if( tasksize==2 ) + { + *task0 = 1; + *task1 = 1; + return; + } + if( tasksize%2==0 ) + { + + /* + * Even division + */ + *task0 = tasksize/2; + *task1 = tasksize/2; + if( *task0%2!=0 ) + { + *task0 = *task0+1; + *task1 = *task1-1; + } + } + else + { + + /* + * Odd task size, split trailing odd part from it. + */ + *task0 = tasksize-1; + *task1 = 1; + } + ae_assert(*task0>=1, "SplitLengthEven: internal error", _state); + ae_assert(*task1>=1, "SplitLengthEven: internal error", _state); +} + + +/************************************************************************* +This function is used in parallel functions for recurrent division of large +task into two smaller tasks. + +It has following properties: +* it works only for TaskSize>=2 and ChunkSize>=2 + (assertion is thrown otherwise) +* Task0+Task1=TaskSize, Task0>0, Task1>0 +* Task0 and Task1 are close to each other +* in case TaskSize>ChunkSize, Task0 is always divisible by ChunkSize + + -- ALGLIB -- + Copyright 07.04.2013 by Bochkanov Sergey +*************************************************************************/ +void splitlength(ae_int_t tasksize, + ae_int_t chunksize, + ae_int_t* task0, + ae_int_t* task1, + ae_state *_state) +{ + + *task0 = 0; + *task1 = 0; + + ae_assert(chunksize>=2, "SplitLength: ChunkSize<2", _state); + ae_assert(tasksize>=2, "SplitLength: TaskSize<2", _state); + *task0 = tasksize/2; + if( *task0>chunksize&&*task0%chunksize!=0 ) + { + *task0 = *task0-*task0%chunksize; + } + *task1 = tasksize-(*task0); + ae_assert(*task0>=1, "SplitLength: internal error", _state); + ae_assert(*task1>=1, "SplitLength: internal error", _state); +} + + +ae_bool _apbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + apbuffers *p = (apbuffers*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->ia0, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ia1, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ia2, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ia3, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ra0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ra1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ra2, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ra3, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _apbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + apbuffers *dst = (apbuffers*)_dst; + apbuffers *src = (apbuffers*)_src; + if( !ae_vector_init_copy(&dst->ia0, &src->ia0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ia1, &src->ia1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ia2, &src->ia2, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ia3, &src->ia3, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ra0, &src->ra0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ra1, &src->ra1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ra2, &src->ra2, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ra3, &src->ra3, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _apbuffers_clear(void* _p) +{ + apbuffers *p = (apbuffers*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->ia0); + ae_vector_clear(&p->ia1); + ae_vector_clear(&p->ia2); + ae_vector_clear(&p->ia3); + ae_vector_clear(&p->ra0); + ae_vector_clear(&p->ra1); + ae_vector_clear(&p->ra2); + ae_vector_clear(&p->ra3); +} + + +void _apbuffers_destroy(void* _p) +{ + apbuffers *p = (apbuffers*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->ia0); + ae_vector_destroy(&p->ia1); + ae_vector_destroy(&p->ia2); + ae_vector_destroy(&p->ia3); + ae_vector_destroy(&p->ra0); + ae_vector_destroy(&p->ra1); + ae_vector_destroy(&p->ra2); + ae_vector_destroy(&p->ra3); +} + + +ae_bool _sboolean_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + sboolean *p = (sboolean*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _sboolean_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + sboolean *dst = (sboolean*)_dst; + sboolean *src = (sboolean*)_src; + dst->val = src->val; + return ae_true; +} + + +void _sboolean_clear(void* _p) +{ + sboolean *p = (sboolean*)_p; + ae_touch_ptr((void*)p); +} + + +void _sboolean_destroy(void* _p) +{ + sboolean *p = (sboolean*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _sbooleanarray_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + sbooleanarray *p = (sbooleanarray*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->val, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _sbooleanarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + sbooleanarray *dst = (sbooleanarray*)_dst; + sbooleanarray *src = (sbooleanarray*)_src; + if( !ae_vector_init_copy(&dst->val, &src->val, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _sbooleanarray_clear(void* _p) +{ + sbooleanarray *p = (sbooleanarray*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->val); +} + + +void _sbooleanarray_destroy(void* _p) +{ + sbooleanarray *p = (sbooleanarray*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->val); +} + + +ae_bool _sinteger_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + sinteger *p = (sinteger*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _sinteger_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + sinteger *dst = (sinteger*)_dst; + sinteger *src = (sinteger*)_src; + dst->val = src->val; + return ae_true; +} + + +void _sinteger_clear(void* _p) +{ + sinteger *p = (sinteger*)_p; + ae_touch_ptr((void*)p); +} + + +void _sinteger_destroy(void* _p) +{ + sinteger *p = (sinteger*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _sintegerarray_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + sintegerarray *p = (sintegerarray*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->val, 0, DT_INT, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _sintegerarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + sintegerarray *dst = (sintegerarray*)_dst; + sintegerarray *src = (sintegerarray*)_src; + if( !ae_vector_init_copy(&dst->val, &src->val, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _sintegerarray_clear(void* _p) +{ + sintegerarray *p = (sintegerarray*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->val); +} + + +void _sintegerarray_destroy(void* _p) +{ + sintegerarray *p = (sintegerarray*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->val); +} + + +ae_bool _sreal_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + sreal *p = (sreal*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _sreal_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + sreal *dst = (sreal*)_dst; + sreal *src = (sreal*)_src; + dst->val = src->val; + return ae_true; +} + + +void _sreal_clear(void* _p) +{ + sreal *p = (sreal*)_p; + ae_touch_ptr((void*)p); +} + + +void _sreal_destroy(void* _p) +{ + sreal *p = (sreal*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _srealarray_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + srealarray *p = (srealarray*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->val, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _srealarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + srealarray *dst = (srealarray*)_dst; + srealarray *src = (srealarray*)_src; + if( !ae_vector_init_copy(&dst->val, &src->val, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _srealarray_clear(void* _p) +{ + srealarray *p = (srealarray*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->val); +} + + +void _srealarray_destroy(void* _p) +{ + srealarray *p = (srealarray*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->val); +} + + +ae_bool _scomplex_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + scomplex *p = (scomplex*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _scomplex_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + scomplex *dst = (scomplex*)_dst; + scomplex *src = (scomplex*)_src; + dst->val = src->val; + return ae_true; +} + + +void _scomplex_clear(void* _p) +{ + scomplex *p = (scomplex*)_p; + ae_touch_ptr((void*)p); +} + + +void _scomplex_destroy(void* _p) +{ + scomplex *p = (scomplex*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _scomplexarray_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + scomplexarray *p = (scomplexarray*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->val, 0, DT_COMPLEX, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _scomplexarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + scomplexarray *dst = (scomplexarray*)_dst; + scomplexarray *src = (scomplexarray*)_src; + if( !ae_vector_init_copy(&dst->val, &src->val, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _scomplexarray_clear(void* _p) +{ + scomplexarray *p = (scomplexarray*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->val); +} + + +void _scomplexarray_destroy(void* _p) +{ + scomplexarray *p = (scomplexarray*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->val); +} + + + + +ae_int_t getrdfserializationcode(ae_state *_state) +{ + ae_int_t result; + + + result = 1; + return result; +} + + +ae_int_t getkdtreeserializationcode(ae_state *_state) +{ + ae_int_t result; + + + result = 2; + return result; +} + + +ae_int_t getmlpserializationcode(ae_state *_state) +{ + ae_int_t result; + + + result = 3; + return result; +} + + +ae_int_t getmlpeserializationcode(ae_state *_state) +{ + ae_int_t result; + + + result = 4; + return result; +} + + +ae_int_t getrbfserializationcode(ae_state *_state) +{ + ae_int_t result; + + + result = 5; + return result; +} + + + + +/************************************************************************* +This function sorts array of real keys by ascending. + +Its results are: +* sorted array A +* permutation tables P1, P2 + +Algorithm outputs permutation tables using two formats: +* as usual permutation of [0..N-1]. If P1[i]=j, then sorted A[i] contains + value which was moved there from J-th position. +* as a sequence of pairwise permutations. Sorted A[] may be obtained by + swaping A[i] and A[P2[i]] for all i from 0 to N-1. + +INPUT PARAMETERS: + A - unsorted array + N - array size + +OUPUT PARAMETERS: + A - sorted array + P1, P2 - permutation tables, array[N] + +NOTES: + this function assumes that A[] is finite; it doesn't checks that + condition. All other conditions (size of input arrays, etc.) are not + checked too. + + -- ALGLIB -- + Copyright 14.05.2008 by Bochkanov Sergey +*************************************************************************/ +void tagsort(/* Real */ ae_vector* a, + ae_int_t n, + /* Integer */ ae_vector* p1, + /* Integer */ ae_vector* p2, + ae_state *_state) +{ + ae_frame _frame_block; + apbuffers buf; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(p1); + ae_vector_clear(p2); + _apbuffers_init(&buf, _state, ae_true); + + tagsortbuf(a, n, p1, p2, &buf, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Buffered variant of TagSort, which accepts preallocated output arrays as +well as special structure for buffered allocations. If arrays are too +short, they are reallocated. If they are large enough, no memory +allocation is done. + +It is intended to be used in the performance-critical parts of code, where +additional allocations can lead to severe performance degradation + + -- ALGLIB -- + Copyright 14.05.2008 by Bochkanov Sergey +*************************************************************************/ +void tagsortbuf(/* Real */ ae_vector* a, + ae_int_t n, + /* Integer */ ae_vector* p1, + /* Integer */ ae_vector* p2, + apbuffers* buf, + ae_state *_state) +{ + ae_int_t i; + ae_int_t lv; + ae_int_t lp; + ae_int_t rv; + ae_int_t rp; + + + + /* + * Special cases + */ + if( n<=0 ) + { + return; + } + if( n==1 ) + { + ivectorsetlengthatleast(p1, 1, _state); + ivectorsetlengthatleast(p2, 1, _state); + p1->ptr.p_int[0] = 0; + p2->ptr.p_int[0] = 0; + return; + } + + /* + * General case, N>1: prepare permutations table P1 + */ + ivectorsetlengthatleast(p1, n, _state); + for(i=0; i<=n-1; i++) + { + p1->ptr.p_int[i] = i; + } + + /* + * General case, N>1: sort, update P1 + */ + rvectorsetlengthatleast(&buf->ra0, n, _state); + ivectorsetlengthatleast(&buf->ia0, n, _state); + tagsortfasti(a, p1, &buf->ra0, &buf->ia0, n, _state); + + /* + * General case, N>1: fill permutations table P2 + * + * To fill P2 we maintain two arrays: + * * PV (Buf.IA0), Position(Value). PV[i] contains position of I-th key at the moment + * * VP (Buf.IA1), Value(Position). VP[i] contains key which has position I at the moment + * + * At each step we making permutation of two items: + * Left, which is given by position/value pair LP/LV + * and Right, which is given by RP/RV + * and updating PV[] and VP[] correspondingly. + */ + ivectorsetlengthatleast(&buf->ia0, n, _state); + ivectorsetlengthatleast(&buf->ia1, n, _state); + ivectorsetlengthatleast(p2, n, _state); + for(i=0; i<=n-1; i++) + { + buf->ia0.ptr.p_int[i] = i; + buf->ia1.ptr.p_int[i] = i; + } + for(i=0; i<=n-1; i++) + { + + /* + * calculate LP, LV, RP, RV + */ + lp = i; + lv = buf->ia1.ptr.p_int[lp]; + rv = p1->ptr.p_int[i]; + rp = buf->ia0.ptr.p_int[rv]; + + /* + * Fill P2 + */ + p2->ptr.p_int[i] = rp; + + /* + * update PV and VP + */ + buf->ia1.ptr.p_int[lp] = rv; + buf->ia1.ptr.p_int[rp] = lv; + buf->ia0.ptr.p_int[lv] = rp; + buf->ia0.ptr.p_int[rv] = lp; + } +} + + +/************************************************************************* +Same as TagSort, but optimized for real keys and integer labels. + +A is sorted, and same permutations are applied to B. + +NOTES: +1. this function assumes that A[] is finite; it doesn't checks that + condition. All other conditions (size of input arrays, etc.) are not + checked too. +2. this function uses two buffers, BufA and BufB, each is N elements large. + They may be preallocated (which will save some time) or not, in which + case function will automatically allocate memory. + + -- ALGLIB -- + Copyright 11.12.2008 by Bochkanov Sergey +*************************************************************************/ +void tagsortfasti(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + /* Real */ ae_vector* bufa, + /* Integer */ ae_vector* bufb, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_bool isascending; + ae_bool isdescending; + double tmpr; + ae_int_t tmpi; + + + + /* + * Special case + */ + if( n<=1 ) + { + return; + } + + /* + * Test for already sorted set + */ + isascending = ae_true; + isdescending = ae_true; + for(i=1; i<=n-1; i++) + { + isascending = isascending&&a->ptr.p_double[i]>=a->ptr.p_double[i-1]; + isdescending = isdescending&&a->ptr.p_double[i]<=a->ptr.p_double[i-1]; + } + if( isascending ) + { + return; + } + if( isdescending ) + { + for(i=0; i<=n-1; i++) + { + j = n-1-i; + if( j<=i ) + { + break; + } + tmpr = a->ptr.p_double[i]; + a->ptr.p_double[i] = a->ptr.p_double[j]; + a->ptr.p_double[j] = tmpr; + tmpi = b->ptr.p_int[i]; + b->ptr.p_int[i] = b->ptr.p_int[j]; + b->ptr.p_int[j] = tmpi; + } + return; + } + + /* + * General case + */ + if( bufa->cntcntptr.p_double[i]>=a->ptr.p_double[i-1]; + isdescending = isdescending&&a->ptr.p_double[i]<=a->ptr.p_double[i-1]; + } + if( isascending ) + { + return; + } + if( isdescending ) + { + for(i=0; i<=n-1; i++) + { + j = n-1-i; + if( j<=i ) + { + break; + } + tmpr = a->ptr.p_double[i]; + a->ptr.p_double[i] = a->ptr.p_double[j]; + a->ptr.p_double[j] = tmpr; + tmpr = b->ptr.p_double[i]; + b->ptr.p_double[i] = b->ptr.p_double[j]; + b->ptr.p_double[j] = tmpr; + } + return; + } + + /* + * General case + */ + if( bufa->cntcntptr.p_double[i]>=a->ptr.p_double[i-1]; + isdescending = isdescending&&a->ptr.p_double[i]<=a->ptr.p_double[i-1]; + } + if( isascending ) + { + return; + } + if( isdescending ) + { + for(i=0; i<=n-1; i++) + { + j = n-1-i; + if( j<=i ) + { + break; + } + tmpr = a->ptr.p_double[i]; + a->ptr.p_double[i] = a->ptr.p_double[j]; + a->ptr.p_double[j] = tmpr; + } + return; + } + + /* + * General case + */ + if( bufa->cnt1: sort, update B + */ + i = 2; + do + { + t = i; + while(t!=1) + { + k = t/2; + if( a->ptr.p_int[offset+k-1]>=a->ptr.p_int[offset+t-1] ) + { + t = 1; + } + else + { + tmp = a->ptr.p_int[offset+k-1]; + a->ptr.p_int[offset+k-1] = a->ptr.p_int[offset+t-1]; + a->ptr.p_int[offset+t-1] = tmp; + tmpr = b->ptr.p_double[offset+k-1]; + b->ptr.p_double[offset+k-1] = b->ptr.p_double[offset+t-1]; + b->ptr.p_double[offset+t-1] = tmpr; + t = k; + } + } + i = i+1; + } + while(i<=n); + i = n-1; + do + { + tmp = a->ptr.p_int[offset+i]; + a->ptr.p_int[offset+i] = a->ptr.p_int[offset+0]; + a->ptr.p_int[offset+0] = tmp; + tmpr = b->ptr.p_double[offset+i]; + b->ptr.p_double[offset+i] = b->ptr.p_double[offset+0]; + b->ptr.p_double[offset+0] = tmpr; + t = 1; + while(t!=0) + { + k = 2*t; + if( k>i ) + { + t = 0; + } + else + { + if( kptr.p_int[offset+k]>a->ptr.p_int[offset+k-1] ) + { + k = k+1; + } + } + if( a->ptr.p_int[offset+t-1]>=a->ptr.p_int[offset+k-1] ) + { + t = 0; + } + else + { + tmp = a->ptr.p_int[offset+k-1]; + a->ptr.p_int[offset+k-1] = a->ptr.p_int[offset+t-1]; + a->ptr.p_int[offset+t-1] = tmp; + tmpr = b->ptr.p_double[offset+k-1]; + b->ptr.p_double[offset+k-1] = b->ptr.p_double[offset+t-1]; + b->ptr.p_double[offset+t-1] = tmpr; + t = k; + } + } + } + i = i-1; + } + while(i>=1); +} + + +/************************************************************************* +Heap operations: adds element to the heap + +PARAMETERS: + A - heap itself, must be at least array[0..N] + B - array of integer tags, which are updated according to + permutations in the heap + N - size of the heap (without new element). + updated on output + VA - value of the element being added + VB - value of the tag + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void tagheappushi(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + ae_int_t* n, + double va, + ae_int_t vb, + ae_state *_state) +{ + ae_int_t j; + ae_int_t k; + double v; + + + if( *n<0 ) + { + return; + } + + /* + * N=0 is a special case + */ + if( *n==0 ) + { + a->ptr.p_double[0] = va; + b->ptr.p_int[0] = vb; + *n = *n+1; + return; + } + + /* + * add current point to the heap + * (add to the bottom, then move up) + * + * we don't write point to the heap + * until its final position is determined + * (it allow us to reduce number of array access operations) + */ + j = *n; + *n = *n+1; + while(j>0) + { + k = (j-1)/2; + v = a->ptr.p_double[k]; + if( ae_fp_less(v,va) ) + { + + /* + * swap with higher element + */ + a->ptr.p_double[j] = v; + b->ptr.p_int[j] = b->ptr.p_int[k]; + j = k; + } + else + { + + /* + * element in its place. terminate. + */ + break; + } + } + a->ptr.p_double[j] = va; + b->ptr.p_int[j] = vb; +} + + +/************************************************************************* +Heap operations: replaces top element with new element +(which is moved down) + +PARAMETERS: + A - heap itself, must be at least array[0..N-1] + B - array of integer tags, which are updated according to + permutations in the heap + N - size of the heap + VA - value of the element which replaces top element + VB - value of the tag + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void tagheapreplacetopi(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + ae_int_t n, + double va, + ae_int_t vb, + ae_state *_state) +{ + ae_int_t j; + ae_int_t k1; + ae_int_t k2; + double v; + double v1; + double v2; + + + if( n<1 ) + { + return; + } + + /* + * N=1 is a special case + */ + if( n==1 ) + { + a->ptr.p_double[0] = va; + b->ptr.p_int[0] = vb; + return; + } + + /* + * move down through heap: + * * J - current element + * * K1 - first child (always exists) + * * K2 - second child (may not exists) + * + * we don't write point to the heap + * until its final position is determined + * (it allow us to reduce number of array access operations) + */ + j = 0; + k1 = 1; + k2 = 2; + while(k1=n ) + { + + /* + * only one child. + * + * swap and terminate (because this child + * have no siblings due to heap structure) + */ + v = a->ptr.p_double[k1]; + if( ae_fp_greater(v,va) ) + { + a->ptr.p_double[j] = v; + b->ptr.p_int[j] = b->ptr.p_int[k1]; + j = k1; + } + break; + } + else + { + + /* + * two childs + */ + v1 = a->ptr.p_double[k1]; + v2 = a->ptr.p_double[k2]; + if( ae_fp_greater(v1,v2) ) + { + if( ae_fp_less(va,v1) ) + { + a->ptr.p_double[j] = v1; + b->ptr.p_int[j] = b->ptr.p_int[k1]; + j = k1; + } + else + { + break; + } + } + else + { + if( ae_fp_less(va,v2) ) + { + a->ptr.p_double[j] = v2; + b->ptr.p_int[j] = b->ptr.p_int[k2]; + j = k2; + } + else + { + break; + } + } + k1 = 2*j+1; + k2 = 2*j+2; + } + } + a->ptr.p_double[j] = va; + b->ptr.p_int[j] = vb; +} + + +/************************************************************************* +Heap operations: pops top element from the heap + +PARAMETERS: + A - heap itself, must be at least array[0..N-1] + B - array of integer tags, which are updated according to + permutations in the heap + N - size of the heap, N>=1 + +On output top element is moved to A[N-1], B[N-1], heap is reordered, N is +decreased by 1. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void tagheappopi(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + ae_int_t* n, + ae_state *_state) +{ + double va; + ae_int_t vb; + + + if( *n<1 ) + { + return; + } + + /* + * N=1 is a special case + */ + if( *n==1 ) + { + *n = 0; + return; + } + + /* + * swap top element and last element, + * then reorder heap + */ + va = a->ptr.p_double[*n-1]; + vb = b->ptr.p_int[*n-1]; + a->ptr.p_double[*n-1] = a->ptr.p_double[0]; + b->ptr.p_int[*n-1] = b->ptr.p_int[0]; + *n = *n-1; + tagheapreplacetopi(a, b, *n, va, vb, _state); +} + + +/************************************************************************* +Search first element less than T in sorted array. + +PARAMETERS: + A - sorted array by ascending from 0 to N-1 + N - number of elements in array + T - the desired element + +RESULT: + The very first element's index, which isn't less than T. +In the case when there aren't such elements, returns N. +*************************************************************************/ +ae_int_t lowerbound(/* Real */ ae_vector* a, + ae_int_t n, + double t, + ae_state *_state) +{ + ae_int_t l; + ae_int_t half; + ae_int_t first; + ae_int_t middle; + ae_int_t result; + + + l = n; + first = 0; + while(l>0) + { + half = l/2; + middle = first+half; + if( ae_fp_less(a->ptr.p_double[middle],t) ) + { + first = middle+1; + l = l-half-1; + } + else + { + l = half; + } + } + result = first; + return result; +} + + +/************************************************************************* +Search first element more than T in sorted array. + +PARAMETERS: + A - sorted array by ascending from 0 to N-1 + N - number of elements in array + T - the desired element + + RESULT: + The very first element's index, which more than T. +In the case when there aren't such elements, returns N. +*************************************************************************/ +ae_int_t upperbound(/* Real */ ae_vector* a, + ae_int_t n, + double t, + ae_state *_state) +{ + ae_int_t l; + ae_int_t half; + ae_int_t first; + ae_int_t middle; + ae_int_t result; + + + l = n; + first = 0; + while(l>0) + { + half = l/2; + middle = first+half; + if( ae_fp_less(t,a->ptr.p_double[middle]) ) + { + l = half; + } + else + { + first = middle+1; + l = l-half-1; + } + } + result = first; + return result; +} + + +/************************************************************************* +Internal TagSortFastI: sorts A[I1...I2] (both bounds are included), +applies same permutations to B. + + -- ALGLIB -- + Copyright 06.09.2010 by Bochkanov Sergey +*************************************************************************/ +static void tsort_tagsortfastirec(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + /* Real */ ae_vector* bufa, + /* Integer */ ae_vector* bufb, + ae_int_t i1, + ae_int_t i2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t cntless; + ae_int_t cnteq; + ae_int_t cntgreater; + double tmpr; + ae_int_t tmpi; + double v0; + double v1; + double v2; + double vp; + + + + /* + * Fast exit + */ + if( i2<=i1 ) + { + return; + } + + /* + * Non-recursive sort for small arrays + */ + if( i2-i1<=16 ) + { + for(j=i1+1; j<=i2; j++) + { + + /* + * Search elements [I1..J-1] for place to insert Jth element. + * + * This code stops immediately if we can leave A[J] at J-th position + * (all elements have same value of A[J] larger than any of them) + */ + tmpr = a->ptr.p_double[j]; + tmpi = j; + for(k=j-1; k>=i1; k--) + { + if( a->ptr.p_double[k]<=tmpr ) + { + break; + } + tmpi = k; + } + k = tmpi; + + /* + * Insert Jth element into Kth position + */ + if( k!=j ) + { + tmpr = a->ptr.p_double[j]; + tmpi = b->ptr.p_int[j]; + for(i=j-1; i>=k; i--) + { + a->ptr.p_double[i+1] = a->ptr.p_double[i]; + b->ptr.p_int[i+1] = b->ptr.p_int[i]; + } + a->ptr.p_double[k] = tmpr; + b->ptr.p_int[k] = tmpi; + } + } + return; + } + + /* + * Quicksort: choose pivot + * Here we assume that I2-I1>=2 + */ + v0 = a->ptr.p_double[i1]; + v1 = a->ptr.p_double[i1+(i2-i1)/2]; + v2 = a->ptr.p_double[i2]; + if( v0>v1 ) + { + tmpr = v1; + v1 = v0; + v0 = tmpr; + } + if( v1>v2 ) + { + tmpr = v2; + v2 = v1; + v1 = tmpr; + } + if( v0>v1 ) + { + tmpr = v1; + v1 = v0; + v0 = tmpr; + } + vp = v1; + + /* + * now pass through A/B and: + * * move elements that are LESS than VP to the left of A/B + * * move elements that are EQUAL to VP to the right of BufA/BufB (in the reverse order) + * * move elements that are GREATER than VP to the left of BufA/BufB (in the normal order + * * move elements from the tail of BufA/BufB to the middle of A/B (restoring normal order) + * * move elements from the left of BufA/BufB to the end of A/B + */ + cntless = 0; + cnteq = 0; + cntgreater = 0; + for(i=i1; i<=i2; i++) + { + v0 = a->ptr.p_double[i]; + if( v0ptr.p_double[k] = v0; + b->ptr.p_int[k] = b->ptr.p_int[i]; + } + cntless = cntless+1; + continue; + } + if( v0==vp ) + { + + /* + * EQUAL + */ + k = i2-cnteq; + bufa->ptr.p_double[k] = v0; + bufb->ptr.p_int[k] = b->ptr.p_int[i]; + cnteq = cnteq+1; + continue; + } + + /* + * GREATER + */ + k = i1+cntgreater; + bufa->ptr.p_double[k] = v0; + bufb->ptr.p_int[k] = b->ptr.p_int[i]; + cntgreater = cntgreater+1; + } + for(i=0; i<=cnteq-1; i++) + { + j = i1+cntless+cnteq-1-i; + k = i2+i-(cnteq-1); + a->ptr.p_double[j] = bufa->ptr.p_double[k]; + b->ptr.p_int[j] = bufb->ptr.p_int[k]; + } + for(i=0; i<=cntgreater-1; i++) + { + j = i1+cntless+cnteq+i; + k = i1+i; + a->ptr.p_double[j] = bufa->ptr.p_double[k]; + b->ptr.p_int[j] = bufb->ptr.p_int[k]; + } + + /* + * Sort left and right parts of the array (ignoring middle part) + */ + tsort_tagsortfastirec(a, b, bufa, bufb, i1, i1+cntless-1, _state); + tsort_tagsortfastirec(a, b, bufa, bufb, i1+cntless+cnteq, i2, _state); +} + + +/************************************************************************* +Internal TagSortFastR: sorts A[I1...I2] (both bounds are included), +applies same permutations to B. + + -- ALGLIB -- + Copyright 06.09.2010 by Bochkanov Sergey +*************************************************************************/ +static void tsort_tagsortfastrrec(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* bufa, + /* Real */ ae_vector* bufb, + ae_int_t i1, + ae_int_t i2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + double tmpr; + double tmpr2; + ae_int_t tmpi; + ae_int_t cntless; + ae_int_t cnteq; + ae_int_t cntgreater; + double v0; + double v1; + double v2; + double vp; + + + + /* + * Fast exit + */ + if( i2<=i1 ) + { + return; + } + + /* + * Non-recursive sort for small arrays + */ + if( i2-i1<=16 ) + { + for(j=i1+1; j<=i2; j++) + { + + /* + * Search elements [I1..J-1] for place to insert Jth element. + * + * This code stops immediatly if we can leave A[J] at J-th position + * (all elements have same value of A[J] larger than any of them) + */ + tmpr = a->ptr.p_double[j]; + tmpi = j; + for(k=j-1; k>=i1; k--) + { + if( a->ptr.p_double[k]<=tmpr ) + { + break; + } + tmpi = k; + } + k = tmpi; + + /* + * Insert Jth element into Kth position + */ + if( k!=j ) + { + tmpr = a->ptr.p_double[j]; + tmpr2 = b->ptr.p_double[j]; + for(i=j-1; i>=k; i--) + { + a->ptr.p_double[i+1] = a->ptr.p_double[i]; + b->ptr.p_double[i+1] = b->ptr.p_double[i]; + } + a->ptr.p_double[k] = tmpr; + b->ptr.p_double[k] = tmpr2; + } + } + return; + } + + /* + * Quicksort: choose pivot + * Here we assume that I2-I1>=16 + */ + v0 = a->ptr.p_double[i1]; + v1 = a->ptr.p_double[i1+(i2-i1)/2]; + v2 = a->ptr.p_double[i2]; + if( v0>v1 ) + { + tmpr = v1; + v1 = v0; + v0 = tmpr; + } + if( v1>v2 ) + { + tmpr = v2; + v2 = v1; + v1 = tmpr; + } + if( v0>v1 ) + { + tmpr = v1; + v1 = v0; + v0 = tmpr; + } + vp = v1; + + /* + * now pass through A/B and: + * * move elements that are LESS than VP to the left of A/B + * * move elements that are EQUAL to VP to the right of BufA/BufB (in the reverse order) + * * move elements that are GREATER than VP to the left of BufA/BufB (in the normal order + * * move elements from the tail of BufA/BufB to the middle of A/B (restoring normal order) + * * move elements from the left of BufA/BufB to the end of A/B + */ + cntless = 0; + cnteq = 0; + cntgreater = 0; + for(i=i1; i<=i2; i++) + { + v0 = a->ptr.p_double[i]; + if( v0ptr.p_double[k] = v0; + b->ptr.p_double[k] = b->ptr.p_double[i]; + } + cntless = cntless+1; + continue; + } + if( v0==vp ) + { + + /* + * EQUAL + */ + k = i2-cnteq; + bufa->ptr.p_double[k] = v0; + bufb->ptr.p_double[k] = b->ptr.p_double[i]; + cnteq = cnteq+1; + continue; + } + + /* + * GREATER + */ + k = i1+cntgreater; + bufa->ptr.p_double[k] = v0; + bufb->ptr.p_double[k] = b->ptr.p_double[i]; + cntgreater = cntgreater+1; + } + for(i=0; i<=cnteq-1; i++) + { + j = i1+cntless+cnteq-1-i; + k = i2+i-(cnteq-1); + a->ptr.p_double[j] = bufa->ptr.p_double[k]; + b->ptr.p_double[j] = bufb->ptr.p_double[k]; + } + for(i=0; i<=cntgreater-1; i++) + { + j = i1+cntless+cnteq+i; + k = i1+i; + a->ptr.p_double[j] = bufa->ptr.p_double[k]; + b->ptr.p_double[j] = bufb->ptr.p_double[k]; + } + + /* + * Sort left and right parts of the array (ignoring middle part) + */ + tsort_tagsortfastrrec(a, b, bufa, bufb, i1, i1+cntless-1, _state); + tsort_tagsortfastrrec(a, b, bufa, bufb, i1+cntless+cnteq, i2, _state); +} + + +/************************************************************************* +Internal TagSortFastI: sorts A[I1...I2] (both bounds are included), +applies same permutations to B. + + -- ALGLIB -- + Copyright 06.09.2010 by Bochkanov Sergey +*************************************************************************/ +static void tsort_tagsortfastrec(/* Real */ ae_vector* a, + /* Real */ ae_vector* bufa, + ae_int_t i1, + ae_int_t i2, + ae_state *_state) +{ + ae_int_t cntless; + ae_int_t cnteq; + ae_int_t cntgreater; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double tmpr; + ae_int_t tmpi; + double v0; + double v1; + double v2; + double vp; + + + + /* + * Fast exit + */ + if( i2<=i1 ) + { + return; + } + + /* + * Non-recursive sort for small arrays + */ + if( i2-i1<=16 ) + { + for(j=i1+1; j<=i2; j++) + { + + /* + * Search elements [I1..J-1] for place to insert Jth element. + * + * This code stops immediatly if we can leave A[J] at J-th position + * (all elements have same value of A[J] larger than any of them) + */ + tmpr = a->ptr.p_double[j]; + tmpi = j; + for(k=j-1; k>=i1; k--) + { + if( a->ptr.p_double[k]<=tmpr ) + { + break; + } + tmpi = k; + } + k = tmpi; + + /* + * Insert Jth element into Kth position + */ + if( k!=j ) + { + tmpr = a->ptr.p_double[j]; + for(i=j-1; i>=k; i--) + { + a->ptr.p_double[i+1] = a->ptr.p_double[i]; + } + a->ptr.p_double[k] = tmpr; + } + } + return; + } + + /* + * Quicksort: choose pivot + * Here we assume that I2-I1>=16 + */ + v0 = a->ptr.p_double[i1]; + v1 = a->ptr.p_double[i1+(i2-i1)/2]; + v2 = a->ptr.p_double[i2]; + if( v0>v1 ) + { + tmpr = v1; + v1 = v0; + v0 = tmpr; + } + if( v1>v2 ) + { + tmpr = v2; + v2 = v1; + v1 = tmpr; + } + if( v0>v1 ) + { + tmpr = v1; + v1 = v0; + v0 = tmpr; + } + vp = v1; + + /* + * now pass through A/B and: + * * move elements that are LESS than VP to the left of A/B + * * move elements that are EQUAL to VP to the right of BufA/BufB (in the reverse order) + * * move elements that are GREATER than VP to the left of BufA/BufB (in the normal order + * * move elements from the tail of BufA/BufB to the middle of A/B (restoring normal order) + * * move elements from the left of BufA/BufB to the end of A/B + */ + cntless = 0; + cnteq = 0; + cntgreater = 0; + for(i=i1; i<=i2; i++) + { + v0 = a->ptr.p_double[i]; + if( v0ptr.p_double[k] = v0; + } + cntless = cntless+1; + continue; + } + if( v0==vp ) + { + + /* + * EQUAL + */ + k = i2-cnteq; + bufa->ptr.p_double[k] = v0; + cnteq = cnteq+1; + continue; + } + + /* + * GREATER + */ + k = i1+cntgreater; + bufa->ptr.p_double[k] = v0; + cntgreater = cntgreater+1; + } + for(i=0; i<=cnteq-1; i++) + { + j = i1+cntless+cnteq-1-i; + k = i2+i-(cnteq-1); + a->ptr.p_double[j] = bufa->ptr.p_double[k]; + } + for(i=0; i<=cntgreater-1; i++) + { + j = i1+cntless+cnteq+i; + k = i1+i; + a->ptr.p_double[j] = bufa->ptr.p_double[k]; + } + + /* + * Sort left and right parts of the array (ignoring middle part) + */ + tsort_tagsortfastrec(a, bufa, i1, i1+cntless-1, _state); + tsort_tagsortfastrec(a, bufa, i1+cntless+cnteq, i2, _state); +} + + + + +/************************************************************************* +Internal ranking subroutine. + +INPUT PARAMETERS: + X - array to rank + N - array size + IsCentered- whether ranks are centered or not: + * True - ranks are centered in such way that their + sum is zero + * False - ranks are not centered + Buf - temporary buffers + +NOTE: when IsCentered is True and all X[] are equal, this function fills + X by zeros (exact zeros are used, not sum which is only approximately + equal to zero). +*************************************************************************/ +void rankx(/* Real */ ae_vector* x, + ae_int_t n, + ae_bool iscentered, + apbuffers* buf, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + double tmp; + double voffs; + + + + /* + * Prepare + */ + if( n<1 ) + { + return; + } + if( n==1 ) + { + x->ptr.p_double[0] = 0; + return; + } + if( buf->ra1.cntra1, n, _state); + } + if( buf->ia1.cntia1, n, _state); + } + for(i=0; i<=n-1; i++) + { + buf->ra1.ptr.p_double[i] = x->ptr.p_double[i]; + buf->ia1.ptr.p_int[i] = i; + } + tagsortfasti(&buf->ra1, &buf->ia1, &buf->ra2, &buf->ia2, n, _state); + + /* + * Special test for all values being equal + */ + if( ae_fp_eq(buf->ra1.ptr.p_double[0],buf->ra1.ptr.p_double[n-1]) ) + { + if( iscentered ) + { + tmp = 0.0; + } + else + { + tmp = (double)(n-1)/(double)2; + } + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = tmp; + } + return; + } + + /* + * compute tied ranks + */ + i = 0; + while(i<=n-1) + { + j = i+1; + while(j<=n-1) + { + if( ae_fp_neq(buf->ra1.ptr.p_double[j],buf->ra1.ptr.p_double[i]) ) + { + break; + } + j = j+1; + } + for(k=i; k<=j-1; k++) + { + buf->ra1.ptr.p_double[k] = (double)(i+j-1)/(double)2; + } + i = j; + } + + /* + * back to x + */ + if( iscentered ) + { + voffs = (double)(n-1)/(double)2; + } + else + { + voffs = 0.0; + } + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[buf->ia1.ptr.p_int[i]] = buf->ra1.ptr.p_double[i]-voffs; + } +} + + + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool cmatrixrank1f(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Complex */ ae_vector* u, + ae_int_t iu, + /* Complex */ ae_vector* v, + ae_int_t iv, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_cmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixrank1f(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_vector* u, + ae_int_t iu, + /* Real */ ae_vector* v, + ae_int_t iv, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_rmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool cmatrixmvf(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t opa, + /* Complex */ ae_vector* x, + ae_int_t ix, + /* Complex */ ae_vector* y, + ae_int_t iy, + ae_state *_state) +{ + ae_bool result; + + + result = ae_false; + return result; +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixmvf(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t opa, + /* Real */ ae_vector* x, + ae_int_t ix, + /* Real */ ae_vector* y, + ae_int_t iy, + ae_state *_state) +{ + ae_bool result; + + + result = ae_false; + return result; +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool cmatrixrighttrsmf(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_cmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool cmatrixlefttrsmf(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_cmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixrighttrsmf(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_rmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixlefttrsmf(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_rmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool cmatrixsyrkf(ae_int_t n, + ae_int_t k, + double alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_cmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixsyrkf(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_rmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixgemmf(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_rmatrixgemmf(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc); +#endif +} + + +/************************************************************************* +Fast kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool cmatrixgemmf(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_ABLAS + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_cmatrixgemmf(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc); +#endif +} + + +/************************************************************************* +CMatrixGEMM kernel, basecase code for CMatrixGEMM. + +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: +* 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 + * 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 - PREALLOCATED output matrix + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 27.03.2013 + Bochkanov Sergey +*************************************************************************/ +void cmatrixgemmk(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_complex v; + ae_complex v00; + ae_complex v01; + ae_complex v10; + ae_complex v11; + double v00x; + double v00y; + double v01x; + double v01y; + double v10x; + double v10y; + double v11x; + double v11y; + double a0x; + double a0y; + double a1x; + double a1y; + double b0x; + double b0y; + double b1x; + double b1y; + ae_int_t idxa0; + ae_int_t idxa1; + ae_int_t idxb0; + ae_int_t idxb1; + ae_int_t i0; + ae_int_t i1; + ae_int_t ik; + ae_int_t j0; + ae_int_t j1; + ae_int_t jk; + ae_int_t t; + ae_int_t offsa; + ae_int_t offsb; + + + + /* + * if matrix size is zero + */ + if( m==0||n==0 ) + { + return; + } + + /* + * Try optimized code + */ + if( cmatrixgemmf(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state) ) + { + return; + } + + /* + * if K=0, then C=Beta*C + */ + if( k==0 ) + { + if( ae_c_neq_d(beta,1) ) + { + if( ae_c_neq_d(beta,0) ) + { + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + c->ptr.pp_complex[ic+i][jc+j] = ae_c_mul(beta,c->ptr.pp_complex[ic+i][jc+j]); + } + } + } + else + { + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + c->ptr.pp_complex[ic+i][jc+j] = ae_complex_from_d(0); + } + } + } + } + return; + } + + /* + * This phase is not really necessary, but compiler complains + * about "possibly uninitialized variables" + */ + a0x = 0; + a0y = 0; + a1x = 0; + a1y = 0; + b0x = 0; + b0y = 0; + b1x = 0; + b1y = 0; + + /* + * General case + */ + i = 0; + while(iptr.pp_complex[idxa0][offsa].x; + a0y = a->ptr.pp_complex[idxa0][offsa].y; + a1x = a->ptr.pp_complex[idxa1][offsa].x; + a1y = a->ptr.pp_complex[idxa1][offsa].y; + } + if( optypea==1 ) + { + a0x = a->ptr.pp_complex[offsa][idxa0].x; + a0y = a->ptr.pp_complex[offsa][idxa0].y; + a1x = a->ptr.pp_complex[offsa][idxa1].x; + a1y = a->ptr.pp_complex[offsa][idxa1].y; + } + if( optypea==2 ) + { + a0x = a->ptr.pp_complex[offsa][idxa0].x; + a0y = -a->ptr.pp_complex[offsa][idxa0].y; + a1x = a->ptr.pp_complex[offsa][idxa1].x; + a1y = -a->ptr.pp_complex[offsa][idxa1].y; + } + if( optypeb==0 ) + { + b0x = b->ptr.pp_complex[offsb][idxb0].x; + b0y = b->ptr.pp_complex[offsb][idxb0].y; + b1x = b->ptr.pp_complex[offsb][idxb1].x; + b1y = b->ptr.pp_complex[offsb][idxb1].y; + } + if( optypeb==1 ) + { + b0x = b->ptr.pp_complex[idxb0][offsb].x; + b0y = b->ptr.pp_complex[idxb0][offsb].y; + b1x = b->ptr.pp_complex[idxb1][offsb].x; + b1y = b->ptr.pp_complex[idxb1][offsb].y; + } + if( optypeb==2 ) + { + b0x = b->ptr.pp_complex[idxb0][offsb].x; + b0y = -b->ptr.pp_complex[idxb0][offsb].y; + b1x = b->ptr.pp_complex[idxb1][offsb].x; + b1y = -b->ptr.pp_complex[idxb1][offsb].y; + } + v00x = v00x+a0x*b0x-a0y*b0y; + v00y = v00y+a0x*b0y+a0y*b0x; + v01x = v01x+a0x*b1x-a0y*b1y; + v01y = v01y+a0x*b1y+a0y*b1x; + v10x = v10x+a1x*b0x-a1y*b0y; + v10y = v10y+a1x*b0y+a1y*b0x; + v11x = v11x+a1x*b1x-a1y*b1y; + v11y = v11y+a1x*b1y+a1y*b1x; + offsa = offsa+1; + offsb = offsb+1; + } + v00.x = v00x; + v00.y = v00y; + v10.x = v10x; + v10.y = v10y; + v01.x = v01x; + v01.y = v01y; + v11.x = v11x; + v11.y = v11y; + if( ae_c_eq_d(beta,0) ) + { + c->ptr.pp_complex[ic+i+0][jc+j+0] = ae_c_mul(alpha,v00); + c->ptr.pp_complex[ic+i+0][jc+j+1] = ae_c_mul(alpha,v01); + c->ptr.pp_complex[ic+i+1][jc+j+0] = ae_c_mul(alpha,v10); + c->ptr.pp_complex[ic+i+1][jc+j+1] = ae_c_mul(alpha,v11); + } + else + { + c->ptr.pp_complex[ic+i+0][jc+j+0] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i+0][jc+j+0]),ae_c_mul(alpha,v00)); + c->ptr.pp_complex[ic+i+0][jc+j+1] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i+0][jc+j+1]),ae_c_mul(alpha,v01)); + c->ptr.pp_complex[ic+i+1][jc+j+0] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i+1][jc+j+0]),ae_c_mul(alpha,v10)); + c->ptr.pp_complex[ic+i+1][jc+j+1] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i+1][jc+j+1]),ae_c_mul(alpha,v11)); + } + } + else + { + + /* + * Determine submatrix [I0..I1]x[J0..J1] to process + */ + i0 = i; + i1 = ae_minint(i+1, m-1, _state); + j0 = j; + j1 = ae_minint(j+1, n-1, _state); + + /* + * Process submatrix + */ + for(ik=i0; ik<=i1; ik++) + { + for(jk=j0; jk<=j1; jk++) + { + if( k==0||ae_c_eq_d(alpha,0) ) + { + v = ae_complex_from_d(0); + } + else + { + v = ae_complex_from_d(0.0); + if( optypea==0&&optypeb==0 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+ik][ja], 1, "N", &b->ptr.pp_complex[ib][jb+jk], b->stride, "N", ae_v_len(ja,ja+k-1)); + } + if( optypea==0&&optypeb==1 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+ik][ja], 1, "N", &b->ptr.pp_complex[ib+jk][jb], 1, "N", ae_v_len(ja,ja+k-1)); + } + if( optypea==0&&optypeb==2 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+ik][ja], 1, "N", &b->ptr.pp_complex[ib+jk][jb], 1, "Conj", ae_v_len(ja,ja+k-1)); + } + if( optypea==1&&optypeb==0 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "N", &b->ptr.pp_complex[ib][jb+jk], b->stride, "N", ae_v_len(ia,ia+k-1)); + } + if( optypea==1&&optypeb==1 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "N", &b->ptr.pp_complex[ib+jk][jb], 1, "N", ae_v_len(ia,ia+k-1)); + } + if( optypea==1&&optypeb==2 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "N", &b->ptr.pp_complex[ib+jk][jb], 1, "Conj", ae_v_len(ia,ia+k-1)); + } + if( optypea==2&&optypeb==0 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "Conj", &b->ptr.pp_complex[ib][jb+jk], b->stride, "N", ae_v_len(ia,ia+k-1)); + } + if( optypea==2&&optypeb==1 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "Conj", &b->ptr.pp_complex[ib+jk][jb], 1, "N", ae_v_len(ia,ia+k-1)); + } + if( optypea==2&&optypeb==2 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+ik], a->stride, "Conj", &b->ptr.pp_complex[ib+jk][jb], 1, "Conj", ae_v_len(ia,ia+k-1)); + } + } + if( ae_c_eq_d(beta,0) ) + { + c->ptr.pp_complex[ic+ik][jc+jk] = ae_c_mul(alpha,v); + } + else + { + c->ptr.pp_complex[ic+ik][jc+jk] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+ik][jc+jk]),ae_c_mul(alpha,v)); + } + } + } + } + j = j+2; + } + i = i+2; + } +} + + +/************************************************************************* +RMatrixGEMM kernel, basecase code for RMatrixGEMM. + +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: +* 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 + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 27.03.2013 + Bochkanov Sergey +*************************************************************************/ +void rmatrixgemmk(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + + + /* + * if matrix size is zero + */ + if( m==0||n==0 ) + { + return; + } + + /* + * Try optimized code + */ + if( rmatrixgemmf(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state) ) + { + return; + } + + /* + * if K=0, then C=Beta*C + */ + if( k==0||ae_fp_eq(alpha,0) ) + { + if( ae_fp_neq(beta,1) ) + { + if( ae_fp_neq(beta,0) ) + { + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + c->ptr.pp_double[ic+i][jc+j] = beta*c->ptr.pp_double[ic+i][jc+j]; + } + } + } + else + { + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + c->ptr.pp_double[ic+i][jc+j] = 0; + } + } + } + } + return; + } + + /* + * Call specialized code. + * + * NOTE: specialized code was moved to separate function because of strange + * issues with instructions cache on some systems; Having too long + * functions significantly slows down internal loop of the algorithm. + */ + if( optypea==0&&optypeb==0 ) + { + rmatrixgemmk44v00(m, n, k, alpha, a, ia, ja, b, ib, jb, beta, c, ic, jc, _state); + } + if( optypea==0&&optypeb!=0 ) + { + rmatrixgemmk44v01(m, n, k, alpha, a, ia, ja, b, ib, jb, beta, c, ic, jc, _state); + } + if( optypea!=0&&optypeb==0 ) + { + rmatrixgemmk44v10(m, n, k, alpha, a, ia, ja, b, ib, jb, beta, c, ic, jc, _state); + } + if( optypea!=0&&optypeb!=0 ) + { + rmatrixgemmk44v11(m, n, k, alpha, a, ia, ja, b, ib, jb, beta, c, ic, jc, _state); + } +} + + +/************************************************************************* +RMatrixGEMM kernel, basecase code for RMatrixGEMM, specialized for sitation +with OpTypeA=0 and OpTypeB=0. + +Additional info: +* this function requires that Alpha<>0 (assertion is thrown otherwise) + +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 + B - matrix + IB - submatrix offset + JB - submatrix offset + Beta - coefficient + C - PREALLOCATED output matrix + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 27.03.2013 + Bochkanov Sergey +*************************************************************************/ +void rmatrixgemmk44v00(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double v; + double v00; + double v01; + double v02; + double v03; + double v10; + double v11; + double v12; + double v13; + double v20; + double v21; + double v22; + double v23; + double v30; + double v31; + double v32; + double v33; + double a0; + double a1; + double a2; + double a3; + double b0; + double b1; + double b2; + double b3; + ae_int_t idxa0; + ae_int_t idxa1; + ae_int_t idxa2; + ae_int_t idxa3; + ae_int_t idxb0; + ae_int_t idxb1; + ae_int_t idxb2; + ae_int_t idxb3; + ae_int_t i0; + ae_int_t i1; + ae_int_t ik; + ae_int_t j0; + ae_int_t j1; + ae_int_t jk; + ae_int_t t; + ae_int_t offsa; + ae_int_t offsb; + + + ae_assert(ae_fp_neq(alpha,0), "RMatrixGEMMK44V00: internal error (Alpha=0)", _state); + + /* + * if matrix size is zero + */ + if( m==0||n==0 ) + { + return; + } + + /* + * A*B + */ + i = 0; + while(iptr.pp_double[idxa0][offsa]; + a1 = a->ptr.pp_double[idxa1][offsa]; + b0 = b->ptr.pp_double[offsb][idxb0]; + b1 = b->ptr.pp_double[offsb][idxb1]; + v00 = v00+a0*b0; + v01 = v01+a0*b1; + v10 = v10+a1*b0; + v11 = v11+a1*b1; + a2 = a->ptr.pp_double[idxa2][offsa]; + a3 = a->ptr.pp_double[idxa3][offsa]; + v20 = v20+a2*b0; + v21 = v21+a2*b1; + v30 = v30+a3*b0; + v31 = v31+a3*b1; + b2 = b->ptr.pp_double[offsb][idxb2]; + b3 = b->ptr.pp_double[offsb][idxb3]; + v22 = v22+a2*b2; + v23 = v23+a2*b3; + v32 = v32+a3*b2; + v33 = v33+a3*b3; + v02 = v02+a0*b2; + v03 = v03+a0*b3; + v12 = v12+a1*b2; + v13 = v13+a1*b3; + offsa = offsa+1; + offsb = offsb+1; + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+i+0][jc+j+0] = alpha*v00; + c->ptr.pp_double[ic+i+0][jc+j+1] = alpha*v01; + c->ptr.pp_double[ic+i+0][jc+j+2] = alpha*v02; + c->ptr.pp_double[ic+i+0][jc+j+3] = alpha*v03; + c->ptr.pp_double[ic+i+1][jc+j+0] = alpha*v10; + c->ptr.pp_double[ic+i+1][jc+j+1] = alpha*v11; + c->ptr.pp_double[ic+i+1][jc+j+2] = alpha*v12; + c->ptr.pp_double[ic+i+1][jc+j+3] = alpha*v13; + c->ptr.pp_double[ic+i+2][jc+j+0] = alpha*v20; + c->ptr.pp_double[ic+i+2][jc+j+1] = alpha*v21; + c->ptr.pp_double[ic+i+2][jc+j+2] = alpha*v22; + c->ptr.pp_double[ic+i+2][jc+j+3] = alpha*v23; + c->ptr.pp_double[ic+i+3][jc+j+0] = alpha*v30; + c->ptr.pp_double[ic+i+3][jc+j+1] = alpha*v31; + c->ptr.pp_double[ic+i+3][jc+j+2] = alpha*v32; + c->ptr.pp_double[ic+i+3][jc+j+3] = alpha*v33; + } + else + { + c->ptr.pp_double[ic+i+0][jc+j+0] = beta*c->ptr.pp_double[ic+i+0][jc+j+0]+alpha*v00; + c->ptr.pp_double[ic+i+0][jc+j+1] = beta*c->ptr.pp_double[ic+i+0][jc+j+1]+alpha*v01; + c->ptr.pp_double[ic+i+0][jc+j+2] = beta*c->ptr.pp_double[ic+i+0][jc+j+2]+alpha*v02; + c->ptr.pp_double[ic+i+0][jc+j+3] = beta*c->ptr.pp_double[ic+i+0][jc+j+3]+alpha*v03; + c->ptr.pp_double[ic+i+1][jc+j+0] = beta*c->ptr.pp_double[ic+i+1][jc+j+0]+alpha*v10; + c->ptr.pp_double[ic+i+1][jc+j+1] = beta*c->ptr.pp_double[ic+i+1][jc+j+1]+alpha*v11; + c->ptr.pp_double[ic+i+1][jc+j+2] = beta*c->ptr.pp_double[ic+i+1][jc+j+2]+alpha*v12; + c->ptr.pp_double[ic+i+1][jc+j+3] = beta*c->ptr.pp_double[ic+i+1][jc+j+3]+alpha*v13; + c->ptr.pp_double[ic+i+2][jc+j+0] = beta*c->ptr.pp_double[ic+i+2][jc+j+0]+alpha*v20; + c->ptr.pp_double[ic+i+2][jc+j+1] = beta*c->ptr.pp_double[ic+i+2][jc+j+1]+alpha*v21; + c->ptr.pp_double[ic+i+2][jc+j+2] = beta*c->ptr.pp_double[ic+i+2][jc+j+2]+alpha*v22; + c->ptr.pp_double[ic+i+2][jc+j+3] = beta*c->ptr.pp_double[ic+i+2][jc+j+3]+alpha*v23; + c->ptr.pp_double[ic+i+3][jc+j+0] = beta*c->ptr.pp_double[ic+i+3][jc+j+0]+alpha*v30; + c->ptr.pp_double[ic+i+3][jc+j+1] = beta*c->ptr.pp_double[ic+i+3][jc+j+1]+alpha*v31; + c->ptr.pp_double[ic+i+3][jc+j+2] = beta*c->ptr.pp_double[ic+i+3][jc+j+2]+alpha*v32; + c->ptr.pp_double[ic+i+3][jc+j+3] = beta*c->ptr.pp_double[ic+i+3][jc+j+3]+alpha*v33; + } + } + else + { + + /* + * Determine submatrix [I0..I1]x[J0..J1] to process + */ + i0 = i; + i1 = ae_minint(i+3, m-1, _state); + j0 = j; + j1 = ae_minint(j+3, n-1, _state); + + /* + * Process submatrix + */ + for(ik=i0; ik<=i1; ik++) + { + for(jk=j0; jk<=j1; jk++) + { + if( k==0||ae_fp_eq(alpha,0) ) + { + v = 0; + } + else + { + v = ae_v_dotproduct(&a->ptr.pp_double[ia+ik][ja], 1, &b->ptr.pp_double[ib][jb+jk], b->stride, ae_v_len(ja,ja+k-1)); + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+ik][jc+jk] = alpha*v; + } + else + { + c->ptr.pp_double[ic+ik][jc+jk] = beta*c->ptr.pp_double[ic+ik][jc+jk]+alpha*v; + } + } + } + } + j = j+4; + } + i = i+4; + } +} + + +/************************************************************************* +RMatrixGEMM kernel, basecase code for RMatrixGEMM, specialized for sitation +with OpTypeA=0 and OpTypeB=1. + +Additional info: +* this function requires that Alpha<>0 (assertion is thrown otherwise) + +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 + B - matrix + IB - submatrix offset + JB - submatrix offset + Beta - coefficient + C - PREALLOCATED output matrix + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 27.03.2013 + Bochkanov Sergey +*************************************************************************/ +void rmatrixgemmk44v01(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double v; + double v00; + double v01; + double v02; + double v03; + double v10; + double v11; + double v12; + double v13; + double v20; + double v21; + double v22; + double v23; + double v30; + double v31; + double v32; + double v33; + double a0; + double a1; + double a2; + double a3; + double b0; + double b1; + double b2; + double b3; + ae_int_t idxa0; + ae_int_t idxa1; + ae_int_t idxa2; + ae_int_t idxa3; + ae_int_t idxb0; + ae_int_t idxb1; + ae_int_t idxb2; + ae_int_t idxb3; + ae_int_t i0; + ae_int_t i1; + ae_int_t ik; + ae_int_t j0; + ae_int_t j1; + ae_int_t jk; + ae_int_t t; + ae_int_t offsa; + ae_int_t offsb; + + + ae_assert(ae_fp_neq(alpha,0), "RMatrixGEMMK44V00: internal error (Alpha=0)", _state); + + /* + * if matrix size is zero + */ + if( m==0||n==0 ) + { + return; + } + + /* + * A*B' + */ + i = 0; + while(iptr.pp_double[idxa0][offsa]; + a1 = a->ptr.pp_double[idxa1][offsa]; + b0 = b->ptr.pp_double[idxb0][offsb]; + b1 = b->ptr.pp_double[idxb1][offsb]; + v00 = v00+a0*b0; + v01 = v01+a0*b1; + v10 = v10+a1*b0; + v11 = v11+a1*b1; + a2 = a->ptr.pp_double[idxa2][offsa]; + a3 = a->ptr.pp_double[idxa3][offsa]; + v20 = v20+a2*b0; + v21 = v21+a2*b1; + v30 = v30+a3*b0; + v31 = v31+a3*b1; + b2 = b->ptr.pp_double[idxb2][offsb]; + b3 = b->ptr.pp_double[idxb3][offsb]; + v22 = v22+a2*b2; + v23 = v23+a2*b3; + v32 = v32+a3*b2; + v33 = v33+a3*b3; + v02 = v02+a0*b2; + v03 = v03+a0*b3; + v12 = v12+a1*b2; + v13 = v13+a1*b3; + offsa = offsa+1; + offsb = offsb+1; + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+i+0][jc+j+0] = alpha*v00; + c->ptr.pp_double[ic+i+0][jc+j+1] = alpha*v01; + c->ptr.pp_double[ic+i+0][jc+j+2] = alpha*v02; + c->ptr.pp_double[ic+i+0][jc+j+3] = alpha*v03; + c->ptr.pp_double[ic+i+1][jc+j+0] = alpha*v10; + c->ptr.pp_double[ic+i+1][jc+j+1] = alpha*v11; + c->ptr.pp_double[ic+i+1][jc+j+2] = alpha*v12; + c->ptr.pp_double[ic+i+1][jc+j+3] = alpha*v13; + c->ptr.pp_double[ic+i+2][jc+j+0] = alpha*v20; + c->ptr.pp_double[ic+i+2][jc+j+1] = alpha*v21; + c->ptr.pp_double[ic+i+2][jc+j+2] = alpha*v22; + c->ptr.pp_double[ic+i+2][jc+j+3] = alpha*v23; + c->ptr.pp_double[ic+i+3][jc+j+0] = alpha*v30; + c->ptr.pp_double[ic+i+3][jc+j+1] = alpha*v31; + c->ptr.pp_double[ic+i+3][jc+j+2] = alpha*v32; + c->ptr.pp_double[ic+i+3][jc+j+3] = alpha*v33; + } + else + { + c->ptr.pp_double[ic+i+0][jc+j+0] = beta*c->ptr.pp_double[ic+i+0][jc+j+0]+alpha*v00; + c->ptr.pp_double[ic+i+0][jc+j+1] = beta*c->ptr.pp_double[ic+i+0][jc+j+1]+alpha*v01; + c->ptr.pp_double[ic+i+0][jc+j+2] = beta*c->ptr.pp_double[ic+i+0][jc+j+2]+alpha*v02; + c->ptr.pp_double[ic+i+0][jc+j+3] = beta*c->ptr.pp_double[ic+i+0][jc+j+3]+alpha*v03; + c->ptr.pp_double[ic+i+1][jc+j+0] = beta*c->ptr.pp_double[ic+i+1][jc+j+0]+alpha*v10; + c->ptr.pp_double[ic+i+1][jc+j+1] = beta*c->ptr.pp_double[ic+i+1][jc+j+1]+alpha*v11; + c->ptr.pp_double[ic+i+1][jc+j+2] = beta*c->ptr.pp_double[ic+i+1][jc+j+2]+alpha*v12; + c->ptr.pp_double[ic+i+1][jc+j+3] = beta*c->ptr.pp_double[ic+i+1][jc+j+3]+alpha*v13; + c->ptr.pp_double[ic+i+2][jc+j+0] = beta*c->ptr.pp_double[ic+i+2][jc+j+0]+alpha*v20; + c->ptr.pp_double[ic+i+2][jc+j+1] = beta*c->ptr.pp_double[ic+i+2][jc+j+1]+alpha*v21; + c->ptr.pp_double[ic+i+2][jc+j+2] = beta*c->ptr.pp_double[ic+i+2][jc+j+2]+alpha*v22; + c->ptr.pp_double[ic+i+2][jc+j+3] = beta*c->ptr.pp_double[ic+i+2][jc+j+3]+alpha*v23; + c->ptr.pp_double[ic+i+3][jc+j+0] = beta*c->ptr.pp_double[ic+i+3][jc+j+0]+alpha*v30; + c->ptr.pp_double[ic+i+3][jc+j+1] = beta*c->ptr.pp_double[ic+i+3][jc+j+1]+alpha*v31; + c->ptr.pp_double[ic+i+3][jc+j+2] = beta*c->ptr.pp_double[ic+i+3][jc+j+2]+alpha*v32; + c->ptr.pp_double[ic+i+3][jc+j+3] = beta*c->ptr.pp_double[ic+i+3][jc+j+3]+alpha*v33; + } + } + else + { + + /* + * Determine submatrix [I0..I1]x[J0..J1] to process + */ + i0 = i; + i1 = ae_minint(i+3, m-1, _state); + j0 = j; + j1 = ae_minint(j+3, n-1, _state); + + /* + * Process submatrix + */ + for(ik=i0; ik<=i1; ik++) + { + for(jk=j0; jk<=j1; jk++) + { + if( k==0||ae_fp_eq(alpha,0) ) + { + v = 0; + } + else + { + v = ae_v_dotproduct(&a->ptr.pp_double[ia+ik][ja], 1, &b->ptr.pp_double[ib+jk][jb], 1, ae_v_len(ja,ja+k-1)); + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+ik][jc+jk] = alpha*v; + } + else + { + c->ptr.pp_double[ic+ik][jc+jk] = beta*c->ptr.pp_double[ic+ik][jc+jk]+alpha*v; + } + } + } + } + j = j+4; + } + i = i+4; + } +} + + +/************************************************************************* +RMatrixGEMM kernel, basecase code for RMatrixGEMM, specialized for sitation +with OpTypeA=1 and OpTypeB=0. + +Additional info: +* this function requires that Alpha<>0 (assertion is thrown otherwise) + +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 + B - matrix + IB - submatrix offset + JB - submatrix offset + Beta - coefficient + C - PREALLOCATED output matrix + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 27.03.2013 + Bochkanov Sergey +*************************************************************************/ +void rmatrixgemmk44v10(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double v; + double v00; + double v01; + double v02; + double v03; + double v10; + double v11; + double v12; + double v13; + double v20; + double v21; + double v22; + double v23; + double v30; + double v31; + double v32; + double v33; + double a0; + double a1; + double a2; + double a3; + double b0; + double b1; + double b2; + double b3; + ae_int_t idxa0; + ae_int_t idxa1; + ae_int_t idxa2; + ae_int_t idxa3; + ae_int_t idxb0; + ae_int_t idxb1; + ae_int_t idxb2; + ae_int_t idxb3; + ae_int_t i0; + ae_int_t i1; + ae_int_t ik; + ae_int_t j0; + ae_int_t j1; + ae_int_t jk; + ae_int_t t; + ae_int_t offsa; + ae_int_t offsb; + + + ae_assert(ae_fp_neq(alpha,0), "RMatrixGEMMK44V00: internal error (Alpha=0)", _state); + + /* + * if matrix size is zero + */ + if( m==0||n==0 ) + { + return; + } + + /* + * A'*B + */ + i = 0; + while(iptr.pp_double[offsa][idxa0]; + a1 = a->ptr.pp_double[offsa][idxa1]; + b0 = b->ptr.pp_double[offsb][idxb0]; + b1 = b->ptr.pp_double[offsb][idxb1]; + v00 = v00+a0*b0; + v01 = v01+a0*b1; + v10 = v10+a1*b0; + v11 = v11+a1*b1; + a2 = a->ptr.pp_double[offsa][idxa2]; + a3 = a->ptr.pp_double[offsa][idxa3]; + v20 = v20+a2*b0; + v21 = v21+a2*b1; + v30 = v30+a3*b0; + v31 = v31+a3*b1; + b2 = b->ptr.pp_double[offsb][idxb2]; + b3 = b->ptr.pp_double[offsb][idxb3]; + v22 = v22+a2*b2; + v23 = v23+a2*b3; + v32 = v32+a3*b2; + v33 = v33+a3*b3; + v02 = v02+a0*b2; + v03 = v03+a0*b3; + v12 = v12+a1*b2; + v13 = v13+a1*b3; + offsa = offsa+1; + offsb = offsb+1; + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+i+0][jc+j+0] = alpha*v00; + c->ptr.pp_double[ic+i+0][jc+j+1] = alpha*v01; + c->ptr.pp_double[ic+i+0][jc+j+2] = alpha*v02; + c->ptr.pp_double[ic+i+0][jc+j+3] = alpha*v03; + c->ptr.pp_double[ic+i+1][jc+j+0] = alpha*v10; + c->ptr.pp_double[ic+i+1][jc+j+1] = alpha*v11; + c->ptr.pp_double[ic+i+1][jc+j+2] = alpha*v12; + c->ptr.pp_double[ic+i+1][jc+j+3] = alpha*v13; + c->ptr.pp_double[ic+i+2][jc+j+0] = alpha*v20; + c->ptr.pp_double[ic+i+2][jc+j+1] = alpha*v21; + c->ptr.pp_double[ic+i+2][jc+j+2] = alpha*v22; + c->ptr.pp_double[ic+i+2][jc+j+3] = alpha*v23; + c->ptr.pp_double[ic+i+3][jc+j+0] = alpha*v30; + c->ptr.pp_double[ic+i+3][jc+j+1] = alpha*v31; + c->ptr.pp_double[ic+i+3][jc+j+2] = alpha*v32; + c->ptr.pp_double[ic+i+3][jc+j+3] = alpha*v33; + } + else + { + c->ptr.pp_double[ic+i+0][jc+j+0] = beta*c->ptr.pp_double[ic+i+0][jc+j+0]+alpha*v00; + c->ptr.pp_double[ic+i+0][jc+j+1] = beta*c->ptr.pp_double[ic+i+0][jc+j+1]+alpha*v01; + c->ptr.pp_double[ic+i+0][jc+j+2] = beta*c->ptr.pp_double[ic+i+0][jc+j+2]+alpha*v02; + c->ptr.pp_double[ic+i+0][jc+j+3] = beta*c->ptr.pp_double[ic+i+0][jc+j+3]+alpha*v03; + c->ptr.pp_double[ic+i+1][jc+j+0] = beta*c->ptr.pp_double[ic+i+1][jc+j+0]+alpha*v10; + c->ptr.pp_double[ic+i+1][jc+j+1] = beta*c->ptr.pp_double[ic+i+1][jc+j+1]+alpha*v11; + c->ptr.pp_double[ic+i+1][jc+j+2] = beta*c->ptr.pp_double[ic+i+1][jc+j+2]+alpha*v12; + c->ptr.pp_double[ic+i+1][jc+j+3] = beta*c->ptr.pp_double[ic+i+1][jc+j+3]+alpha*v13; + c->ptr.pp_double[ic+i+2][jc+j+0] = beta*c->ptr.pp_double[ic+i+2][jc+j+0]+alpha*v20; + c->ptr.pp_double[ic+i+2][jc+j+1] = beta*c->ptr.pp_double[ic+i+2][jc+j+1]+alpha*v21; + c->ptr.pp_double[ic+i+2][jc+j+2] = beta*c->ptr.pp_double[ic+i+2][jc+j+2]+alpha*v22; + c->ptr.pp_double[ic+i+2][jc+j+3] = beta*c->ptr.pp_double[ic+i+2][jc+j+3]+alpha*v23; + c->ptr.pp_double[ic+i+3][jc+j+0] = beta*c->ptr.pp_double[ic+i+3][jc+j+0]+alpha*v30; + c->ptr.pp_double[ic+i+3][jc+j+1] = beta*c->ptr.pp_double[ic+i+3][jc+j+1]+alpha*v31; + c->ptr.pp_double[ic+i+3][jc+j+2] = beta*c->ptr.pp_double[ic+i+3][jc+j+2]+alpha*v32; + c->ptr.pp_double[ic+i+3][jc+j+3] = beta*c->ptr.pp_double[ic+i+3][jc+j+3]+alpha*v33; + } + } + else + { + + /* + * Determine submatrix [I0..I1]x[J0..J1] to process + */ + i0 = i; + i1 = ae_minint(i+3, m-1, _state); + j0 = j; + j1 = ae_minint(j+3, n-1, _state); + + /* + * Process submatrix + */ + for(ik=i0; ik<=i1; ik++) + { + for(jk=j0; jk<=j1; jk++) + { + if( k==0||ae_fp_eq(alpha,0) ) + { + v = 0; + } + else + { + v = 0.0; + v = ae_v_dotproduct(&a->ptr.pp_double[ia][ja+ik], a->stride, &b->ptr.pp_double[ib][jb+jk], b->stride, ae_v_len(ia,ia+k-1)); + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+ik][jc+jk] = alpha*v; + } + else + { + c->ptr.pp_double[ic+ik][jc+jk] = beta*c->ptr.pp_double[ic+ik][jc+jk]+alpha*v; + } + } + } + } + j = j+4; + } + i = i+4; + } +} + + +/************************************************************************* +RMatrixGEMM kernel, basecase code for RMatrixGEMM, specialized for sitation +with OpTypeA=1 and OpTypeB=1. + +Additional info: +* this function requires that Alpha<>0 (assertion is thrown otherwise) + +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 + B - matrix + IB - submatrix offset + JB - submatrix offset + Beta - coefficient + C - PREALLOCATED output matrix + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 27.03.2013 + Bochkanov Sergey +*************************************************************************/ +void rmatrixgemmk44v11(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double v; + double v00; + double v01; + double v02; + double v03; + double v10; + double v11; + double v12; + double v13; + double v20; + double v21; + double v22; + double v23; + double v30; + double v31; + double v32; + double v33; + double a0; + double a1; + double a2; + double a3; + double b0; + double b1; + double b2; + double b3; + ae_int_t idxa0; + ae_int_t idxa1; + ae_int_t idxa2; + ae_int_t idxa3; + ae_int_t idxb0; + ae_int_t idxb1; + ae_int_t idxb2; + ae_int_t idxb3; + ae_int_t i0; + ae_int_t i1; + ae_int_t ik; + ae_int_t j0; + ae_int_t j1; + ae_int_t jk; + ae_int_t t; + ae_int_t offsa; + ae_int_t offsb; + + + ae_assert(ae_fp_neq(alpha,0), "RMatrixGEMMK44V00: internal error (Alpha=0)", _state); + + /* + * if matrix size is zero + */ + if( m==0||n==0 ) + { + return; + } + + /* + * A'*B' + */ + i = 0; + while(iptr.pp_double[offsa][idxa0]; + a1 = a->ptr.pp_double[offsa][idxa1]; + b0 = b->ptr.pp_double[idxb0][offsb]; + b1 = b->ptr.pp_double[idxb1][offsb]; + v00 = v00+a0*b0; + v01 = v01+a0*b1; + v10 = v10+a1*b0; + v11 = v11+a1*b1; + a2 = a->ptr.pp_double[offsa][idxa2]; + a3 = a->ptr.pp_double[offsa][idxa3]; + v20 = v20+a2*b0; + v21 = v21+a2*b1; + v30 = v30+a3*b0; + v31 = v31+a3*b1; + b2 = b->ptr.pp_double[idxb2][offsb]; + b3 = b->ptr.pp_double[idxb3][offsb]; + v22 = v22+a2*b2; + v23 = v23+a2*b3; + v32 = v32+a3*b2; + v33 = v33+a3*b3; + v02 = v02+a0*b2; + v03 = v03+a0*b3; + v12 = v12+a1*b2; + v13 = v13+a1*b3; + offsa = offsa+1; + offsb = offsb+1; + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+i+0][jc+j+0] = alpha*v00; + c->ptr.pp_double[ic+i+0][jc+j+1] = alpha*v01; + c->ptr.pp_double[ic+i+0][jc+j+2] = alpha*v02; + c->ptr.pp_double[ic+i+0][jc+j+3] = alpha*v03; + c->ptr.pp_double[ic+i+1][jc+j+0] = alpha*v10; + c->ptr.pp_double[ic+i+1][jc+j+1] = alpha*v11; + c->ptr.pp_double[ic+i+1][jc+j+2] = alpha*v12; + c->ptr.pp_double[ic+i+1][jc+j+3] = alpha*v13; + c->ptr.pp_double[ic+i+2][jc+j+0] = alpha*v20; + c->ptr.pp_double[ic+i+2][jc+j+1] = alpha*v21; + c->ptr.pp_double[ic+i+2][jc+j+2] = alpha*v22; + c->ptr.pp_double[ic+i+2][jc+j+3] = alpha*v23; + c->ptr.pp_double[ic+i+3][jc+j+0] = alpha*v30; + c->ptr.pp_double[ic+i+3][jc+j+1] = alpha*v31; + c->ptr.pp_double[ic+i+3][jc+j+2] = alpha*v32; + c->ptr.pp_double[ic+i+3][jc+j+3] = alpha*v33; + } + else + { + c->ptr.pp_double[ic+i+0][jc+j+0] = beta*c->ptr.pp_double[ic+i+0][jc+j+0]+alpha*v00; + c->ptr.pp_double[ic+i+0][jc+j+1] = beta*c->ptr.pp_double[ic+i+0][jc+j+1]+alpha*v01; + c->ptr.pp_double[ic+i+0][jc+j+2] = beta*c->ptr.pp_double[ic+i+0][jc+j+2]+alpha*v02; + c->ptr.pp_double[ic+i+0][jc+j+3] = beta*c->ptr.pp_double[ic+i+0][jc+j+3]+alpha*v03; + c->ptr.pp_double[ic+i+1][jc+j+0] = beta*c->ptr.pp_double[ic+i+1][jc+j+0]+alpha*v10; + c->ptr.pp_double[ic+i+1][jc+j+1] = beta*c->ptr.pp_double[ic+i+1][jc+j+1]+alpha*v11; + c->ptr.pp_double[ic+i+1][jc+j+2] = beta*c->ptr.pp_double[ic+i+1][jc+j+2]+alpha*v12; + c->ptr.pp_double[ic+i+1][jc+j+3] = beta*c->ptr.pp_double[ic+i+1][jc+j+3]+alpha*v13; + c->ptr.pp_double[ic+i+2][jc+j+0] = beta*c->ptr.pp_double[ic+i+2][jc+j+0]+alpha*v20; + c->ptr.pp_double[ic+i+2][jc+j+1] = beta*c->ptr.pp_double[ic+i+2][jc+j+1]+alpha*v21; + c->ptr.pp_double[ic+i+2][jc+j+2] = beta*c->ptr.pp_double[ic+i+2][jc+j+2]+alpha*v22; + c->ptr.pp_double[ic+i+2][jc+j+3] = beta*c->ptr.pp_double[ic+i+2][jc+j+3]+alpha*v23; + c->ptr.pp_double[ic+i+3][jc+j+0] = beta*c->ptr.pp_double[ic+i+3][jc+j+0]+alpha*v30; + c->ptr.pp_double[ic+i+3][jc+j+1] = beta*c->ptr.pp_double[ic+i+3][jc+j+1]+alpha*v31; + c->ptr.pp_double[ic+i+3][jc+j+2] = beta*c->ptr.pp_double[ic+i+3][jc+j+2]+alpha*v32; + c->ptr.pp_double[ic+i+3][jc+j+3] = beta*c->ptr.pp_double[ic+i+3][jc+j+3]+alpha*v33; + } + } + else + { + + /* + * Determine submatrix [I0..I1]x[J0..J1] to process + */ + i0 = i; + i1 = ae_minint(i+3, m-1, _state); + j0 = j; + j1 = ae_minint(j+3, n-1, _state); + + /* + * Process submatrix + */ + for(ik=i0; ik<=i1; ik++) + { + for(jk=j0; jk<=j1; jk++) + { + if( k==0||ae_fp_eq(alpha,0) ) + { + v = 0; + } + else + { + v = 0.0; + v = ae_v_dotproduct(&a->ptr.pp_double[ia][ja+ik], a->stride, &b->ptr.pp_double[ib+jk][jb], 1, ae_v_len(ia,ia+k-1)); + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+ik][jc+jk] = alpha*v; + } + else + { + c->ptr.pp_double[ic+ik][jc+jk] = beta*c->ptr.pp_double[ic+ik][jc+jk]+alpha*v; + } + } + } + } + j = j+4; + } + i = i+4; + } +} + + + + +/************************************************************************* +MKL-based kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixsyrkmkl(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_MKL + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_rmatrixsyrkmkl(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper); +#endif +} + + +/************************************************************************* +MKL-based kernel + + -- ALGLIB routine -- + 19.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixgemmmkl(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_MKL + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_rmatrixgemmmkl(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc); +#endif +} + + + + +double vectornorm2(/* Real */ ae_vector* x, + ae_int_t i1, + ae_int_t i2, + ae_state *_state) +{ + ae_int_t n; + ae_int_t ix; + double absxi; + double scl; + double ssq; + double result; + + + n = i2-i1+1; + if( n<1 ) + { + result = 0; + return result; + } + if( n==1 ) + { + result = ae_fabs(x->ptr.p_double[i1], _state); + return result; + } + scl = 0; + ssq = 1; + for(ix=i1; ix<=i2; ix++) + { + if( ae_fp_neq(x->ptr.p_double[ix],0) ) + { + absxi = ae_fabs(x->ptr.p_double[ix], _state); + if( ae_fp_less(scl,absxi) ) + { + ssq = 1+ssq*ae_sqr(scl/absxi, _state); + scl = absxi; + } + else + { + ssq = ssq+ae_sqr(absxi/scl, _state); + } + } + } + result = scl*ae_sqrt(ssq, _state); + return result; +} + + +ae_int_t vectoridxabsmax(/* Real */ ae_vector* x, + ae_int_t i1, + ae_int_t i2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t result; + + + result = i1; + for(i=i1+1; i<=i2; i++) + { + if( ae_fp_greater(ae_fabs(x->ptr.p_double[i], _state),ae_fabs(x->ptr.p_double[result], _state)) ) + { + result = i; + } + } + return result; +} + + +ae_int_t columnidxabsmax(/* Real */ ae_matrix* x, + ae_int_t i1, + ae_int_t i2, + ae_int_t j, + ae_state *_state) +{ + ae_int_t i; + ae_int_t result; + + + result = i1; + for(i=i1+1; i<=i2; i++) + { + if( ae_fp_greater(ae_fabs(x->ptr.pp_double[i][j], _state),ae_fabs(x->ptr.pp_double[result][j], _state)) ) + { + result = i; + } + } + return result; +} + + +ae_int_t rowidxabsmax(/* Real */ ae_matrix* x, + ae_int_t j1, + ae_int_t j2, + ae_int_t i, + ae_state *_state) +{ + ae_int_t j; + ae_int_t result; + + + result = j1; + for(j=j1+1; j<=j2; j++) + { + if( ae_fp_greater(ae_fabs(x->ptr.pp_double[i][j], _state),ae_fabs(x->ptr.pp_double[i][result], _state)) ) + { + result = j; + } + } + return result; +} + + +double upperhessenberg1norm(/* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t i2, + ae_int_t j1, + ae_int_t j2, + /* Real */ ae_vector* work, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double result; + + + ae_assert(i2-i1==j2-j1, "UpperHessenberg1Norm: I2-I1<>J2-J1!", _state); + for(j=j1; j<=j2; j++) + { + work->ptr.p_double[j] = 0; + } + for(i=i1; i<=i2; i++) + { + for(j=ae_maxint(j1, j1+i-i1-1, _state); j<=j2; j++) + { + work->ptr.p_double[j] = work->ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state); + } + } + result = 0; + for(j=j1; j<=j2; j++) + { + result = ae_maxreal(result, work->ptr.p_double[j], _state); + } + return result; +} + + +void copymatrix(/* Real */ ae_matrix* a, + ae_int_t is1, + ae_int_t is2, + ae_int_t js1, + ae_int_t js2, + /* Real */ ae_matrix* b, + ae_int_t id1, + ae_int_t id2, + ae_int_t jd1, + ae_int_t jd2, + ae_state *_state) +{ + ae_int_t isrc; + ae_int_t idst; + + + if( is1>is2||js1>js2 ) + { + return; + } + ae_assert(is2-is1==id2-id1, "CopyMatrix: different sizes!", _state); + ae_assert(js2-js1==jd2-jd1, "CopyMatrix: different sizes!", _state); + for(isrc=is1; isrc<=is2; isrc++) + { + idst = isrc-is1+id1; + ae_v_move(&b->ptr.pp_double[idst][jd1], 1, &a->ptr.pp_double[isrc][js1], 1, ae_v_len(jd1,jd2)); + } +} + + +void inplacetranspose(/* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t i2, + ae_int_t j1, + ae_int_t j2, + /* Real */ ae_vector* work, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t ips; + ae_int_t jps; + ae_int_t l; + + + if( i1>i2||j1>j2 ) + { + return; + } + ae_assert(i1-i2==j1-j2, "InplaceTranspose error: incorrect array size!", _state); + for(i=i1; i<=i2-1; i++) + { + j = j1+i-i1; + ips = i+1; + jps = j1+ips-i1; + l = i2-i; + ae_v_move(&work->ptr.p_double[1], 1, &a->ptr.pp_double[ips][j], a->stride, ae_v_len(1,l)); + ae_v_move(&a->ptr.pp_double[ips][j], a->stride, &a->ptr.pp_double[i][jps], 1, ae_v_len(ips,i2)); + ae_v_move(&a->ptr.pp_double[i][jps], 1, &work->ptr.p_double[1], 1, ae_v_len(jps,j2)); + } +} + + +void copyandtranspose(/* Real */ ae_matrix* a, + ae_int_t is1, + ae_int_t is2, + ae_int_t js1, + ae_int_t js2, + /* Real */ ae_matrix* b, + ae_int_t id1, + ae_int_t id2, + ae_int_t jd1, + ae_int_t jd2, + ae_state *_state) +{ + ae_int_t isrc; + ae_int_t jdst; + + + if( is1>is2||js1>js2 ) + { + return; + } + ae_assert(is2-is1==jd2-jd1, "CopyAndTranspose: different sizes!", _state); + ae_assert(js2-js1==id2-id1, "CopyAndTranspose: different sizes!", _state); + for(isrc=is1; isrc<=is2; isrc++) + { + jdst = isrc-is1+jd1; + ae_v_move(&b->ptr.pp_double[id1][jdst], b->stride, &a->ptr.pp_double[isrc][js1], 1, ae_v_len(id1,id2)); + } +} + + +void matrixvectormultiply(/* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t i2, + ae_int_t j1, + ae_int_t j2, + ae_bool trans, + /* Real */ ae_vector* x, + ae_int_t ix1, + ae_int_t ix2, + double alpha, + /* Real */ ae_vector* y, + ae_int_t iy1, + ae_int_t iy2, + double beta, + ae_state *_state) +{ + ae_int_t i; + double v; + + + if( !trans ) + { + + /* + * y := alpha*A*x + beta*y; + */ + if( i1>i2||j1>j2 ) + { + return; + } + ae_assert(j2-j1==ix2-ix1, "MatrixVectorMultiply: A and X dont match!", _state); + ae_assert(i2-i1==iy2-iy1, "MatrixVectorMultiply: A and Y dont match!", _state); + + /* + * beta*y + */ + if( ae_fp_eq(beta,0) ) + { + for(i=iy1; i<=iy2; i++) + { + y->ptr.p_double[i] = 0; + } + } + else + { + ae_v_muld(&y->ptr.p_double[iy1], 1, ae_v_len(iy1,iy2), beta); + } + + /* + * alpha*A*x + */ + for(i=i1; i<=i2; i++) + { + v = ae_v_dotproduct(&a->ptr.pp_double[i][j1], 1, &x->ptr.p_double[ix1], 1, ae_v_len(j1,j2)); + y->ptr.p_double[iy1+i-i1] = y->ptr.p_double[iy1+i-i1]+alpha*v; + } + } + else + { + + /* + * y := alpha*A'*x + beta*y; + */ + if( i1>i2||j1>j2 ) + { + return; + } + ae_assert(i2-i1==ix2-ix1, "MatrixVectorMultiply: A and X dont match!", _state); + ae_assert(j2-j1==iy2-iy1, "MatrixVectorMultiply: A and Y dont match!", _state); + + /* + * beta*y + */ + if( ae_fp_eq(beta,0) ) + { + for(i=iy1; i<=iy2; i++) + { + y->ptr.p_double[i] = 0; + } + } + else + { + ae_v_muld(&y->ptr.p_double[iy1], 1, ae_v_len(iy1,iy2), beta); + } + + /* + * alpha*A'*x + */ + for(i=i1; i<=i2; i++) + { + v = alpha*x->ptr.p_double[ix1+i-i1]; + ae_v_addd(&y->ptr.p_double[iy1], 1, &a->ptr.pp_double[i][j1], 1, ae_v_len(iy1,iy2), v); + } + } +} + + +double pythag2(double x, double y, ae_state *_state) +{ + double w; + double xabs; + double yabs; + double z; + double result; + + + xabs = ae_fabs(x, _state); + yabs = ae_fabs(y, _state); + w = ae_maxreal(xabs, yabs, _state); + z = ae_minreal(xabs, yabs, _state); + if( ae_fp_eq(z,0) ) + { + result = w; + } + else + { + result = w*ae_sqrt(1+ae_sqr(z/w, _state), _state); + } + return result; +} + + +void matrixmatrixmultiply(/* Real */ ae_matrix* a, + ae_int_t ai1, + ae_int_t ai2, + ae_int_t aj1, + ae_int_t aj2, + ae_bool transa, + /* Real */ ae_matrix* b, + ae_int_t bi1, + ae_int_t bi2, + ae_int_t bj1, + ae_int_t bj2, + ae_bool transb, + double alpha, + /* Real */ ae_matrix* c, + ae_int_t ci1, + ae_int_t ci2, + ae_int_t cj1, + ae_int_t cj2, + double beta, + /* Real */ ae_vector* work, + ae_state *_state) +{ + ae_int_t arows; + ae_int_t acols; + ae_int_t brows; + ae_int_t bcols; + ae_int_t crows; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t l; + ae_int_t r; + double v; + + + + /* + * Setup + */ + if( !transa ) + { + arows = ai2-ai1+1; + acols = aj2-aj1+1; + } + else + { + arows = aj2-aj1+1; + acols = ai2-ai1+1; + } + if( !transb ) + { + brows = bi2-bi1+1; + bcols = bj2-bj1+1; + } + else + { + brows = bj2-bj1+1; + bcols = bi2-bi1+1; + } + ae_assert(acols==brows, "MatrixMatrixMultiply: incorrect matrix sizes!", _state); + if( ((arows<=0||acols<=0)||brows<=0)||bcols<=0 ) + { + return; + } + crows = arows; + + /* + * Test WORK + */ + i = ae_maxint(arows, acols, _state); + i = ae_maxint(brows, i, _state); + i = ae_maxint(i, bcols, _state); + work->ptr.p_double[1] = 0; + work->ptr.p_double[i] = 0; + + /* + * Prepare C + */ + if( ae_fp_eq(beta,0) ) + { + for(i=ci1; i<=ci2; i++) + { + for(j=cj1; j<=cj2; j++) + { + c->ptr.pp_double[i][j] = 0; + } + } + } + else + { + for(i=ci1; i<=ci2; i++) + { + ae_v_muld(&c->ptr.pp_double[i][cj1], 1, ae_v_len(cj1,cj2), beta); + } + } + + /* + * A*B + */ + if( !transa&&!transb ) + { + for(l=ai1; l<=ai2; l++) + { + for(r=bi1; r<=bi2; r++) + { + v = alpha*a->ptr.pp_double[l][aj1+r-bi1]; + k = ci1+l-ai1; + ae_v_addd(&c->ptr.pp_double[k][cj1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(cj1,cj2), v); + } + } + return; + } + + /* + * A*B' + */ + if( !transa&&transb ) + { + if( arows*acolsptr.pp_double[l][aj1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(aj1,aj2)); + c->ptr.pp_double[ci1+l-ai1][cj1+r-bi1] = c->ptr.pp_double[ci1+l-ai1][cj1+r-bi1]+alpha*v; + } + } + return; + } + else + { + for(l=ai1; l<=ai2; l++) + { + for(r=bi1; r<=bi2; r++) + { + v = ae_v_dotproduct(&a->ptr.pp_double[l][aj1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(aj1,aj2)); + c->ptr.pp_double[ci1+l-ai1][cj1+r-bi1] = c->ptr.pp_double[ci1+l-ai1][cj1+r-bi1]+alpha*v; + } + } + return; + } + } + + /* + * A'*B + */ + if( transa&&!transb ) + { + for(l=aj1; l<=aj2; l++) + { + for(r=bi1; r<=bi2; r++) + { + v = alpha*a->ptr.pp_double[ai1+r-bi1][l]; + k = ci1+l-aj1; + ae_v_addd(&c->ptr.pp_double[k][cj1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(cj1,cj2), v); + } + } + return; + } + + /* + * A'*B' + */ + if( transa&&transb ) + { + if( arows*acolsptr.p_double[i] = 0.0; + } + for(l=ai1; l<=ai2; l++) + { + v = alpha*b->ptr.pp_double[r][bj1+l-ai1]; + ae_v_addd(&work->ptr.p_double[1], 1, &a->ptr.pp_double[l][aj1], 1, ae_v_len(1,crows), v); + } + ae_v_add(&c->ptr.pp_double[ci1][k], c->stride, &work->ptr.p_double[1], 1, ae_v_len(ci1,ci2)); + } + return; + } + else + { + for(l=aj1; l<=aj2; l++) + { + k = ai2-ai1+1; + ae_v_move(&work->ptr.p_double[1], 1, &a->ptr.pp_double[ai1][l], a->stride, ae_v_len(1,k)); + for(r=bi1; r<=bi2; r++) + { + v = ae_v_dotproduct(&work->ptr.p_double[1], 1, &b->ptr.pp_double[r][bj1], 1, ae_v_len(1,k)); + c->ptr.pp_double[ci1+l-aj1][cj1+r-bi1] = c->ptr.pp_double[ci1+l-aj1][cj1+r-bi1]+alpha*v; + } + } + return; + } + } +} + + + + +void hermitianmatrixvectormultiply(/* Complex */ ae_matrix* a, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Complex */ ae_vector* x, + ae_complex alpha, + /* Complex */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + ae_int_t ba1; + ae_int_t by1; + ae_int_t by2; + ae_int_t bx1; + ae_int_t bx2; + ae_int_t n; + ae_complex v; + + + n = i2-i1+1; + if( n<=0 ) + { + return; + } + + /* + * Let A = L + D + U, where + * L is strictly lower triangular (main diagonal is zero) + * D is diagonal + * U is strictly upper triangular (main diagonal is zero) + * + * A*x = L*x + D*x + U*x + * + * Calculate D*x first + */ + for(i=i1; i<=i2; i++) + { + y->ptr.p_complex[i-i1+1] = ae_c_mul(a->ptr.pp_complex[i][i],x->ptr.p_complex[i-i1+1]); + } + + /* + * Add L*x + U*x + */ + if( isupper ) + { + for(i=i1; i<=i2-1; i++) + { + + /* + * Add L*x to the result + */ + v = x->ptr.p_complex[i-i1+1]; + by1 = i-i1+2; + by2 = n; + ba1 = i+1; + ae_v_caddc(&y->ptr.p_complex[by1], 1, &a->ptr.pp_complex[i][ba1], 1, "Conj", ae_v_len(by1,by2), v); + + /* + * Add U*x to the result + */ + bx1 = i-i1+2; + bx2 = n; + ba1 = i+1; + v = ae_v_cdotproduct(&x->ptr.p_complex[bx1], 1, "N", &a->ptr.pp_complex[i][ba1], 1, "N", ae_v_len(bx1,bx2)); + y->ptr.p_complex[i-i1+1] = ae_c_add(y->ptr.p_complex[i-i1+1],v); + } + } + else + { + for(i=i1+1; i<=i2; i++) + { + + /* + * Add L*x to the result + */ + bx1 = 1; + bx2 = i-i1; + ba1 = i1; + v = ae_v_cdotproduct(&x->ptr.p_complex[bx1], 1, "N", &a->ptr.pp_complex[i][ba1], 1, "N", ae_v_len(bx1,bx2)); + y->ptr.p_complex[i-i1+1] = ae_c_add(y->ptr.p_complex[i-i1+1],v); + + /* + * Add U*x to the result + */ + v = x->ptr.p_complex[i-i1+1]; + by1 = 1; + by2 = i-i1; + ba1 = i1; + ae_v_caddc(&y->ptr.p_complex[by1], 1, &a->ptr.pp_complex[i][ba1], 1, "Conj", ae_v_len(by1,by2), v); + } + } + ae_v_cmulc(&y->ptr.p_complex[1], 1, ae_v_len(1,n), alpha); +} + + +void hermitianrank2update(/* Complex */ ae_matrix* a, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Complex */ ae_vector* x, + /* Complex */ ae_vector* y, + /* Complex */ ae_vector* t, + ae_complex alpha, + ae_state *_state) +{ + ae_int_t i; + ae_int_t tp1; + ae_int_t tp2; + ae_complex v; + + + if( isupper ) + { + for(i=i1; i<=i2; i++) + { + tp1 = i+1-i1; + tp2 = i2-i1+1; + v = ae_c_mul(alpha,x->ptr.p_complex[i+1-i1]); + ae_v_cmovec(&t->ptr.p_complex[tp1], 1, &y->ptr.p_complex[tp1], 1, "Conj", ae_v_len(tp1,tp2), v); + v = ae_c_mul(ae_c_conj(alpha, _state),y->ptr.p_complex[i+1-i1]); + ae_v_caddc(&t->ptr.p_complex[tp1], 1, &x->ptr.p_complex[tp1], 1, "Conj", ae_v_len(tp1,tp2), v); + ae_v_cadd(&a->ptr.pp_complex[i][i], 1, &t->ptr.p_complex[tp1], 1, "N", ae_v_len(i,i2)); + } + } + else + { + for(i=i1; i<=i2; i++) + { + tp1 = 1; + tp2 = i+1-i1; + v = ae_c_mul(alpha,x->ptr.p_complex[i+1-i1]); + ae_v_cmovec(&t->ptr.p_complex[tp1], 1, &y->ptr.p_complex[tp1], 1, "Conj", ae_v_len(tp1,tp2), v); + v = ae_c_mul(ae_c_conj(alpha, _state),y->ptr.p_complex[i+1-i1]); + ae_v_caddc(&t->ptr.p_complex[tp1], 1, &x->ptr.p_complex[tp1], 1, "Conj", ae_v_len(tp1,tp2), v); + ae_v_cadd(&a->ptr.pp_complex[i][i1], 1, &t->ptr.p_complex[tp1], 1, "N", ae_v_len(i1,i)); + } + } +} + + + + +/************************************************************************* +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 generatereflection(/* Real */ ae_vector* x, + ae_int_t n, + double* tau, + ae_state *_state) +{ + ae_int_t j; + double alpha; + double xnorm; + double v; + double beta; + double mx; + double s; + + *tau = 0; + + if( n<=1 ) + { + *tau = 0; + return; + } + + /* + * Scale if needed (to avoid overflow/underflow during intermediate + * calculations). + */ + mx = 0; + for(j=1; j<=n; j++) + { + mx = ae_maxreal(ae_fabs(x->ptr.p_double[j], _state), mx, _state); + } + s = 1; + if( ae_fp_neq(mx,0) ) + { + if( ae_fp_less_eq(mx,ae_minrealnumber/ae_machineepsilon) ) + { + s = ae_minrealnumber/ae_machineepsilon; + v = 1/s; + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), v); + mx = mx*v; + } + else + { + if( ae_fp_greater_eq(mx,ae_maxrealnumber*ae_machineepsilon) ) + { + s = ae_maxrealnumber*ae_machineepsilon; + v = 1/s; + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), v); + mx = mx*v; + } + } + } + + /* + * XNORM = DNRM2( N-1, X, INCX ) + */ + alpha = x->ptr.p_double[1]; + xnorm = 0; + if( ae_fp_neq(mx,0) ) + { + for(j=2; j<=n; j++) + { + xnorm = xnorm+ae_sqr(x->ptr.p_double[j]/mx, _state); + } + xnorm = ae_sqrt(xnorm, _state)*mx; + } + if( ae_fp_eq(xnorm,0) ) + { + + /* + * H = I + */ + *tau = 0; + x->ptr.p_double[1] = x->ptr.p_double[1]*s; + return; + } + + /* + * general case + */ + mx = ae_maxreal(ae_fabs(alpha, _state), ae_fabs(xnorm, _state), _state); + beta = -mx*ae_sqrt(ae_sqr(alpha/mx, _state)+ae_sqr(xnorm/mx, _state), _state); + if( ae_fp_less(alpha,0) ) + { + beta = -beta; + } + *tau = (beta-alpha)/beta; + v = 1/(alpha-beta); + ae_v_muld(&x->ptr.p_double[2], 1, ae_v_len(2,n), v); + x->ptr.p_double[1] = beta; + + /* + * Scale back outputs + */ + x->ptr.p_double[1] = x->ptr.p_double[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 applyreflectionfromtheleft(/* Real */ ae_matrix* c, + double tau, + /* Real */ ae_vector* v, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Real */ ae_vector* work, + ae_state *_state) +{ + double t; + ae_int_t i; + + + if( (ae_fp_eq(tau,0)||n1>n2)||m1>m2 ) + { + return; + } + + /* + * w := C' * v + */ + for(i=n1; i<=n2; i++) + { + work->ptr.p_double[i] = 0; + } + for(i=m1; i<=m2; i++) + { + t = v->ptr.p_double[i+1-m1]; + ae_v_addd(&work->ptr.p_double[n1], 1, &c->ptr.pp_double[i][n1], 1, ae_v_len(n1,n2), t); + } + + /* + * C := C - tau * v * w' + */ + for(i=m1; i<=m2; i++) + { + t = v->ptr.p_double[i-m1+1]*tau; + ae_v_subd(&c->ptr.pp_double[i][n1], 1, &work->ptr.p_double[n1], 1, ae_v_len(n1,n2), t); + } +} + + +/************************************************************************* +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 applyreflectionfromtheright(/* Real */ ae_matrix* c, + double tau, + /* Real */ ae_vector* v, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Real */ ae_vector* work, + ae_state *_state) +{ + double t; + ae_int_t i; + ae_int_t vm; + + + if( (ae_fp_eq(tau,0)||n1>n2)||m1>m2 ) + { + return; + } + vm = n2-n1+1; + for(i=m1; i<=m2; i++) + { + t = ae_v_dotproduct(&c->ptr.pp_double[i][n1], 1, &v->ptr.p_double[1], 1, ae_v_len(n1,n2)); + t = t*tau; + ae_v_subd(&c->ptr.pp_double[i][n1], 1, &v->ptr.p_double[1], 1, ae_v_len(n1,n2), t); + } + + /* + * This line is necessary to avoid spurious compiler warnings + */ + touchint(&vm, _state); +} + + + + +/************************************************************************* +Generation of an elementary complex reflection transformation + +The subroutine generates elementary complex reflection H of order N, so +that, for a given X, the following equality holds true: + + ( X(1) ) ( Beta ) +H' * ( .. ) = ( 0 ), H'*H = I, Beta is a real number + ( X(n) ) ( 0 ) + +where + + ( V(1) ) +H = 1 - Tau * ( .. ) * ( conj(V(1)), ..., conj(V(n)) ) + ( V(n) ) + +where the first component of vector V equals 1. + +Input parameters: + X - vector. Array with elements [1..N]. + N - reflection order. + +Output parameters: + X - components from 2 to N are replaced by vector V. + The first component is replaced with parameter Beta. + Tau - scalar value Tau. + +This subroutine is the modification of CLARFG subroutines from the LAPACK +library. It has similar functionality except for the fact that it doesn’t +handle errors when intermediate results cause an overflow. + + -- 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 complexgeneratereflection(/* Complex */ ae_vector* x, + ae_int_t n, + ae_complex* tau, + ae_state *_state) +{ + ae_int_t j; + ae_complex alpha; + double alphi; + double alphr; + double beta; + double xnorm; + double mx; + ae_complex t; + double s; + ae_complex v; + + tau->x = 0; + tau->y = 0; + + if( n<=0 ) + { + *tau = ae_complex_from_d(0); + return; + } + + /* + * Scale if needed (to avoid overflow/underflow during intermediate + * calculations). + */ + mx = 0; + for(j=1; j<=n; j++) + { + mx = ae_maxreal(ae_c_abs(x->ptr.p_complex[j], _state), mx, _state); + } + s = 1; + if( ae_fp_neq(mx,0) ) + { + if( ae_fp_less(mx,1) ) + { + s = ae_sqrt(ae_minrealnumber, _state); + v = ae_complex_from_d(1/s); + ae_v_cmulc(&x->ptr.p_complex[1], 1, ae_v_len(1,n), v); + } + else + { + s = ae_sqrt(ae_maxrealnumber, _state); + v = ae_complex_from_d(1/s); + ae_v_cmulc(&x->ptr.p_complex[1], 1, ae_v_len(1,n), v); + } + } + + /* + * calculate + */ + alpha = x->ptr.p_complex[1]; + mx = 0; + for(j=2; j<=n; j++) + { + mx = ae_maxreal(ae_c_abs(x->ptr.p_complex[j], _state), mx, _state); + } + xnorm = 0; + if( ae_fp_neq(mx,0) ) + { + for(j=2; j<=n; j++) + { + t = ae_c_div_d(x->ptr.p_complex[j],mx); + xnorm = xnorm+ae_c_mul(t,ae_c_conj(t, _state)).x; + } + xnorm = ae_sqrt(xnorm, _state)*mx; + } + alphr = alpha.x; + alphi = alpha.y; + if( ae_fp_eq(xnorm,0)&&ae_fp_eq(alphi,0) ) + { + *tau = ae_complex_from_d(0); + x->ptr.p_complex[1] = ae_c_mul_d(x->ptr.p_complex[1],s); + return; + } + mx = ae_maxreal(ae_fabs(alphr, _state), ae_fabs(alphi, _state), _state); + mx = ae_maxreal(mx, ae_fabs(xnorm, _state), _state); + beta = -mx*ae_sqrt(ae_sqr(alphr/mx, _state)+ae_sqr(alphi/mx, _state)+ae_sqr(xnorm/mx, _state), _state); + if( ae_fp_less(alphr,0) ) + { + beta = -beta; + } + tau->x = (beta-alphr)/beta; + tau->y = -alphi/beta; + alpha = ae_c_d_div(1,ae_c_sub_d(alpha,beta)); + if( n>1 ) + { + ae_v_cmulc(&x->ptr.p_complex[2], 1, ae_v_len(2,n), alpha); + } + alpha = ae_complex_from_d(beta); + x->ptr.p_complex[1] = alpha; + + /* + * Scale back + */ + x->ptr.p_complex[1] = ae_c_mul_d(x->ptr.p_complex[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). 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. + +Note: the matrix is multiplied by H, not by H'. If it is required to +multiply the matrix by H', it is necessary to pass Conj(Tau) instead of Tau. + +Input parameters: + C - matrix to be transformed. + Tau - scalar defining transformation. + V - column defining 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 index 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 complexapplyreflectionfromtheleft(/* Complex */ ae_matrix* c, + ae_complex tau, + /* Complex */ ae_vector* v, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Complex */ ae_vector* work, + ae_state *_state) +{ + ae_complex t; + ae_int_t i; + + + if( (ae_c_eq_d(tau,0)||n1>n2)||m1>m2 ) + { + return; + } + + /* + * w := C^T * conj(v) + */ + for(i=n1; i<=n2; i++) + { + work->ptr.p_complex[i] = ae_complex_from_d(0); + } + for(i=m1; i<=m2; i++) + { + t = ae_c_conj(v->ptr.p_complex[i+1-m1], _state); + ae_v_caddc(&work->ptr.p_complex[n1], 1, &c->ptr.pp_complex[i][n1], 1, "N", ae_v_len(n1,n2), t); + } + + /* + * C := C - tau * v * w^T + */ + for(i=m1; i<=m2; i++) + { + t = ae_c_mul(v->ptr.p_complex[i-m1+1],tau); + ae_v_csubc(&c->ptr.pp_complex[i][n1], 1, &work->ptr.p_complex[n1], 1, "N", ae_v_len(n1,n2), t); + } +} + + +/************************************************************************* +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). 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 transformation. + V - column defining 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 index 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 complexapplyreflectionfromtheright(/* Complex */ ae_matrix* c, + ae_complex tau, + /* Complex */ ae_vector* v, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Complex */ ae_vector* work, + ae_state *_state) +{ + ae_complex t; + ae_int_t i; + ae_int_t vm; + + + if( (ae_c_eq_d(tau,0)||n1>n2)||m1>m2 ) + { + return; + } + + /* + * w := C * v + */ + vm = n2-n1+1; + for(i=m1; i<=m2; i++) + { + t = ae_v_cdotproduct(&c->ptr.pp_complex[i][n1], 1, "N", &v->ptr.p_complex[1], 1, "N", ae_v_len(n1,n2)); + work->ptr.p_complex[i] = t; + } + + /* + * C := C - w * conj(v^T) + */ + ae_v_cmove(&v->ptr.p_complex[1], 1, &v->ptr.p_complex[1], 1, "Conj", ae_v_len(1,vm)); + for(i=m1; i<=m2; i++) + { + t = ae_c_mul(work->ptr.p_complex[i],tau); + ae_v_csubc(&c->ptr.pp_complex[i][n1], 1, &v->ptr.p_complex[1], 1, "N", ae_v_len(n1,n2), t); + } + ae_v_cmove(&v->ptr.p_complex[1], 1, &v->ptr.p_complex[1], 1, "Conj", ae_v_len(1,vm)); +} + + + + +void symmetricmatrixvectormultiply(/* Real */ ae_matrix* a, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_vector* x, + double alpha, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + ae_int_t ba1; + ae_int_t ba2; + ae_int_t by1; + ae_int_t by2; + ae_int_t bx1; + ae_int_t bx2; + ae_int_t n; + double v; + + + n = i2-i1+1; + if( n<=0 ) + { + return; + } + + /* + * Let A = L + D + U, where + * L is strictly lower triangular (main diagonal is zero) + * D is diagonal + * U is strictly upper triangular (main diagonal is zero) + * + * A*x = L*x + D*x + U*x + * + * Calculate D*x first + */ + for(i=i1; i<=i2; i++) + { + y->ptr.p_double[i-i1+1] = a->ptr.pp_double[i][i]*x->ptr.p_double[i-i1+1]; + } + + /* + * Add L*x + U*x + */ + if( isupper ) + { + for(i=i1; i<=i2-1; i++) + { + + /* + * Add L*x to the result + */ + v = x->ptr.p_double[i-i1+1]; + by1 = i-i1+2; + by2 = n; + ba1 = i+1; + ba2 = i2; + ae_v_addd(&y->ptr.p_double[by1], 1, &a->ptr.pp_double[i][ba1], 1, ae_v_len(by1,by2), v); + + /* + * Add U*x to the result + */ + bx1 = i-i1+2; + bx2 = n; + ba1 = i+1; + ba2 = i2; + v = ae_v_dotproduct(&x->ptr.p_double[bx1], 1, &a->ptr.pp_double[i][ba1], 1, ae_v_len(bx1,bx2)); + y->ptr.p_double[i-i1+1] = y->ptr.p_double[i-i1+1]+v; + } + } + else + { + for(i=i1+1; i<=i2; i++) + { + + /* + * Add L*x to the result + */ + bx1 = 1; + bx2 = i-i1; + ba1 = i1; + ba2 = i-1; + v = ae_v_dotproduct(&x->ptr.p_double[bx1], 1, &a->ptr.pp_double[i][ba1], 1, ae_v_len(bx1,bx2)); + y->ptr.p_double[i-i1+1] = y->ptr.p_double[i-i1+1]+v; + + /* + * Add U*x to the result + */ + v = x->ptr.p_double[i-i1+1]; + by1 = 1; + by2 = i-i1; + ba1 = i1; + ba2 = i-1; + ae_v_addd(&y->ptr.p_double[by1], 1, &a->ptr.pp_double[i][ba1], 1, ae_v_len(by1,by2), v); + } + } + ae_v_muld(&y->ptr.p_double[1], 1, ae_v_len(1,n), alpha); + touchint(&ba2, _state); +} + + +void symmetricrank2update(/* Real */ ae_matrix* a, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* t, + double alpha, + ae_state *_state) +{ + ae_int_t i; + ae_int_t tp1; + ae_int_t tp2; + double v; + + + if( isupper ) + { + for(i=i1; i<=i2; i++) + { + tp1 = i+1-i1; + tp2 = i2-i1+1; + v = x->ptr.p_double[i+1-i1]; + ae_v_moved(&t->ptr.p_double[tp1], 1, &y->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), v); + v = y->ptr.p_double[i+1-i1]; + ae_v_addd(&t->ptr.p_double[tp1], 1, &x->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), v); + ae_v_muld(&t->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), alpha); + ae_v_add(&a->ptr.pp_double[i][i], 1, &t->ptr.p_double[tp1], 1, ae_v_len(i,i2)); + } + } + else + { + for(i=i1; i<=i2; i++) + { + tp1 = 1; + tp2 = i+1-i1; + v = x->ptr.p_double[i+1-i1]; + ae_v_moved(&t->ptr.p_double[tp1], 1, &y->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), v); + v = y->ptr.p_double[i+1-i1]; + ae_v_addd(&t->ptr.p_double[tp1], 1, &x->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), v); + ae_v_muld(&t->ptr.p_double[tp1], 1, ae_v_len(tp1,tp2), alpha); + ae_v_add(&a->ptr.pp_double[i][i1], 1, &t->ptr.p_double[tp1], 1, ae_v_len(i1,i)); + } + } +} + + + + +/************************************************************************* +Application of a sequence of elementary rotations to a matrix + +The algorithm pre-multiplies the matrix by a sequence of rotation +transformations which is given by arrays C and S. Depending on the value +of the IsForward parameter either 1 and 2, 3 and 4 and so on (if IsForward=true) +rows are rotated, or the rows N and N-1, N-2 and N-3 and so on, are rotated. + +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: + IsForward - the sequence of the rotation application. + M1,M2 - the range of rows to be transformed. + N1, N2 - the range of columns to be transformed. + C,S - transformation coefficients. + Array whose index ranges within [1..M2-M1]. + A - processed matrix. + WORK - working array whose index ranges within [N1..N2]. + +Output parameters: + A - transformed matrix. + +Utility subroutine. +*************************************************************************/ +void applyrotationsfromtheleft(ae_bool isforward, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Real */ ae_vector* c, + /* Real */ ae_vector* s, + /* Real */ ae_matrix* a, + /* Real */ ae_vector* work, + ae_state *_state) +{ + ae_int_t j; + ae_int_t jp1; + double ctemp; + double stemp; + double temp; + + + if( m1>m2||n1>n2 ) + { + return; + } + + /* + * Form P * A + */ + if( isforward ) + { + if( n1!=n2 ) + { + + /* + * Common case: N1<>N2 + */ + for(j=m1; j<=m2-1; j++) + { + ctemp = c->ptr.p_double[j-m1+1]; + stemp = s->ptr.p_double[j-m1+1]; + if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) + { + jp1 = j+1; + ae_v_moved(&work->ptr.p_double[n1], 1, &a->ptr.pp_double[jp1][n1], 1, ae_v_len(n1,n2), ctemp); + ae_v_subd(&work->ptr.p_double[n1], 1, &a->ptr.pp_double[j][n1], 1, ae_v_len(n1,n2), stemp); + ae_v_muld(&a->ptr.pp_double[j][n1], 1, ae_v_len(n1,n2), ctemp); + ae_v_addd(&a->ptr.pp_double[j][n1], 1, &a->ptr.pp_double[jp1][n1], 1, ae_v_len(n1,n2), stemp); + ae_v_move(&a->ptr.pp_double[jp1][n1], 1, &work->ptr.p_double[n1], 1, ae_v_len(n1,n2)); + } + } + } + else + { + + /* + * Special case: N1=N2 + */ + for(j=m1; j<=m2-1; j++) + { + ctemp = c->ptr.p_double[j-m1+1]; + stemp = s->ptr.p_double[j-m1+1]; + if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) + { + temp = a->ptr.pp_double[j+1][n1]; + a->ptr.pp_double[j+1][n1] = ctemp*temp-stemp*a->ptr.pp_double[j][n1]; + a->ptr.pp_double[j][n1] = stemp*temp+ctemp*a->ptr.pp_double[j][n1]; + } + } + } + } + else + { + if( n1!=n2 ) + { + + /* + * Common case: N1<>N2 + */ + for(j=m2-1; j>=m1; j--) + { + ctemp = c->ptr.p_double[j-m1+1]; + stemp = s->ptr.p_double[j-m1+1]; + if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) + { + jp1 = j+1; + ae_v_moved(&work->ptr.p_double[n1], 1, &a->ptr.pp_double[jp1][n1], 1, ae_v_len(n1,n2), ctemp); + ae_v_subd(&work->ptr.p_double[n1], 1, &a->ptr.pp_double[j][n1], 1, ae_v_len(n1,n2), stemp); + ae_v_muld(&a->ptr.pp_double[j][n1], 1, ae_v_len(n1,n2), ctemp); + ae_v_addd(&a->ptr.pp_double[j][n1], 1, &a->ptr.pp_double[jp1][n1], 1, ae_v_len(n1,n2), stemp); + ae_v_move(&a->ptr.pp_double[jp1][n1], 1, &work->ptr.p_double[n1], 1, ae_v_len(n1,n2)); + } + } + } + else + { + + /* + * Special case: N1=N2 + */ + for(j=m2-1; j>=m1; j--) + { + ctemp = c->ptr.p_double[j-m1+1]; + stemp = s->ptr.p_double[j-m1+1]; + if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) + { + temp = a->ptr.pp_double[j+1][n1]; + a->ptr.pp_double[j+1][n1] = ctemp*temp-stemp*a->ptr.pp_double[j][n1]; + a->ptr.pp_double[j][n1] = stemp*temp+ctemp*a->ptr.pp_double[j][n1]; + } + } + } + } +} + + +/************************************************************************* +Application of a sequence of elementary rotations to a matrix + +The algorithm post-multiplies the matrix by a sequence of rotation +transformations which is given by arrays C and S. Depending on the value +of the IsForward parameter either 1 and 2, 3 and 4 and so on (if IsForward=true) +rows are rotated, or the rows N and N-1, N-2 and N-3 and so on are rotated. + +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: + IsForward - the sequence of the rotation application. + M1,M2 - the range of rows to be transformed. + N1, N2 - the range of columns to be transformed. + C,S - transformation coefficients. + Array whose index ranges within [1..N2-N1]. + A - processed matrix. + WORK - working array whose index ranges within [M1..M2]. + +Output parameters: + A - transformed matrix. + +Utility subroutine. +*************************************************************************/ +void applyrotationsfromtheright(ae_bool isforward, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Real */ ae_vector* c, + /* Real */ ae_vector* s, + /* Real */ ae_matrix* a, + /* Real */ ae_vector* work, + ae_state *_state) +{ + ae_int_t j; + ae_int_t jp1; + double ctemp; + double stemp; + double temp; + + + + /* + * Form A * P' + */ + if( isforward ) + { + if( m1!=m2 ) + { + + /* + * Common case: M1<>M2 + */ + for(j=n1; j<=n2-1; j++) + { + ctemp = c->ptr.p_double[j-n1+1]; + stemp = s->ptr.p_double[j-n1+1]; + if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) + { + jp1 = j+1; + ae_v_moved(&work->ptr.p_double[m1], 1, &a->ptr.pp_double[m1][jp1], a->stride, ae_v_len(m1,m2), ctemp); + ae_v_subd(&work->ptr.p_double[m1], 1, &a->ptr.pp_double[m1][j], a->stride, ae_v_len(m1,m2), stemp); + ae_v_muld(&a->ptr.pp_double[m1][j], a->stride, ae_v_len(m1,m2), ctemp); + ae_v_addd(&a->ptr.pp_double[m1][j], a->stride, &a->ptr.pp_double[m1][jp1], a->stride, ae_v_len(m1,m2), stemp); + ae_v_move(&a->ptr.pp_double[m1][jp1], a->stride, &work->ptr.p_double[m1], 1, ae_v_len(m1,m2)); + } + } + } + else + { + + /* + * Special case: M1=M2 + */ + for(j=n1; j<=n2-1; j++) + { + ctemp = c->ptr.p_double[j-n1+1]; + stemp = s->ptr.p_double[j-n1+1]; + if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) + { + temp = a->ptr.pp_double[m1][j+1]; + a->ptr.pp_double[m1][j+1] = ctemp*temp-stemp*a->ptr.pp_double[m1][j]; + a->ptr.pp_double[m1][j] = stemp*temp+ctemp*a->ptr.pp_double[m1][j]; + } + } + } + } + else + { + if( m1!=m2 ) + { + + /* + * Common case: M1<>M2 + */ + for(j=n2-1; j>=n1; j--) + { + ctemp = c->ptr.p_double[j-n1+1]; + stemp = s->ptr.p_double[j-n1+1]; + if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) + { + jp1 = j+1; + ae_v_moved(&work->ptr.p_double[m1], 1, &a->ptr.pp_double[m1][jp1], a->stride, ae_v_len(m1,m2), ctemp); + ae_v_subd(&work->ptr.p_double[m1], 1, &a->ptr.pp_double[m1][j], a->stride, ae_v_len(m1,m2), stemp); + ae_v_muld(&a->ptr.pp_double[m1][j], a->stride, ae_v_len(m1,m2), ctemp); + ae_v_addd(&a->ptr.pp_double[m1][j], a->stride, &a->ptr.pp_double[m1][jp1], a->stride, ae_v_len(m1,m2), stemp); + ae_v_move(&a->ptr.pp_double[m1][jp1], a->stride, &work->ptr.p_double[m1], 1, ae_v_len(m1,m2)); + } + } + } + else + { + + /* + * Special case: M1=M2 + */ + for(j=n2-1; j>=n1; j--) + { + ctemp = c->ptr.p_double[j-n1+1]; + stemp = s->ptr.p_double[j-n1+1]; + if( ae_fp_neq(ctemp,1)||ae_fp_neq(stemp,0) ) + { + temp = a->ptr.pp_double[m1][j+1]; + a->ptr.pp_double[m1][j+1] = ctemp*temp-stemp*a->ptr.pp_double[m1][j]; + a->ptr.pp_double[m1][j] = stemp*temp+ctemp*a->ptr.pp_double[m1][j]; + } + } + } + } +} + + +/************************************************************************* +The subroutine generates the elementary rotation, so that: + +[ CS SN ] . [ F ] = [ R ] +[ -SN CS ] [ G ] [ 0 ] + +CS**2 + SN**2 = 1 +*************************************************************************/ +void generaterotation(double f, + double g, + double* cs, + double* sn, + double* r, + ae_state *_state) +{ + double f1; + double g1; + + *cs = 0; + *sn = 0; + *r = 0; + + if( ae_fp_eq(g,0) ) + { + *cs = 1; + *sn = 0; + *r = f; + } + else + { + if( ae_fp_eq(f,0) ) + { + *cs = 0; + *sn = 1; + *r = g; + } + else + { + f1 = f; + g1 = g; + if( ae_fp_greater(ae_fabs(f1, _state),ae_fabs(g1, _state)) ) + { + *r = ae_fabs(f1, _state)*ae_sqrt(1+ae_sqr(g1/f1, _state), _state); + } + else + { + *r = ae_fabs(g1, _state)*ae_sqrt(1+ae_sqr(f1/g1, _state), _state); + } + *cs = f1/(*r); + *sn = g1/(*r); + if( ae_fp_greater(ae_fabs(f, _state),ae_fabs(g, _state))&&ae_fp_less(*cs,0) ) + { + *cs = -*cs; + *sn = -*sn; + *r = -*r; + } + } + } +} + + + + +/************************************************************************* +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 this + parameter 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). +*************************************************************************/ +ae_bool upperhessenbergschurdecomposition(/* Real */ ae_matrix* h, + ae_int_t n, + /* Real */ ae_matrix* s, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector wi; + ae_vector wr; + ae_int_t info; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(s); + ae_vector_init(&wi, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wr, 0, DT_REAL, _state, ae_true); + + internalschurdecomposition(h, n, 1, 2, &wr, &wi, s, &info, _state); + result = info==0; + ae_frame_leave(_state); + return result; +} + + +void internalschurdecomposition(/* Real */ ae_matrix* h, + ae_int_t n, + ae_int_t tneeded, + ae_int_t zneeded, + /* Real */ ae_vector* wr, + /* Real */ ae_vector* wi, + /* Real */ ae_matrix* z, + ae_int_t* info, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_int_t i; + ae_int_t i1; + ae_int_t i2; + ae_int_t ierr; + ae_int_t ii; + ae_int_t itemp; + ae_int_t itn; + ae_int_t its; + ae_int_t j; + ae_int_t k; + ae_int_t l; + ae_int_t maxb; + ae_int_t nr; + ae_int_t ns; + ae_int_t nv; + double absw; + double smlnum; + double tau; + double temp; + double tst1; + double ulp; + double unfl; + ae_matrix s; + ae_vector v; + ae_vector vv; + ae_vector workc1; + ae_vector works1; + ae_vector workv3; + ae_vector tmpwr; + ae_vector tmpwi; + ae_bool initz; + ae_bool wantt; + ae_bool wantz; + double cnst; + ae_bool failflag; + ae_int_t p1; + ae_int_t p2; + double vt; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(wr); + ae_vector_clear(wi); + *info = 0; + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&s, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + ae_vector_init(&vv, 0, DT_REAL, _state, ae_true); + ae_vector_init(&workc1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&works1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&workv3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpwr, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpwi, 0, DT_REAL, _state, ae_true); + + + /* + * 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 = ae_maxint(3, maxb, _state); + ns = ae_minint(maxb, ns, _state); + + /* + * Initialize + */ + cnst = 1.5; + ae_vector_set_length(&work, ae_maxint(n, 1, _state)+1, _state); + ae_matrix_set_length(&s, ns+1, ns+1, _state); + ae_vector_set_length(&v, ns+1+1, _state); + ae_vector_set_length(&vv, ns+1+1, _state); + ae_vector_set_length(wr, ae_maxint(n, 1, _state)+1, _state); + ae_vector_set_length(wi, ae_maxint(n, 1, _state)+1, _state); + ae_vector_set_length(&workc1, 1+1, _state); + ae_vector_set_length(&works1, 1+1, _state); + ae_vector_set_length(&workv3, 3+1, _state); + ae_vector_set_length(&tmpwr, ae_maxint(n, 1, _state)+1, _state); + ae_vector_set_length(&tmpwi, ae_maxint(n, 1, _state)+1, _state); + ae_assert(n>=0, "InternalSchurDecomposition: incorrect N!", _state); + ae_assert(tneeded==0||tneeded==1, "InternalSchurDecomposition: incorrect TNeeded!", _state); + ae_assert((zneeded==0||zneeded==1)||zneeded==2, "InternalSchurDecomposition: incorrect ZNeeded!", _state); + wantt = tneeded==1; + initz = zneeded==2; + wantz = zneeded!=0; + *info = 0; + + /* + * Initialize Z, if necessary + */ + if( initz ) + { + ae_matrix_set_length(z, n+1, n+1, _state); + for(i=1; i<=n; i++) + { + for(j=1; j<=n; j++) + { + if( i==j ) + { + z->ptr.pp_double[i][j] = 1; + } + else + { + z->ptr.pp_double[i][j] = 0; + } + } + } + } + + /* + * Quick return if possible + */ + if( n==0 ) + { + ae_frame_leave(_state); + return; + } + if( n==1 ) + { + wr->ptr.p_double[1] = h->ptr.pp_double[1][1]; + wi->ptr.p_double[1] = 0; + ae_frame_leave(_state); + return; + } + + /* + * Set rows and columns 1 to N to zero below the first + * subdiagonal. + */ + for(j=1; j<=n-2; j++) + { + for(i=j+2; i<=n; i++) + { + h->ptr.pp_double[i][j] = 0; + } + } + + /* + * Test if N is sufficiently small + */ + if( (ns<=2||ns>n)||maxb>=n ) + { + + /* + * Use the standard double-shift algorithm + */ + hsschur_internalauxschur(wantt, wantz, n, 1, n, h, wr, wi, 1, n, z, &work, &workv3, &workc1, &works1, info, _state); + + /* + * fill entries under diagonal blocks of T with zeros + */ + if( wantt ) + { + j = 1; + while(j<=n) + { + if( ae_fp_eq(wi->ptr.p_double[j],0) ) + { + for(i=j+1; i<=n; i++) + { + h->ptr.pp_double[i][j] = 0; + } + j = j+1; + } + else + { + for(i=j+2; i<=n; i++) + { + h->ptr.pp_double[i][j] = 0; + h->ptr.pp_double[i][j+1] = 0; + } + j = j+2; + } + } + } + ae_frame_leave(_state); + return; + } + unfl = ae_minrealnumber; + ulp = 2*ae_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; + for(;;) + { + l = 1; + if( i<1 ) + { + + /* + * fill entries under diagonal blocks of T with zeros + */ + if( wantt ) + { + j = 1; + while(j<=n) + { + if( ae_fp_eq(wi->ptr.p_double[j],0) ) + { + for(i=j+1; i<=n; i++) + { + h->ptr.pp_double[i][j] = 0; + } + j = j+1; + } + else + { + for(i=j+2; i<=n; i++) + { + h->ptr.pp_double[i][j] = 0; + h->ptr.pp_double[i][j+1] = 0; + } + j = j+2; + } + } + } + + /* + * Exit + */ + ae_frame_leave(_state); + 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 = ae_true; + for(its=0; its<=itn; its++) + { + + /* + * Look for a single small subdiagonal element. + */ + for(k=i; k>=l+1; k--) + { + tst1 = ae_fabs(h->ptr.pp_double[k-1][k-1], _state)+ae_fabs(h->ptr.pp_double[k][k], _state); + if( ae_fp_eq(tst1,0) ) + { + tst1 = upperhessenberg1norm(h, l, i, l, i, &work, _state); + } + if( ae_fp_less_eq(ae_fabs(h->ptr.pp_double[k][k-1], _state),ae_maxreal(ulp*tst1, smlnum, _state)) ) + { + break; + } + } + l = k; + if( l>1 ) + { + + /* + * H(L,L-1) is negligible. + */ + h->ptr.pp_double[l][l-1] = 0; + } + + /* + * Exit from loop if a submatrix of order <= MAXB has split off. + */ + if( l>=i-maxb+1 ) + { + failflag = ae_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->ptr.p_double[ii] = cnst*(ae_fabs(h->ptr.pp_double[ii][ii-1], _state)+ae_fabs(h->ptr.pp_double[ii][ii], _state)); + wi->ptr.p_double[ii] = 0; + } + } + else + { + + /* + * Use eigenvalues of trailing submatrix of order NS as shifts. + */ + copymatrix(h, i-ns+1, i, i-ns+1, i, &s, 1, ns, 1, ns, _state); + hsschur_internalauxschur(ae_false, ae_false, ns, 1, ns, &s, &tmpwr, &tmpwi, 1, ns, z, &work, &workv3, &workc1, &works1, &ierr, _state); + for(p1=1; p1<=ns; p1++) + { + wr->ptr.p_double[i-ns+p1] = tmpwr.ptr.p_double[p1]; + wi->ptr.p_double[i-ns+p1] = tmpwi.ptr.p_double[p1]; + } + 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->ptr.p_double[i-ns+ii] = s.ptr.pp_double[ii][ii]; + wi->ptr.p_double[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.ptr.p_double[1] = 1; + for(ii=2; ii<=ns+1; ii++) + { + v.ptr.p_double[ii] = 0; + } + nv = 1; + for(j=i-ns+1; j<=i; j++) + { + if( ae_fp_greater_eq(wi->ptr.p_double[j],0) ) + { + if( ae_fp_eq(wi->ptr.p_double[j],0) ) + { + + /* + * real shift + */ + p1 = nv+1; + ae_v_move(&vv.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,p1)); + matrixvectormultiply(h, l, l+nv, l, l+nv-1, ae_false, &vv, 1, nv, 1.0, &v, 1, nv+1, -wr->ptr.p_double[j], _state); + nv = nv+1; + } + else + { + if( ae_fp_greater(wi->ptr.p_double[j],0) ) + { + + /* + * complex conjugate pair of shifts + */ + p1 = nv+1; + ae_v_move(&vv.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,p1)); + matrixvectormultiply(h, l, l+nv, l, l+nv-1, ae_false, &v, 1, nv, 1.0, &vv, 1, nv+1, -2*wr->ptr.p_double[j], _state); + itemp = vectoridxabsmax(&vv, 1, nv+1, _state); + temp = 1/ae_maxreal(ae_fabs(vv.ptr.p_double[itemp], _state), smlnum, _state); + p1 = nv+1; + ae_v_muld(&vv.ptr.p_double[1], 1, ae_v_len(1,p1), temp); + absw = pythag2(wr->ptr.p_double[j], wi->ptr.p_double[j], _state); + temp = temp*absw*absw; + matrixvectormultiply(h, l, l+nv+1, l, l+nv, ae_false, &vv, 1, nv+1, 1.0, &v, 1, nv+2, temp, _state); + 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 = vectoridxabsmax(&v, 1, nv, _state); + temp = ae_fabs(v.ptr.p_double[itemp], _state); + if( ae_fp_eq(temp,0) ) + { + v.ptr.p_double[1] = 1; + for(ii=2; ii<=nv; ii++) + { + v.ptr.p_double[ii] = 0; + } + } + else + { + temp = ae_maxreal(temp, smlnum, _state); + vt = 1/temp; + ae_v_muld(&v.ptr.p_double[1], 1, ae_v_len(1,nv), vt); + } + } + } + + /* + * 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 = ae_minint(ns+1, i-k+1, _state); + if( k>l ) + { + p1 = k-1; + p2 = k+nr-1; + ae_v_move(&v.ptr.p_double[1], 1, &h->ptr.pp_double[k][p1], h->stride, ae_v_len(1,nr)); + touchint(&p2, _state); + } + generatereflection(&v, nr, &tau, _state); + if( k>l ) + { + h->ptr.pp_double[k][k-1] = v.ptr.p_double[1]; + for(ii=k+1; ii<=i; ii++) + { + h->ptr.pp_double[ii][k-1] = 0; + } + } + v.ptr.p_double[1] = 1; + + /* + * Apply G from the left to transform the rows of the matrix in + * columns K to I2. + */ + applyreflectionfromtheleft(h, tau, &v, k, k+nr-1, k, i2, &work, _state); + + /* + * Apply G from the right to transform the columns of the + * matrix in rows I1 to min(K+NR,I). + */ + applyreflectionfromtheright(h, tau, &v, i1, ae_minint(k+nr, i, _state), k, k+nr-1, &work, _state); + if( wantz ) + { + + /* + * Accumulate transformations in the matrix Z + */ + applyreflectionfromtheright(z, tau, &v, 1, n, k, k+nr-1, &work, _state); + } + } + } + + /* + * Failure to converge in remaining number of iterations + */ + if( failflag ) + { + *info = i; + ae_frame_leave(_state); + 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. + */ + hsschur_internalauxschur(wantt, wantz, n, l, i, h, wr, wi, 1, n, z, &work, &workv3, &workc1, &works1, info, _state); + if( *info>0 ) + { + ae_frame_leave(_state); + 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; + } + ae_frame_leave(_state); +} + + +static void hsschur_internalauxschur(ae_bool wantt, + ae_bool wantz, + ae_int_t n, + ae_int_t ilo, + ae_int_t ihi, + /* Real */ ae_matrix* h, + /* Real */ ae_vector* wr, + /* Real */ ae_vector* wi, + ae_int_t iloz, + ae_int_t ihiz, + /* Real */ ae_matrix* z, + /* Real */ ae_vector* work, + /* Real */ ae_vector* workv3, + /* Real */ ae_vector* workc1, + /* Real */ ae_vector* works1, + ae_int_t* info, + ae_state *_state) +{ + ae_int_t i; + ae_int_t i1; + ae_int_t i2; + ae_int_t itn; + ae_int_t its; + ae_int_t j; + ae_int_t k; + ae_int_t l; + ae_int_t m; + ae_int_t nh; + ae_int_t nr; + ae_int_t nz; + double ave; + double cs; + double disc; + double h00; + double h10; + double h11; + double h12; + double h21; + double h22; + double h33; + double h33s; + double h43h34; + double h44; + double h44s; + double s; + double smlnum; + double sn; + double sum; + double t1; + double t2; + double t3; + double tst1; + double unfl; + double v1; + double v2; + double v3; + ae_bool failflag; + double dat1; + double dat2; + ae_int_t p1; + double him1im1; + double him1i; + double hiim1; + double hii; + double wrim1; + double wri; + double wiim1; + double wii; + double ulp; + + *info = 0; + + *info = 0; + dat1 = 0.75; + dat2 = -0.4375; + ulp = ae_machineepsilon; + + /* + * Quick return if possible + */ + if( n==0 ) + { + return; + } + if( ilo==ihi ) + { + wr->ptr.p_double[ilo] = h->ptr.pp_double[ilo][ilo]; + wi->ptr.p_double[ilo] = 0; + return; + } + nh = ihi-ilo+1; + nz = ihiz-iloz+1; + + /* + * Set machine-dependent constants for the stopping criterion. + * If norm(H) <= sqrt(MaxRealNumber), overflow should not occur. + */ + unfl = ae_minrealnumber; + smlnum = unfl*(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. + */ + i1 = 1; + i2 = n; + + /* + * ITN is the total number of QR iterations allowed. + */ + itn = 30*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; + for(;;) + { + l = ilo; + if( i=l+1; k--) + { + tst1 = ae_fabs(h->ptr.pp_double[k-1][k-1], _state)+ae_fabs(h->ptr.pp_double[k][k], _state); + if( ae_fp_eq(tst1,0) ) + { + tst1 = upperhessenberg1norm(h, l, i, l, i, work, _state); + } + if( ae_fp_less_eq(ae_fabs(h->ptr.pp_double[k][k-1], _state),ae_maxreal(ulp*tst1, smlnum, _state)) ) + { + break; + } + } + l = k; + if( l>ilo ) + { + + /* + * H(L,L-1) is negligible + */ + h->ptr.pp_double[l][l-1] = 0; + } + + /* + * Exit from loop if a submatrix of order 1 or 2 has split off. + */ + if( l>=i-1 ) + { + failflag = ae_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==10||its==20 ) + { + + /* + * Exceptional shift. + */ + s = ae_fabs(h->ptr.pp_double[i][i-1], _state)+ae_fabs(h->ptr.pp_double[i-1][i-2], _state); + h44 = dat1*s+h->ptr.pp_double[i][i]; + h33 = h44; + h43h34 = dat2*s*s; + } + else + { + + /* + * Prepare to use Francis' double shift + * (i.e. 2nd degree generalized Rayleigh quotient) + */ + h44 = h->ptr.pp_double[i][i]; + h33 = h->ptr.pp_double[i-1][i-1]; + h43h34 = h->ptr.pp_double[i][i-1]*h->ptr.pp_double[i-1][i]; + s = h->ptr.pp_double[i-1][i-2]*h->ptr.pp_double[i-1][i-2]; + disc = (h33-h44)*0.5; + disc = disc*disc+h43h34; + if( ae_fp_greater(disc,0) ) + { + + /* + * Real roots: use Wilkinson's shift twice + */ + disc = ae_sqrt(disc, _state); + ave = 0.5*(h33+h44); + if( ae_fp_greater(ae_fabs(h33, _state)-ae_fabs(h44, _state),0) ) + { + h33 = h33*h44-h43h34; + h44 = h33/(hsschur_extschursign(disc, ave, _state)+ave); + } + else + { + h44 = hsschur_extschursign(disc, ave, _state)+ave; + } + h33 = h44; + h43h34 = 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. + */ + h11 = h->ptr.pp_double[m][m]; + h22 = h->ptr.pp_double[m+1][m+1]; + h21 = h->ptr.pp_double[m+1][m]; + h12 = h->ptr.pp_double[m][m+1]; + h44s = h44-h11; + h33s = h33-h11; + v1 = (h33s*h44s-h43h34)/h21+h12; + v2 = h22-h11-h33s-h44s; + v3 = h->ptr.pp_double[m+2][m+1]; + s = ae_fabs(v1, _state)+ae_fabs(v2, _state)+ae_fabs(v3, _state); + v1 = v1/s; + v2 = v2/s; + v3 = v3/s; + workv3->ptr.p_double[1] = v1; + workv3->ptr.p_double[2] = v2; + workv3->ptr.p_double[3] = v3; + if( m==l ) + { + break; + } + h00 = h->ptr.pp_double[m-1][m-1]; + h10 = h->ptr.pp_double[m][m-1]; + tst1 = ae_fabs(v1, _state)*(ae_fabs(h00, _state)+ae_fabs(h11, _state)+ae_fabs(h22, _state)); + if( ae_fp_less_eq(ae_fabs(h10, _state)*(ae_fabs(v2, _state)+ae_fabs(v3, _state)),ulp*tst1) ) + { + break; + } + } + + /* + * Double-shift QR step + */ + for(k=m; 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 = ae_minint(3, i-k+1, _state); + if( k>m ) + { + for(p1=1; p1<=nr; p1++) + { + workv3->ptr.p_double[p1] = h->ptr.pp_double[k+p1-1][k-1]; + } + } + generatereflection(workv3, nr, &t1, _state); + if( k>m ) + { + h->ptr.pp_double[k][k-1] = workv3->ptr.p_double[1]; + h->ptr.pp_double[k+1][k-1] = 0; + if( kptr.pp_double[k+2][k-1] = 0; + } + } + else + { + if( m>l ) + { + h->ptr.pp_double[k][k-1] = -h->ptr.pp_double[k][k-1]; + } + } + v2 = workv3->ptr.p_double[2]; + t2 = t1*v2; + if( nr==3 ) + { + v3 = workv3->ptr.p_double[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->ptr.pp_double[k][j]+v2*h->ptr.pp_double[k+1][j]+v3*h->ptr.pp_double[k+2][j]; + h->ptr.pp_double[k][j] = h->ptr.pp_double[k][j]-sum*t1; + h->ptr.pp_double[k+1][j] = h->ptr.pp_double[k+1][j]-sum*t2; + h->ptr.pp_double[k+2][j] = h->ptr.pp_double[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<=ae_minint(k+3, i, _state); j++) + { + sum = h->ptr.pp_double[j][k]+v2*h->ptr.pp_double[j][k+1]+v3*h->ptr.pp_double[j][k+2]; + h->ptr.pp_double[j][k] = h->ptr.pp_double[j][k]-sum*t1; + h->ptr.pp_double[j][k+1] = h->ptr.pp_double[j][k+1]-sum*t2; + h->ptr.pp_double[j][k+2] = h->ptr.pp_double[j][k+2]-sum*t3; + } + if( wantz ) + { + + /* + * Accumulate transformations in the matrix Z + */ + for(j=iloz; j<=ihiz; j++) + { + sum = z->ptr.pp_double[j][k]+v2*z->ptr.pp_double[j][k+1]+v3*z->ptr.pp_double[j][k+2]; + z->ptr.pp_double[j][k] = z->ptr.pp_double[j][k]-sum*t1; + z->ptr.pp_double[j][k+1] = z->ptr.pp_double[j][k+1]-sum*t2; + z->ptr.pp_double[j][k+2] = z->ptr.pp_double[j][k+2]-sum*t3; + } + } + } + else + { + 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->ptr.pp_double[k][j]+v2*h->ptr.pp_double[k+1][j]; + h->ptr.pp_double[k][j] = h->ptr.pp_double[k][j]-sum*t1; + h->ptr.pp_double[k+1][j] = h->ptr.pp_double[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->ptr.pp_double[j][k]+v2*h->ptr.pp_double[j][k+1]; + h->ptr.pp_double[j][k] = h->ptr.pp_double[j][k]-sum*t1; + h->ptr.pp_double[j][k+1] = h->ptr.pp_double[j][k+1]-sum*t2; + } + if( wantz ) + { + + /* + * Accumulate transformations in the matrix Z + */ + for(j=iloz; j<=ihiz; j++) + { + sum = z->ptr.pp_double[j][k]+v2*z->ptr.pp_double[j][k+1]; + z->ptr.pp_double[j][k] = z->ptr.pp_double[j][k]-sum*t1; + z->ptr.pp_double[j][k+1] = z->ptr.pp_double[j][k+1]-sum*t2; + } + } + } + } + } + } + if( failflag ) + { + + /* + * Failure to converge in remaining number of iterations + */ + *info = i; + return; + } + if( l==i ) + { + + /* + * H(I,I-1) is negligible: one eigenvalue has converged. + */ + wr->ptr.p_double[i] = h->ptr.pp_double[i][i]; + wi->ptr.p_double[i] = 0; + } + else + { + 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->ptr.pp_double[i-1][i-1]; + him1i = h->ptr.pp_double[i-1][i]; + hiim1 = h->ptr.pp_double[i][i-1]; + hii = h->ptr.pp_double[i][i]; + hsschur_aux2x2schur(&him1im1, &him1i, &hiim1, &hii, &wrim1, &wiim1, &wri, &wii, &cs, &sn, _state); + wr->ptr.p_double[i-1] = wrim1; + wi->ptr.p_double[i-1] = wiim1; + wr->ptr.p_double[i] = wri; + wi->ptr.p_double[i] = wii; + h->ptr.pp_double[i-1][i-1] = him1im1; + h->ptr.pp_double[i-1][i] = him1i; + h->ptr.pp_double[i][i-1] = hiim1; + h->ptr.pp_double[i][i] = hii; + if( wantt ) + { + + /* + * Apply the transformation to the rest of H. + */ + if( i2>i ) + { + workc1->ptr.p_double[1] = cs; + works1->ptr.p_double[1] = sn; + applyrotationsfromtheleft(ae_true, i-1, i, i+1, i2, workc1, works1, h, work, _state); + } + workc1->ptr.p_double[1] = cs; + works1->ptr.p_double[1] = sn; + applyrotationsfromtheright(ae_true, i1, i-2, i-1, i, workc1, works1, h, work, _state); + } + if( wantz ) + { + + /* + * Apply the transformation to Z. + */ + workc1->ptr.p_double[1] = cs; + works1->ptr.p_double[1] = sn; + applyrotationsfromtheright(ae_true, iloz, iloz+nz-1, i-1, i, workc1, works1, z, work, _state); + } + } + } + + /* + * Decrement number of remaining iterations, and return to start of + * the main loop with new value of I. + */ + itn = itn-its; + i = l-1; + } +} + + +static void hsschur_aux2x2schur(double* a, + double* b, + double* c, + double* d, + double* rt1r, + double* rt1i, + double* rt2r, + double* rt2i, + double* cs, + double* sn, + ae_state *_state) +{ + double multpl; + double aa; + double bb; + double bcmax; + double bcmis; + double cc; + double cs1; + double dd; + double eps; + double p; + double sab; + double sac; + double scl; + double sigma; + double sn1; + double tau; + double temp; + double z; + + *rt1r = 0; + *rt1i = 0; + *rt2r = 0; + *rt2i = 0; + *cs = 0; + *sn = 0; + + multpl = 4.0; + eps = ae_machineepsilon; + if( ae_fp_eq(*c,0) ) + { + *cs = 1; + *sn = 0; + } + else + { + if( ae_fp_eq(*b,0) ) + { + + /* + * Swap rows and columns + */ + *cs = 0; + *sn = 1; + temp = *d; + *d = *a; + *a = temp; + *b = -*c; + *c = 0; + } + else + { + if( ae_fp_eq(*a-(*d),0)&&hsschur_extschursigntoone(*b, _state)!=hsschur_extschursigntoone(*c, _state) ) + { + *cs = 1; + *sn = 0; + } + else + { + temp = *a-(*d); + p = 0.5*temp; + bcmax = ae_maxreal(ae_fabs(*b, _state), ae_fabs(*c, _state), _state); + bcmis = ae_minreal(ae_fabs(*b, _state), ae_fabs(*c, _state), _state)*hsschur_extschursigntoone(*b, _state)*hsschur_extschursigntoone(*c, _state); + scl = ae_maxreal(ae_fabs(p, _state), bcmax, _state); + 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( ae_fp_greater_eq(z,multpl*eps) ) + { + + /* + * Real eigenvalues. Compute A and D. + */ + z = p+hsschur_extschursign(ae_sqrt(scl, _state)*ae_sqrt(z, _state), p, _state); + *a = *d+z; + *d = *d-bcmax/z*bcmis; + + /* + * Compute B and the rotation matrix + */ + tau = pythag2(*c, z, _state); + *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 = pythag2(sigma, temp, _state); + *cs = ae_sqrt(0.5*(1+ae_fabs(sigma, _state)/tau), _state); + *sn = -p/(tau*(*cs))*hsschur_extschursign(1, sigma, _state); + + /* + * 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; + if( ae_fp_neq(*c,0) ) + { + if( ae_fp_neq(*b,0) ) + { + if( hsschur_extschursigntoone(*b, _state)==hsschur_extschursigntoone(*c, _state) ) + { + + /* + * Real eigenvalues: reduce to upper triangular form + */ + sab = ae_sqrt(ae_fabs(*b, _state), _state); + sac = ae_sqrt(ae_fabs(*c, _state), _state); + p = hsschur_extschursign(sab*sac, *c, _state); + tau = 1/ae_sqrt(ae_fabs(*b+(*c), _state), _state); + *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 + { + *b = -*c; + *c = 0; + temp = *cs; + *cs = -*sn; + *sn = temp; + } + } + } + } + } + } + + /* + * Store eigenvalues in (RT1R,RT1I) and (RT2R,RT2I). + */ + *rt1r = *a; + *rt2r = *d; + if( ae_fp_eq(*c,0) ) + { + *rt1i = 0; + *rt2i = 0; + } + else + { + *rt1i = ae_sqrt(ae_fabs(*b, _state), _state)*ae_sqrt(ae_fabs(*c, _state), _state); + *rt2i = -*rt1i; + } +} + + +static double hsschur_extschursign(double a, double b, ae_state *_state) +{ + double result; + + + if( ae_fp_greater_eq(b,0) ) + { + result = ae_fabs(a, _state); + } + else + { + result = -ae_fabs(a, _state); + } + return result; +} + + +static ae_int_t hsschur_extschursigntoone(double b, ae_state *_state) +{ + ae_int_t result; + + + if( ae_fp_greater_eq(b,0) ) + { + result = 1; + } + else + { + result = -1; + } + return result; +} + + + + +/************************************************************************* +Utility subroutine performing the "safe" solution of system of linear +equations with triangular coefficient matrices. + +The subroutine uses scaling and solves the scaled system A*x=s*b (where s +is a scalar value) instead of A*x=b, choosing s so that x can be +represented by a floating-point number. The closer the system gets to a +singular, the less s is. If the system is singular, s=0 and x contains the +non-trivial solution of equation A*x=0. + +The feature of an algorithm is that it could not cause an overflow or a +division by zero regardless of the matrix used as the input. + +The algorithm can solve systems of equations with upper/lower triangular +matrices, with/without unit diagonal, and systems of type A*x=b or A'*x=b +(where A' is a transposed matrix A). + +Input parameters: + A - system matrix. Array whose indexes range within [0..N-1, 0..N-1]. + N - size of matrix A. + X - right-hand member of a system. + Array whose index ranges within [0..N-1]. + IsUpper - matrix type. If it is True, the system matrix is the upper + triangular and is located in the corresponding part of + matrix A. + Trans - problem type. If it is True, the problem to be solved is + A'*x=b, otherwise it is A*x=b. + Isunit - matrix type. If it is True, the system matrix has a unit + diagonal (the elements on the main diagonal are not used + in the calculation process), otherwise the matrix is considered + to be a general triangular matrix. + +Output parameters: + X - solution. Array whose index ranges within [0..N-1]. + S - scaling factor. + + -- LAPACK auxiliary 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 rmatrixtrsafesolve(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* x, + double* s, + ae_bool isupper, + ae_bool istrans, + ae_bool isunit, + ae_state *_state) +{ + ae_frame _frame_block; + ae_bool normin; + ae_vector cnorm; + ae_matrix a1; + ae_vector x1; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + *s = 0; + ae_vector_init(&cnorm, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&a1, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x1, 0, DT_REAL, _state, ae_true); + + + /* + * From 0-based to 1-based + */ + normin = ae_false; + ae_matrix_set_length(&a1, n+1, n+1, _state); + ae_vector_set_length(&x1, n+1, _state); + for(i=1; i<=n; i++) + { + ae_v_move(&a1.ptr.pp_double[i][1], 1, &a->ptr.pp_double[i-1][0], 1, ae_v_len(1,n)); + } + ae_v_move(&x1.ptr.p_double[1], 1, &x->ptr.p_double[0], 1, ae_v_len(1,n)); + + /* + * Solve 1-based + */ + safesolvetriangular(&a1, n, &x1, s, isupper, istrans, isunit, normin, &cnorm, _state); + + /* + * From 1-based to 0-based + */ + ae_v_move(&x->ptr.p_double[0], 1, &x1.ptr.p_double[1], 1, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Obsolete 1-based subroutine. +See RMatrixTRSafeSolve for 0-based replacement. +*************************************************************************/ +void safesolvetriangular(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* x, + double* s, + ae_bool isupper, + ae_bool istrans, + ae_bool isunit, + ae_bool normin, + /* Real */ ae_vector* cnorm, + ae_state *_state) +{ + ae_int_t i; + ae_int_t imax; + ae_int_t j; + ae_int_t jfirst; + ae_int_t jinc; + ae_int_t jlast; + ae_int_t jm1; + ae_int_t jp1; + ae_int_t ip1; + ae_int_t im1; + ae_int_t k; + ae_int_t flg; + double v; + double vd; + double bignum; + double grow; + double rec; + double smlnum; + double sumj; + double tjj; + double tjjs; + double tmax; + double tscal; + double uscal; + double xbnd; + double xj; + double xmax; + ae_bool notran; + ae_bool upper; + ae_bool nounit; + + *s = 0; + + upper = isupper; + notran = !istrans; + nounit = !isunit; + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + tjjs = 0; + + /* + * Quick return if possible + */ + if( n==0 ) + { + return; + } + + /* + * Determine machine dependent parameters to control overflow. + */ + smlnum = ae_minrealnumber/(ae_machineepsilon*2); + bignum = 1/smlnum; + *s = 1; + if( !normin ) + { + ae_vector_set_length(cnorm, n+1, _state); + + /* + * Compute the 1-norm of each column, not including the diagonal. + */ + if( upper ) + { + + /* + * A is upper triangular. + */ + for(j=1; j<=n; j++) + { + v = 0; + for(k=1; k<=j-1; k++) + { + v = v+ae_fabs(a->ptr.pp_double[k][j], _state); + } + cnorm->ptr.p_double[j] = v; + } + } + else + { + + /* + * A is lower triangular. + */ + for(j=1; j<=n-1; j++) + { + v = 0; + for(k=j+1; k<=n; k++) + { + v = v+ae_fabs(a->ptr.pp_double[k][j], _state); + } + cnorm->ptr.p_double[j] = v; + } + cnorm->ptr.p_double[n] = 0; + } + } + + /* + * Scale the column norms by TSCAL if the maximum element in CNORM is + * greater than BIGNUM. + */ + imax = 1; + for(k=2; k<=n; k++) + { + if( ae_fp_greater(cnorm->ptr.p_double[k],cnorm->ptr.p_double[imax]) ) + { + imax = k; + } + } + tmax = cnorm->ptr.p_double[imax]; + if( ae_fp_less_eq(tmax,bignum) ) + { + tscal = 1; + } + else + { + tscal = 1/(smlnum*tmax); + ae_v_muld(&cnorm->ptr.p_double[1], 1, ae_v_len(1,n), tscal); + } + + /* + * Compute a bound on the computed solution vector to see if the + * Level 2 BLAS routine DTRSV can be used. + */ + j = 1; + for(k=2; k<=n; k++) + { + if( ae_fp_greater(ae_fabs(x->ptr.p_double[k], _state),ae_fabs(x->ptr.p_double[j], _state)) ) + { + j = k; + } + } + xmax = ae_fabs(x->ptr.p_double[j], _state); + xbnd = xmax; + if( notran ) + { + + /* + * Compute the growth in A * x = b. + */ + if( upper ) + { + jfirst = n; + jlast = 1; + jinc = -1; + } + else + { + jfirst = 1; + jlast = n; + jinc = 1; + } + if( ae_fp_neq(tscal,1) ) + { + grow = 0; + } + else + { + if( nounit ) + { + + /* + * A is non-unit triangular. + * + * Compute GROW = 1/G(j) and XBND = 1/M(j). + * Initially, G(0) = max{x(i), i=1,...,n}. + */ + grow = 1/ae_maxreal(xbnd, smlnum, _state); + xbnd = grow; + j = jfirst; + while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) + { + + /* + * Exit the loop if the growth factor is too small. + */ + if( ae_fp_less_eq(grow,smlnum) ) + { + break; + } + + /* + * M(j) = G(j-1) / abs(A(j,j)) + */ + tjj = ae_fabs(a->ptr.pp_double[j][j], _state); + xbnd = ae_minreal(xbnd, ae_minreal(1, tjj, _state)*grow, _state); + if( ae_fp_greater_eq(tjj+cnorm->ptr.p_double[j],smlnum) ) + { + + /* + * G(j) = G(j-1)*( 1 + CNORM(j) / abs(A(j,j)) ) + */ + grow = grow*(tjj/(tjj+cnorm->ptr.p_double[j])); + } + else + { + + /* + * G(j) could overflow, set GROW to 0. + */ + grow = 0; + } + if( j==jlast ) + { + grow = xbnd; + } + j = j+jinc; + } + } + else + { + + /* + * A is unit triangular. + * + * Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. + */ + grow = ae_minreal(1, 1/ae_maxreal(xbnd, smlnum, _state), _state); + j = jfirst; + while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) + { + + /* + * Exit the loop if the growth factor is too small. + */ + if( ae_fp_less_eq(grow,smlnum) ) + { + break; + } + + /* + * G(j) = G(j-1)*( 1 + CNORM(j) ) + */ + grow = grow*(1/(1+cnorm->ptr.p_double[j])); + j = j+jinc; + } + } + } + } + else + { + + /* + * Compute the growth in A' * x = b. + */ + if( upper ) + { + jfirst = 1; + jlast = n; + jinc = 1; + } + else + { + jfirst = n; + jlast = 1; + jinc = -1; + } + if( ae_fp_neq(tscal,1) ) + { + grow = 0; + } + else + { + if( nounit ) + { + + /* + * A is non-unit triangular. + * + * Compute GROW = 1/G(j) and XBND = 1/M(j). + * Initially, M(0) = max{x(i), i=1,...,n}. + */ + grow = 1/ae_maxreal(xbnd, smlnum, _state); + xbnd = grow; + j = jfirst; + while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) + { + + /* + * Exit the loop if the growth factor is too small. + */ + if( ae_fp_less_eq(grow,smlnum) ) + { + break; + } + + /* + * G(j) = max( G(j-1), M(j-1)*( 1 + CNORM(j) ) ) + */ + xj = 1+cnorm->ptr.p_double[j]; + grow = ae_minreal(grow, xbnd/xj, _state); + + /* + * M(j) = M(j-1)*( 1 + CNORM(j) ) / abs(A(j,j)) + */ + tjj = ae_fabs(a->ptr.pp_double[j][j], _state); + if( ae_fp_greater(xj,tjj) ) + { + xbnd = xbnd*(tjj/xj); + } + if( j==jlast ) + { + grow = ae_minreal(grow, xbnd, _state); + } + j = j+jinc; + } + } + else + { + + /* + * A is unit triangular. + * + * Compute GROW = 1/G(j), where G(0) = max{x(i), i=1,...,n}. + */ + grow = ae_minreal(1, 1/ae_maxreal(xbnd, smlnum, _state), _state); + j = jfirst; + while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) + { + + /* + * Exit the loop if the growth factor is too small. + */ + if( ae_fp_less_eq(grow,smlnum) ) + { + break; + } + + /* + * G(j) = ( 1 + CNORM(j) )*G(j-1) + */ + xj = 1+cnorm->ptr.p_double[j]; + grow = grow/xj; + j = j+jinc; + } + } + } + } + if( ae_fp_greater(grow*tscal,smlnum) ) + { + + /* + * Use the Level 2 BLAS solve if the reciprocal of the bound on + * elements of X is not too small. + */ + if( (upper&¬ran)||(!upper&&!notran) ) + { + if( nounit ) + { + vd = a->ptr.pp_double[n][n]; + } + else + { + vd = 1; + } + x->ptr.p_double[n] = x->ptr.p_double[n]/vd; + for(i=n-1; i>=1; i--) + { + ip1 = i+1; + if( upper ) + { + v = ae_v_dotproduct(&a->ptr.pp_double[i][ip1], 1, &x->ptr.p_double[ip1], 1, ae_v_len(ip1,n)); + } + else + { + v = ae_v_dotproduct(&a->ptr.pp_double[ip1][i], a->stride, &x->ptr.p_double[ip1], 1, ae_v_len(ip1,n)); + } + if( nounit ) + { + vd = a->ptr.pp_double[i][i]; + } + else + { + vd = 1; + } + x->ptr.p_double[i] = (x->ptr.p_double[i]-v)/vd; + } + } + else + { + if( nounit ) + { + vd = a->ptr.pp_double[1][1]; + } + else + { + vd = 1; + } + x->ptr.p_double[1] = x->ptr.p_double[1]/vd; + for(i=2; i<=n; i++) + { + im1 = i-1; + if( upper ) + { + v = ae_v_dotproduct(&a->ptr.pp_double[1][i], a->stride, &x->ptr.p_double[1], 1, ae_v_len(1,im1)); + } + else + { + v = ae_v_dotproduct(&a->ptr.pp_double[i][1], 1, &x->ptr.p_double[1], 1, ae_v_len(1,im1)); + } + if( nounit ) + { + vd = a->ptr.pp_double[i][i]; + } + else + { + vd = 1; + } + x->ptr.p_double[i] = (x->ptr.p_double[i]-v)/vd; + } + } + } + else + { + + /* + * Use a Level 1 BLAS solve, scaling intermediate results. + */ + if( ae_fp_greater(xmax,bignum) ) + { + + /* + * Scale X so that its components are less than or equal to + * BIGNUM in absolute value. + */ + *s = bignum/xmax; + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), *s); + xmax = bignum; + } + if( notran ) + { + + /* + * Solve A * x = b + */ + j = jfirst; + while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) + { + + /* + * Compute x(j) = b(j) / A(j,j), scaling x if necessary. + */ + xj = ae_fabs(x->ptr.p_double[j], _state); + flg = 0; + if( nounit ) + { + tjjs = a->ptr.pp_double[j][j]*tscal; + } + else + { + tjjs = tscal; + if( ae_fp_eq(tscal,1) ) + { + flg = 100; + } + } + if( flg!=100 ) + { + tjj = ae_fabs(tjjs, _state); + if( ae_fp_greater(tjj,smlnum) ) + { + + /* + * abs(A(j,j)) > SMLNUM: + */ + if( ae_fp_less(tjj,1) ) + { + if( ae_fp_greater(xj,tjj*bignum) ) + { + + /* + * Scale x by 1/b(j). + */ + rec = 1/xj; + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); + *s = *s*rec; + xmax = xmax*rec; + } + } + x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs; + xj = ae_fabs(x->ptr.p_double[j], _state); + } + else + { + if( ae_fp_greater(tjj,0) ) + { + + /* + * 0 < abs(A(j,j)) <= SMLNUM: + */ + if( ae_fp_greater(xj,tjj*bignum) ) + { + + /* + * Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM + * to avoid overflow when dividing by A(j,j). + */ + rec = tjj*bignum/xj; + if( ae_fp_greater(cnorm->ptr.p_double[j],1) ) + { + + /* + * Scale by 1/CNORM(j) to avoid overflow when + * multiplying x(j) times column j. + */ + rec = rec/cnorm->ptr.p_double[j]; + } + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); + *s = *s*rec; + xmax = xmax*rec; + } + x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs; + xj = ae_fabs(x->ptr.p_double[j], _state); + } + else + { + + /* + * A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and + * scale = 0, and compute a solution to A*x = 0. + */ + for(i=1; i<=n; i++) + { + x->ptr.p_double[i] = 0; + } + x->ptr.p_double[j] = 1; + xj = 1; + *s = 0; + xmax = 0; + } + } + } + + /* + * Scale x if necessary to avoid overflow when adding a + * multiple of column j of A. + */ + if( ae_fp_greater(xj,1) ) + { + rec = 1/xj; + if( ae_fp_greater(cnorm->ptr.p_double[j],(bignum-xmax)*rec) ) + { + + /* + * Scale x by 1/(2*abs(x(j))). + */ + rec = rec*0.5; + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); + *s = *s*rec; + } + } + else + { + if( ae_fp_greater(xj*cnorm->ptr.p_double[j],bignum-xmax) ) + { + + /* + * Scale x by 1/2. + */ + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), 0.5); + *s = *s*0.5; + } + } + if( upper ) + { + if( j>1 ) + { + + /* + * Compute the update + * x(1:j-1) := x(1:j-1) - x(j) * A(1:j-1,j) + */ + v = x->ptr.p_double[j]*tscal; + jm1 = j-1; + ae_v_subd(&x->ptr.p_double[1], 1, &a->ptr.pp_double[1][j], a->stride, ae_v_len(1,jm1), v); + i = 1; + for(k=2; k<=j-1; k++) + { + if( ae_fp_greater(ae_fabs(x->ptr.p_double[k], _state),ae_fabs(x->ptr.p_double[i], _state)) ) + { + i = k; + } + } + xmax = ae_fabs(x->ptr.p_double[i], _state); + } + } + else + { + if( jptr.p_double[j]*tscal; + ae_v_subd(&x->ptr.p_double[jp1], 1, &a->ptr.pp_double[jp1][j], a->stride, ae_v_len(jp1,n), v); + i = j+1; + for(k=j+2; k<=n; k++) + { + if( ae_fp_greater(ae_fabs(x->ptr.p_double[k], _state),ae_fabs(x->ptr.p_double[i], _state)) ) + { + i = k; + } + } + xmax = ae_fabs(x->ptr.p_double[i], _state); + } + } + j = j+jinc; + } + } + else + { + + /* + * Solve A' * x = b + */ + j = jfirst; + while((jinc>0&&j<=jlast)||(jinc<0&&j>=jlast)) + { + + /* + * Compute x(j) = b(j) - sum A(k,j)*x(k). + * k<>j + */ + xj = ae_fabs(x->ptr.p_double[j], _state); + uscal = tscal; + rec = 1/ae_maxreal(xmax, 1, _state); + if( ae_fp_greater(cnorm->ptr.p_double[j],(bignum-xj)*rec) ) + { + + /* + * If x(j) could overflow, scale x by 1/(2*XMAX). + */ + rec = rec*0.5; + if( nounit ) + { + tjjs = a->ptr.pp_double[j][j]*tscal; + } + else + { + tjjs = tscal; + } + tjj = ae_fabs(tjjs, _state); + if( ae_fp_greater(tjj,1) ) + { + + /* + * Divide by A(j,j) when scaling x if A(j,j) > 1. + */ + rec = ae_minreal(1, rec*tjj, _state); + uscal = uscal/tjjs; + } + if( ae_fp_less(rec,1) ) + { + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); + *s = *s*rec; + xmax = xmax*rec; + } + } + sumj = 0; + if( ae_fp_eq(uscal,1) ) + { + + /* + * If the scaling needed for A in the dot product is 1, + * call DDOT to perform the dot product. + */ + if( upper ) + { + if( j>1 ) + { + jm1 = j-1; + sumj = ae_v_dotproduct(&a->ptr.pp_double[1][j], a->stride, &x->ptr.p_double[1], 1, ae_v_len(1,jm1)); + } + else + { + sumj = 0; + } + } + else + { + if( jptr.pp_double[jp1][j], a->stride, &x->ptr.p_double[jp1], 1, ae_v_len(jp1,n)); + } + } + } + else + { + + /* + * Otherwise, use in-line code for the dot product. + */ + if( upper ) + { + for(i=1; i<=j-1; i++) + { + v = a->ptr.pp_double[i][j]*uscal; + sumj = sumj+v*x->ptr.p_double[i]; + } + } + else + { + if( jptr.pp_double[i][j]*uscal; + sumj = sumj+v*x->ptr.p_double[i]; + } + } + } + } + if( ae_fp_eq(uscal,tscal) ) + { + + /* + * Compute x(j) := ( x(j) - sumj ) / A(j,j) if 1/A(j,j) + * was not used to scale the dotproduct. + */ + x->ptr.p_double[j] = x->ptr.p_double[j]-sumj; + xj = ae_fabs(x->ptr.p_double[j], _state); + flg = 0; + if( nounit ) + { + tjjs = a->ptr.pp_double[j][j]*tscal; + } + else + { + tjjs = tscal; + if( ae_fp_eq(tscal,1) ) + { + flg = 150; + } + } + + /* + * Compute x(j) = x(j) / A(j,j), scaling if necessary. + */ + if( flg!=150 ) + { + tjj = ae_fabs(tjjs, _state); + if( ae_fp_greater(tjj,smlnum) ) + { + + /* + * abs(A(j,j)) > SMLNUM: + */ + if( ae_fp_less(tjj,1) ) + { + if( ae_fp_greater(xj,tjj*bignum) ) + { + + /* + * Scale X by 1/abs(x(j)). + */ + rec = 1/xj; + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); + *s = *s*rec; + xmax = xmax*rec; + } + } + x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs; + } + else + { + if( ae_fp_greater(tjj,0) ) + { + + /* + * 0 < abs(A(j,j)) <= SMLNUM: + */ + if( ae_fp_greater(xj,tjj*bignum) ) + { + + /* + * Scale x by (1/abs(x(j)))*abs(A(j,j))*BIGNUM. + */ + rec = tjj*bignum/xj; + ae_v_muld(&x->ptr.p_double[1], 1, ae_v_len(1,n), rec); + *s = *s*rec; + xmax = xmax*rec; + } + x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs; + } + else + { + + /* + * A(j,j) = 0: Set x(1:n) = 0, x(j) = 1, and + * scale = 0, and compute a solution to A'*x = 0. + */ + for(i=1; i<=n; i++) + { + x->ptr.p_double[i] = 0; + } + x->ptr.p_double[j] = 1; + *s = 0; + xmax = 0; + } + } + } + } + else + { + + /* + * Compute x(j) := x(j) / A(j,j) - sumj if the dot + * product has already been divided by 1/A(j,j). + */ + x->ptr.p_double[j] = x->ptr.p_double[j]/tjjs-sumj; + } + xmax = ae_maxreal(xmax, ae_fabs(x->ptr.p_double[j], _state), _state); + j = j+jinc; + } + } + *s = *s/tscal; + } + + /* + * Scale the column norms by 1/TSCAL for return. + */ + if( ae_fp_neq(tscal,1) ) + { + v = 1/tscal; + ae_v_muld(&cnorm->ptr.p_double[1], 1, ae_v_len(1,n), v); + } +} + + + + +/************************************************************************* +Real implementation of CMatrixScaledTRSafeSolve + + -- ALGLIB routine -- + 21.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixscaledtrsafesolve(/* Real */ ae_matrix* a, + double sa, + ae_int_t n, + /* Real */ ae_vector* x, + ae_bool isupper, + ae_int_t trans, + ae_bool isunit, + double maxgrowth, + ae_state *_state) +{ + ae_frame _frame_block; + double lnmax; + double nrmb; + double nrmx; + ae_int_t i; + ae_complex alpha; + ae_complex beta; + double vr; + ae_complex cx; + ae_vector tmp; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "RMatrixTRSafeSolve: incorrect N!", _state); + ae_assert(trans==0||trans==1, "RMatrixTRSafeSolve: incorrect Trans!", _state); + result = ae_true; + lnmax = ae_log(ae_maxrealnumber, _state); + + /* + * Quick return if possible + */ + if( n<=0 ) + { + ae_frame_leave(_state); + return result; + } + + /* + * Load norms: right part and X + */ + nrmb = 0; + for(i=0; i<=n-1; i++) + { + nrmb = ae_maxreal(nrmb, ae_fabs(x->ptr.p_double[i], _state), _state); + } + nrmx = 0; + + /* + * Solve + */ + ae_vector_set_length(&tmp, n, _state); + result = ae_true; + if( isupper&&trans==0 ) + { + + /* + * U*x = b + */ + for(i=n-1; i>=0; i--) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_complex_from_d(a->ptr.pp_double[i][i]*sa); + } + if( iptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sa); + vr = ae_v_dotproduct(&tmp.ptr.p_double[i+1], 1, &x->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); + beta = ae_complex_from_d(x->ptr.p_double[i]-vr); + } + else + { + beta = ae_complex_from_d(x->ptr.p_double[i]); + } + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &cx, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_double[i] = cx.x; + } + ae_frame_leave(_state); + return result; + } + if( !isupper&&trans==0 ) + { + + /* + * L*x = b + */ + for(i=0; i<=n-1; i++) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_complex_from_d(a->ptr.pp_double[i][i]*sa); + } + if( i>0 ) + { + ae_v_moved(&tmp.ptr.p_double[0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sa); + vr = ae_v_dotproduct(&tmp.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,i-1)); + beta = ae_complex_from_d(x->ptr.p_double[i]-vr); + } + else + { + beta = ae_complex_from_d(x->ptr.p_double[i]); + } + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &cx, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_double[i] = cx.x; + } + ae_frame_leave(_state); + return result; + } + if( isupper&&trans==1 ) + { + + /* + * U^T*x = b + */ + for(i=0; i<=n-1; i++) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_complex_from_d(a->ptr.pp_double[i][i]*sa); + } + beta = ae_complex_from_d(x->ptr.p_double[i]); + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &cx, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_double[i] = cx.x; + + /* + * update the rest of right part + */ + if( iptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sa); + ae_v_subd(&x->ptr.p_double[i+1], 1, &tmp.ptr.p_double[i+1], 1, ae_v_len(i+1,n-1), vr); + } + } + ae_frame_leave(_state); + return result; + } + if( !isupper&&trans==1 ) + { + + /* + * L^T*x = b + */ + for(i=n-1; i>=0; i--) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_complex_from_d(a->ptr.pp_double[i][i]*sa); + } + beta = ae_complex_from_d(x->ptr.p_double[i]); + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &cx, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_double[i] = cx.x; + + /* + * update the rest of right part + */ + if( i>0 ) + { + vr = cx.x; + ae_v_moved(&tmp.ptr.p_double[0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sa); + ae_v_subd(&x->ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,i-1), vr); + } + } + ae_frame_leave(_state); + return result; + } + result = ae_false; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Internal subroutine for safe solution of + + SA*op(A)=b + +where A is NxN upper/lower triangular/unitriangular matrix, op(A) is +either identity transform, transposition or Hermitian transposition, SA is +a scaling factor such that max(|SA*A[i,j]|) is close to 1.0 in magnutude. + +This subroutine limits relative growth of solution (in inf-norm) by +MaxGrowth, returning False if growth exceeds MaxGrowth. Degenerate or +near-degenerate matrices are handled correctly (False is returned) as long +as MaxGrowth is significantly less than MaxRealNumber/norm(b). + + -- ALGLIB routine -- + 21.01.2010 + Bochkanov Sergey +*************************************************************************/ +ae_bool cmatrixscaledtrsafesolve(/* Complex */ ae_matrix* a, + double sa, + ae_int_t n, + /* Complex */ ae_vector* x, + ae_bool isupper, + ae_int_t trans, + ae_bool isunit, + double maxgrowth, + ae_state *_state) +{ + ae_frame _frame_block; + double lnmax; + double nrmb; + double nrmx; + ae_int_t i; + ae_complex alpha; + ae_complex beta; + ae_complex vc; + ae_vector tmp; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(n>0, "CMatrixTRSafeSolve: incorrect N!", _state); + ae_assert((trans==0||trans==1)||trans==2, "CMatrixTRSafeSolve: incorrect Trans!", _state); + result = ae_true; + lnmax = ae_log(ae_maxrealnumber, _state); + + /* + * Quick return if possible + */ + if( n<=0 ) + { + ae_frame_leave(_state); + return result; + } + + /* + * Load norms: right part and X + */ + nrmb = 0; + for(i=0; i<=n-1; i++) + { + nrmb = ae_maxreal(nrmb, ae_c_abs(x->ptr.p_complex[i], _state), _state); + } + nrmx = 0; + + /* + * Solve + */ + ae_vector_set_length(&tmp, n, _state); + result = ae_true; + if( isupper&&trans==0 ) + { + + /* + * U*x = b + */ + for(i=n-1; i>=0; i--) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_c_mul_d(a->ptr.pp_complex[i][i],sa); + } + if( iptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1), sa); + vc = ae_v_cdotproduct(&tmp.ptr.p_complex[i+1], 1, "N", &x->ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1)); + beta = ae_c_sub(x->ptr.p_complex[i],vc); + } + else + { + beta = x->ptr.p_complex[i]; + } + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_complex[i] = vc; + } + ae_frame_leave(_state); + return result; + } + if( !isupper&&trans==0 ) + { + + /* + * L*x = b + */ + for(i=0; i<=n-1; i++) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_c_mul_d(a->ptr.pp_complex[i][i],sa); + } + if( i>0 ) + { + ae_v_cmoved(&tmp.ptr.p_complex[0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,i-1), sa); + vc = ae_v_cdotproduct(&tmp.ptr.p_complex[0], 1, "N", &x->ptr.p_complex[0], 1, "N", ae_v_len(0,i-1)); + beta = ae_c_sub(x->ptr.p_complex[i],vc); + } + else + { + beta = x->ptr.p_complex[i]; + } + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_complex[i] = vc; + } + ae_frame_leave(_state); + return result; + } + if( isupper&&trans==1 ) + { + + /* + * U^T*x = b + */ + for(i=0; i<=n-1; i++) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_c_mul_d(a->ptr.pp_complex[i][i],sa); + } + beta = x->ptr.p_complex[i]; + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_complex[i] = vc; + + /* + * update the rest of right part + */ + if( iptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1), sa); + ae_v_csubc(&x->ptr.p_complex[i+1], 1, &tmp.ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1), vc); + } + } + ae_frame_leave(_state); + return result; + } + if( !isupper&&trans==1 ) + { + + /* + * L^T*x = b + */ + for(i=n-1; i>=0; i--) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_c_mul_d(a->ptr.pp_complex[i][i],sa); + } + beta = x->ptr.p_complex[i]; + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_complex[i] = vc; + + /* + * update the rest of right part + */ + if( i>0 ) + { + ae_v_cmoved(&tmp.ptr.p_complex[0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,i-1), sa); + ae_v_csubc(&x->ptr.p_complex[0], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(0,i-1), vc); + } + } + ae_frame_leave(_state); + return result; + } + if( isupper&&trans==2 ) + { + + /* + * U^H*x = b + */ + for(i=0; i<=n-1; i++) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_c_mul_d(ae_c_conj(a->ptr.pp_complex[i][i], _state),sa); + } + beta = x->ptr.p_complex[i]; + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_complex[i] = vc; + + /* + * update the rest of right part + */ + if( iptr.pp_complex[i][i+1], 1, "Conj", ae_v_len(i+1,n-1), sa); + ae_v_csubc(&x->ptr.p_complex[i+1], 1, &tmp.ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1), vc); + } + } + ae_frame_leave(_state); + return result; + } + if( !isupper&&trans==2 ) + { + + /* + * L^T*x = b + */ + for(i=n-1; i>=0; i--) + { + + /* + * Task is reduced to alpha*x[i] = beta + */ + if( isunit ) + { + alpha = ae_complex_from_d(sa); + } + else + { + alpha = ae_c_mul_d(ae_c_conj(a->ptr.pp_complex[i][i], _state),sa); + } + beta = x->ptr.p_complex[i]; + + /* + * solve alpha*x[i] = beta + */ + result = safesolve_cbasicsolveandupdate(alpha, beta, lnmax, nrmb, maxgrowth, &nrmx, &vc, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + x->ptr.p_complex[i] = vc; + + /* + * update the rest of right part + */ + if( i>0 ) + { + ae_v_cmoved(&tmp.ptr.p_complex[0], 1, &a->ptr.pp_complex[i][0], 1, "Conj", ae_v_len(0,i-1), sa); + ae_v_csubc(&x->ptr.p_complex[0], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(0,i-1), vc); + } + } + ae_frame_leave(_state); + return result; + } + result = ae_false; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +complex basic solver-updater for reduced linear system + + alpha*x[i] = beta + +solves this equation and updates it in overlfow-safe manner (keeping track +of relative growth of solution). + +Parameters: + Alpha - alpha + Beta - beta + LnMax - precomputed Ln(MaxRealNumber) + BNorm - inf-norm of b (right part of original system) + MaxGrowth- maximum growth of norm(x) relative to norm(b) + XNorm - inf-norm of other components of X (which are already processed) + it is updated by CBasicSolveAndUpdate. + X - solution + + -- ALGLIB routine -- + 26.01.2009 + Bochkanov Sergey +*************************************************************************/ +static ae_bool safesolve_cbasicsolveandupdate(ae_complex alpha, + ae_complex beta, + double lnmax, + double bnorm, + double maxgrowth, + double* xnorm, + ae_complex* x, + ae_state *_state) +{ + double v; + ae_bool result; + + x->x = 0; + x->y = 0; + + result = ae_false; + if( ae_c_eq_d(alpha,0) ) + { + return result; + } + if( ae_c_neq_d(beta,0) ) + { + + /* + * alpha*x[i]=beta + */ + v = ae_log(ae_c_abs(beta, _state), _state)-ae_log(ae_c_abs(alpha, _state), _state); + if( ae_fp_greater(v,lnmax) ) + { + return result; + } + *x = ae_c_div(beta,alpha); + } + else + { + + /* + * alpha*x[i]=0 + */ + *x = ae_complex_from_d(0); + } + + /* + * update NrmX, test growth limit + */ + *xnorm = ae_maxreal(*xnorm, ae_c_abs(*x, _state), _state); + if( ae_fp_greater(*xnorm,maxgrowth*bnorm) ) + { + return result; + } + result = ae_true; + return result; +} + + + + +/************************************************************************* +Prepares HPC compuations of chunked gradient with HPCChunkedGradient(). +You have to call this function before calling HPCChunkedGradient() for +a new set of weights. You have to call it only once, see example below: + +HOW TO PROCESS DATASET WITH THIS FUNCTION: + Grad:=0 + HPCPrepareChunkedGradient(Weights, WCount, NTotal, NOut, Buf) + foreach chunk-of-dataset do + HPCChunkedGradient(...) + HPCFinalizeChunkedGradient(Buf, Grad) + +*************************************************************************/ +void hpcpreparechunkedgradient(/* Real */ ae_vector* weights, + ae_int_t wcount, + ae_int_t ntotal, + ae_int_t nin, + ae_int_t nout, + mlpbuffers* buf, + ae_state *_state) +{ + ae_int_t i; + ae_int_t batch4size; + ae_int_t chunksize; + + + chunksize = 4; + batch4size = 3*chunksize*ntotal+chunksize*(2*nout+1); + if( buf->xy.rowsxy.colsxy, chunksize, nin+nout, _state); + } + if( buf->xy2.rowsxy2.colsxy2, chunksize, nin+nout, _state); + } + if( buf->xyrow.cntxyrow, nin+nout, _state); + } + if( buf->x.cntx, nin, _state); + } + if( buf->y.cnty, nout, _state); + } + if( buf->desiredy.cntdesiredy, nout, _state); + } + if( buf->batch4buf.cntbatch4buf, batch4size, _state); + } + if( buf->hpcbuf.cnthpcbuf, wcount, _state); + } + if( buf->g.cntg, wcount, _state); + } + if( !hpccores_hpcpreparechunkedgradientx(weights, wcount, &buf->hpcbuf, _state) ) + { + for(i=0; i<=wcount-1; i++) + { + buf->hpcbuf.ptr.p_double[i] = 0.0; + } + } + buf->wcount = wcount; + buf->ntotal = ntotal; + buf->nin = nin; + buf->nout = nout; + buf->chunksize = chunksize; +} + + +/************************************************************************* +Finalizes HPC compuations of chunked gradient with HPCChunkedGradient(). +You have to call this function after calling HPCChunkedGradient() for +a new set of weights. You have to call it only once, see example below: + +HOW TO PROCESS DATASET WITH THIS FUNCTION: + Grad:=0 + HPCPrepareChunkedGradient(Weights, WCount, NTotal, NOut, Buf) + foreach chunk-of-dataset do + HPCChunkedGradient(...) + HPCFinalizeChunkedGradient(Buf, Grad) + +*************************************************************************/ +void hpcfinalizechunkedgradient(mlpbuffers* buf, + /* Real */ ae_vector* grad, + ae_state *_state) +{ + ae_int_t i; + + + if( !hpccores_hpcfinalizechunkedgradientx(&buf->hpcbuf, buf->wcount, grad, _state) ) + { + for(i=0; i<=buf->wcount-1; i++) + { + grad->ptr.p_double[i] = grad->ptr.p_double[i]+buf->hpcbuf.ptr.p_double[i]; + } + } +} + + +/************************************************************************* +Fast kernel for chunked gradient. + +*************************************************************************/ +ae_bool hpcchunkedgradient(/* Real */ ae_vector* weights, + /* Integer */ ae_vector* structinfo, + /* Real */ ae_vector* columnmeans, + /* Real */ ae_vector* columnsigmas, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + /* Real */ ae_vector* batch4buf, + /* Real */ ae_vector* hpcbuf, + double* e, + ae_bool naturalerrorfunc, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_SSE2 + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_hpcchunkedgradient(weights, structinfo, columnmeans, columnsigmas, xy, cstart, csize, batch4buf, hpcbuf, e, naturalerrorfunc); +#endif +} + + +/************************************************************************* +Fast kernel for chunked processing. + +*************************************************************************/ +ae_bool hpcchunkedprocess(/* Real */ ae_vector* weights, + /* Integer */ ae_vector* structinfo, + /* Real */ ae_vector* columnmeans, + /* Real */ ae_vector* columnsigmas, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + /* Real */ ae_vector* batch4buf, + /* Real */ ae_vector* hpcbuf, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_SSE2 + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_hpcchunkedprocess(weights, structinfo, columnmeans, columnsigmas, xy, cstart, csize, batch4buf, hpcbuf); +#endif +} + + +/************************************************************************* +Stub function. + + -- ALGLIB routine -- + 14.06.2013 + Bochkanov Sergey +*************************************************************************/ +static ae_bool hpccores_hpcpreparechunkedgradientx(/* Real */ ae_vector* weights, + ae_int_t wcount, + /* Real */ ae_vector* hpcbuf, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_SSE2 + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_hpcpreparechunkedgradientx(weights, wcount, hpcbuf); +#endif +} + + +/************************************************************************* +Stub function. + + -- ALGLIB routine -- + 14.06.2013 + Bochkanov Sergey +*************************************************************************/ +static ae_bool hpccores_hpcfinalizechunkedgradientx(/* Real */ ae_vector* buf, + ae_int_t wcount, + /* Real */ ae_vector* grad, + ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_SSE2 + ae_bool result; + + + result = ae_false; + return result; +#else + return _ialglib_i_hpcfinalizechunkedgradientx(buf, wcount, grad); +#endif +} + + +ae_bool _mlpbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mlpbuffers *p = (mlpbuffers*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->batch4buf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->hpcbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->xy, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->xy2, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xyrow, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->desiredy, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _mlpbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mlpbuffers *dst = (mlpbuffers*)_dst; + mlpbuffers *src = (mlpbuffers*)_src; + dst->chunksize = src->chunksize; + dst->ntotal = src->ntotal; + dst->nin = src->nin; + dst->nout = src->nout; + dst->wcount = src->wcount; + if( !ae_vector_init_copy(&dst->batch4buf, &src->batch4buf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->hpcbuf, &src->hpcbuf, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->xy, &src->xy, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->xy2, &src->xy2, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xyrow, &src->xyrow, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->desiredy, &src->desiredy, _state, make_automatic) ) + return ae_false; + dst->e = src->e; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _mlpbuffers_clear(void* _p) +{ + mlpbuffers *p = (mlpbuffers*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->batch4buf); + ae_vector_clear(&p->hpcbuf); + ae_matrix_clear(&p->xy); + ae_matrix_clear(&p->xy2); + ae_vector_clear(&p->xyrow); + ae_vector_clear(&p->x); + ae_vector_clear(&p->y); + ae_vector_clear(&p->desiredy); + ae_vector_clear(&p->g); + ae_vector_clear(&p->tmp0); +} + + +void _mlpbuffers_destroy(void* _p) +{ + mlpbuffers *p = (mlpbuffers*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->batch4buf); + ae_vector_destroy(&p->hpcbuf); + ae_matrix_destroy(&p->xy); + ae_matrix_destroy(&p->xy2); + ae_vector_destroy(&p->xyrow); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->y); + ae_vector_destroy(&p->desiredy); + ae_vector_destroy(&p->g); + ae_vector_destroy(&p->tmp0); +} + + + + +/************************************************************************* +More precise dot-product. Absolute error of subroutine result is about +1 ulp of max(MX,V), where: + MX = max( |a[i]*b[i]| ) + V = |(a,b)| + +INPUT PARAMETERS + A - array[0..N-1], vector 1 + B - array[0..N-1], vector 2 + N - vectors length, N<2^29. + Temp - array[0..N-1], pre-allocated temporary storage + +OUTPUT PARAMETERS + R - (A,B) + RErr - estimate of error. This estimate accounts for both errors + during calculation of (A,B) and errors introduced by + rounding of A and B to fit in double (about 1 ulp). + + -- ALGLIB -- + Copyright 24.08.2009 by Bochkanov Sergey +*************************************************************************/ +void xdot(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* temp, + double* r, + double* rerr, + ae_state *_state) +{ + ae_int_t i; + double mx; + double v; + + *r = 0; + *rerr = 0; + + + /* + * special cases: + * * N=0 + */ + if( n==0 ) + { + *r = 0; + *rerr = 0; + return; + } + mx = 0; + for(i=0; i<=n-1; i++) + { + v = a->ptr.p_double[i]*b->ptr.p_double[i]; + temp->ptr.p_double[i] = v; + mx = ae_maxreal(mx, ae_fabs(v, _state), _state); + } + if( ae_fp_eq(mx,0) ) + { + *r = 0; + *rerr = 0; + return; + } + xblas_xsum(temp, mx, n, r, rerr, _state); +} + + +/************************************************************************* +More precise complex dot-product. Absolute error of subroutine result is +about 1 ulp of max(MX,V), where: + MX = max( |a[i]*b[i]| ) + V = |(a,b)| + +INPUT PARAMETERS + A - array[0..N-1], vector 1 + B - array[0..N-1], vector 2 + N - vectors length, N<2^29. + Temp - array[0..2*N-1], pre-allocated temporary storage + +OUTPUT PARAMETERS + R - (A,B) + RErr - estimate of error. This estimate accounts for both errors + during calculation of (A,B) and errors introduced by + rounding of A and B to fit in double (about 1 ulp). + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void xcdot(/* Complex */ ae_vector* a, + /* Complex */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* temp, + ae_complex* r, + double* rerr, + ae_state *_state) +{ + ae_int_t i; + double mx; + double v; + double rerrx; + double rerry; + + r->x = 0; + r->y = 0; + *rerr = 0; + + + /* + * special cases: + * * N=0 + */ + if( n==0 ) + { + *r = ae_complex_from_d(0); + *rerr = 0; + return; + } + + /* + * calculate real part + */ + mx = 0; + for(i=0; i<=n-1; i++) + { + v = a->ptr.p_complex[i].x*b->ptr.p_complex[i].x; + temp->ptr.p_double[2*i+0] = v; + mx = ae_maxreal(mx, ae_fabs(v, _state), _state); + v = -a->ptr.p_complex[i].y*b->ptr.p_complex[i].y; + temp->ptr.p_double[2*i+1] = v; + mx = ae_maxreal(mx, ae_fabs(v, _state), _state); + } + if( ae_fp_eq(mx,0) ) + { + r->x = 0; + rerrx = 0; + } + else + { + xblas_xsum(temp, mx, 2*n, &r->x, &rerrx, _state); + } + + /* + * calculate imaginary part + */ + mx = 0; + for(i=0; i<=n-1; i++) + { + v = a->ptr.p_complex[i].x*b->ptr.p_complex[i].y; + temp->ptr.p_double[2*i+0] = v; + mx = ae_maxreal(mx, ae_fabs(v, _state), _state); + v = a->ptr.p_complex[i].y*b->ptr.p_complex[i].x; + temp->ptr.p_double[2*i+1] = v; + mx = ae_maxreal(mx, ae_fabs(v, _state), _state); + } + if( ae_fp_eq(mx,0) ) + { + r->y = 0; + rerry = 0; + } + else + { + xblas_xsum(temp, mx, 2*n, &r->y, &rerry, _state); + } + + /* + * total error + */ + if( ae_fp_eq(rerrx,0)&&ae_fp_eq(rerry,0) ) + { + *rerr = 0; + } + else + { + *rerr = ae_maxreal(rerrx, rerry, _state)*ae_sqrt(1+ae_sqr(ae_minreal(rerrx, rerry, _state)/ae_maxreal(rerrx, rerry, _state), _state), _state); + } +} + + +/************************************************************************* +Internal subroutine for extra-precise calculation of SUM(w[i]). + +INPUT PARAMETERS: + W - array[0..N-1], values to be added + W is modified during calculations. + MX - max(W[i]) + N - array size + +OUTPUT PARAMETERS: + R - SUM(w[i]) + RErr- error estimate for R + + -- ALGLIB -- + Copyright 24.08.2009 by Bochkanov Sergey +*************************************************************************/ +static void xblas_xsum(/* Real */ ae_vector* w, + double mx, + ae_int_t n, + double* r, + double* rerr, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + ae_int_t ks; + double v; + double s; + double ln2; + double chunk; + double invchunk; + ae_bool allzeros; + + *r = 0; + *rerr = 0; + + + /* + * special cases: + * * N=0 + * * N is too large to use integer arithmetics + */ + if( n==0 ) + { + *r = 0; + *rerr = 0; + return; + } + if( ae_fp_eq(mx,0) ) + { + *r = 0; + *rerr = 0; + return; + } + ae_assert(n<536870912, "XDot: N is too large!", _state); + + /* + * Prepare + */ + ln2 = ae_log(2, _state); + *rerr = mx*ae_machineepsilon; + + /* + * 1. find S such that 0.5<=S*MX<1 + * 2. multiply W by S, so task is normalized in some sense + * 3. S:=1/S so we can obtain original vector multiplying by S + */ + k = ae_round(ae_log(mx, _state)/ln2, _state); + s = xblas_xfastpow(2, -k, _state); + while(ae_fp_greater_eq(s*mx,1)) + { + s = 0.5*s; + } + while(ae_fp_less(s*mx,0.5)) + { + s = 2*s; + } + ae_v_muld(&w->ptr.p_double[0], 1, ae_v_len(0,n-1), s); + s = 1/s; + + /* + * find Chunk=2^M such that N*Chunk<2^29 + * + * we have chosen upper limit (2^29) with enough space left + * to tolerate possible problems with rounding and N's close + * to the limit, so we don't want to be very strict here. + */ + k = ae_trunc(ae_log((double)536870912/(double)n, _state)/ln2, _state); + chunk = xblas_xfastpow(2, k, _state); + if( ae_fp_less(chunk,2) ) + { + chunk = 2; + } + invchunk = 1/chunk; + + /* + * calculate result + */ + *r = 0; + ae_v_muld(&w->ptr.p_double[0], 1, ae_v_len(0,n-1), chunk); + for(;;) + { + s = s*invchunk; + allzeros = ae_true; + ks = 0; + for(i=0; i<=n-1; i++) + { + v = w->ptr.p_double[i]; + k = ae_trunc(v, _state); + if( ae_fp_neq(v,k) ) + { + allzeros = ae_false; + } + w->ptr.p_double[i] = chunk*(v-k); + ks = ks+k; + } + *r = *r+s*ks; + v = ae_fabs(*r, _state); + if( allzeros||ae_fp_eq(s*n+mx,mx) ) + { + break; + } + } + + /* + * correct error + */ + *rerr = ae_maxreal(*rerr, ae_fabs(*r, _state)*ae_machineepsilon, _state); +} + + +/************************************************************************* +Fast Pow + + -- ALGLIB -- + Copyright 24.08.2009 by Bochkanov Sergey +*************************************************************************/ +static double xblas_xfastpow(double r, ae_int_t n, ae_state *_state) +{ + double result; + + + result = 0; + if( n>0 ) + { + if( n%2==0 ) + { + result = ae_sqr(xblas_xfastpow(r, n/2, _state), _state); + } + else + { + result = r*xblas_xfastpow(r, n-1, _state); + } + return result; + } + if( n==0 ) + { + result = 1; + } + if( n<0 ) + { + result = xblas_xfastpow(1/r, -n, _state); + } + return result; +} + + + + +/************************************************************************* +Normalizes direction/step pair: makes |D|=1, scales Stp. +If |D|=0, it returns, leavind D/Stp unchanged. + + -- ALGLIB -- + Copyright 01.04.2010 by Bochkanov Sergey +*************************************************************************/ +void linminnormalized(/* Real */ ae_vector* d, + double* stp, + ae_int_t n, + ae_state *_state) +{ + double mx; + double s; + ae_int_t i; + + + + /* + * first, scale D to avoid underflow/overflow durng squaring + */ + mx = 0; + for(i=0; i<=n-1; i++) + { + mx = ae_maxreal(mx, ae_fabs(d->ptr.p_double[i], _state), _state); + } + if( ae_fp_eq(mx,0) ) + { + return; + } + s = 1/mx; + ae_v_muld(&d->ptr.p_double[0], 1, ae_v_len(0,n-1), s); + *stp = *stp/s; + + /* + * normalize D + */ + s = ae_v_dotproduct(&d->ptr.p_double[0], 1, &d->ptr.p_double[0], 1, ae_v_len(0,n-1)); + s = 1/ae_sqrt(s, _state); + ae_v_muld(&d->ptr.p_double[0], 1, ae_v_len(0,n-1), s); + *stp = *stp/s; +} + + +/************************************************************************* +THE PURPOSE OF MCSRCH IS TO FIND A STEP WHICH SATISFIES A SUFFICIENT +DECREASE CONDITION AND A CURVATURE CONDITION. + +AT EACH STAGE THE SUBROUTINE UPDATES AN INTERVAL OF UNCERTAINTY WITH +ENDPOINTS STX AND STY. THE INTERVAL OF UNCERTAINTY IS INITIALLY CHOSEN +SO THAT IT CONTAINS A MINIMIZER OF THE MODIFIED FUNCTION + + F(X+STP*S) - F(X) - FTOL*STP*(GRADF(X)'S). + +IF A STEP IS OBTAINED FOR WHICH THE MODIFIED FUNCTION HAS A NONPOSITIVE +FUNCTION VALUE AND NONNEGATIVE DERIVATIVE, THEN THE INTERVAL OF +UNCERTAINTY IS CHOSEN SO THAT IT CONTAINS A MINIMIZER OF F(X+STP*S). + +THE ALGORITHM IS DESIGNED TO FIND A STEP WHICH SATISFIES THE SUFFICIENT +DECREASE CONDITION + + F(X+STP*S) .LE. F(X) + FTOL*STP*(GRADF(X)'S), + +AND THE CURVATURE CONDITION + + ABS(GRADF(X+STP*S)'S)) .LE. GTOL*ABS(GRADF(X)'S). + +IF FTOL IS LESS THAN GTOL AND IF, FOR EXAMPLE, THE FUNCTION IS BOUNDED +BELOW, THEN THERE IS ALWAYS A STEP WHICH SATISFIES BOTH CONDITIONS. +IF NO STEP CAN BE FOUND WHICH SATISFIES BOTH CONDITIONS, THEN THE +ALGORITHM USUALLY STOPS WHEN ROUNDING ERRORS PREVENT FURTHER PROGRESS. +IN THIS CASE STP ONLY SATISFIES THE SUFFICIENT DECREASE CONDITION. + + +:::::::::::::IMPORTANT NOTES::::::::::::: + +NOTE 1: + +This routine guarantees that it will stop at the last point where function +value was calculated. It won't make several additional function evaluations +after finding good point. So if you store function evaluations requested by +this routine, you can be sure that last one is the point where we've stopped. + +NOTE 2: + +when 0xtrapf = 4.0; + zero = 0; + if( ae_fp_eq(stpmax,0) ) + { + stpmax = linmin_defstpmax; + } + if( ae_fp_less(*stp,linmin_stpmin) ) + { + *stp = linmin_stpmin; + } + if( ae_fp_greater(*stp,stpmax) ) + { + *stp = stpmax; + } + + /* + * Main cycle + */ + for(;;) + { + if( *stage==0 ) + { + + /* + * NEXT + */ + *stage = 2; + continue; + } + if( *stage==2 ) + { + state->infoc = 1; + *info = 0; + + /* + * CHECK THE INPUT PARAMETERS FOR ERRORS. + */ + if( ae_fp_less(stpmax,linmin_stpmin)&&ae_fp_greater(stpmax,0) ) + { + *info = 5; + *stp = 0.0; + return; + } + if( ((((((n<=0||ae_fp_less_eq(*stp,0))||ae_fp_less(linmin_ftol,0))||ae_fp_less(gtol,zero))||ae_fp_less(linmin_xtol,zero))||ae_fp_less(linmin_stpmin,zero))||ae_fp_less(stpmax,linmin_stpmin))||linmin_maxfev<=0 ) + { + *stage = 0; + return; + } + + /* + * COMPUTE THE INITIAL GRADIENT IN THE SEARCH DIRECTION + * AND CHECK THAT S IS A DESCENT DIRECTION. + */ + v = ae_v_dotproduct(&g->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->dginit = v; + if( ae_fp_greater_eq(state->dginit,0) ) + { + *stage = 0; + return; + } + + /* + * INITIALIZE LOCAL VARIABLES. + */ + state->brackt = ae_false; + state->stage1 = ae_true; + *nfev = 0; + state->finit = *f; + state->dgtest = linmin_ftol*state->dginit; + state->width = stpmax-linmin_stpmin; + state->width1 = state->width/p5; + ae_v_move(&wa->ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * THE VARIABLES STX, FX, DGX CONTAIN THE VALUES OF THE STEP, + * FUNCTION, AND DIRECTIONAL DERIVATIVE AT THE BEST STEP. + * THE VARIABLES STY, FY, DGY CONTAIN THE VALUE OF THE STEP, + * FUNCTION, AND DERIVATIVE AT THE OTHER ENDPOINT OF + * THE INTERVAL OF UNCERTAINTY. + * THE VARIABLES STP, F, DG CONTAIN THE VALUES OF THE STEP, + * FUNCTION, AND DERIVATIVE AT THE CURRENT STEP. + */ + state->stx = 0; + state->fx = state->finit; + state->dgx = state->dginit; + state->sty = 0; + state->fy = state->finit; + state->dgy = state->dginit; + + /* + * NEXT + */ + *stage = 3; + continue; + } + if( *stage==3 ) + { + + /* + * START OF ITERATION. + * + * SET THE MINIMUM AND MAXIMUM STEPS TO CORRESPOND + * TO THE PRESENT INTERVAL OF UNCERTAINTY. + */ + if( state->brackt ) + { + if( ae_fp_less(state->stx,state->sty) ) + { + state->stmin = state->stx; + state->stmax = state->sty; + } + else + { + state->stmin = state->sty; + state->stmax = state->stx; + } + } + else + { + state->stmin = state->stx; + state->stmax = *stp+state->xtrapf*(*stp-state->stx); + } + + /* + * FORCE THE STEP TO BE WITHIN THE BOUNDS STPMAX AND STPMIN. + */ + if( ae_fp_greater(*stp,stpmax) ) + { + *stp = stpmax; + } + if( ae_fp_less(*stp,linmin_stpmin) ) + { + *stp = linmin_stpmin; + } + + /* + * IF AN UNUSUAL TERMINATION IS TO OCCUR THEN LET + * STP BE THE LOWEST POINT OBTAINED SO FAR. + */ + if( (((state->brackt&&(ae_fp_less_eq(*stp,state->stmin)||ae_fp_greater_eq(*stp,state->stmax)))||*nfev>=linmin_maxfev-1)||state->infoc==0)||(state->brackt&&ae_fp_less_eq(state->stmax-state->stmin,linmin_xtol*state->stmax)) ) + { + *stp = state->stx; + } + + /* + * EVALUATE THE FUNCTION AND GRADIENT AT STP + * AND COMPUTE THE DIRECTIONAL DERIVATIVE. + */ + ae_v_move(&x->ptr.p_double[0], 1, &wa->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&x->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1), *stp); + + /* + * NEXT + */ + *stage = 4; + return; + } + if( *stage==4 ) + { + *info = 0; + *nfev = *nfev+1; + v = ae_v_dotproduct(&g->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->dg = v; + state->ftest1 = state->finit+*stp*state->dgtest; + + /* + * TEST FOR CONVERGENCE. + */ + if( (state->brackt&&(ae_fp_less_eq(*stp,state->stmin)||ae_fp_greater_eq(*stp,state->stmax)))||state->infoc==0 ) + { + *info = 6; + } + if( (ae_fp_eq(*stp,stpmax)&&ae_fp_less_eq(*f,state->ftest1))&&ae_fp_less_eq(state->dg,state->dgtest) ) + { + *info = 5; + } + if( ae_fp_eq(*stp,linmin_stpmin)&&(ae_fp_greater(*f,state->ftest1)||ae_fp_greater_eq(state->dg,state->dgtest)) ) + { + *info = 4; + } + if( *nfev>=linmin_maxfev ) + { + *info = 3; + } + if( state->brackt&&ae_fp_less_eq(state->stmax-state->stmin,linmin_xtol*state->stmax) ) + { + *info = 2; + } + if( ae_fp_less_eq(*f,state->ftest1)&&ae_fp_less_eq(ae_fabs(state->dg, _state),-gtol*state->dginit) ) + { + *info = 1; + } + + /* + * CHECK FOR TERMINATION. + */ + if( *info!=0 ) + { + *stage = 0; + return; + } + + /* + * IN THE FIRST STAGE WE SEEK A STEP FOR WHICH THE MODIFIED + * FUNCTION HAS A NONPOSITIVE VALUE AND NONNEGATIVE DERIVATIVE. + */ + if( (state->stage1&&ae_fp_less_eq(*f,state->ftest1))&&ae_fp_greater_eq(state->dg,ae_minreal(linmin_ftol, gtol, _state)*state->dginit) ) + { + state->stage1 = ae_false; + } + + /* + * A MODIFIED FUNCTION IS USED TO PREDICT THE STEP ONLY IF + * WE HAVE NOT OBTAINED A STEP FOR WHICH THE MODIFIED + * FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE + * DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN + * OBTAINED BUT THE DECREASE IS NOT SUFFICIENT. + */ + if( (state->stage1&&ae_fp_less_eq(*f,state->fx))&&ae_fp_greater(*f,state->ftest1) ) + { + + /* + * DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES. + */ + state->fm = *f-*stp*state->dgtest; + state->fxm = state->fx-state->stx*state->dgtest; + state->fym = state->fy-state->sty*state->dgtest; + state->dgm = state->dg-state->dgtest; + state->dgxm = state->dgx-state->dgtest; + state->dgym = state->dgy-state->dgtest; + + /* + * CALL CSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY + * AND TO COMPUTE THE NEW STEP. + */ + linmin_mcstep(&state->stx, &state->fxm, &state->dgxm, &state->sty, &state->fym, &state->dgym, stp, state->fm, state->dgm, &state->brackt, state->stmin, state->stmax, &state->infoc, _state); + + /* + * RESET THE FUNCTION AND GRADIENT VALUES FOR F. + */ + state->fx = state->fxm+state->stx*state->dgtest; + state->fy = state->fym+state->sty*state->dgtest; + state->dgx = state->dgxm+state->dgtest; + state->dgy = state->dgym+state->dgtest; + } + else + { + + /* + * CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY + * AND TO COMPUTE THE NEW STEP. + */ + linmin_mcstep(&state->stx, &state->fx, &state->dgx, &state->sty, &state->fy, &state->dgy, stp, *f, state->dg, &state->brackt, state->stmin, state->stmax, &state->infoc, _state); + } + + /* + * FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE + * INTERVAL OF UNCERTAINTY. + */ + if( state->brackt ) + { + if( ae_fp_greater_eq(ae_fabs(state->sty-state->stx, _state),p66*state->width1) ) + { + *stp = state->stx+p5*(state->sty-state->stx); + } + state->width1 = state->width; + state->width = ae_fabs(state->sty-state->stx, _state); + } + + /* + * NEXT. + */ + *stage = 3; + continue; + } + } +} + + +/************************************************************************* +These functions perform Armijo line search using at most FMAX function +evaluations. It doesn't enforce some kind of " sufficient decrease" +criterion - it just tries different Armijo steps and returns optimum found +so far. + +Optimization is done using F-rcomm interface: +* ArmijoCreate initializes State structure + (reusing previously allocated buffers) +* ArmijoIteration is subsequently called +* ArmijoResults returns results + +INPUT PARAMETERS: + N - problem size + X - array[N], starting point + F - F(X+S*STP) + S - step direction, S>0 + STP - step length + STPMAX - maximum value for STP or zero (if no limit is imposed) + FMAX - maximum number of function evaluations + State - optimization state + + -- ALGLIB -- + Copyright 05.10.2010 by Bochkanov Sergey +*************************************************************************/ +void armijocreate(ae_int_t n, + /* Real */ ae_vector* x, + double f, + /* Real */ ae_vector* s, + double stp, + double stpmax, + ae_int_t fmax, + armijostate* state, + ae_state *_state) +{ + + + if( state->x.cntx, n, _state); + } + if( state->xbase.cntxbase, n, _state); + } + if( state->s.cnts, n, _state); + } + state->stpmax = stpmax; + state->fmax = fmax; + state->stplen = stp; + state->fcur = f; + state->n = n; + ae_v_move(&state->xbase.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->s.ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_vector_set_length(&state->rstate.ia, 0+1, _state); + ae_vector_set_length(&state->rstate.ra, 0+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +This is rcomm-based search function + + -- ALGLIB -- + Copyright 05.10.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool armijoiteration(armijostate* state, ae_state *_state) +{ + double v; + ae_int_t n; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + v = state->rstate.ra.ptr.p_double[0]; + } + else + { + n = -983; + v = -989; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + + /* + * Routine body + */ + if( (ae_fp_less_eq(state->stplen,0)||ae_fp_less(state->stpmax,0))||state->fmax<2 ) + { + state->info = 0; + result = ae_false; + return result; + } + if( ae_fp_less_eq(state->stplen,linmin_stpmin) ) + { + state->info = 4; + result = ae_false; + return result; + } + n = state->n; + state->nfev = 0; + + /* + * We always need F + */ + state->needf = ae_true; + + /* + * Bound StpLen + */ + if( ae_fp_greater(state->stplen,state->stpmax)&&ae_fp_neq(state->stpmax,0) ) + { + state->stplen = state->stpmax; + } + + /* + * Increase length + */ + v = state->stplen*linmin_armijofactor; + if( ae_fp_greater(v,state->stpmax)&&ae_fp_neq(state->stpmax,0) ) + { + v = state->stpmax; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->x.ptr.p_double[0], 1, &state->s.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->nfev = state->nfev+1; + if( ae_fp_greater_eq(state->f,state->fcur) ) + { + goto lbl_4; + } + state->stplen = v; + state->fcur = state->f; +lbl_6: + if( ae_false ) + { + goto lbl_7; + } + + /* + * test stopping conditions + */ + if( state->nfev>=state->fmax ) + { + state->info = 3; + result = ae_false; + return result; + } + if( ae_fp_greater_eq(state->stplen,state->stpmax) ) + { + state->info = 5; + result = ae_false; + return result; + } + + /* + * evaluate F + */ + v = state->stplen*linmin_armijofactor; + if( ae_fp_greater(v,state->stpmax)&&ae_fp_neq(state->stpmax,0) ) + { + v = state->stpmax; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->x.ptr.p_double[0], 1, &state->s.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->nfev = state->nfev+1; + + /* + * make decision + */ + if( ae_fp_less(state->f,state->fcur) ) + { + state->stplen = v; + state->fcur = state->f; + } + else + { + state->info = 1; + result = ae_false; + return result; + } + goto lbl_6; +lbl_7: +lbl_4: + + /* + * Decrease length + */ + v = state->stplen/linmin_armijofactor; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->x.ptr.p_double[0], 1, &state->s.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + state->nfev = state->nfev+1; + if( ae_fp_greater_eq(state->f,state->fcur) ) + { + goto lbl_8; + } + state->stplen = state->stplen/linmin_armijofactor; + state->fcur = state->f; +lbl_10: + if( ae_false ) + { + goto lbl_11; + } + + /* + * test stopping conditions + */ + if( state->nfev>=state->fmax ) + { + state->info = 3; + result = ae_false; + return result; + } + if( ae_fp_less_eq(state->stplen,linmin_stpmin) ) + { + state->info = 4; + result = ae_false; + return result; + } + + /* + * evaluate F + */ + v = state->stplen/linmin_armijofactor; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->x.ptr.p_double[0], 1, &state->s.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->nfev = state->nfev+1; + + /* + * make decision + */ + if( ae_fp_less(state->f,state->fcur) ) + { + state->stplen = state->stplen/linmin_armijofactor; + state->fcur = state->f; + } + else + { + state->info = 1; + result = ae_false; + return result; + } + goto lbl_10; +lbl_11: +lbl_8: + + /* + * Nothing to be done + */ + state->info = 1; + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ra.ptr.p_double[0] = v; + return result; +} + + +/************************************************************************* +Results of Armijo search + +OUTPUT PARAMETERS: + INFO - on output it is set to one of the return codes: + * 0 improper input params + * 1 optimum step is found with at most FMAX evaluations + * 3 FMAX evaluations were used, + X contains optimum found so far + * 4 step is at lower bound STPMIN + * 5 step is at upper bound + STP - step length (in case of failure it is still returned) + F - function value (in case of failure it is still returned) + + -- ALGLIB -- + Copyright 05.10.2010 by Bochkanov Sergey +*************************************************************************/ +void armijoresults(armijostate* state, + ae_int_t* info, + double* stp, + double* f, + ae_state *_state) +{ + + + *info = state->info; + *stp = state->stplen; + *f = state->fcur; +} + + +static void linmin_mcstep(double* stx, + double* fx, + double* dx, + double* sty, + double* fy, + double* dy, + double* stp, + double fp, + double dp, + ae_bool* brackt, + double stmin, + double stmax, + ae_int_t* info, + ae_state *_state) +{ + ae_bool bound; + double gamma; + double p; + double q; + double r; + double s; + double sgnd; + double stpc; + double stpf; + double stpq; + double theta; + + + *info = 0; + + /* + * CHECK THE INPUT PARAMETERS FOR ERRORS. + */ + if( ((*brackt&&(ae_fp_less_eq(*stp,ae_minreal(*stx, *sty, _state))||ae_fp_greater_eq(*stp,ae_maxreal(*stx, *sty, _state))))||ae_fp_greater_eq(*dx*(*stp-(*stx)),0))||ae_fp_less(stmax,stmin) ) + { + return; + } + + /* + * DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN. + */ + sgnd = dp*(*dx/ae_fabs(*dx, _state)); + + /* + * FIRST CASE. A HIGHER FUNCTION VALUE. + * THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER + * TO STX THAN THE QUADRATIC STEP, THE CUBIC STEP IS TAKEN, + * ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN. + */ + if( ae_fp_greater(fp,*fx) ) + { + *info = 1; + bound = ae_true; + theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; + s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); + gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state); + if( ae_fp_less(*stp,*stx) ) + { + gamma = -gamma; + } + p = gamma-(*dx)+theta; + q = gamma-(*dx)+gamma+dp; + r = p/q; + stpc = *stx+r*(*stp-(*stx)); + stpq = *stx+*dx/((*fx-fp)/(*stp-(*stx))+(*dx))/2*(*stp-(*stx)); + if( ae_fp_less(ae_fabs(stpc-(*stx), _state),ae_fabs(stpq-(*stx), _state)) ) + { + stpf = stpc; + } + else + { + stpf = stpc+(stpq-stpc)/2; + } + *brackt = ae_true; + } + else + { + if( ae_fp_less(sgnd,0) ) + { + + /* + * SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF + * OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC + * STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP, + * THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN. + */ + *info = 2; + bound = ae_false; + theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; + s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); + gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state); + if( ae_fp_greater(*stp,*stx) ) + { + gamma = -gamma; + } + p = gamma-dp+theta; + q = gamma-dp+gamma+(*dx); + r = p/q; + stpc = *stp+r*(*stx-(*stp)); + stpq = *stp+dp/(dp-(*dx))*(*stx-(*stp)); + if( ae_fp_greater(ae_fabs(stpc-(*stp), _state),ae_fabs(stpq-(*stp), _state)) ) + { + stpf = stpc; + } + else + { + stpf = stpq; + } + *brackt = ae_true; + } + else + { + if( ae_fp_less(ae_fabs(dp, _state),ae_fabs(*dx, _state)) ) + { + + /* + * THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE + * SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES. + * THE CUBIC STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY + * IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC + * IS BEYOND STP. OTHERWISE THE CUBIC STEP IS DEFINED TO BE + * EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO + * COMPUTED AND IF THE MINIMUM IS BRACKETED THEN THE THE STEP + * CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN. + */ + *info = 3; + bound = ae_true; + theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; + s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); + + /* + * THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND + * TO INFINITY IN THE DIRECTION OF THE STEP. + */ + gamma = s*ae_sqrt(ae_maxreal(0, ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state), _state); + if( ae_fp_greater(*stp,*stx) ) + { + gamma = -gamma; + } + p = gamma-dp+theta; + q = gamma+(*dx-dp)+gamma; + r = p/q; + if( ae_fp_less(r,0)&&ae_fp_neq(gamma,0) ) + { + stpc = *stp+r*(*stx-(*stp)); + } + else + { + if( ae_fp_greater(*stp,*stx) ) + { + stpc = stmax; + } + else + { + stpc = stmin; + } + } + stpq = *stp+dp/(dp-(*dx))*(*stx-(*stp)); + if( *brackt ) + { + if( ae_fp_less(ae_fabs(*stp-stpc, _state),ae_fabs(*stp-stpq, _state)) ) + { + stpf = stpc; + } + else + { + stpf = stpq; + } + } + else + { + if( ae_fp_greater(ae_fabs(*stp-stpc, _state),ae_fabs(*stp-stpq, _state)) ) + { + stpf = stpc; + } + else + { + stpf = stpq; + } + } + } + else + { + + /* + * FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE + * SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES + * NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP + * IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN. + */ + *info = 4; + bound = ae_false; + if( *brackt ) + { + theta = 3*(fp-(*fy))/(*sty-(*stp))+(*dy)+dp; + s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dy, _state), ae_fabs(dp, _state), _state), _state); + gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dy/s*(dp/s), _state); + if( ae_fp_greater(*stp,*sty) ) + { + gamma = -gamma; + } + p = gamma-dp+theta; + q = gamma-dp+gamma+(*dy); + r = p/q; + stpc = *stp+r*(*sty-(*stp)); + stpf = stpc; + } + else + { + if( ae_fp_greater(*stp,*stx) ) + { + stpf = stmax; + } + else + { + stpf = stmin; + } + } + } + } + } + + /* + * UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT + * DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE. + */ + if( ae_fp_greater(fp,*fx) ) + { + *sty = *stp; + *fy = fp; + *dy = dp; + } + else + { + if( ae_fp_less(sgnd,0.0) ) + { + *sty = *stx; + *fy = *fx; + *dy = *dx; + } + *stx = *stp; + *fx = fp; + *dx = dp; + } + + /* + * COMPUTE THE NEW STEP AND SAFEGUARD IT. + */ + stpf = ae_minreal(stmax, stpf, _state); + stpf = ae_maxreal(stmin, stpf, _state); + *stp = stpf; + if( *brackt&&bound ) + { + if( ae_fp_greater(*sty,*stx) ) + { + *stp = ae_minreal(*stx+0.66*(*sty-(*stx)), *stp, _state); + } + else + { + *stp = ae_maxreal(*stx+0.66*(*sty-(*stx)), *stp, _state); + } + } +} + + +ae_bool _linminstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + linminstate *p = (linminstate*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _linminstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + linminstate *dst = (linminstate*)_dst; + linminstate *src = (linminstate*)_src; + dst->brackt = src->brackt; + dst->stage1 = src->stage1; + dst->infoc = src->infoc; + dst->dg = src->dg; + dst->dgm = src->dgm; + dst->dginit = src->dginit; + dst->dgtest = src->dgtest; + dst->dgx = src->dgx; + dst->dgxm = src->dgxm; + dst->dgy = src->dgy; + dst->dgym = src->dgym; + dst->finit = src->finit; + dst->ftest1 = src->ftest1; + dst->fm = src->fm; + dst->fx = src->fx; + dst->fxm = src->fxm; + dst->fy = src->fy; + dst->fym = src->fym; + dst->stx = src->stx; + dst->sty = src->sty; + dst->stmin = src->stmin; + dst->stmax = src->stmax; + dst->width = src->width; + dst->width1 = src->width1; + dst->xtrapf = src->xtrapf; + return ae_true; +} + + +void _linminstate_clear(void* _p) +{ + linminstate *p = (linminstate*)_p; + ae_touch_ptr((void*)p); +} + + +void _linminstate_destroy(void* _p) +{ + linminstate *p = (linminstate*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _armijostate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + armijostate *p = (armijostate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xbase, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _armijostate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + armijostate *dst = (armijostate*)_dst; + armijostate *src = (armijostate*)_src; + dst->needf = src->needf; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + dst->f = src->f; + dst->n = src->n; + if( !ae_vector_init_copy(&dst->xbase, &src->xbase, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) + return ae_false; + dst->stplen = src->stplen; + dst->fcur = src->fcur; + dst->stpmax = src->stpmax; + dst->fmax = src->fmax; + dst->nfev = src->nfev; + dst->info = src->info; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _armijostate_clear(void* _p) +{ + armijostate *p = (armijostate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x); + ae_vector_clear(&p->xbase); + ae_vector_clear(&p->s); + _rcommstate_clear(&p->rstate); +} + + +void _armijostate_destroy(void* _p) +{ + armijostate *p = (armijostate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->xbase); + ae_vector_destroy(&p->s); + _rcommstate_destroy(&p->rstate); +} + + + + +void findprimitiverootandinverse(ae_int_t n, + ae_int_t* proot, + ae_int_t* invproot, + ae_state *_state) +{ + ae_int_t candroot; + ae_int_t phin; + ae_int_t q; + ae_int_t f; + ae_bool allnonone; + ae_int_t x; + ae_int_t lastx; + ae_int_t y; + ae_int_t lasty; + ae_int_t a; + ae_int_t b; + ae_int_t t; + ae_int_t n2; + + *proot = 0; + *invproot = 0; + + ae_assert(n>=3, "FindPrimitiveRootAndInverse: N<3", _state); + *proot = 0; + *invproot = 0; + + /* + * check that N is prime + */ + ae_assert(ntheory_isprime(n, _state), "FindPrimitiveRoot: N is not prime", _state); + + /* + * Because N is prime, Euler totient function is equal to N-1 + */ + phin = n-1; + + /* + * Test different values of PRoot - from 2 to N-1. + * One of these values MUST be primitive root. + * + * For testing we use algorithm from Wiki (Primitive root modulo n): + * * compute phi(N) + * * determine the different prime factors of phi(N), say p1, ..., pk + * * for every element m of Zn*, compute m^(phi(N)/pi) mod N for i=1..k + * using a fast algorithm for modular exponentiation. + * * a number m for which these k results are all different from 1 is a + * primitive root. + */ + for(candroot=2; candroot<=n-1; candroot++) + { + + /* + * We have current candidate root in CandRoot. + * + * Scan different prime factors of PhiN. Here: + * * F is a current candidate factor + * * Q is a current quotient - amount which was left after dividing PhiN + * by all previous factors + * + * For each factor, perform test mentioned above. + */ + q = phin; + f = 2; + allnonone = ae_true; + while(q>1) + { + if( q%f==0 ) + { + t = ntheory_modexp(candroot, phin/f, n, _state); + if( t==1 ) + { + allnonone = ae_false; + break; + } + while(q%f==0) + { + q = q/f; + } + } + f = f+1; + } + if( allnonone ) + { + *proot = candroot; + break; + } + } + ae_assert(*proot>=2, "FindPrimitiveRoot: internal error (root not found)", _state); + + /* + * Use extended Euclidean algorithm to find multiplicative inverse of primitive root + */ + x = 0; + lastx = 1; + y = 1; + lasty = 0; + a = *proot; + b = n; + while(b!=0) + { + q = a/b; + t = a%b; + a = b; + b = t; + t = lastx-q*x; + lastx = x; + x = t; + t = lasty-q*y; + lasty = y; + y = t; + } + while(lastx<0) + { + lastx = lastx+n; + } + *invproot = lastx; + + /* + * Check that it is safe to perform multiplication modulo N. + * Check results for consistency. + */ + n2 = (n-1)*(n-1); + ae_assert(n2/(n-1)==n-1, "FindPrimitiveRoot: internal error", _state); + ae_assert(*proot*(*invproot)/(*proot)==(*invproot), "FindPrimitiveRoot: internal error", _state); + ae_assert(*proot*(*invproot)/(*invproot)==(*proot), "FindPrimitiveRoot: internal error", _state); + ae_assert(*proot*(*invproot)%n==1, "FindPrimitiveRoot: internal error", _state); +} + + +static ae_bool ntheory_isprime(ae_int_t n, ae_state *_state) +{ + ae_int_t p; + ae_bool result; + + + result = ae_false; + p = 2; + while(p*p<=n) + { + if( n%p==0 ) + { + return result; + } + p = p+1; + } + result = ae_true; + return result; +} + + +static ae_int_t ntheory_modmul(ae_int_t a, + ae_int_t b, + ae_int_t n, + ae_state *_state) +{ + ae_int_t t; + double ra; + double rb; + ae_int_t result; + + + ae_assert(a>=0&&a=N", _state); + ae_assert(b>=0&&b=N", _state); + + /* + * Base cases + */ + ra = a; + rb = b; + if( b==0||a==0 ) + { + result = 0; + return result; + } + if( b==1||a==1 ) + { + result = a*b; + return result; + } + if( ae_fp_eq(ra*rb,a*b) ) + { + result = a*b%n; + return result; + } + + /* + * Non-base cases + */ + if( b%2==0 ) + { + + /* + * A*B = (A*(B/2)) * 2 + * + * Product T=A*(B/2) is calculated recursively, product T*2 is + * calculated as follows: + * * result:=T-N + * * result:=result+T + * * if result<0 then result:=result+N + * + * In case integer result overflows, we generate exception + */ + t = ntheory_modmul(a, b/2, n, _state); + result = t-n; + result = result+t; + if( result<0 ) + { + result = result+n; + } + } + else + { + + /* + * A*B = (A*(B div 2)) * 2 + A + * + * Product T=A*(B/2) is calculated recursively, product T*2 is + * calculated as follows: + * * result:=T-N + * * result:=result+T + * * if result<0 then result:=result+N + * + * In case integer result overflows, we generate exception + */ + t = ntheory_modmul(a, b/2, n, _state); + result = t-n; + result = result+t; + if( result<0 ) + { + result = result+n; + } + result = result-n; + result = result+a; + if( result<0 ) + { + result = result+n; + } + } + return result; +} + + +static ae_int_t ntheory_modexp(ae_int_t a, + ae_int_t b, + ae_int_t n, + ae_state *_state) +{ + ae_int_t t; + ae_int_t result; + + + ae_assert(a>=0&&a=N", _state); + ae_assert(b>=0, "ModExp: B<0", _state); + + /* + * Base cases + */ + if( b==0 ) + { + result = 1; + return result; + } + if( b==1 ) + { + result = a; + return result; + } + + /* + * Non-base cases + */ + if( b%2==0 ) + { + t = ntheory_modmul(a, a, n, _state); + result = ntheory_modexp(t, b/2, n, _state); + } + else + { + t = ntheory_modmul(a, a, n, _state); + result = ntheory_modexp(t, b/2, n, _state); + result = ntheory_modmul(result, a, n, _state); + } + return result; +} + + + + +/************************************************************************* +This subroutine generates FFT plan for K complex FFT's with length N each. + +INPUT PARAMETERS: + N - FFT length (in complex numbers), N>=1 + K - number of repetitions, K>=1 + +OUTPUT PARAMETERS: + Plan - plan + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +void ftcomplexfftplan(ae_int_t n, + ae_int_t k, + fasttransformplan* plan, + ae_state *_state) +{ + ae_frame _frame_block; + srealarray bluesteinbuf; + ae_int_t rowptr; + ae_int_t bluesteinsize; + ae_int_t precrptr; + ae_int_t preciptr; + ae_int_t precrsize; + ae_int_t precisize; + + ae_frame_make(_state, &_frame_block); + _fasttransformplan_clear(plan); + _srealarray_init(&bluesteinbuf, _state, ae_true); + + + /* + * Initial check for parameters + */ + ae_assert(n>0, "FTComplexFFTPlan: N<=0", _state); + ae_assert(k>0, "FTComplexFFTPlan: K<=0", _state); + + /* + * Determine required sizes of precomputed real and integer + * buffers. This stage of code is highly dependent on internals + * of FTComplexFFTPlanRec() and must be kept synchronized with + * possible changes in internals of plan generation function. + * + * Buffer size is determined as follows: + * * N is factorized + * * we factor out anything which is less or equal to MaxRadix + * * prime factor F>RaderThreshold requires 4*FTBaseFindSmooth(2*F-1) + * real entries to store precomputed Quantities for Bluestein's + * transformation + * * prime factor F<=RaderThreshold does NOT require + * precomputed storage + */ + precrsize = 0; + precisize = 0; + ftbase_ftdeterminespacerequirements(n, &precrsize, &precisize, _state); + if( precrsize>0 ) + { + ae_vector_set_length(&plan->precr, precrsize, _state); + } + if( precisize>0 ) + { + ae_vector_set_length(&plan->preci, precisize, _state); + } + + /* + * Generate plan + */ + rowptr = 0; + precrptr = 0; + preciptr = 0; + bluesteinsize = 1; + ae_vector_set_length(&plan->buffer, 2*n*k, _state); + ftbase_ftcomplexfftplanrec(n, k, ae_true, ae_true, &rowptr, &bluesteinsize, &precrptr, &preciptr, plan, _state); + ae_vector_set_length(&bluesteinbuf.val, bluesteinsize, _state); + ae_shared_pool_set_seed(&plan->bluesteinpool, &bluesteinbuf, sizeof(bluesteinbuf), _srealarray_init, _srealarray_init_copy, _srealarray_destroy, _state); + + /* + * Check that actual amount of precomputed space used by transformation + * plan is EXACTLY equal to amount of space allocated by us. + */ + ae_assert(precrptr==precrsize, "FTComplexFFTPlan: internal error (PrecRPtr<>PrecRSize)", _state); + ae_assert(preciptr==precisize, "FTComplexFFTPlan: internal error (PrecRPtr<>PrecRSize)", _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine applies transformation plan to input/output array A. + +INPUT PARAMETERS: + Plan - transformation plan + A - array, must be large enough for plan to work + OffsA - offset of the subarray to process + RepCnt - repetition count (transformation is repeatedly applied + to subsequent subarrays) + +OUTPUT PARAMETERS: + Plan - plan (temporary buffers can be modified, plan itself + is unchanged and can be reused) + A - transformed array + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +void ftapplyplan(fasttransformplan* plan, + /* Real */ ae_vector* a, + ae_int_t offsa, + ae_int_t repcnt, + ae_state *_state) +{ + ae_int_t plansize; + ae_int_t i; + + + plansize = plan->entries.ptr.pp_int[0][ftbase_coloperandscnt]*plan->entries.ptr.pp_int[0][ftbase_coloperandsize]*plan->entries.ptr.pp_int[0][ftbase_colmicrovectorsize]; + for(i=0; i<=repcnt-1; i++) + { + ftbase_ftapplysubplan(plan, 0, a, offsa+plansize*i, 0, &plan->buffer, 1, _state); + } +} + + +/************************************************************************* +Returns good factorization N=N1*N2. + +Usually N1<=N2 (but not always - small N's may be exception). +if N1<>1 then N2<>1. + +Factorization is chosen depending on task type and codelets we have. + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +void ftbasefactorize(ae_int_t n, + ae_int_t tasktype, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state) +{ + ae_int_t j; + + *n1 = 0; + *n2 = 0; + + *n1 = 0; + *n2 = 0; + + /* + * try to find good codelet + */ + if( *n1*(*n2)!=n ) + { + for(j=ftbase_ftbasecodeletrecommended; j>=2; j--) + { + if( n%j==0 ) + { + *n1 = j; + *n2 = n/j; + break; + } + } + } + + /* + * try to factorize N + */ + if( *n1*(*n2)!=n ) + { + for(j=ftbase_ftbasecodeletrecommended+1; j<=n-1; j++) + { + if( n%j==0 ) + { + *n1 = j; + *n2 = n/j; + break; + } + } + } + + /* + * looks like N is prime :( + */ + if( *n1*(*n2)!=n ) + { + *n1 = 1; + *n2 = n; + } + + /* + * normalize + */ + if( *n2==1&&*n1!=1 ) + { + *n2 = *n1; + *n1 = 1; + } +} + + +/************************************************************************* +Is number smooth? + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool ftbaseissmooth(ae_int_t n, ae_state *_state) +{ + ae_int_t i; + ae_bool result; + + + for(i=2; i<=ftbase_ftbasemaxsmoothfactor; i++) + { + while(n%i==0) + { + n = n/i; + } + } + result = n==1; + return result; +} + + +/************************************************************************* +Returns smallest smooth (divisible only by 2, 3, 5) number that is greater +than or equal to max(N,2) + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +ae_int_t ftbasefindsmooth(ae_int_t n, ae_state *_state) +{ + ae_int_t best; + ae_int_t result; + + + best = 2; + while(bestRaderThreshold requires 4*FTBaseFindSmooth(2*F-1) + * real entries to store precomputed Quantities for Bluestein's + * transformation + * * prime factor F<=RaderThreshold requires 2*(F-1)+ESTIMATE(F-1) + * precomputed storage + */ + ncur = n; + for(i=2; i<=ftbase_maxradix; i++) + { + while(ncur%i==0) + { + ncur = ncur/i; + } + } + f = 2; + while(f<=ncur) + { + while(ncur%f==0) + { + if( f>ftbase_raderthreshold ) + { + *precrsize = *precrsize+4*ftbasefindsmooth(2*f-1, _state); + } + else + { + *precrsize = *precrsize+2*(f-1); + ftbase_ftdeterminespacerequirements(f-1, precrsize, precisize, _state); + } + ncur = ncur/f; + } + f = f+1; + } +} + + +/************************************************************************* +Recurrent function called by FTComplexFFTPlan() and other functions. It +recursively builds transformation plan + +INPUT PARAMETERS: + N - FFT length (in complex numbers), N>=1 + K - number of repetitions, K>=1 + ChildPlan - if True, plan generator inserts OpStart/opEnd in the + plan header/footer. + TopmostPlan - if True, plan generator assumes that it is topmost plan: + * it may use global buffer for transpositions + and there is no other plan which executes in parallel + RowPtr - index which points to past-the-last entry generated so far + BluesteinSize- amount of storage (in real numbers) required for Bluestein buffer + PrecRPtr - pointer to unused part of precomputed real buffer (Plan.PrecR): + * when this function stores some data to precomputed buffer, + it advances pointer. + * it is responsibility of the function to assert that + Plan.PrecR has enough space to store data before actually + writing to buffer. + * it is responsibility of the caller to allocate enough + space before calling this function + PrecIPtr - pointer to unused part of precomputed integer buffer (Plan.PrecI): + * when this function stores some data to precomputed buffer, + it advances pointer. + * it is responsibility of the function to assert that + Plan.PrecR has enough space to store data before actually + writing to buffer. + * it is responsibility of the caller to allocate enough + space before calling this function + Plan - plan (generated so far) + +OUTPUT PARAMETERS: + RowPtr - updated pointer (advanced by number of entries generated + by function) + BluesteinSize- updated amount + (may be increased, but may never be decreased) + +NOTE: in case TopmostPlan is True, ChildPlan is also must be True. + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftcomplexfftplanrec(ae_int_t n, + ae_int_t k, + ae_bool childplan, + ae_bool topmostplan, + ae_int_t* rowptr, + ae_int_t* bluesteinsize, + ae_int_t* precrptr, + ae_int_t* preciptr, + fasttransformplan* plan, + ae_state *_state) +{ + ae_frame _frame_block; + srealarray localbuf; + ae_int_t m; + ae_int_t n1; + ae_int_t n2; + ae_int_t gq; + ae_int_t giq; + ae_int_t row0; + ae_int_t row1; + ae_int_t row2; + ae_int_t row3; + + ae_frame_make(_state, &_frame_block); + _srealarray_init(&localbuf, _state, ae_true); + + ae_assert(n>0, "FTComplexFFTPlan: N<=0", _state); + ae_assert(k>0, "FTComplexFFTPlan: K<=0", _state); + ae_assert(!topmostplan||childplan, "FTComplexFFTPlan: ChildPlan is inconsistent with TopmostPlan", _state); + + /* + * Try to generate "topmost" plan + */ + if( topmostplan&&n>ftbase_recursivethreshold ) + { + ftbase_ftfactorize(n, ae_false, &n1, &n2, _state); + if( n1*n2==0 ) + { + + /* + * Handle prime-factor FFT with Bluestein's FFT. + * Determine size of Bluestein's buffer. + */ + m = ftbasefindsmooth(2*n-1, _state); + *bluesteinsize = ae_maxint(2*m, *bluesteinsize, _state); + + /* + * Generate plan + */ + ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); + ftbase_ftpushentry4(plan, rowptr, ftbase_opbluesteinsfft, k, n, 2, m, 2, *precrptr, 0, _state); + row0 = *rowptr; + ftbase_ftpushentry(plan, rowptr, ftbase_opjmp, 0, 0, 0, 0, _state); + ftbase_ftcomplexfftplanrec(m, 1, ae_true, ae_true, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + row1 = *rowptr; + plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; + ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); + + /* + * Fill precomputed buffer + */ + ftbase_ftprecomputebluesteinsfft(n, m, &plan->precr, *precrptr, _state); + + /* + * Update pointer to the precomputed area + */ + *precrptr = *precrptr+4*m; + } + else + { + + /* + * Handle composite FFT with recursive Cooley-Tukey which + * uses global buffer instead of local one. + */ + ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); + row0 = *rowptr; + ftbase_ftpushentry2(plan, rowptr, ftbase_opparallelcall, k*n2, n1, 2, 0, ftbase_ftoptimisticestimate(n, _state), _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexfftfactors, k, n, 2, n1, _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n2, _state); + row2 = *rowptr; + ftbase_ftpushentry2(plan, rowptr, ftbase_opparallelcall, k*n1, n2, 2, 0, ftbase_ftoptimisticestimate(n, _state), _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); + row1 = *rowptr; + ftbase_ftcomplexfftplanrec(n1, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; + row3 = *rowptr; + ftbase_ftcomplexfftplanrec(n2, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + plan->entries.ptr.pp_int[row2][ftbase_colparam0] = row3-row2; + } + ae_frame_leave(_state); + return; + } + + /* + * Prepare "non-topmost" plan: + * * calculate factorization + * * use local (shared) buffer + * * update buffer size - ANY plan will need at least + * 2*N temporaries, additional requirements can be + * applied later + */ + ftbase_ftfactorize(n, ae_false, &n1, &n2, _state); + + /* + * Handle FFT's with N1*N2=0: either small-N or prime-factor + */ + if( n1*n2==0 ) + { + if( n<=ftbase_maxradix ) + { + + /* + * Small-N FFT + */ + if( childplan ) + { + ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); + } + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexcodeletfft, k, n, 2, 0, _state); + if( childplan ) + { + ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); + } + ae_frame_leave(_state); + return; + } + if( n<=ftbase_raderthreshold ) + { + + /* + * Handle prime-factor FFT's with Rader's FFT + */ + m = n-1; + if( childplan ) + { + ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); + } + findprimitiverootandinverse(n, &gq, &giq, _state); + ftbase_ftpushentry4(plan, rowptr, ftbase_opradersfft, k, n, 2, 2, gq, giq, *precrptr, _state); + ftbase_ftprecomputeradersfft(n, gq, giq, &plan->precr, *precrptr, _state); + *precrptr = *precrptr+2*(n-1); + row0 = *rowptr; + ftbase_ftpushentry(plan, rowptr, ftbase_opjmp, 0, 0, 0, 0, _state); + ftbase_ftcomplexfftplanrec(m, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + row1 = *rowptr; + plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; + if( childplan ) + { + ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); + } + } + else + { + + /* + * Handle prime-factor FFT's with Bluestein's FFT + */ + m = ftbasefindsmooth(2*n-1, _state); + *bluesteinsize = ae_maxint(2*m, *bluesteinsize, _state); + if( childplan ) + { + ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); + } + ftbase_ftpushentry4(plan, rowptr, ftbase_opbluesteinsfft, k, n, 2, m, 2, *precrptr, 0, _state); + ftbase_ftprecomputebluesteinsfft(n, m, &plan->precr, *precrptr, _state); + *precrptr = *precrptr+4*m; + row0 = *rowptr; + ftbase_ftpushentry(plan, rowptr, ftbase_opjmp, 0, 0, 0, 0, _state); + ftbase_ftcomplexfftplanrec(m, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + row1 = *rowptr; + plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; + if( childplan ) + { + ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); + } + } + ae_frame_leave(_state); + return; + } + + /* + * Handle Cooley-Tukey FFT with small N1 + */ + if( n1<=ftbase_maxradix ) + { + + /* + * Specialized transformation for small N1: + * * N2 short inplace FFT's, each N1-point, with integrated twiddle factors + * * N1 long FFT's + * * final transposition + */ + if( childplan ) + { + ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); + } + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexcodelettwfft, k, n1, 2*n2, 0, _state); + ftbase_ftcomplexfftplanrec(n2, k*n1, ae_false, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); + if( childplan ) + { + ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); + } + ae_frame_leave(_state); + return; + } + + /* + * Handle general Cooley-Tukey FFT, either "flat" or "recursive" + */ + if( n<=ftbase_recursivethreshold ) + { + + /* + * General code for large N1/N2, "flat" version without explicit recurrence + * (nested subplans are inserted directly into the body of the plan) + */ + if( childplan ) + { + ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); + } + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); + ftbase_ftcomplexfftplanrec(n1, k*n2, ae_false, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexfftfactors, k, n, 2, n1, _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n2, _state); + ftbase_ftcomplexfftplanrec(n2, k*n1, ae_false, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); + if( childplan ) + { + ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); + } + } + else + { + + /* + * General code for large N1/N2, "recursive" version - nested subplans + * are separated from the plan body. + * + * Generate parent plan. + */ + if( childplan ) + { + ftbase_ftpushentry2(plan, rowptr, ftbase_opstart, k, n, 2, -1, ftbase_ftoptimisticestimate(n, _state), _state); + } + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); + row0 = *rowptr; + ftbase_ftpushentry2(plan, rowptr, ftbase_opparallelcall, k*n2, n1, 2, 0, ftbase_ftoptimisticestimate(n, _state), _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplexfftfactors, k, n, 2, n1, _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n2, _state); + row2 = *rowptr; + ftbase_ftpushentry2(plan, rowptr, ftbase_opparallelcall, k*n1, n2, 2, 0, ftbase_ftoptimisticestimate(n, _state), _state); + ftbase_ftpushentry(plan, rowptr, ftbase_opcomplextranspose, k, n, 2, n1, _state); + if( childplan ) + { + ftbase_ftpushentry(plan, rowptr, ftbase_opend, k, n, 2, 0, _state); + } + + /* + * Generate child subplans, insert refence to parent plans + */ + row1 = *rowptr; + ftbase_ftcomplexfftplanrec(n1, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + plan->entries.ptr.pp_int[row0][ftbase_colparam0] = row1-row0; + row3 = *rowptr; + ftbase_ftcomplexfftplanrec(n2, 1, ae_true, ae_false, rowptr, bluesteinsize, precrptr, preciptr, plan, _state); + plan->entries.ptr.pp_int[row2][ftbase_colparam0] = row3-row2; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function pushes one more entry to the plan. It resizes Entries matrix +if needed. + +INPUT PARAMETERS: + Plan - plan (generated so far) + RowPtr - index which points to past-the-last entry generated so far + EType - entry type + EOpCnt - operands count + EOpSize - operand size + EMcvSize - microvector size + EParam0 - parameter 0 + +OUTPUT PARAMETERS: + Plan - updated plan + RowPtr - updated pointer + +NOTE: Param1 is set to -1. + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftpushentry(fasttransformplan* plan, + ae_int_t* rowptr, + ae_int_t etype, + ae_int_t eopcnt, + ae_int_t eopsize, + ae_int_t emcvsize, + ae_int_t eparam0, + ae_state *_state) +{ + + + ftbase_ftpushentry2(plan, rowptr, etype, eopcnt, eopsize, emcvsize, eparam0, -1, _state); +} + + +/************************************************************************* +Same as FTPushEntry(), but sets Param0 AND Param1. +This function pushes one more entry to the plan. It resized Entries matrix +if needed. + +INPUT PARAMETERS: + Plan - plan (generated so far) + RowPtr - index which points to past-the-last entry generated so far + EType - entry type + EOpCnt - operands count + EOpSize - operand size + EMcvSize - microvector size + EParam0 - parameter 0 + EParam1 - parameter 1 + +OUTPUT PARAMETERS: + Plan - updated plan + RowPtr - updated pointer + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftpushentry2(fasttransformplan* plan, + ae_int_t* rowptr, + ae_int_t etype, + ae_int_t eopcnt, + ae_int_t eopsize, + ae_int_t emcvsize, + ae_int_t eparam0, + ae_int_t eparam1, + ae_state *_state) +{ + + + if( *rowptr>=plan->entries.rows ) + { + imatrixresize(&plan->entries, ae_maxint(2*plan->entries.rows, 1, _state), ftbase_colscnt, _state); + } + plan->entries.ptr.pp_int[*rowptr][ftbase_coltype] = etype; + plan->entries.ptr.pp_int[*rowptr][ftbase_coloperandscnt] = eopcnt; + plan->entries.ptr.pp_int[*rowptr][ftbase_coloperandsize] = eopsize; + plan->entries.ptr.pp_int[*rowptr][ftbase_colmicrovectorsize] = emcvsize; + plan->entries.ptr.pp_int[*rowptr][ftbase_colparam0] = eparam0; + plan->entries.ptr.pp_int[*rowptr][ftbase_colparam1] = eparam1; + plan->entries.ptr.pp_int[*rowptr][ftbase_colparam2] = 0; + plan->entries.ptr.pp_int[*rowptr][ftbase_colparam3] = 0; + *rowptr = *rowptr+1; +} + + +/************************************************************************* +Same as FTPushEntry(), but sets Param0, Param1, Param2 and Param3. +This function pushes one more entry to the plan. It resized Entries matrix +if needed. + +INPUT PARAMETERS: + Plan - plan (generated so far) + RowPtr - index which points to past-the-last entry generated so far + EType - entry type + EOpCnt - operands count + EOpSize - operand size + EMcvSize - microvector size + EParam0 - parameter 0 + EParam1 - parameter 1 + EParam2 - parameter 2 + EParam3 - parameter 3 + +OUTPUT PARAMETERS: + Plan - updated plan + RowPtr - updated pointer + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftpushentry4(fasttransformplan* plan, + ae_int_t* rowptr, + ae_int_t etype, + ae_int_t eopcnt, + ae_int_t eopsize, + ae_int_t emcvsize, + ae_int_t eparam0, + ae_int_t eparam1, + ae_int_t eparam2, + ae_int_t eparam3, + ae_state *_state) +{ + + + if( *rowptr>=plan->entries.rows ) + { + imatrixresize(&plan->entries, ae_maxint(2*plan->entries.rows, 1, _state), ftbase_colscnt, _state); + } + plan->entries.ptr.pp_int[*rowptr][ftbase_coltype] = etype; + plan->entries.ptr.pp_int[*rowptr][ftbase_coloperandscnt] = eopcnt; + plan->entries.ptr.pp_int[*rowptr][ftbase_coloperandsize] = eopsize; + plan->entries.ptr.pp_int[*rowptr][ftbase_colmicrovectorsize] = emcvsize; + plan->entries.ptr.pp_int[*rowptr][ftbase_colparam0] = eparam0; + plan->entries.ptr.pp_int[*rowptr][ftbase_colparam1] = eparam1; + plan->entries.ptr.pp_int[*rowptr][ftbase_colparam2] = eparam2; + plan->entries.ptr.pp_int[*rowptr][ftbase_colparam3] = eparam3; + *rowptr = *rowptr+1; +} + + +/************************************************************************* +This subroutine applies subplan to input/output array A. + +INPUT PARAMETERS: + Plan - transformation plan + SubPlan - subplan index + A - array, must be large enough for plan to work + ABase - base offset in array A, this value points to start of + subarray whose length is equal to length of the plan + AOffset - offset with respect to ABase, 0<=AOffsetentries.ptr.pp_int[subplan][ftbase_coltype]==ftbase_opstart, "FTApplySubPlan: incorrect subplan header", _state); + rowidx = subplan+1; + while(plan->entries.ptr.pp_int[rowidx][ftbase_coltype]!=ftbase_opend) + { + operation = plan->entries.ptr.pp_int[rowidx][ftbase_coltype]; + operandscnt = repcnt*plan->entries.ptr.pp_int[rowidx][ftbase_coloperandscnt]; + operandsize = plan->entries.ptr.pp_int[rowidx][ftbase_coloperandsize]; + microvectorsize = plan->entries.ptr.pp_int[rowidx][ftbase_colmicrovectorsize]; + param0 = plan->entries.ptr.pp_int[rowidx][ftbase_colparam0]; + param1 = plan->entries.ptr.pp_int[rowidx][ftbase_colparam1]; + touchint(¶m1, _state); + + /* + * Process "jump" operation + */ + if( operation==ftbase_opjmp ) + { + rowidx = rowidx+plan->entries.ptr.pp_int[rowidx][ftbase_colparam0]; + continue; + } + + /* + * Process "parallel call" operation: + * * we perform initial check for consistency between parent and child plans + * * we call FTSplitAndApplyParallelPlan(), which splits parallel plan into + * several parallel tasks + */ + if( operation==ftbase_opparallelcall ) + { + parentsize = operandsize*microvectorsize; + childsize = plan->entries.ptr.pp_int[rowidx+param0][ftbase_coloperandscnt]*plan->entries.ptr.pp_int[rowidx+param0][ftbase_coloperandsize]*plan->entries.ptr.pp_int[rowidx+param0][ftbase_colmicrovectorsize]; + ae_assert(plan->entries.ptr.pp_int[rowidx+param0][ftbase_coltype]==ftbase_opstart, "FTApplySubPlan: incorrect child subplan header", _state); + ae_assert(parentsize==childsize, "FTApplySubPlan: incorrect child subplan header", _state); + chunksize = ae_maxint(ftbase_recursivethreshold/childsize, 1, _state); + lastchunksize = operandscnt%chunksize; + if( lastchunksize==0 ) + { + lastchunksize = chunksize; + } + i = 0; + while(ibluesteinpool, &_bufa, _state); + ae_shared_pool_retrieve(&plan->bluesteinpool, &_bufb, _state); + ae_shared_pool_retrieve(&plan->bluesteinpool, &_bufc, _state); + ae_shared_pool_retrieve(&plan->bluesteinpool, &_bufd, _state); + ftbase_ftbluesteinsfft(plan, a, abase, aoffset, operandscnt, operandsize, plan->entries.ptr.pp_int[rowidx][ftbase_colparam0], plan->entries.ptr.pp_int[rowidx][ftbase_colparam2], rowidx+plan->entries.ptr.pp_int[rowidx][ftbase_colparam1], &bufa->val, &bufb->val, &bufc->val, &bufd->val, _state); + ae_shared_pool_recycle(&plan->bluesteinpool, &_bufa, _state); + ae_shared_pool_recycle(&plan->bluesteinpool, &_bufb, _state); + ae_shared_pool_recycle(&plan->bluesteinpool, &_bufc, _state); + ae_shared_pool_recycle(&plan->bluesteinpool, &_bufd, _state); + rowidx = rowidx+1; + continue; + } + + /* + * Process Rader's FFT + */ + if( operation==ftbase_opradersfft ) + { + ftbase_ftradersfft(plan, a, abase, aoffset, operandscnt, operandsize, rowidx+plan->entries.ptr.pp_int[rowidx][ftbase_colparam0], plan->entries.ptr.pp_int[rowidx][ftbase_colparam1], plan->entries.ptr.pp_int[rowidx][ftbase_colparam2], plan->entries.ptr.pp_int[rowidx][ftbase_colparam3], buf, _state); + rowidx = rowidx+1; + continue; + } + + /* + * Process "complex twiddle factors" operation + */ + if( operation==ftbase_opcomplexfftfactors ) + { + ae_assert(microvectorsize==2, "FTApplySubPlan: MicrovectorSize<>1", _state); + n1 = plan->entries.ptr.pp_int[rowidx][ftbase_colparam0]; + n2 = operandsize/n1; + for(i=0; i<=operandscnt-1; i++) + { + ftbase_ffttwcalc(a, abase+aoffset+i*operandsize*2, n1, n2, _state); + } + rowidx = rowidx+1; + continue; + } + + /* + * Process "complex transposition" operation + */ + if( operation==ftbase_opcomplextranspose ) + { + ae_assert(microvectorsize==2, "FTApplySubPlan: MicrovectorSize<>1", _state); + n1 = plan->entries.ptr.pp_int[rowidx][ftbase_colparam0]; + n2 = operandsize/n1; + for(i=0; i<=operandscnt-1; i++) + { + ftbase_internalcomplexlintranspose(a, n1, n2, abase+aoffset+i*operandsize*2, buf, _state); + } + rowidx = rowidx+1; + continue; + } + + /* + * Error + */ + ae_assert(ae_false, "FTApplySubPlan: unexpected plan type", _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine applies complex reference FFT to input/output array A. + +VERY SLOW OPERATION, do not use it in real life plans :) + +INPUT PARAMETERS: + A - array, must be large enough for plan to work + Offs - offset of the subarray to process + OperandsCnt - operands count (see description of FastTransformPlan) + OperandSize - operand size (see description of FastTransformPlan) + MicrovectorSize-microvector size (see description of FastTransformPlan) + Buf - temporary array, must be at least OperandsCnt*OperandSize*MicrovectorSize + +OUTPUT PARAMETERS: + A - transformed array + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftapplycomplexreffft(/* Real */ ae_vector* a, + ae_int_t offs, + ae_int_t operandscnt, + ae_int_t operandsize, + ae_int_t microvectorsize, + /* Real */ ae_vector* buf, + ae_state *_state) +{ + ae_int_t opidx; + ae_int_t i; + ae_int_t k; + double hre; + double him; + double c; + double s; + double re; + double im; + ae_int_t n; + + + ae_assert(operandscnt>=1, "FTApplyComplexRefFFT: OperandsCnt<1", _state); + ae_assert(operandsize>=1, "FTApplyComplexRefFFT: OperandSize<1", _state); + ae_assert(microvectorsize==2, "FTApplyComplexRefFFT: MicrovectorSize<>2", _state); + n = operandsize; + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + for(i=0; i<=n-1; i++) + { + hre = 0; + him = 0; + for(k=0; k<=n-1; k++) + { + re = a->ptr.p_double[offs+opidx*operandsize*2+2*k+0]; + im = a->ptr.p_double[offs+opidx*operandsize*2+2*k+1]; + c = ae_cos(-2*ae_pi*k*i/n, _state); + s = ae_sin(-2*ae_pi*k*i/n, _state); + hre = hre+c*re-s*im; + him = him+c*im+s*re; + } + buf->ptr.p_double[2*i+0] = hre; + buf->ptr.p_double[2*i+1] = him; + } + for(i=0; i<=operandsize*2-1; i++) + { + a->ptr.p_double[offs+opidx*operandsize*2+i] = buf->ptr.p_double[i]; + } + } +} + + +/************************************************************************* +This subroutine applies complex codelet FFT to input/output array A. + +INPUT PARAMETERS: + A - array, must be large enough for plan to work + Offs - offset of the subarray to process + OperandsCnt - operands count (see description of FastTransformPlan) + OperandSize - operand size (see description of FastTransformPlan) + MicrovectorSize-microvector size, must be 2 + +OUTPUT PARAMETERS: + A - transformed array + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftapplycomplexcodeletfft(/* Real */ ae_vector* a, + ae_int_t offs, + ae_int_t operandscnt, + ae_int_t operandsize, + ae_int_t microvectorsize, + ae_state *_state) +{ + ae_int_t opidx; + ae_int_t n; + ae_int_t aoffset; + double a0x; + double a0y; + double a1x; + double a1y; + double a2x; + double a2y; + double a3x; + double a3y; + double a4x; + double a4y; + double a5x; + double a5y; + double v0; + double v1; + double v2; + double v3; + double t1x; + double t1y; + double t2x; + double t2y; + double t3x; + double t3y; + double t4x; + double t4y; + double t5x; + double t5y; + double m1x; + double m1y; + double m2x; + double m2y; + double m3x; + double m3y; + double m4x; + double m4y; + double m5x; + double m5y; + double s1x; + double s1y; + double s2x; + double s2y; + double s3x; + double s3y; + double s4x; + double s4y; + double s5x; + double s5y; + double c1; + double c2; + double c3; + double c4; + double c5; + double v; + + + ae_assert(operandscnt>=1, "FTApplyComplexCodeletFFT: OperandsCnt<1", _state); + ae_assert(operandsize>=1, "FTApplyComplexCodeletFFT: OperandSize<1", _state); + ae_assert(microvectorsize==2, "FTApplyComplexCodeletFFT: MicrovectorSize<>2", _state); + n = operandsize; + + /* + * Hard-coded transforms for different N's + */ + ae_assert(n<=ftbase_maxradix, "FTApplyComplexCodeletFFT: N>MaxRadix", _state); + if( n==2 ) + { + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset = offs+opidx*operandsize*2; + a0x = a->ptr.p_double[aoffset+0]; + a0y = a->ptr.p_double[aoffset+1]; + a1x = a->ptr.p_double[aoffset+2]; + a1y = a->ptr.p_double[aoffset+3]; + v0 = a0x+a1x; + v1 = a0y+a1y; + v2 = a0x-a1x; + v3 = a0y-a1y; + a->ptr.p_double[aoffset+0] = v0; + a->ptr.p_double[aoffset+1] = v1; + a->ptr.p_double[aoffset+2] = v2; + a->ptr.p_double[aoffset+3] = v3; + } + return; + } + if( n==3 ) + { + c1 = ae_cos(2*ae_pi/3, _state)-1; + c2 = ae_sin(2*ae_pi/3, _state); + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset = offs+opidx*operandsize*2; + a0x = a->ptr.p_double[aoffset+0]; + a0y = a->ptr.p_double[aoffset+1]; + a1x = a->ptr.p_double[aoffset+2]; + a1y = a->ptr.p_double[aoffset+3]; + a2x = a->ptr.p_double[aoffset+4]; + a2y = a->ptr.p_double[aoffset+5]; + t1x = a1x+a2x; + t1y = a1y+a2y; + a0x = a0x+t1x; + a0y = a0y+t1y; + m1x = c1*t1x; + m1y = c1*t1y; + m2x = c2*(a1y-a2y); + m2y = c2*(a2x-a1x); + s1x = a0x+m1x; + s1y = a0y+m1y; + a1x = s1x+m2x; + a1y = s1y+m2y; + a2x = s1x-m2x; + a2y = s1y-m2y; + a->ptr.p_double[aoffset+0] = a0x; + a->ptr.p_double[aoffset+1] = a0y; + a->ptr.p_double[aoffset+2] = a1x; + a->ptr.p_double[aoffset+3] = a1y; + a->ptr.p_double[aoffset+4] = a2x; + a->ptr.p_double[aoffset+5] = a2y; + } + return; + } + if( n==4 ) + { + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset = offs+opidx*operandsize*2; + a0x = a->ptr.p_double[aoffset+0]; + a0y = a->ptr.p_double[aoffset+1]; + a1x = a->ptr.p_double[aoffset+2]; + a1y = a->ptr.p_double[aoffset+3]; + a2x = a->ptr.p_double[aoffset+4]; + a2y = a->ptr.p_double[aoffset+5]; + a3x = a->ptr.p_double[aoffset+6]; + a3y = a->ptr.p_double[aoffset+7]; + t1x = a0x+a2x; + t1y = a0y+a2y; + t2x = a1x+a3x; + t2y = a1y+a3y; + m2x = a0x-a2x; + m2y = a0y-a2y; + m3x = a1y-a3y; + m3y = a3x-a1x; + a->ptr.p_double[aoffset+0] = t1x+t2x; + a->ptr.p_double[aoffset+1] = t1y+t2y; + a->ptr.p_double[aoffset+4] = t1x-t2x; + a->ptr.p_double[aoffset+5] = t1y-t2y; + a->ptr.p_double[aoffset+2] = m2x+m3x; + a->ptr.p_double[aoffset+3] = m2y+m3y; + a->ptr.p_double[aoffset+6] = m2x-m3x; + a->ptr.p_double[aoffset+7] = m2y-m3y; + } + return; + } + if( n==5 ) + { + v = 2*ae_pi/5; + c1 = (ae_cos(v, _state)+ae_cos(2*v, _state))/2-1; + c2 = (ae_cos(v, _state)-ae_cos(2*v, _state))/2; + c3 = -ae_sin(v, _state); + c4 = -(ae_sin(v, _state)+ae_sin(2*v, _state)); + c5 = ae_sin(v, _state)-ae_sin(2*v, _state); + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset = offs+opidx*operandsize*2; + t1x = a->ptr.p_double[aoffset+2]+a->ptr.p_double[aoffset+8]; + t1y = a->ptr.p_double[aoffset+3]+a->ptr.p_double[aoffset+9]; + t2x = a->ptr.p_double[aoffset+4]+a->ptr.p_double[aoffset+6]; + t2y = a->ptr.p_double[aoffset+5]+a->ptr.p_double[aoffset+7]; + t3x = a->ptr.p_double[aoffset+2]-a->ptr.p_double[aoffset+8]; + t3y = a->ptr.p_double[aoffset+3]-a->ptr.p_double[aoffset+9]; + t4x = a->ptr.p_double[aoffset+6]-a->ptr.p_double[aoffset+4]; + t4y = a->ptr.p_double[aoffset+7]-a->ptr.p_double[aoffset+5]; + t5x = t1x+t2x; + t5y = t1y+t2y; + a->ptr.p_double[aoffset+0] = a->ptr.p_double[aoffset+0]+t5x; + a->ptr.p_double[aoffset+1] = a->ptr.p_double[aoffset+1]+t5y; + m1x = c1*t5x; + m1y = c1*t5y; + m2x = c2*(t1x-t2x); + m2y = c2*(t1y-t2y); + m3x = -c3*(t3y+t4y); + m3y = c3*(t3x+t4x); + m4x = -c4*t4y; + m4y = c4*t4x; + m5x = -c5*t3y; + m5y = c5*t3x; + s3x = m3x-m4x; + s3y = m3y-m4y; + s5x = m3x+m5x; + s5y = m3y+m5y; + s1x = a->ptr.p_double[aoffset+0]+m1x; + s1y = a->ptr.p_double[aoffset+1]+m1y; + s2x = s1x+m2x; + s2y = s1y+m2y; + s4x = s1x-m2x; + s4y = s1y-m2y; + a->ptr.p_double[aoffset+2] = s2x+s3x; + a->ptr.p_double[aoffset+3] = s2y+s3y; + a->ptr.p_double[aoffset+4] = s4x+s5x; + a->ptr.p_double[aoffset+5] = s4y+s5y; + a->ptr.p_double[aoffset+6] = s4x-s5x; + a->ptr.p_double[aoffset+7] = s4y-s5y; + a->ptr.p_double[aoffset+8] = s2x-s3x; + a->ptr.p_double[aoffset+9] = s2y-s3y; + } + return; + } + if( n==6 ) + { + c1 = ae_cos(2*ae_pi/3, _state)-1; + c2 = ae_sin(2*ae_pi/3, _state); + c3 = ae_cos(-ae_pi/3, _state); + c4 = ae_sin(-ae_pi/3, _state); + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset = offs+opidx*operandsize*2; + a0x = a->ptr.p_double[aoffset+0]; + a0y = a->ptr.p_double[aoffset+1]; + a1x = a->ptr.p_double[aoffset+2]; + a1y = a->ptr.p_double[aoffset+3]; + a2x = a->ptr.p_double[aoffset+4]; + a2y = a->ptr.p_double[aoffset+5]; + a3x = a->ptr.p_double[aoffset+6]; + a3y = a->ptr.p_double[aoffset+7]; + a4x = a->ptr.p_double[aoffset+8]; + a4y = a->ptr.p_double[aoffset+9]; + a5x = a->ptr.p_double[aoffset+10]; + a5y = a->ptr.p_double[aoffset+11]; + v0 = a0x; + v1 = a0y; + a0x = a0x+a3x; + a0y = a0y+a3y; + a3x = v0-a3x; + a3y = v1-a3y; + v0 = a1x; + v1 = a1y; + a1x = a1x+a4x; + a1y = a1y+a4y; + a4x = v0-a4x; + a4y = v1-a4y; + v0 = a2x; + v1 = a2y; + a2x = a2x+a5x; + a2y = a2y+a5y; + a5x = v0-a5x; + a5y = v1-a5y; + t4x = a4x*c3-a4y*c4; + t4y = a4x*c4+a4y*c3; + a4x = t4x; + a4y = t4y; + t5x = -a5x*c3-a5y*c4; + t5y = a5x*c4-a5y*c3; + a5x = t5x; + a5y = t5y; + t1x = a1x+a2x; + t1y = a1y+a2y; + a0x = a0x+t1x; + a0y = a0y+t1y; + m1x = c1*t1x; + m1y = c1*t1y; + m2x = c2*(a1y-a2y); + m2y = c2*(a2x-a1x); + s1x = a0x+m1x; + s1y = a0y+m1y; + a1x = s1x+m2x; + a1y = s1y+m2y; + a2x = s1x-m2x; + a2y = s1y-m2y; + t1x = a4x+a5x; + t1y = a4y+a5y; + a3x = a3x+t1x; + a3y = a3y+t1y; + m1x = c1*t1x; + m1y = c1*t1y; + m2x = c2*(a4y-a5y); + m2y = c2*(a5x-a4x); + s1x = a3x+m1x; + s1y = a3y+m1y; + a4x = s1x+m2x; + a4y = s1y+m2y; + a5x = s1x-m2x; + a5y = s1y-m2y; + a->ptr.p_double[aoffset+0] = a0x; + a->ptr.p_double[aoffset+1] = a0y; + a->ptr.p_double[aoffset+2] = a3x; + a->ptr.p_double[aoffset+3] = a3y; + a->ptr.p_double[aoffset+4] = a1x; + a->ptr.p_double[aoffset+5] = a1y; + a->ptr.p_double[aoffset+6] = a4x; + a->ptr.p_double[aoffset+7] = a4y; + a->ptr.p_double[aoffset+8] = a2x; + a->ptr.p_double[aoffset+9] = a2y; + a->ptr.p_double[aoffset+10] = a5x; + a->ptr.p_double[aoffset+11] = a5y; + } + return; + } +} + + +/************************************************************************* +This subroutine applies complex "integrated" codelet FFT to input/output +array A. "Integrated" codelet differs from "normal" one in following ways: +* it can work with MicrovectorSize>1 +* hence, it can be used in Cooley-Tukey FFT without transpositions +* it performs inlined multiplication by twiddle factors of Cooley-Tukey + FFT with N2=MicrovectorSize/2. + +INPUT PARAMETERS: + A - array, must be large enough for plan to work + Offs - offset of the subarray to process + OperandsCnt - operands count (see description of FastTransformPlan) + OperandSize - operand size (see description of FastTransformPlan) + MicrovectorSize-microvector size, must be 1 + +OUTPUT PARAMETERS: + A - transformed array + + -- ALGLIB -- + Copyright 05.04.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftapplycomplexcodelettwfft(/* Real */ ae_vector* a, + ae_int_t offs, + ae_int_t operandscnt, + ae_int_t operandsize, + ae_int_t microvectorsize, + ae_state *_state) +{ + ae_int_t opidx; + ae_int_t mvidx; + ae_int_t n; + ae_int_t m; + ae_int_t aoffset0; + ae_int_t aoffset2; + ae_int_t aoffset4; + ae_int_t aoffset6; + ae_int_t aoffset8; + ae_int_t aoffset10; + double a0x; + double a0y; + double a1x; + double a1y; + double a2x; + double a2y; + double a3x; + double a3y; + double a4x; + double a4y; + double a5x; + double a5y; + double v0; + double v1; + double v2; + double v3; + double q0x; + double q0y; + double t1x; + double t1y; + double t2x; + double t2y; + double t3x; + double t3y; + double t4x; + double t4y; + double t5x; + double t5y; + double m1x; + double m1y; + double m2x; + double m2y; + double m3x; + double m3y; + double m4x; + double m4y; + double m5x; + double m5y; + double s1x; + double s1y; + double s2x; + double s2y; + double s3x; + double s3y; + double s4x; + double s4y; + double s5x; + double s5y; + double c1; + double c2; + double c3; + double c4; + double c5; + double v; + double tw0; + double tw1; + double twx; + double twxm1; + double twy; + double tw2x; + double tw2y; + double tw3x; + double tw3y; + double tw4x; + double tw4y; + double tw5x; + double tw5y; + + + ae_assert(operandscnt>=1, "FTApplyComplexCodeletFFT: OperandsCnt<1", _state); + ae_assert(operandsize>=1, "FTApplyComplexCodeletFFT: OperandSize<1", _state); + ae_assert(microvectorsize>=1, "FTApplyComplexCodeletFFT: MicrovectorSize<>1", _state); + ae_assert(microvectorsize%2==0, "FTApplyComplexCodeletFFT: MicrovectorSize is not even", _state); + n = operandsize; + m = microvectorsize/2; + + /* + * Hard-coded transforms for different N's + */ + ae_assert(n<=ftbase_maxradix, "FTApplyComplexCodeletTwFFT: N>MaxRadix", _state); + if( n==2 ) + { + v = -2*ae_pi/(n*m); + tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); + tw1 = ae_sin(v, _state); + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset0 = offs+opidx*operandsize*microvectorsize; + aoffset2 = aoffset0+microvectorsize; + twxm1 = 0.0; + twy = 0.0; + for(mvidx=0; mvidx<=m-1; mvidx++) + { + a0x = a->ptr.p_double[aoffset0]; + a0y = a->ptr.p_double[aoffset0+1]; + a1x = a->ptr.p_double[aoffset2]; + a1y = a->ptr.p_double[aoffset2+1]; + v0 = a0x+a1x; + v1 = a0y+a1y; + v2 = a0x-a1x; + v3 = a0y-a1y; + a->ptr.p_double[aoffset0] = v0; + a->ptr.p_double[aoffset0+1] = v1; + a->ptr.p_double[aoffset2] = v2*(1+twxm1)-v3*twy; + a->ptr.p_double[aoffset2+1] = v3*(1+twxm1)+v2*twy; + aoffset0 = aoffset0+2; + aoffset2 = aoffset2+2; + if( (mvidx+1)%ftbase_updatetw==0 ) + { + v = -2*ae_pi*(mvidx+1)/(n*m); + twxm1 = ae_sin(0.5*v, _state); + twxm1 = -2*twxm1*twxm1; + twy = ae_sin(v, _state); + } + else + { + v = twxm1+tw0+twxm1*tw0-twy*tw1; + twy = twy+tw1+twxm1*tw1+twy*tw0; + twxm1 = v; + } + } + } + return; + } + if( n==3 ) + { + v = -2*ae_pi/(n*m); + tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); + tw1 = ae_sin(v, _state); + c1 = ae_cos(2*ae_pi/3, _state)-1; + c2 = ae_sin(2*ae_pi/3, _state); + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset0 = offs+opidx*operandsize*microvectorsize; + aoffset2 = aoffset0+microvectorsize; + aoffset4 = aoffset2+microvectorsize; + twx = 1.0; + twxm1 = 0.0; + twy = 0.0; + for(mvidx=0; mvidx<=m-1; mvidx++) + { + a0x = a->ptr.p_double[aoffset0]; + a0y = a->ptr.p_double[aoffset0+1]; + a1x = a->ptr.p_double[aoffset2]; + a1y = a->ptr.p_double[aoffset2+1]; + a2x = a->ptr.p_double[aoffset4]; + a2y = a->ptr.p_double[aoffset4+1]; + t1x = a1x+a2x; + t1y = a1y+a2y; + a0x = a0x+t1x; + a0y = a0y+t1y; + m1x = c1*t1x; + m1y = c1*t1y; + m2x = c2*(a1y-a2y); + m2y = c2*(a2x-a1x); + s1x = a0x+m1x; + s1y = a0y+m1y; + a1x = s1x+m2x; + a1y = s1y+m2y; + a2x = s1x-m2x; + a2y = s1y-m2y; + tw2x = twx*twx-twy*twy; + tw2y = 2*twx*twy; + a->ptr.p_double[aoffset0] = a0x; + a->ptr.p_double[aoffset0+1] = a0y; + a->ptr.p_double[aoffset2] = a1x*twx-a1y*twy; + a->ptr.p_double[aoffset2+1] = a1y*twx+a1x*twy; + a->ptr.p_double[aoffset4] = a2x*tw2x-a2y*tw2y; + a->ptr.p_double[aoffset4+1] = a2y*tw2x+a2x*tw2y; + aoffset0 = aoffset0+2; + aoffset2 = aoffset2+2; + aoffset4 = aoffset4+2; + if( (mvidx+1)%ftbase_updatetw==0 ) + { + v = -2*ae_pi*(mvidx+1)/(n*m); + twxm1 = ae_sin(0.5*v, _state); + twxm1 = -2*twxm1*twxm1; + twy = ae_sin(v, _state); + twx = twxm1+1; + } + else + { + v = twxm1+tw0+twxm1*tw0-twy*tw1; + twy = twy+tw1+twxm1*tw1+twy*tw0; + twxm1 = v; + twx = v+1; + } + } + } + return; + } + if( n==4 ) + { + v = -2*ae_pi/(n*m); + tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); + tw1 = ae_sin(v, _state); + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset0 = offs+opidx*operandsize*microvectorsize; + aoffset2 = aoffset0+microvectorsize; + aoffset4 = aoffset2+microvectorsize; + aoffset6 = aoffset4+microvectorsize; + twx = 1.0; + twxm1 = 0.0; + twy = 0.0; + for(mvidx=0; mvidx<=m-1; mvidx++) + { + a0x = a->ptr.p_double[aoffset0]; + a0y = a->ptr.p_double[aoffset0+1]; + a1x = a->ptr.p_double[aoffset2]; + a1y = a->ptr.p_double[aoffset2+1]; + a2x = a->ptr.p_double[aoffset4]; + a2y = a->ptr.p_double[aoffset4+1]; + a3x = a->ptr.p_double[aoffset6]; + a3y = a->ptr.p_double[aoffset6+1]; + t1x = a0x+a2x; + t1y = a0y+a2y; + t2x = a1x+a3x; + t2y = a1y+a3y; + m2x = a0x-a2x; + m2y = a0y-a2y; + m3x = a1y-a3y; + m3y = a3x-a1x; + tw2x = twx*twx-twy*twy; + tw2y = 2*twx*twy; + tw3x = twx*tw2x-twy*tw2y; + tw3y = twx*tw2y+twy*tw2x; + a1x = m2x+m3x; + a1y = m2y+m3y; + a2x = t1x-t2x; + a2y = t1y-t2y; + a3x = m2x-m3x; + a3y = m2y-m3y; + a->ptr.p_double[aoffset0] = t1x+t2x; + a->ptr.p_double[aoffset0+1] = t1y+t2y; + a->ptr.p_double[aoffset2] = a1x*twx-a1y*twy; + a->ptr.p_double[aoffset2+1] = a1y*twx+a1x*twy; + a->ptr.p_double[aoffset4] = a2x*tw2x-a2y*tw2y; + a->ptr.p_double[aoffset4+1] = a2y*tw2x+a2x*tw2y; + a->ptr.p_double[aoffset6] = a3x*tw3x-a3y*tw3y; + a->ptr.p_double[aoffset6+1] = a3y*tw3x+a3x*tw3y; + aoffset0 = aoffset0+2; + aoffset2 = aoffset2+2; + aoffset4 = aoffset4+2; + aoffset6 = aoffset6+2; + if( (mvidx+1)%ftbase_updatetw==0 ) + { + v = -2*ae_pi*(mvidx+1)/(n*m); + twxm1 = ae_sin(0.5*v, _state); + twxm1 = -2*twxm1*twxm1; + twy = ae_sin(v, _state); + twx = twxm1+1; + } + else + { + v = twxm1+tw0+twxm1*tw0-twy*tw1; + twy = twy+tw1+twxm1*tw1+twy*tw0; + twxm1 = v; + twx = v+1; + } + } + } + return; + } + if( n==5 ) + { + v = -2*ae_pi/(n*m); + tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); + tw1 = ae_sin(v, _state); + v = 2*ae_pi/5; + c1 = (ae_cos(v, _state)+ae_cos(2*v, _state))/2-1; + c2 = (ae_cos(v, _state)-ae_cos(2*v, _state))/2; + c3 = -ae_sin(v, _state); + c4 = -(ae_sin(v, _state)+ae_sin(2*v, _state)); + c5 = ae_sin(v, _state)-ae_sin(2*v, _state); + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset0 = offs+opidx*operandsize*microvectorsize; + aoffset2 = aoffset0+microvectorsize; + aoffset4 = aoffset2+microvectorsize; + aoffset6 = aoffset4+microvectorsize; + aoffset8 = aoffset6+microvectorsize; + twx = 1.0; + twxm1 = 0.0; + twy = 0.0; + for(mvidx=0; mvidx<=m-1; mvidx++) + { + a0x = a->ptr.p_double[aoffset0]; + a0y = a->ptr.p_double[aoffset0+1]; + a1x = a->ptr.p_double[aoffset2]; + a1y = a->ptr.p_double[aoffset2+1]; + a2x = a->ptr.p_double[aoffset4]; + a2y = a->ptr.p_double[aoffset4+1]; + a3x = a->ptr.p_double[aoffset6]; + a3y = a->ptr.p_double[aoffset6+1]; + a4x = a->ptr.p_double[aoffset8]; + a4y = a->ptr.p_double[aoffset8+1]; + t1x = a1x+a4x; + t1y = a1y+a4y; + t2x = a2x+a3x; + t2y = a2y+a3y; + t3x = a1x-a4x; + t3y = a1y-a4y; + t4x = a3x-a2x; + t4y = a3y-a2y; + t5x = t1x+t2x; + t5y = t1y+t2y; + q0x = a0x+t5x; + q0y = a0y+t5y; + m1x = c1*t5x; + m1y = c1*t5y; + m2x = c2*(t1x-t2x); + m2y = c2*(t1y-t2y); + m3x = -c3*(t3y+t4y); + m3y = c3*(t3x+t4x); + m4x = -c4*t4y; + m4y = c4*t4x; + m5x = -c5*t3y; + m5y = c5*t3x; + s3x = m3x-m4x; + s3y = m3y-m4y; + s5x = m3x+m5x; + s5y = m3y+m5y; + s1x = q0x+m1x; + s1y = q0y+m1y; + s2x = s1x+m2x; + s2y = s1y+m2y; + s4x = s1x-m2x; + s4y = s1y-m2y; + tw2x = twx*twx-twy*twy; + tw2y = 2*twx*twy; + tw3x = twx*tw2x-twy*tw2y; + tw3y = twx*tw2y+twy*tw2x; + tw4x = tw2x*tw2x-tw2y*tw2y; + tw4y = tw2x*tw2y+tw2y*tw2x; + a1x = s2x+s3x; + a1y = s2y+s3y; + a2x = s4x+s5x; + a2y = s4y+s5y; + a3x = s4x-s5x; + a3y = s4y-s5y; + a4x = s2x-s3x; + a4y = s2y-s3y; + a->ptr.p_double[aoffset0] = q0x; + a->ptr.p_double[aoffset0+1] = q0y; + a->ptr.p_double[aoffset2] = a1x*twx-a1y*twy; + a->ptr.p_double[aoffset2+1] = a1x*twy+a1y*twx; + a->ptr.p_double[aoffset4] = a2x*tw2x-a2y*tw2y; + a->ptr.p_double[aoffset4+1] = a2x*tw2y+a2y*tw2x; + a->ptr.p_double[aoffset6] = a3x*tw3x-a3y*tw3y; + a->ptr.p_double[aoffset6+1] = a3x*tw3y+a3y*tw3x; + a->ptr.p_double[aoffset8] = a4x*tw4x-a4y*tw4y; + a->ptr.p_double[aoffset8+1] = a4x*tw4y+a4y*tw4x; + aoffset0 = aoffset0+2; + aoffset2 = aoffset2+2; + aoffset4 = aoffset4+2; + aoffset6 = aoffset6+2; + aoffset8 = aoffset8+2; + if( (mvidx+1)%ftbase_updatetw==0 ) + { + v = -2*ae_pi*(mvidx+1)/(n*m); + twxm1 = ae_sin(0.5*v, _state); + twxm1 = -2*twxm1*twxm1; + twy = ae_sin(v, _state); + twx = twxm1+1; + } + else + { + v = twxm1+tw0+twxm1*tw0-twy*tw1; + twy = twy+tw1+twxm1*tw1+twy*tw0; + twxm1 = v; + twx = v+1; + } + } + } + return; + } + if( n==6 ) + { + c1 = ae_cos(2*ae_pi/3, _state)-1; + c2 = ae_sin(2*ae_pi/3, _state); + c3 = ae_cos(-ae_pi/3, _state); + c4 = ae_sin(-ae_pi/3, _state); + v = -2*ae_pi/(n*m); + tw0 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); + tw1 = ae_sin(v, _state); + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + aoffset0 = offs+opidx*operandsize*microvectorsize; + aoffset2 = aoffset0+microvectorsize; + aoffset4 = aoffset2+microvectorsize; + aoffset6 = aoffset4+microvectorsize; + aoffset8 = aoffset6+microvectorsize; + aoffset10 = aoffset8+microvectorsize; + twx = 1.0; + twxm1 = 0.0; + twy = 0.0; + for(mvidx=0; mvidx<=m-1; mvidx++) + { + a0x = a->ptr.p_double[aoffset0+0]; + a0y = a->ptr.p_double[aoffset0+1]; + a1x = a->ptr.p_double[aoffset2+0]; + a1y = a->ptr.p_double[aoffset2+1]; + a2x = a->ptr.p_double[aoffset4+0]; + a2y = a->ptr.p_double[aoffset4+1]; + a3x = a->ptr.p_double[aoffset6+0]; + a3y = a->ptr.p_double[aoffset6+1]; + a4x = a->ptr.p_double[aoffset8+0]; + a4y = a->ptr.p_double[aoffset8+1]; + a5x = a->ptr.p_double[aoffset10+0]; + a5y = a->ptr.p_double[aoffset10+1]; + v0 = a0x; + v1 = a0y; + a0x = a0x+a3x; + a0y = a0y+a3y; + a3x = v0-a3x; + a3y = v1-a3y; + v0 = a1x; + v1 = a1y; + a1x = a1x+a4x; + a1y = a1y+a4y; + a4x = v0-a4x; + a4y = v1-a4y; + v0 = a2x; + v1 = a2y; + a2x = a2x+a5x; + a2y = a2y+a5y; + a5x = v0-a5x; + a5y = v1-a5y; + t4x = a4x*c3-a4y*c4; + t4y = a4x*c4+a4y*c3; + a4x = t4x; + a4y = t4y; + t5x = -a5x*c3-a5y*c4; + t5y = a5x*c4-a5y*c3; + a5x = t5x; + a5y = t5y; + t1x = a1x+a2x; + t1y = a1y+a2y; + a0x = a0x+t1x; + a0y = a0y+t1y; + m1x = c1*t1x; + m1y = c1*t1y; + m2x = c2*(a1y-a2y); + m2y = c2*(a2x-a1x); + s1x = a0x+m1x; + s1y = a0y+m1y; + a1x = s1x+m2x; + a1y = s1y+m2y; + a2x = s1x-m2x; + a2y = s1y-m2y; + t1x = a4x+a5x; + t1y = a4y+a5y; + a3x = a3x+t1x; + a3y = a3y+t1y; + m1x = c1*t1x; + m1y = c1*t1y; + m2x = c2*(a4y-a5y); + m2y = c2*(a5x-a4x); + s1x = a3x+m1x; + s1y = a3y+m1y; + a4x = s1x+m2x; + a4y = s1y+m2y; + a5x = s1x-m2x; + a5y = s1y-m2y; + tw2x = twx*twx-twy*twy; + tw2y = 2*twx*twy; + tw3x = twx*tw2x-twy*tw2y; + tw3y = twx*tw2y+twy*tw2x; + tw4x = tw2x*tw2x-tw2y*tw2y; + tw4y = 2*tw2x*tw2y; + tw5x = tw3x*tw2x-tw3y*tw2y; + tw5y = tw3x*tw2y+tw3y*tw2x; + a->ptr.p_double[aoffset0+0] = a0x; + a->ptr.p_double[aoffset0+1] = a0y; + a->ptr.p_double[aoffset2+0] = a3x*twx-a3y*twy; + a->ptr.p_double[aoffset2+1] = a3y*twx+a3x*twy; + a->ptr.p_double[aoffset4+0] = a1x*tw2x-a1y*tw2y; + a->ptr.p_double[aoffset4+1] = a1y*tw2x+a1x*tw2y; + a->ptr.p_double[aoffset6+0] = a4x*tw3x-a4y*tw3y; + a->ptr.p_double[aoffset6+1] = a4y*tw3x+a4x*tw3y; + a->ptr.p_double[aoffset8+0] = a2x*tw4x-a2y*tw4y; + a->ptr.p_double[aoffset8+1] = a2y*tw4x+a2x*tw4y; + a->ptr.p_double[aoffset10+0] = a5x*tw5x-a5y*tw5y; + a->ptr.p_double[aoffset10+1] = a5y*tw5x+a5x*tw5y; + aoffset0 = aoffset0+2; + aoffset2 = aoffset2+2; + aoffset4 = aoffset4+2; + aoffset6 = aoffset6+2; + aoffset8 = aoffset8+2; + aoffset10 = aoffset10+2; + if( (mvidx+1)%ftbase_updatetw==0 ) + { + v = -2*ae_pi*(mvidx+1)/(n*m); + twxm1 = ae_sin(0.5*v, _state); + twxm1 = -2*twxm1*twxm1; + twy = ae_sin(v, _state); + twx = twxm1+1; + } + else + { + v = twxm1+tw0+twxm1*tw0-twy*tw1; + twy = twy+tw1+twxm1*tw1+twy*tw0; + twxm1 = v; + twx = v+1; + } + } + } + return; + } +} + + +/************************************************************************* +This subroutine precomputes data for complex Bluestein's FFT and writes +them to array PrecR[] at specified offset. It is responsibility of the +caller to make sure that PrecR[] is large enough. + +INPUT PARAMETERS: + N - original size of the transform + M - size of the "padded" Bluestein's transform + PrecR - preallocated array + Offs - offset + +OUTPUT PARAMETERS: + PrecR - data at Offs:Offs+4*M-1 are modified: + * PrecR[Offs:Offs+2*M-1] stores Z[k]=exp(i*pi*k^2/N) + * PrecR[Offs+2*M:Offs+4*M-1] stores FFT of the Z + Other parts of PrecR are unchanged. + +NOTE: this function performs internal M-point FFT. It allocates temporary + plan which is destroyed after leaving this function. + + -- ALGLIB -- + Copyright 08.05.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftprecomputebluesteinsfft(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* precr, + ae_int_t offs, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + double bx; + double by; + fasttransformplan plan; + + ae_frame_make(_state, &_frame_block); + _fasttransformplan_init(&plan, _state, ae_true); + + + /* + * Fill first half of PrecR with b[k] = exp(i*pi*k^2/N) + */ + for(i=0; i<=2*m-1; i++) + { + precr->ptr.p_double[offs+i] = 0; + } + for(i=0; i<=n-1; i++) + { + bx = ae_cos(ae_pi/n*i*i, _state); + by = ae_sin(ae_pi/n*i*i, _state); + precr->ptr.p_double[offs+2*i+0] = bx; + precr->ptr.p_double[offs+2*i+1] = by; + precr->ptr.p_double[offs+2*((m-i)%m)+0] = bx; + precr->ptr.p_double[offs+2*((m-i)%m)+1] = by; + } + + /* + * Precomputed FFT + */ + ftcomplexfftplan(m, 1, &plan, _state); + for(i=0; i<=2*m-1; i++) + { + precr->ptr.p_double[offs+2*m+i] = precr->ptr.p_double[offs+i]; + } + ftbase_ftapplysubplan(&plan, 0, precr, offs+2*m, 0, &plan.buffer, 1, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine applies complex Bluestein's FFT to input/output array A. + +INPUT PARAMETERS: + Plan - transformation plan + A - array, must be large enough for plan to work + ABase - base offset in array A, this value points to start of + subarray whose length is equal to length of the plan + AOffset - offset with respect to ABase, 0<=AOffsetptr.p_double[p0+0]; + y = a->ptr.p_double[p0+1]; + bx = plan->precr.ptr.p_double[p1+0]; + by = -plan->precr.ptr.p_double[p1+1]; + bufa->ptr.p_double[2*i+0] = x*bx-y*by; + bufa->ptr.p_double[2*i+1] = x*by+y*bx; + p0 = p0+2; + p1 = p1+2; + } + for(i=2*n; i<=2*m-1; i++) + { + bufa->ptr.p_double[i] = 0; + } + + /* + * Perform convolution of A and Z (using precomputed + * FFT of Z stored in Plan structure). + */ + ftbase_ftapplysubplan(plan, subplan, bufa, 0, 0, bufc, 1, _state); + p0 = 0; + p1 = precoffs+2*m; + for(i=0; i<=m-1; i++) + { + ax = bufa->ptr.p_double[p0+0]; + ay = bufa->ptr.p_double[p0+1]; + bx = plan->precr.ptr.p_double[p1+0]; + by = plan->precr.ptr.p_double[p1+1]; + bufa->ptr.p_double[p0+0] = ax*bx-ay*by; + bufa->ptr.p_double[p0+1] = -(ax*by+ay*bx); + p0 = p0+2; + p1 = p1+2; + } + ftbase_ftapplysubplan(plan, subplan, bufa, 0, 0, bufc, 1, _state); + + /* + * Post processing: + * A:=conj(Z)*conj(A)/M + * Here conj(A)/M corresponds to last stage of inverse DFT, + * and conj(Z) comes from Bluestein's FFT algorithm. + */ + p0 = precoffs; + p1 = 0; + p2 = abase+aoffset+op*2*n; + for(i=0; i<=n-1; i++) + { + bx = plan->precr.ptr.p_double[p0+0]; + by = plan->precr.ptr.p_double[p0+1]; + rx = bufa->ptr.p_double[p1+0]/m; + ry = -bufa->ptr.p_double[p1+1]/m; + a->ptr.p_double[p2+0] = rx*bx-ry*(-by); + a->ptr.p_double[p2+1] = rx*(-by)+ry*bx; + p0 = p0+2; + p1 = p1+2; + p2 = p2+2; + } + } +} + + +/************************************************************************* +This subroutine precomputes data for complex Rader's FFT and writes them +to array PrecR[] at specified offset. It is responsibility of the caller +to make sure that PrecR[] is large enough. + +INPUT PARAMETERS: + N - original size of the transform (before reduction to N-1) + RQ - primitive root modulo N + RIQ - inverse of primitive root modulo N + PrecR - preallocated array + Offs - offset + +OUTPUT PARAMETERS: + PrecR - data at Offs:Offs+2*(N-1)-1 store FFT of Rader's factors, + other parts of PrecR are unchanged. + +NOTE: this function performs internal (N-1)-point FFT. It allocates temporary + plan which is destroyed after leaving this function. + + -- ALGLIB -- + Copyright 08.05.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftprecomputeradersfft(ae_int_t n, + ae_int_t rq, + ae_int_t riq, + /* Real */ ae_vector* precr, + ae_int_t offs, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t q; + fasttransformplan plan; + ae_int_t kiq; + double v; + + ae_frame_make(_state, &_frame_block); + _fasttransformplan_init(&plan, _state, ae_true); + + + /* + * Fill PrecR with Rader factors, perform FFT + */ + kiq = 1; + for(q=0; q<=n-2; q++) + { + v = -2*ae_pi*kiq/n; + precr->ptr.p_double[offs+2*q+0] = ae_cos(v, _state); + precr->ptr.p_double[offs+2*q+1] = ae_sin(v, _state); + kiq = kiq*riq%n; + } + ftcomplexfftplan(n-1, 1, &plan, _state); + ftbase_ftapplysubplan(&plan, 0, precr, offs, 0, &plan.buffer, 1, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine applies complex Rader's FFT to input/output array A. + +INPUT PARAMETERS: + A - array, must be large enough for plan to work + ABase - base offset in array A, this value points to start of + subarray whose length is equal to length of the plan + AOffset - offset with respect to ABase, 0<=AOffset=1, "FTApplyComplexRefFFT: OperandsCnt<1", _state); + + /* + * Process operands + */ + for(opidx=0; opidx<=operandscnt-1; opidx++) + { + + /* + * fill QA + */ + kq = 1; + p0 = abase+aoffset+opidx*n*2; + p1 = aoffset+opidx*n*2; + rx = a->ptr.p_double[p0+0]; + ry = a->ptr.p_double[p0+1]; + x0 = rx; + y0 = ry; + for(q=0; q<=n-2; q++) + { + ax = a->ptr.p_double[p0+2*kq+0]; + ay = a->ptr.p_double[p0+2*kq+1]; + buf->ptr.p_double[p1+0] = ax; + buf->ptr.p_double[p1+1] = ay; + rx = rx+ax; + ry = ry+ay; + kq = kq*rq%n; + p1 = p1+2; + } + p0 = abase+aoffset+opidx*n*2; + p1 = aoffset+opidx*n*2; + for(q=0; q<=n-2; q++) + { + a->ptr.p_double[p0] = buf->ptr.p_double[p1]; + a->ptr.p_double[p0+1] = buf->ptr.p_double[p1+1]; + p0 = p0+2; + p1 = p1+2; + } + + /* + * Convolution + */ + ftbase_ftapplysubplan(plan, subplan, a, abase, aoffset+opidx*n*2, buf, 1, _state); + p0 = abase+aoffset+opidx*n*2; + p1 = precoffs; + for(i=0; i<=n-2; i++) + { + ax = a->ptr.p_double[p0+0]; + ay = a->ptr.p_double[p0+1]; + bx = plan->precr.ptr.p_double[p1+0]; + by = plan->precr.ptr.p_double[p1+1]; + a->ptr.p_double[p0+0] = ax*bx-ay*by; + a->ptr.p_double[p0+1] = -(ax*by+ay*bx); + p0 = p0+2; + p1 = p1+2; + } + ftbase_ftapplysubplan(plan, subplan, a, abase, aoffset+opidx*n*2, buf, 1, _state); + p0 = abase+aoffset+opidx*n*2; + for(i=0; i<=n-2; i++) + { + a->ptr.p_double[p0+0] = a->ptr.p_double[p0+0]/(n-1); + a->ptr.p_double[p0+1] = -a->ptr.p_double[p0+1]/(n-1); + p0 = p0+2; + } + + /* + * Result + */ + buf->ptr.p_double[aoffset+opidx*n*2+0] = rx; + buf->ptr.p_double[aoffset+opidx*n*2+1] = ry; + kiq = 1; + p0 = aoffset+opidx*n*2; + p1 = abase+aoffset+opidx*n*2; + for(q=0; q<=n-2; q++) + { + buf->ptr.p_double[p0+2*kiq+0] = x0+a->ptr.p_double[p1+0]; + buf->ptr.p_double[p0+2*kiq+1] = y0+a->ptr.p_double[p1+1]; + kiq = kiq*riq%n; + p1 = p1+2; + } + p0 = abase+aoffset+opidx*n*2; + p1 = aoffset+opidx*n*2; + for(q=0; q<=n-1; q++) + { + a->ptr.p_double[p0] = buf->ptr.p_double[p1]; + a->ptr.p_double[p0+1] = buf->ptr.p_double[p1+1]; + p0 = p0+2; + p1 = p1+2; + } + } +} + + +/************************************************************************* +Factorizes task size N into product of two smaller sizes N1 and N2 + +INPUT PARAMETERS: + N - task size, N>0 + IsRoot - whether taks is root task (first one in a sequence) + +OUTPUT PARAMETERS: + N1, N2 - such numbers that: + * for prime N: N1=N2=0 + * for composite N<=MaxRadix: N1=N2=0 + * for composite N>MaxRadix: 1<=N1<=N2, N1*N2=N + + -- ALGLIB -- + Copyright 08.04.2013 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftfactorize(ae_int_t n, + ae_bool isroot, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state) +{ + ae_int_t j; + ae_int_t k; + + *n1 = 0; + *n2 = 0; + + ae_assert(n>0, "FTFactorize: N<=0", _state); + *n1 = 0; + *n2 = 0; + + /* + * Small N + */ + if( n<=ftbase_maxradix ) + { + return; + } + + /* + * Large N, recursive split + */ + if( n>ftbase_recursivethreshold ) + { + k = ae_iceil(ae_sqrt(n, _state), _state)+1; + ae_assert(k*k>=n, "FTFactorize: internal error during recursive factorization", _state); + for(j=k; j>=2; j--) + { + if( n%j==0 ) + { + *n1 = ae_minint(n/j, j, _state); + *n2 = ae_maxint(n/j, j, _state); + return; + } + } + } + + /* + * N>MaxRadix, try to find good codelet + */ + for(j=ftbase_maxradix; j>=2; j--) + { + if( n%j==0 ) + { + *n1 = j; + *n2 = n/j; + break; + } + } + + /* + * In case no good codelet was found, + * try to factorize N into product of ANY primes. + */ + if( *n1*(*n2)!=n ) + { + for(j=2; j<=n-1; j++) + { + if( n%j==0 ) + { + *n1 = j; + *n2 = n/j; + break; + } + if( j*j>n ) + { + break; + } + } + } + + /* + * normalize + */ + if( *n1>(*n2) ) + { + j = *n1; + *n1 = *n2; + *n2 = j; + } +} + + +/************************************************************************* +Returns optimistic estimate of the FFT cost, in UNITs (1 UNIT = 100 KFLOPs) + +INPUT PARAMETERS: + N - task size, N>0 + +RESULU: + cost in UNITs, rounded down to nearest integer + +NOTE: If FFT cost is less than 1 UNIT, it will return 0 as result. + + -- ALGLIB -- + Copyright 08.04.2013 by Bochkanov Sergey +*************************************************************************/ +static ae_int_t ftbase_ftoptimisticestimate(ae_int_t n, ae_state *_state) +{ + ae_int_t result; + + + ae_assert(n>0, "FTOptimisticEstimate: N<=0", _state); + result = ae_ifloor(1.0E-5*5*n*ae_log(n, _state)/ae_log(2, _state), _state); + return result; +} + + +/************************************************************************* +Twiddle factors calculation + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ffttwcalc(/* Real */ ae_vector* a, + ae_int_t aoffset, + ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j2; + ae_int_t n; + ae_int_t halfn1; + ae_int_t offs; + double x; + double y; + double twxm1; + double twy; + double twbasexm1; + double twbasey; + double twrowxm1; + double twrowy; + double tmpx; + double tmpy; + double v; + ae_int_t updatetw2; + + + + /* + * Multiplication by twiddle factors for complex Cooley-Tukey FFT + * with N factorized as N1*N2. + * + * Naive solution to this problem is given below: + * + * > for K:=1 to N2-1 do + * > for J:=1 to N1-1 do + * > begin + * > Idx:=K*N1+J; + * > X:=A[AOffset+2*Idx+0]; + * > Y:=A[AOffset+2*Idx+1]; + * > TwX:=Cos(-2*Pi()*K*J/(N1*N2)); + * > TwY:=Sin(-2*Pi()*K*J/(N1*N2)); + * > A[AOffset+2*Idx+0]:=X*TwX-Y*TwY; + * > A[AOffset+2*Idx+1]:=X*TwY+Y*TwX; + * > end; + * + * However, there are exist more efficient solutions. + * + * Each pass of the inner cycle corresponds to multiplication of one + * entry of A by W[k,j]=exp(-I*2*pi*k*j/N). This factor can be rewritten + * as exp(-I*2*pi*k/N)^j. So we can replace costly exponentiation by + * repeated multiplication: W[k,j+1]=W[k,j]*exp(-I*2*pi*k/N), with + * second factor being computed once in the beginning of the iteration. + * + * Also, exp(-I*2*pi*k/N) can be represented as exp(-I*2*pi/N)^k, i.e. + * we have W[K+1,1]=W[K,1]*W[1,1]. + * + * In our loop we use following variables: + * * [TwBaseXM1,TwBaseY] = [cos(2*pi/N)-1, sin(2*pi/N)] + * * [TwRowXM1, TwRowY] = [cos(2*pi*I/N)-1, sin(2*pi*I/N)] + * * [TwXM1, TwY] = [cos(2*pi*I*J/N)-1, sin(2*pi*I*J/N)] + * + * Meaning of the variables: + * * [TwXM1,TwY] is current twiddle factor W[I,J] + * * [TwRowXM1, TwRowY] is W[I,1] + * * [TwBaseXM1,TwBaseY] is W[1,1] + * + * During inner loop we multiply current twiddle factor by W[I,1], + * during outer loop we update W[I,1]. + * + */ + ae_assert(ftbase_updatetw>=2, "FFTTwCalc: internal error - UpdateTw<2", _state); + updatetw2 = ftbase_updatetw/2; + halfn1 = n1/2; + n = n1*n2; + v = -2*ae_pi/n; + twbasexm1 = -2*ae_sqr(ae_sin(0.5*v, _state), _state); + twbasey = ae_sin(v, _state); + twrowxm1 = 0; + twrowy = 0; + offs = aoffset; + for(i=0; i<=n2-1; i++) + { + + /* + * Initialize twiddle factor for current row + */ + twxm1 = 0; + twy = 0; + + /* + * N1-point block is separated into 2-point chunks and residual 1-point chunk + * (in case N1 is odd). Unrolled loop is several times faster. + */ + for(j2=0; j2<=halfn1-1; j2++) + { + + /* + * Processing: + * * process first element in a chunk. + * * update twiddle factor (unconditional update) + * * process second element + * * conditional update of the twiddle factor + */ + x = a->ptr.p_double[offs+0]; + y = a->ptr.p_double[offs+1]; + tmpx = x*(1+twxm1)-y*twy; + tmpy = x*twy+y*(1+twxm1); + a->ptr.p_double[offs+0] = tmpx; + a->ptr.p_double[offs+1] = tmpy; + tmpx = (1+twxm1)*twrowxm1-twy*twrowy; + twy = twy+(1+twxm1)*twrowy+twy*twrowxm1; + twxm1 = twxm1+tmpx; + x = a->ptr.p_double[offs+2]; + y = a->ptr.p_double[offs+3]; + tmpx = x*(1+twxm1)-y*twy; + tmpy = x*twy+y*(1+twxm1); + a->ptr.p_double[offs+2] = tmpx; + a->ptr.p_double[offs+3] = tmpy; + offs = offs+4; + if( (j2+1)%updatetw2==0&&j2ptr.p_double[offs+0]; + y = a->ptr.p_double[offs+1]; + tmpx = x*(1+twxm1)-y*twy; + tmpy = x*twy+y*(1+twxm1); + a->ptr.p_double[offs+0] = tmpx; + a->ptr.p_double[offs+1] = tmpy; + offs = offs+2; + } + + /* + * update TwRow: TwRow(new) = TwRow(old)*TwBase + */ + if( iptr.p_double[astart], 1, &buf->ptr.p_double[0], 1, ae_v_len(astart,astart+2*m*n-1)); +} + + +/************************************************************************* +Recurrent subroutine for a InternalComplexLinTranspose + +Write A^T to B, where: +* A is m*n complex matrix stored in array A as pairs of real/image values, + beginning from AStart position, with AStride stride +* B is n*m complex matrix stored in array B as pairs of real/image values, + beginning from BStart position, with BStride stride +stride is measured in complex numbers, i.e. in real/image pairs. + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ffticltrec(/* Real */ ae_vector* a, + ae_int_t astart, + ae_int_t astride, + /* Real */ ae_vector* b, + ae_int_t bstart, + ae_int_t bstride, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t idx1; + ae_int_t idx2; + ae_int_t m2; + ae_int_t m1; + ae_int_t n1; + + + if( m==0||n==0 ) + { + return; + } + if( ae_maxint(m, n, _state)<=8 ) + { + m2 = 2*bstride; + for(i=0; i<=m-1; i++) + { + idx1 = bstart+2*i; + idx2 = astart+2*i*astride; + for(j=0; j<=n-1; j++) + { + b->ptr.p_double[idx1+0] = a->ptr.p_double[idx2+0]; + b->ptr.p_double[idx1+1] = a->ptr.p_double[idx2+1]; + idx1 = idx1+m2; + idx2 = idx2+2; + } + } + return; + } + if( n>m ) + { + + /* + * New partition: + * + * "A^T -> B" becomes "(A1 A2)^T -> ( B1 ) + * ( B2 ) + */ + n1 = n/2; + if( n-n1>=8&&n1%8!=0 ) + { + n1 = n1+(8-n1%8); + } + ae_assert(n-n1>0, "Assertion failed", _state); + ftbase_ffticltrec(a, astart, astride, b, bstart, bstride, m, n1, _state); + ftbase_ffticltrec(a, astart+2*n1, astride, b, bstart+2*n1*bstride, bstride, m, n-n1, _state); + } + else + { + + /* + * New partition: + * + * "A^T -> B" becomes "( A1 )^T -> ( B1 B2 ) + * ( A2 ) + */ + m1 = m/2; + if( m-m1>=8&&m1%8!=0 ) + { + m1 = m1+(8-m1%8); + } + ae_assert(m-m1>0, "Assertion failed", _state); + ftbase_ffticltrec(a, astart, astride, b, bstart, bstride, m1, n, _state); + ftbase_ffticltrec(a, astart+2*m1*astride, astride, b, bstart+2*m1, bstride, m-m1, n, _state); + } +} + + +/************************************************************************* +Recurrent subroutine for a InternalRealLinTranspose + + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_fftirltrec(/* Real */ ae_vector* a, + ae_int_t astart, + ae_int_t astride, + /* Real */ ae_vector* b, + ae_int_t bstart, + ae_int_t bstride, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t idx1; + ae_int_t idx2; + ae_int_t m1; + ae_int_t n1; + + + if( m==0||n==0 ) + { + return; + } + if( ae_maxint(m, n, _state)<=8 ) + { + for(i=0; i<=m-1; i++) + { + idx1 = bstart+i; + idx2 = astart+i*astride; + for(j=0; j<=n-1; j++) + { + b->ptr.p_double[idx1] = a->ptr.p_double[idx2]; + idx1 = idx1+bstride; + idx2 = idx2+1; + } + } + return; + } + if( n>m ) + { + + /* + * New partition: + * + * "A^T -> B" becomes "(A1 A2)^T -> ( B1 ) + * ( B2 ) + */ + n1 = n/2; + if( n-n1>=8&&n1%8!=0 ) + { + n1 = n1+(8-n1%8); + } + ae_assert(n-n1>0, "Assertion failed", _state); + ftbase_fftirltrec(a, astart, astride, b, bstart, bstride, m, n1, _state); + ftbase_fftirltrec(a, astart+n1, astride, b, bstart+n1*bstride, bstride, m, n-n1, _state); + } + else + { + + /* + * New partition: + * + * "A^T -> B" becomes "( A1 )^T -> ( B1 B2 ) + * ( A2 ) + */ + m1 = m/2; + if( m-m1>=8&&m1%8!=0 ) + { + m1 = m1+(8-m1%8); + } + ae_assert(m-m1>0, "Assertion failed", _state); + ftbase_fftirltrec(a, astart, astride, b, bstart, bstride, m1, n, _state); + ftbase_fftirltrec(a, astart+m1*astride, astride, b, bstart+m1, bstride, m-m1, n, _state); + } +} + + +/************************************************************************* +recurrent subroutine for FFTFindSmoothRec + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftbasefindsmoothrec(ae_int_t n, + ae_int_t seed, + ae_int_t leastfactor, + ae_int_t* best, + ae_state *_state) +{ + + + ae_assert(ftbase_ftbasemaxsmoothfactor<=5, "FTBaseFindSmoothRec: internal error!", _state); + if( seed>=n ) + { + *best = ae_minint(*best, seed, _state); + return; + } + if( leastfactor<=2 ) + { + ftbase_ftbasefindsmoothrec(n, seed*2, 2, best, _state); + } + if( leastfactor<=3 ) + { + ftbase_ftbasefindsmoothrec(n, seed*3, 3, best, _state); + } + if( leastfactor<=5 ) + { + ftbase_ftbasefindsmoothrec(n, seed*5, 5, best, _state); + } +} + + +ae_bool _fasttransformplan_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + fasttransformplan *p = (fasttransformplan*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->entries, 0, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->buffer, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->precr, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->preci, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init(&p->bluesteinpool, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _fasttransformplan_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + fasttransformplan *dst = (fasttransformplan*)_dst; + fasttransformplan *src = (fasttransformplan*)_src; + if( !ae_matrix_init_copy(&dst->entries, &src->entries, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->buffer, &src->buffer, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->precr, &src->precr, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->preci, &src->preci, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init_copy(&dst->bluesteinpool, &src->bluesteinpool, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _fasttransformplan_clear(void* _p) +{ + fasttransformplan *p = (fasttransformplan*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->entries); + ae_vector_clear(&p->buffer); + ae_vector_clear(&p->precr); + ae_vector_clear(&p->preci); + ae_shared_pool_clear(&p->bluesteinpool); +} + + +void _fasttransformplan_destroy(void* _p) +{ + fasttransformplan *p = (fasttransformplan*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->entries); + ae_vector_destroy(&p->buffer); + ae_vector_destroy(&p->precr); + ae_vector_destroy(&p->preci); + ae_shared_pool_destroy(&p->bluesteinpool); +} + + + + +double nulog1p(double x, ae_state *_state) +{ + double z; + double lp; + double lq; + double result; + + + z = 1.0+x; + if( ae_fp_less(z,0.70710678118654752440)||ae_fp_greater(z,1.41421356237309504880) ) + { + result = ae_log(z, _state); + return result; + } + z = x*x; + lp = 4.5270000862445199635215E-5; + lp = lp*x+4.9854102823193375972212E-1; + lp = lp*x+6.5787325942061044846969E0; + lp = lp*x+2.9911919328553073277375E1; + lp = lp*x+6.0949667980987787057556E1; + lp = lp*x+5.7112963590585538103336E1; + lp = lp*x+2.0039553499201281259648E1; + lq = 1.0000000000000000000000E0; + lq = lq*x+1.5062909083469192043167E1; + lq = lq*x+8.3047565967967209469434E1; + lq = lq*x+2.2176239823732856465394E2; + lq = lq*x+3.0909872225312059774938E2; + lq = lq*x+2.1642788614495947685003E2; + lq = lq*x+6.0118660497603843919306E1; + z = -0.5*z+x*(z*lp/lq); + result = x+z; + return result; +} + + +double nuexpm1(double x, ae_state *_state) +{ + double r; + double xx; + double ep; + double eq; + double result; + + + if( ae_fp_less(x,-0.5)||ae_fp_greater(x,0.5) ) + { + result = ae_exp(x, _state)-1.0; + return result; + } + xx = x*x; + ep = 1.2617719307481059087798E-4; + ep = ep*xx+3.0299440770744196129956E-2; + ep = ep*xx+9.9999999999999999991025E-1; + eq = 3.0019850513866445504159E-6; + eq = eq*xx+2.5244834034968410419224E-3; + eq = eq*xx+2.2726554820815502876593E-1; + eq = eq*xx+2.0000000000000000000897E0; + r = x*ep; + r = r/(eq-r); + result = r+r; + return result; +} + + +double nucosm1(double x, ae_state *_state) +{ + double xx; + double c; + double result; + + + if( ae_fp_less(x,-0.25*ae_pi)||ae_fp_greater(x,0.25*ae_pi) ) + { + result = ae_cos(x, _state)-1; + return result; + } + xx = x*x; + c = 4.7377507964246204691685E-14; + c = c*xx-1.1470284843425359765671E-11; + c = c*xx+2.0876754287081521758361E-9; + c = c*xx-2.7557319214999787979814E-7; + c = c*xx+2.4801587301570552304991E-5; + c = c*xx-1.3888888888888872993737E-3; + c = c*xx+4.1666666666666666609054E-2; + result = -0.5*xx+xx*xx*c; + return result; +} + + + + + +} + diff --git a/psdlag/src/alglibinternal.h b/psdlag/src/alglibinternal.h new file mode 100644 index 0000000..a59bf7e --- /dev/null +++ b/psdlag/src/alglibinternal.h @@ -0,0 +1,1074 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _alglibinternal_pkg_h +#define _alglibinternal_pkg_h +#include "ap.h" + + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + ae_vector ia0; + ae_vector ia1; + ae_vector ia2; + ae_vector ia3; + ae_vector ra0; + ae_vector ra1; + ae_vector ra2; + ae_vector ra3; +} apbuffers; +typedef struct +{ + ae_bool val; +} sboolean; +typedef struct +{ + ae_vector val; +} sbooleanarray; +typedef struct +{ + ae_int_t val; +} sinteger; +typedef struct +{ + ae_vector val; +} sintegerarray; +typedef struct +{ + double val; +} sreal; +typedef struct +{ + ae_vector val; +} srealarray; +typedef struct +{ + ae_complex val; +} scomplex; +typedef struct +{ + ae_vector val; +} scomplexarray; +typedef struct +{ + ae_int_t chunksize; + ae_int_t ntotal; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_vector batch4buf; + ae_vector hpcbuf; + ae_matrix xy; + ae_matrix xy2; + ae_vector xyrow; + ae_vector x; + ae_vector y; + ae_vector desiredy; + double e; + ae_vector g; + ae_vector tmp0; +} mlpbuffers; +typedef struct +{ + ae_bool brackt; + ae_bool stage1; + ae_int_t infoc; + double dg; + double dgm; + double dginit; + double dgtest; + double dgx; + double dgxm; + double dgy; + double dgym; + double finit; + double ftest1; + double fm; + double fx; + double fxm; + double fy; + double fym; + double stx; + double sty; + double stmin; + double stmax; + double width; + double width1; + double xtrapf; +} linminstate; +typedef struct +{ + ae_bool needf; + ae_vector x; + double f; + ae_int_t n; + ae_vector xbase; + ae_vector s; + double stplen; + double fcur; + double stpmax; + ae_int_t fmax; + ae_int_t nfev; + ae_int_t info; + rcommstate rstate; +} armijostate; +typedef struct +{ + ae_matrix entries; + ae_vector buffer; + ae_vector precr; + ae_vector preci; + ae_shared_pool bluesteinpool; +} fasttransformplan; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +ae_bool seterrorflag(ae_bool* flag, ae_bool cond, ae_state *_state); +ae_bool seterrorflagdiff(ae_bool* flag, + double val, + double refval, + double tol, + double s, + ae_state *_state); +void touchint(ae_int_t* a, ae_state *_state); +void touchreal(double* a, ae_state *_state); +double inttoreal(ae_int_t a, ae_state *_state); +double log2(double x, ae_state *_state); +ae_bool approxequalrel(double a, double b, double tol, ae_state *_state); +void taskgenint1d(double a, + double b, + ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void taskgenint1dequidist(double a, + double b, + ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void taskgenint1dcheb1(double a, + double b, + ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void taskgenint1dcheb2(double a, + double b, + ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +ae_bool aredistinct(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +ae_bool aresameboolean(ae_bool v1, ae_bool v2, ae_state *_state); +void bvectorsetlengthatleast(/* Boolean */ ae_vector* x, + ae_int_t n, + ae_state *_state); +void ivectorsetlengthatleast(/* Integer */ ae_vector* x, + ae_int_t n, + ae_state *_state); +void rvectorsetlengthatleast(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +void rmatrixsetlengthatleast(/* Real */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state); +void rmatrixresize(/* Real */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state); +void imatrixresize(/* Integer */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state); +ae_bool isfinitevector(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +ae_bool isfinitecvector(/* Complex */ ae_vector* z, + ae_int_t n, + ae_state *_state); +ae_bool apservisfinitematrix(/* Real */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state); +ae_bool apservisfinitecmatrix(/* Complex */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state); +ae_bool isfinitertrmatrix(/* Real */ ae_matrix* x, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +ae_bool apservisfinitectrmatrix(/* Complex */ ae_matrix* x, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +ae_bool apservisfiniteornanmatrix(/* Real */ ae_matrix* x, + ae_int_t m, + ae_int_t n, + ae_state *_state); +double safepythag2(double x, double y, ae_state *_state); +double safepythag3(double x, double y, double z, ae_state *_state); +ae_int_t saferdiv(double x, double y, double* r, ae_state *_state); +double safeminposrv(double x, double y, double v, ae_state *_state); +void apperiodicmap(double* x, + double a, + double b, + double* k, + ae_state *_state); +double randomnormal(ae_state *_state); +void randomunit(ae_int_t n, /* Real */ ae_vector* x, ae_state *_state); +void inc(ae_int_t* v, ae_state *_state); +void dec(ae_int_t* v, ae_state *_state); +void countdown(ae_int_t* v, ae_state *_state); +double boundval(double x, double b1, double b2, ae_state *_state); +void alloccomplex(ae_serializer* s, ae_complex v, ae_state *_state); +void serializecomplex(ae_serializer* s, ae_complex v, ae_state *_state); +ae_complex unserializecomplex(ae_serializer* s, ae_state *_state); +void allocrealarray(ae_serializer* s, + /* Real */ ae_vector* v, + ae_int_t n, + ae_state *_state); +void serializerealarray(ae_serializer* s, + /* Real */ ae_vector* v, + ae_int_t n, + ae_state *_state); +void unserializerealarray(ae_serializer* s, + /* Real */ ae_vector* v, + ae_state *_state); +void allocintegerarray(ae_serializer* s, + /* Integer */ ae_vector* v, + ae_int_t n, + ae_state *_state); +void serializeintegerarray(ae_serializer* s, + /* Integer */ ae_vector* v, + ae_int_t n, + ae_state *_state); +void unserializeintegerarray(ae_serializer* s, + /* Integer */ ae_vector* v, + ae_state *_state); +void allocrealmatrix(ae_serializer* s, + /* Real */ ae_matrix* v, + ae_int_t n0, + ae_int_t n1, + ae_state *_state); +void serializerealmatrix(ae_serializer* s, + /* Real */ ae_matrix* v, + ae_int_t n0, + ae_int_t n1, + ae_state *_state); +void unserializerealmatrix(ae_serializer* s, + /* Real */ ae_matrix* v, + ae_state *_state); +void copyintegerarray(/* Integer */ ae_vector* src, + /* Integer */ ae_vector* dst, + ae_state *_state); +void copyrealarray(/* Real */ ae_vector* src, + /* Real */ ae_vector* dst, + ae_state *_state); +void copyrealmatrix(/* Real */ ae_matrix* src, + /* Real */ ae_matrix* dst, + ae_state *_state); +ae_int_t recsearch(/* Integer */ ae_vector* a, + ae_int_t nrec, + ae_int_t nheader, + ae_int_t i0, + ae_int_t i1, + /* Integer */ ae_vector* b, + ae_state *_state); +void splitlengtheven(ae_int_t tasksize, + ae_int_t* task0, + ae_int_t* task1, + ae_state *_state); +void splitlength(ae_int_t tasksize, + ae_int_t chunksize, + ae_int_t* task0, + ae_int_t* task1, + ae_state *_state); +ae_bool _apbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _apbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _apbuffers_clear(void* _p); +void _apbuffers_destroy(void* _p); +ae_bool _sboolean_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _sboolean_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _sboolean_clear(void* _p); +void _sboolean_destroy(void* _p); +ae_bool _sbooleanarray_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _sbooleanarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _sbooleanarray_clear(void* _p); +void _sbooleanarray_destroy(void* _p); +ae_bool _sinteger_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _sinteger_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _sinteger_clear(void* _p); +void _sinteger_destroy(void* _p); +ae_bool _sintegerarray_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _sintegerarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _sintegerarray_clear(void* _p); +void _sintegerarray_destroy(void* _p); +ae_bool _sreal_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _sreal_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _sreal_clear(void* _p); +void _sreal_destroy(void* _p); +ae_bool _srealarray_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _srealarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _srealarray_clear(void* _p); +void _srealarray_destroy(void* _p); +ae_bool _scomplex_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _scomplex_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _scomplex_clear(void* _p); +void _scomplex_destroy(void* _p); +ae_bool _scomplexarray_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _scomplexarray_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _scomplexarray_clear(void* _p); +void _scomplexarray_destroy(void* _p); +ae_int_t getrdfserializationcode(ae_state *_state); +ae_int_t getkdtreeserializationcode(ae_state *_state); +ae_int_t getmlpserializationcode(ae_state *_state); +ae_int_t getmlpeserializationcode(ae_state *_state); +ae_int_t getrbfserializationcode(ae_state *_state); +void tagsort(/* Real */ ae_vector* a, + ae_int_t n, + /* Integer */ ae_vector* p1, + /* Integer */ ae_vector* p2, + ae_state *_state); +void tagsortbuf(/* Real */ ae_vector* a, + ae_int_t n, + /* Integer */ ae_vector* p1, + /* Integer */ ae_vector* p2, + apbuffers* buf, + ae_state *_state); +void tagsortfasti(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + /* Real */ ae_vector* bufa, + /* Integer */ ae_vector* bufb, + ae_int_t n, + ae_state *_state); +void tagsortfastr(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* bufa, + /* Real */ ae_vector* bufb, + ae_int_t n, + ae_state *_state); +void tagsortfast(/* Real */ ae_vector* a, + /* Real */ ae_vector* bufa, + ae_int_t n, + ae_state *_state); +void tagsortmiddleir(/* Integer */ ae_vector* a, + /* Real */ ae_vector* b, + ae_int_t offset, + ae_int_t n, + ae_state *_state); +void tagheappushi(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + ae_int_t* n, + double va, + ae_int_t vb, + ae_state *_state); +void tagheapreplacetopi(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + ae_int_t n, + double va, + ae_int_t vb, + ae_state *_state); +void tagheappopi(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + ae_int_t* n, + ae_state *_state); +ae_int_t lowerbound(/* Real */ ae_vector* a, + ae_int_t n, + double t, + ae_state *_state); +ae_int_t upperbound(/* Real */ ae_vector* a, + ae_int_t n, + double t, + ae_state *_state); +void rankx(/* Real */ ae_vector* x, + ae_int_t n, + ae_bool iscentered, + apbuffers* buf, + ae_state *_state); +ae_bool cmatrixrank1f(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Complex */ ae_vector* u, + ae_int_t iu, + /* Complex */ ae_vector* v, + ae_int_t iv, + ae_state *_state); +ae_bool rmatrixrank1f(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_vector* u, + ae_int_t iu, + /* Real */ ae_vector* v, + ae_int_t iv, + ae_state *_state); +ae_bool cmatrixmvf(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t opa, + /* Complex */ ae_vector* x, + ae_int_t ix, + /* Complex */ ae_vector* y, + ae_int_t iy, + ae_state *_state); +ae_bool rmatrixmvf(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t opa, + /* Real */ ae_vector* x, + ae_int_t ix, + /* Real */ ae_vector* y, + ae_int_t iy, + ae_state *_state); +ae_bool cmatrixrighttrsmf(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +ae_bool cmatrixlefttrsmf(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +ae_bool rmatrixrighttrsmf(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +ae_bool rmatrixlefttrsmf(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +ae_bool cmatrixsyrkf(ae_int_t n, + ae_int_t k, + double alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state); +ae_bool rmatrixsyrkf(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state); +ae_bool rmatrixgemmf(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +ae_bool cmatrixgemmf(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +void cmatrixgemmk(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +void rmatrixgemmk(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +void rmatrixgemmk44v00(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +void rmatrixgemmk44v01(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +void rmatrixgemmk44v10(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +void rmatrixgemmk44v11(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +ae_bool rmatrixsyrkmkl(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state); +ae_bool rmatrixgemmmkl(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +double vectornorm2(/* Real */ ae_vector* x, + ae_int_t i1, + ae_int_t i2, + ae_state *_state); +ae_int_t vectoridxabsmax(/* Real */ ae_vector* x, + ae_int_t i1, + ae_int_t i2, + ae_state *_state); +ae_int_t columnidxabsmax(/* Real */ ae_matrix* x, + ae_int_t i1, + ae_int_t i2, + ae_int_t j, + ae_state *_state); +ae_int_t rowidxabsmax(/* Real */ ae_matrix* x, + ae_int_t j1, + ae_int_t j2, + ae_int_t i, + ae_state *_state); +double upperhessenberg1norm(/* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t i2, + ae_int_t j1, + ae_int_t j2, + /* Real */ ae_vector* work, + ae_state *_state); +void copymatrix(/* Real */ ae_matrix* a, + ae_int_t is1, + ae_int_t is2, + ae_int_t js1, + ae_int_t js2, + /* Real */ ae_matrix* b, + ae_int_t id1, + ae_int_t id2, + ae_int_t jd1, + ae_int_t jd2, + ae_state *_state); +void inplacetranspose(/* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t i2, + ae_int_t j1, + ae_int_t j2, + /* Real */ ae_vector* work, + ae_state *_state); +void copyandtranspose(/* Real */ ae_matrix* a, + ae_int_t is1, + ae_int_t is2, + ae_int_t js1, + ae_int_t js2, + /* Real */ ae_matrix* b, + ae_int_t id1, + ae_int_t id2, + ae_int_t jd1, + ae_int_t jd2, + ae_state *_state); +void matrixvectormultiply(/* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t i2, + ae_int_t j1, + ae_int_t j2, + ae_bool trans, + /* Real */ ae_vector* x, + ae_int_t ix1, + ae_int_t ix2, + double alpha, + /* Real */ ae_vector* y, + ae_int_t iy1, + ae_int_t iy2, + double beta, + ae_state *_state); +double pythag2(double x, double y, ae_state *_state); +void matrixmatrixmultiply(/* Real */ ae_matrix* a, + ae_int_t ai1, + ae_int_t ai2, + ae_int_t aj1, + ae_int_t aj2, + ae_bool transa, + /* Real */ ae_matrix* b, + ae_int_t bi1, + ae_int_t bi2, + ae_int_t bj1, + ae_int_t bj2, + ae_bool transb, + double alpha, + /* Real */ ae_matrix* c, + ae_int_t ci1, + ae_int_t ci2, + ae_int_t cj1, + ae_int_t cj2, + double beta, + /* Real */ ae_vector* work, + ae_state *_state); +void hermitianmatrixvectormultiply(/* Complex */ ae_matrix* a, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Complex */ ae_vector* x, + ae_complex alpha, + /* Complex */ ae_vector* y, + ae_state *_state); +void hermitianrank2update(/* Complex */ ae_matrix* a, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Complex */ ae_vector* x, + /* Complex */ ae_vector* y, + /* Complex */ ae_vector* t, + ae_complex alpha, + ae_state *_state); +void generatereflection(/* Real */ ae_vector* x, + ae_int_t n, + double* tau, + ae_state *_state); +void applyreflectionfromtheleft(/* Real */ ae_matrix* c, + double tau, + /* Real */ ae_vector* v, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Real */ ae_vector* work, + ae_state *_state); +void applyreflectionfromtheright(/* Real */ ae_matrix* c, + double tau, + /* Real */ ae_vector* v, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Real */ ae_vector* work, + ae_state *_state); +void complexgeneratereflection(/* Complex */ ae_vector* x, + ae_int_t n, + ae_complex* tau, + ae_state *_state); +void complexapplyreflectionfromtheleft(/* Complex */ ae_matrix* c, + ae_complex tau, + /* Complex */ ae_vector* v, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Complex */ ae_vector* work, + ae_state *_state); +void complexapplyreflectionfromtheright(/* Complex */ ae_matrix* c, + ae_complex tau, + /* Complex */ ae_vector* v, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Complex */ ae_vector* work, + ae_state *_state); +void symmetricmatrixvectormultiply(/* Real */ ae_matrix* a, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_vector* x, + double alpha, + /* Real */ ae_vector* y, + ae_state *_state); +void symmetricrank2update(/* Real */ ae_matrix* a, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* t, + double alpha, + ae_state *_state); +void applyrotationsfromtheleft(ae_bool isforward, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Real */ ae_vector* c, + /* Real */ ae_vector* s, + /* Real */ ae_matrix* a, + /* Real */ ae_vector* work, + ae_state *_state); +void applyrotationsfromtheright(ae_bool isforward, + ae_int_t m1, + ae_int_t m2, + ae_int_t n1, + ae_int_t n2, + /* Real */ ae_vector* c, + /* Real */ ae_vector* s, + /* Real */ ae_matrix* a, + /* Real */ ae_vector* work, + ae_state *_state); +void generaterotation(double f, + double g, + double* cs, + double* sn, + double* r, + ae_state *_state); +ae_bool upperhessenbergschurdecomposition(/* Real */ ae_matrix* h, + ae_int_t n, + /* Real */ ae_matrix* s, + ae_state *_state); +void internalschurdecomposition(/* Real */ ae_matrix* h, + ae_int_t n, + ae_int_t tneeded, + ae_int_t zneeded, + /* Real */ ae_vector* wr, + /* Real */ ae_vector* wi, + /* Real */ ae_matrix* z, + ae_int_t* info, + ae_state *_state); +void rmatrixtrsafesolve(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* x, + double* s, + ae_bool isupper, + ae_bool istrans, + ae_bool isunit, + ae_state *_state); +void safesolvetriangular(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* x, + double* s, + ae_bool isupper, + ae_bool istrans, + ae_bool isunit, + ae_bool normin, + /* Real */ ae_vector* cnorm, + ae_state *_state); +ae_bool rmatrixscaledtrsafesolve(/* Real */ ae_matrix* a, + double sa, + ae_int_t n, + /* Real */ ae_vector* x, + ae_bool isupper, + ae_int_t trans, + ae_bool isunit, + double maxgrowth, + ae_state *_state); +ae_bool cmatrixscaledtrsafesolve(/* Complex */ ae_matrix* a, + double sa, + ae_int_t n, + /* Complex */ ae_vector* x, + ae_bool isupper, + ae_int_t trans, + ae_bool isunit, + double maxgrowth, + ae_state *_state); +void hpcpreparechunkedgradient(/* Real */ ae_vector* weights, + ae_int_t wcount, + ae_int_t ntotal, + ae_int_t nin, + ae_int_t nout, + mlpbuffers* buf, + ae_state *_state); +void hpcfinalizechunkedgradient(mlpbuffers* buf, + /* Real */ ae_vector* grad, + ae_state *_state); +ae_bool hpcchunkedgradient(/* Real */ ae_vector* weights, + /* Integer */ ae_vector* structinfo, + /* Real */ ae_vector* columnmeans, + /* Real */ ae_vector* columnsigmas, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + /* Real */ ae_vector* batch4buf, + /* Real */ ae_vector* hpcbuf, + double* e, + ae_bool naturalerrorfunc, + ae_state *_state); +ae_bool hpcchunkedprocess(/* Real */ ae_vector* weights, + /* Integer */ ae_vector* structinfo, + /* Real */ ae_vector* columnmeans, + /* Real */ ae_vector* columnsigmas, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + /* Real */ ae_vector* batch4buf, + /* Real */ ae_vector* hpcbuf, + ae_state *_state); +ae_bool _mlpbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mlpbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mlpbuffers_clear(void* _p); +void _mlpbuffers_destroy(void* _p); +void xdot(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* temp, + double* r, + double* rerr, + ae_state *_state); +void xcdot(/* Complex */ ae_vector* a, + /* Complex */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* temp, + ae_complex* r, + double* rerr, + ae_state *_state); +void linminnormalized(/* Real */ ae_vector* d, + double* stp, + ae_int_t n, + ae_state *_state); +void mcsrch(ae_int_t n, + /* Real */ ae_vector* x, + double* f, + /* Real */ ae_vector* g, + /* Real */ ae_vector* s, + double* stp, + double stpmax, + double gtol, + ae_int_t* info, + ae_int_t* nfev, + /* Real */ ae_vector* wa, + linminstate* state, + ae_int_t* stage, + ae_state *_state); +void armijocreate(ae_int_t n, + /* Real */ ae_vector* x, + double f, + /* Real */ ae_vector* s, + double stp, + double stpmax, + ae_int_t fmax, + armijostate* state, + ae_state *_state); +ae_bool armijoiteration(armijostate* state, ae_state *_state); +void armijoresults(armijostate* state, + ae_int_t* info, + double* stp, + double* f, + ae_state *_state); +ae_bool _linminstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _linminstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _linminstate_clear(void* _p); +void _linminstate_destroy(void* _p); +ae_bool _armijostate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _armijostate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _armijostate_clear(void* _p); +void _armijostate_destroy(void* _p); +void findprimitiverootandinverse(ae_int_t n, + ae_int_t* proot, + ae_int_t* invproot, + ae_state *_state); +void ftcomplexfftplan(ae_int_t n, + ae_int_t k, + fasttransformplan* plan, + ae_state *_state); +void ftapplyplan(fasttransformplan* plan, + /* Real */ ae_vector* a, + ae_int_t offsa, + ae_int_t repcnt, + ae_state *_state); +void ftbasefactorize(ae_int_t n, + ae_int_t tasktype, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state); +ae_bool ftbaseissmooth(ae_int_t n, ae_state *_state); +ae_int_t ftbasefindsmooth(ae_int_t n, ae_state *_state); +ae_int_t ftbasefindsmootheven(ae_int_t n, ae_state *_state); +double ftbasegetflopestimate(ae_int_t n, ae_state *_state); +ae_bool _fasttransformplan_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _fasttransformplan_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _fasttransformplan_clear(void* _p); +void _fasttransformplan_destroy(void* _p); +double nulog1p(double x, ae_state *_state); +double nuexpm1(double x, ae_state *_state); +double nucosm1(double x, ae_state *_state); + +} +#endif + diff --git a/psdlag/src/alglibmisc.cpp b/psdlag/src/alglibmisc.cpp new file mode 100644 index 0000000..cc4e095 --- /dev/null +++ b/psdlag/src/alglibmisc.cpp @@ -0,0 +1,3611 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "alglibmisc.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +Portable high quality random number generator state. +Initialized with HQRNDRandomize() or HQRNDSeed(). + +Fields: + S1, S2 - seed values + V - precomputed value + MagicV - 'magic' value used to determine whether State structure + was correctly initialized. +*************************************************************************/ +_hqrndstate_owner::_hqrndstate_owner() +{ + p_struct = (alglib_impl::hqrndstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::hqrndstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_hqrndstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_hqrndstate_owner::_hqrndstate_owner(const _hqrndstate_owner &rhs) +{ + p_struct = (alglib_impl::hqrndstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::hqrndstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_hqrndstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_hqrndstate_owner& _hqrndstate_owner::operator=(const _hqrndstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_hqrndstate_clear(p_struct); + if( !alglib_impl::_hqrndstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_hqrndstate_owner::~_hqrndstate_owner() +{ + alglib_impl::_hqrndstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::hqrndstate* _hqrndstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::hqrndstate* _hqrndstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +hqrndstate::hqrndstate() : _hqrndstate_owner() +{ +} + +hqrndstate::hqrndstate(const hqrndstate &rhs):_hqrndstate_owner(rhs) +{ +} + +hqrndstate& hqrndstate::operator=(const hqrndstate &rhs) +{ + if( this==&rhs ) + return *this; + _hqrndstate_owner::operator=(rhs); + return *this; +} + +hqrndstate::~hqrndstate() +{ +} + +/************************************************************************* +HQRNDState initialization with random values which come from standard +RNG. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndrandomize(hqrndstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hqrndrandomize(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +HQRNDState initialization with seed values + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndseed(const ae_int_t s1, const ae_int_t s2, hqrndstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hqrndseed(s1, s2, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function generates random real number in (0,1), +not including interval boundaries + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double hqrnduniformr(const hqrndstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hqrnduniformr(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function generates random integer number in [0, N) + +1. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() +2. N can be any positive number except for very large numbers: + * close to 2^31 on 32-bit systems + * close to 2^62 on 64-bit systems + An exception will be generated if N is too large. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +ae_int_t hqrnduniformi(const hqrndstate &state, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::hqrnduniformi(const_cast(state.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Random number generator: normal numbers + +This function generates one random number from normal distribution. +Its performance is equal to that of HQRNDNormal2() + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double hqrndnormal(const hqrndstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hqrndnormal(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Random number generator: random X and Y such that X^2+Y^2=1 + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndunit2(const hqrndstate &state, double &x, double &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hqrndunit2(const_cast(state.c_ptr()), &x, &y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Random number generator: normal numbers + +This function generates two independent random numbers from normal +distribution. Its performance is equal to that of HQRNDNormal() + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndnormal2(const hqrndstate &state, double &x1, double &x2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hqrndnormal2(const_cast(state.c_ptr()), &x1, &x2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Random number generator: exponential distribution + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 11.08.2007 by Bochkanov Sergey +*************************************************************************/ +double hqrndexponential(const hqrndstate &state, const double lambdav) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hqrndexponential(const_cast(state.c_ptr()), lambdav, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function generates random number from discrete distribution given by +finite sample X. + +INPUT PARAMETERS + State - high quality random number generator, must be + initialized with HQRNDRandomize() or HQRNDSeed(). + X - finite sample + N - number of elements to use, N>=1 + +RESULT + this function returns one of the X[i] for random i=0..N-1 + + -- ALGLIB -- + Copyright 08.11.2011 by Bochkanov Sergey +*************************************************************************/ +double hqrnddiscrete(const hqrndstate &state, const real_1d_array &x, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hqrnddiscrete(const_cast(state.c_ptr()), const_cast(x.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function generates random number from continuous distribution given +by finite sample X. + +INPUT PARAMETERS + State - high quality random number generator, must be + initialized with HQRNDRandomize() or HQRNDSeed(). + X - finite sample, array[N] (can be larger, in this case only + leading N elements are used). THIS ARRAY MUST BE SORTED BY + ASCENDING. + N - number of elements to use, N>=1 + +RESULT + this function returns random number from continuous distribution which + tries to approximate X as mush as possible. min(X)<=Result<=max(X). + + -- ALGLIB -- + Copyright 08.11.2011 by Bochkanov Sergey +*************************************************************************/ +double hqrndcontinuous(const hqrndstate &state, const real_1d_array &x, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hqrndcontinuous(const_cast(state.c_ptr()), const_cast(x.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +_kdtree_owner::_kdtree_owner() +{ + p_struct = (alglib_impl::kdtree*)alglib_impl::ae_malloc(sizeof(alglib_impl::kdtree), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_kdtree_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_kdtree_owner::_kdtree_owner(const _kdtree_owner &rhs) +{ + p_struct = (alglib_impl::kdtree*)alglib_impl::ae_malloc(sizeof(alglib_impl::kdtree), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_kdtree_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_kdtree_owner& _kdtree_owner::operator=(const _kdtree_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_kdtree_clear(p_struct); + if( !alglib_impl::_kdtree_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_kdtree_owner::~_kdtree_owner() +{ + alglib_impl::_kdtree_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::kdtree* _kdtree_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::kdtree* _kdtree_owner::c_ptr() const +{ + return const_cast(p_struct); +} +kdtree::kdtree() : _kdtree_owner() +{ +} + +kdtree::kdtree(const kdtree &rhs):_kdtree_owner(rhs) +{ +} + +kdtree& kdtree::operator=(const kdtree &rhs) +{ + if( this==&rhs ) + return *this; + _kdtree_owner::operator=(rhs); + return *this; +} + +kdtree::~kdtree() +{ +} + + +/************************************************************************* +This function serializes data structure to string. + +Important properties of s_out: +* it contains alphanumeric characters, dots, underscores, minus signs +* these symbols are grouped into words, which are separated by spaces + and Windows-style (CR+LF) newlines +* although serializer uses spaces and CR+LF as separators, you can + replace any separator character by arbitrary combination of spaces, + tabs, Windows or Unix newlines. It allows flexible reformatting of + the string in case you want to include it into text or XML file. + But you should not insert separators into the middle of the "words" + nor you should change case of letters. +* s_out can be freely moved between 32-bit and 64-bit systems, little + and big endian machines, and so on. You can serialize structure on + 32-bit machine and unserialize it on 64-bit one (or vice versa), or + serialize it on SPARC and unserialize on x86. You can also + serialize it in C++ version of ALGLIB and unserialize in C# one, + and vice versa. +*************************************************************************/ +void kdtreeserialize(kdtree &obj, std::string &s_out) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + alglib_impl::ae_int_t ssize; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_alloc_start(&serializer); + alglib_impl::kdtreealloc(&serializer, obj.c_ptr(), &state); + ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); + s_out.clear(); + s_out.reserve((size_t)(ssize+1)); + alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); + alglib_impl::kdtreeserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + if( s_out.length()>(size_t)ssize ) + throw ap_error("ALGLIB: serialization integrity error"); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} +/************************************************************************* +This function unserializes data structure from string. +*************************************************************************/ +void kdtreeunserialize(std::string &s_in, kdtree &obj) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); + alglib_impl::kdtreeunserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} + +/************************************************************************* +KD-tree creation + +This subroutine creates KD-tree from set of X-values and optional Y-values + +INPUT PARAMETERS + XY - dataset, array[0..N-1,0..NX+NY-1]. + one row corresponds to one point. + first NX columns contain X-values, next NY (NY may be zero) + columns may contain associated Y-values + N - number of points, N>=0. + NX - space dimension, NX>=1. + NY - number of optional Y-values, NY>=0. + NormType- norm type: + * 0 denotes infinity-norm + * 1 denotes 1-norm + * 2 denotes 2-norm (Euclidean norm) + +OUTPUT PARAMETERS + KDT - KD-tree + + +NOTES + +1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory + requirements. +2. Although KD-trees may be used with any combination of N and NX, they + are more efficient than brute-force search only when N >> 4^NX. So they + are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another + inefficient case, because simple binary search (without additional + structures) is much more efficient in such tasks than KD-trees. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreebuild(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreebuild(const_cast(xy.c_ptr()), n, nx, ny, normtype, const_cast(kdt.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +KD-tree creation + +This subroutine creates KD-tree from set of X-values and optional Y-values + +INPUT PARAMETERS + XY - dataset, array[0..N-1,0..NX+NY-1]. + one row corresponds to one point. + first NX columns contain X-values, next NY (NY may be zero) + columns may contain associated Y-values + N - number of points, N>=0. + NX - space dimension, NX>=1. + NY - number of optional Y-values, NY>=0. + NormType- norm type: + * 0 denotes infinity-norm + * 1 denotes 1-norm + * 2 denotes 2-norm (Euclidean norm) + +OUTPUT PARAMETERS + KDT - KD-tree + + +NOTES + +1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory + requirements. +2. Although KD-trees may be used with any combination of N and NX, they + are more efficient than brute-force search only when N >> 4^NX. So they + are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another + inefficient case, because simple binary search (without additional + structures) is much more efficient in such tasks than KD-trees. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreebuild(const real_2d_array &xy, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = xy.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreebuild(const_cast(xy.c_ptr()), n, nx, ny, normtype, const_cast(kdt.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +KD-tree creation + +This subroutine creates KD-tree from set of X-values, integer tags and +optional Y-values + +INPUT PARAMETERS + XY - dataset, array[0..N-1,0..NX+NY-1]. + one row corresponds to one point. + first NX columns contain X-values, next NY (NY may be zero) + columns may contain associated Y-values + Tags - tags, array[0..N-1], contains integer tags associated + with points. + N - number of points, N>=0 + NX - space dimension, NX>=1. + NY - number of optional Y-values, NY>=0. + NormType- norm type: + * 0 denotes infinity-norm + * 1 denotes 1-norm + * 2 denotes 2-norm (Euclidean norm) + +OUTPUT PARAMETERS + KDT - KD-tree + +NOTES + +1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory + requirements. +2. Although KD-trees may be used with any combination of N and NX, they + are more efficient than brute-force search only when N >> 4^NX. So they + are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another + inefficient case, because simple binary search (without additional + structures) is much more efficient in such tasks than KD-trees. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreebuildtagged(const real_2d_array &xy, const integer_1d_array &tags, const ae_int_t n, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreebuildtagged(const_cast(xy.c_ptr()), const_cast(tags.c_ptr()), n, nx, ny, normtype, const_cast(kdt.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +KD-tree creation + +This subroutine creates KD-tree from set of X-values, integer tags and +optional Y-values + +INPUT PARAMETERS + XY - dataset, array[0..N-1,0..NX+NY-1]. + one row corresponds to one point. + first NX columns contain X-values, next NY (NY may be zero) + columns may contain associated Y-values + Tags - tags, array[0..N-1], contains integer tags associated + with points. + N - number of points, N>=0 + NX - space dimension, NX>=1. + NY - number of optional Y-values, NY>=0. + NormType- norm type: + * 0 denotes infinity-norm + * 1 denotes 1-norm + * 2 denotes 2-norm (Euclidean norm) + +OUTPUT PARAMETERS + KDT - KD-tree + +NOTES + +1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory + requirements. +2. Although KD-trees may be used with any combination of N and NX, they + are more efficient than brute-force search only when N >> 4^NX. So they + are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another + inefficient case, because simple binary search (without additional + structures) is much more efficient in such tasks than KD-trees. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreebuildtagged(const real_2d_array &xy, const integer_1d_array &tags, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (xy.rows()!=tags.length())) + throw ap_error("Error while calling 'kdtreebuildtagged': looks like one of arguments has wrong size"); + n = xy.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreebuildtagged(const_cast(xy.c_ptr()), const_cast(tags.c_ptr()), n, nx, ny, normtype, const_cast(kdt.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +K-NN query: K nearest neighbors + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + K - number of neighbors to return, K>=1 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + +RESULT + number of actual neighbors found (either K or N, if K>N). + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +these results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const bool selfmatch) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::kdtreequeryknn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), k, selfmatch, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +K-NN query: K nearest neighbors + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + K - number of neighbors to return, K>=1 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + +RESULT + number of actual neighbors found (either K or N, if K>N). + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +these results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + bool selfmatch; + + selfmatch = true; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::kdtreequeryknn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), k, selfmatch, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +R-NN query: all points within R-sphere centered at X + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + R - radius of sphere (in corresponding norm), R>0 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + +RESULT + number of neighbors found, >=0 + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +actual results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryrnn(const kdtree &kdt, const real_1d_array &x, const double r, const bool selfmatch) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::kdtreequeryrnn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), r, selfmatch, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +R-NN query: all points within R-sphere centered at X + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + R - radius of sphere (in corresponding norm), R>0 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + +RESULT + number of neighbors found, >=0 + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +actual results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryrnn(const kdtree &kdt, const real_1d_array &x, const double r) +{ + alglib_impl::ae_state _alglib_env_state; + bool selfmatch; + + selfmatch = true; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::kdtreequeryrnn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), r, selfmatch, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +K-NN query: approximate K nearest neighbors + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + K - number of neighbors to return, K>=1 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + Eps - approximation factor, Eps>=0. eps-approximate nearest + neighbor is a neighbor whose distance from X is at + most (1+eps) times distance of true nearest neighbor. + +RESULT + number of actual neighbors found (either K or N, if K>N). + +NOTES + significant performance gain may be achieved only when Eps is is on + the order of magnitude of 1 or larger. + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +these results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryaknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const bool selfmatch, const double eps) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::kdtreequeryaknn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), k, selfmatch, eps, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +K-NN query: approximate K nearest neighbors + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + K - number of neighbors to return, K>=1 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + Eps - approximation factor, Eps>=0. eps-approximate nearest + neighbor is a neighbor whose distance from X is at + most (1+eps) times distance of true nearest neighbor. + +RESULT + number of actual neighbors found (either K or N, if K>N). + +NOTES + significant performance gain may be achieved only when Eps is is on + the order of magnitude of 1 or larger. + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +these results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryaknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const double eps) +{ + alglib_impl::ae_state _alglib_env_state; + bool selfmatch; + + selfmatch = true; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::kdtreequeryaknn(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), k, selfmatch, eps, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +X-values from last query + +INPUT PARAMETERS + KDT - KD-tree + X - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + X - rows are filled with X-values + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsTags() tag values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsx(const kdtree &kdt, real_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreequeryresultsx(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +X- and Y-values from last query + +INPUT PARAMETERS + KDT - KD-tree + XY - possibly pre-allocated buffer. If XY is too small to store + result, it is resized. If size(XY) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + XY - rows are filled with points: first NX columns with + X-values, next NY columns - with Y-values. + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsTags() tag values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxy(const kdtree &kdt, real_2d_array &xy) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreequeryresultsxy(const_cast(kdt.c_ptr()), const_cast(xy.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Tags from last query + +INPUT PARAMETERS + KDT - KD-tree + Tags - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + Tags - filled with tags associated with points, + or, when no tags were supplied, with zeros + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultstags(const kdtree &kdt, integer_1d_array &tags) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreequeryresultstags(const_cast(kdt.c_ptr()), const_cast(tags.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Distances from last query + +INPUT PARAMETERS + KDT - KD-tree + R - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + R - filled with distances (in corresponding norm) + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsTags() tag values + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsdistances(const kdtree &kdt, real_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreequeryresultsdistances(const_cast(kdt.c_ptr()), const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +X-values from last query; 'interactive' variant for languages like Python +which support constructs like "X = KDTreeQueryResultsXI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxi(const kdtree &kdt, real_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreequeryresultsxi(const_cast(kdt.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +XY-values from last query; 'interactive' variant for languages like Python +which support constructs like "XY = KDTreeQueryResultsXYI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxyi(const kdtree &kdt, real_2d_array &xy) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreequeryresultsxyi(const_cast(kdt.c_ptr()), const_cast(xy.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Tags from last query; 'interactive' variant for languages like Python +which support constructs like "Tags = KDTreeQueryResultsTagsI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultstagsi(const kdtree &kdt, integer_1d_array &tags) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreequeryresultstagsi(const_cast(kdt.c_ptr()), const_cast(tags.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Distances from last query; 'interactive' variant for languages like Python +which support constructs like "R = KDTreeQueryResultsDistancesI(KDT)" +and interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsdistancesi(const kdtree &kdt, real_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kdtreequeryresultsdistancesi(const_cast(kdt.c_ptr()), const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +static ae_int_t hqrnd_hqrndmax = 2147483561; +static ae_int_t hqrnd_hqrndm1 = 2147483563; +static ae_int_t hqrnd_hqrndm2 = 2147483399; +static ae_int_t hqrnd_hqrndmagic = 1634357784; +static ae_int_t hqrnd_hqrndintegerbase(hqrndstate* state, + ae_state *_state); + + +static ae_int_t nearestneighbor_splitnodesize = 6; +static ae_int_t nearestneighbor_kdtreefirstversion = 0; +static void nearestneighbor_kdtreesplit(kdtree* kdt, + ae_int_t i1, + ae_int_t i2, + ae_int_t d, + double s, + ae_int_t* i3, + ae_state *_state); +static void nearestneighbor_kdtreegeneratetreerec(kdtree* kdt, + ae_int_t* nodesoffs, + ae_int_t* splitsoffs, + ae_int_t i1, + ae_int_t i2, + ae_int_t maxleafsize, + ae_state *_state); +static void nearestneighbor_kdtreequerynnrec(kdtree* kdt, + ae_int_t offs, + ae_state *_state); +static void nearestneighbor_kdtreeinitbox(kdtree* kdt, + /* Real */ ae_vector* x, + ae_state *_state); +static void nearestneighbor_kdtreeallocdatasetindependent(kdtree* kdt, + ae_int_t nx, + ae_int_t ny, + ae_state *_state); +static void nearestneighbor_kdtreeallocdatasetdependent(kdtree* kdt, + ae_int_t n, + ae_int_t nx, + ae_int_t ny, + ae_state *_state); +static void nearestneighbor_kdtreealloctemporaries(kdtree* kdt, + ae_int_t n, + ae_int_t nx, + ae_int_t ny, + ae_state *_state); + + + + + +/************************************************************************* +HQRNDState initialization with random values which come from standard +RNG. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndrandomize(hqrndstate* state, ae_state *_state) +{ + ae_int_t s0; + ae_int_t s1; + + _hqrndstate_clear(state); + + s0 = ae_randominteger(hqrnd_hqrndm1, _state); + s1 = ae_randominteger(hqrnd_hqrndm2, _state); + hqrndseed(s0, s1, state, _state); +} + + +/************************************************************************* +HQRNDState initialization with seed values + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndseed(ae_int_t s1, + ae_int_t s2, + hqrndstate* state, + ae_state *_state) +{ + + _hqrndstate_clear(state); + + + /* + * Protection against negative seeds: + * + * SEED := -(SEED+1) + * + * We can use just "-SEED" because there exists such integer number N + * that N<0, -N=N<0 too. (This number is equal to 0x800...000). Need + * to handle such seed correctly forces us to use a bit complicated + * formula. + */ + if( s1<0 ) + { + s1 = -(s1+1); + } + if( s2<0 ) + { + s2 = -(s2+1); + } + state->s1 = s1%(hqrnd_hqrndm1-1)+1; + state->s2 = s2%(hqrnd_hqrndm2-1)+1; + state->magicv = hqrnd_hqrndmagic; +} + + +/************************************************************************* +This function generates random real number in (0,1), +not including interval boundaries + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double hqrnduniformr(hqrndstate* state, ae_state *_state) +{ + double result; + + + result = (double)(hqrnd_hqrndintegerbase(state, _state)+1)/(double)(hqrnd_hqrndmax+2); + return result; +} + + +/************************************************************************* +This function generates random integer number in [0, N) + +1. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() +2. N can be any positive number except for very large numbers: + * close to 2^31 on 32-bit systems + * close to 2^62 on 64-bit systems + An exception will be generated if N is too large. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +ae_int_t hqrnduniformi(hqrndstate* state, ae_int_t n, ae_state *_state) +{ + ae_int_t maxcnt; + ae_int_t mx; + ae_int_t a; + ae_int_t b; + ae_int_t result; + + + ae_assert(n>0, "HQRNDUniformI: N<=0!", _state); + maxcnt = hqrnd_hqrndmax+1; + + /* + * Two branches: one for N<=MaxCnt, another for N>MaxCnt. + */ + if( n>maxcnt ) + { + + /* + * N>=MaxCnt. + * + * We have two options here: + * a) N is exactly divisible by MaxCnt + * b) N is not divisible by MaxCnt + * + * In both cases we reduce problem on interval spanning [0,N) + * to several subproblems on intervals spanning [0,MaxCnt). + */ + if( n%maxcnt==0 ) + { + + /* + * N is exactly divisible by MaxCnt. + * + * [0,N) range is dividided into N/MaxCnt bins, + * each of them having length equal to MaxCnt. + * + * We generate: + * * random bin number B + * * random offset within bin A + * Both random numbers are generated by recursively + * calling HQRNDUniformI(). + * + * Result is equal to A+MaxCnt*B. + */ + ae_assert(n/maxcnt<=maxcnt, "HQRNDUniformI: N is too large", _state); + a = hqrnduniformi(state, maxcnt, _state); + b = hqrnduniformi(state, n/maxcnt, _state); + result = a+maxcnt*b; + } + else + { + + /* + * N is NOT exactly divisible by MaxCnt. + * + * [0,N) range is dividided into Ceil(N/MaxCnt) bins, + * each of them having length equal to MaxCnt. + * + * We generate: + * * random bin number B in [0, Ceil(N/MaxCnt)-1] + * * random offset within bin A + * * if both of what is below is true + * 1) bin number B is that of the last bin + * 2) A >= N mod MaxCnt + * then we repeat generation of A/B. + * This stage is essential in order to avoid bias in the result. + * * otherwise, we return A*MaxCnt+N + */ + ae_assert(n/maxcnt+1<=maxcnt, "HQRNDUniformI: N is too large", _state); + result = -1; + do + { + a = hqrnduniformi(state, maxcnt, _state); + b = hqrnduniformi(state, n/maxcnt+1, _state); + if( b==n/maxcnt&&a>=n%maxcnt ) + { + continue; + } + result = a+maxcnt*b; + } + while(result<0); + } + } + else + { + + /* + * N<=MaxCnt + * + * Code below is a bit complicated because we can not simply + * return "HQRNDIntegerBase() mod N" - it will be skewed for + * large N's in [0.1*HQRNDMax...HQRNDMax]. + */ + mx = maxcnt-maxcnt%n; + do + { + result = hqrnd_hqrndintegerbase(state, _state); + } + while(result>=mx); + result = result%n; + } + return result; +} + + +/************************************************************************* +Random number generator: normal numbers + +This function generates one random number from normal distribution. +Its performance is equal to that of HQRNDNormal2() + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double hqrndnormal(hqrndstate* state, ae_state *_state) +{ + double v1; + double v2; + double result; + + + hqrndnormal2(state, &v1, &v2, _state); + result = v1; + return result; +} + + +/************************************************************************* +Random number generator: random X and Y such that X^2+Y^2=1 + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndunit2(hqrndstate* state, double* x, double* y, ae_state *_state) +{ + double v; + double mx; + double mn; + + *x = 0; + *y = 0; + + do + { + hqrndnormal2(state, x, y, _state); + } + while(!(ae_fp_neq(*x,0)||ae_fp_neq(*y,0))); + mx = ae_maxreal(ae_fabs(*x, _state), ae_fabs(*y, _state), _state); + mn = ae_minreal(ae_fabs(*x, _state), ae_fabs(*y, _state), _state); + v = mx*ae_sqrt(1+ae_sqr(mn/mx, _state), _state); + *x = *x/v; + *y = *y/v; +} + + +/************************************************************************* +Random number generator: normal numbers + +This function generates two independent random numbers from normal +distribution. Its performance is equal to that of HQRNDNormal() + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndnormal2(hqrndstate* state, + double* x1, + double* x2, + ae_state *_state) +{ + double u; + double v; + double s; + + *x1 = 0; + *x2 = 0; + + for(;;) + { + u = 2*hqrnduniformr(state, _state)-1; + v = 2*hqrnduniformr(state, _state)-1; + s = ae_sqr(u, _state)+ae_sqr(v, _state); + if( ae_fp_greater(s,0)&&ae_fp_less(s,1) ) + { + + /* + * two Sqrt's instead of one to + * avoid overflow when S is too small + */ + s = ae_sqrt(-2*ae_log(s, _state), _state)/ae_sqrt(s, _state); + *x1 = u*s; + *x2 = v*s; + return; + } + } +} + + +/************************************************************************* +Random number generator: exponential distribution + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 11.08.2007 by Bochkanov Sergey +*************************************************************************/ +double hqrndexponential(hqrndstate* state, + double lambdav, + ae_state *_state) +{ + double result; + + + ae_assert(ae_fp_greater(lambdav,0), "HQRNDExponential: LambdaV<=0!", _state); + result = -ae_log(hqrnduniformr(state, _state), _state)/lambdav; + return result; +} + + +/************************************************************************* +This function generates random number from discrete distribution given by +finite sample X. + +INPUT PARAMETERS + State - high quality random number generator, must be + initialized with HQRNDRandomize() or HQRNDSeed(). + X - finite sample + N - number of elements to use, N>=1 + +RESULT + this function returns one of the X[i] for random i=0..N-1 + + -- ALGLIB -- + Copyright 08.11.2011 by Bochkanov Sergey +*************************************************************************/ +double hqrnddiscrete(hqrndstate* state, + /* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + double result; + + + ae_assert(n>0, "HQRNDDiscrete: N<=0", _state); + ae_assert(n<=x->cnt, "HQRNDDiscrete: Length(X)ptr.p_double[hqrnduniformi(state, n, _state)]; + return result; +} + + +/************************************************************************* +This function generates random number from continuous distribution given +by finite sample X. + +INPUT PARAMETERS + State - high quality random number generator, must be + initialized with HQRNDRandomize() or HQRNDSeed(). + X - finite sample, array[N] (can be larger, in this case only + leading N elements are used). THIS ARRAY MUST BE SORTED BY + ASCENDING. + N - number of elements to use, N>=1 + +RESULT + this function returns random number from continuous distribution which + tries to approximate X as mush as possible. min(X)<=Result<=max(X). + + -- ALGLIB -- + Copyright 08.11.2011 by Bochkanov Sergey +*************************************************************************/ +double hqrndcontinuous(hqrndstate* state, + /* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + double mx; + double mn; + ae_int_t i; + double result; + + + ae_assert(n>0, "HQRNDContinuous: N<=0", _state); + ae_assert(n<=x->cnt, "HQRNDContinuous: Length(X)ptr.p_double[0]; + return result; + } + i = hqrnduniformi(state, n-1, _state); + mn = x->ptr.p_double[i]; + mx = x->ptr.p_double[i+1]; + ae_assert(ae_fp_greater_eq(mx,mn), "HQRNDDiscrete: X is not sorted by ascending", _state); + if( ae_fp_neq(mx,mn) ) + { + result = (mx-mn)*hqrnduniformr(state, _state)+mn; + } + else + { + result = mn; + } + return result; +} + + +/************************************************************************* +This function returns random integer in [0,HQRNDMax] + +L'Ecuyer, Efficient and portable combined random number generators +*************************************************************************/ +static ae_int_t hqrnd_hqrndintegerbase(hqrndstate* state, + ae_state *_state) +{ + ae_int_t k; + ae_int_t result; + + + ae_assert(state->magicv==hqrnd_hqrndmagic, "HQRNDIntegerBase: State is not correctly initialized!", _state); + k = state->s1/53668; + state->s1 = 40014*(state->s1-k*53668)-k*12211; + if( state->s1<0 ) + { + state->s1 = state->s1+2147483563; + } + k = state->s2/52774; + state->s2 = 40692*(state->s2-k*52774)-k*3791; + if( state->s2<0 ) + { + state->s2 = state->s2+2147483399; + } + + /* + * Result + */ + result = state->s1-state->s2; + if( result<1 ) + { + result = result+2147483562; + } + result = result-1; + return result; +} + + +ae_bool _hqrndstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + hqrndstate *p = (hqrndstate*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _hqrndstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + hqrndstate *dst = (hqrndstate*)_dst; + hqrndstate *src = (hqrndstate*)_src; + dst->s1 = src->s1; + dst->s2 = src->s2; + dst->magicv = src->magicv; + return ae_true; +} + + +void _hqrndstate_clear(void* _p) +{ + hqrndstate *p = (hqrndstate*)_p; + ae_touch_ptr((void*)p); +} + + +void _hqrndstate_destroy(void* _p) +{ + hqrndstate *p = (hqrndstate*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* +KD-tree creation + +This subroutine creates KD-tree from set of X-values and optional Y-values + +INPUT PARAMETERS + XY - dataset, array[0..N-1,0..NX+NY-1]. + one row corresponds to one point. + first NX columns contain X-values, next NY (NY may be zero) + columns may contain associated Y-values + N - number of points, N>=0. + NX - space dimension, NX>=1. + NY - number of optional Y-values, NY>=0. + NormType- norm type: + * 0 denotes infinity-norm + * 1 denotes 1-norm + * 2 denotes 2-norm (Euclidean norm) + +OUTPUT PARAMETERS + KDT - KD-tree + + +NOTES + +1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory + requirements. +2. Although KD-trees may be used with any combination of N and NX, they + are more efficient than brute-force search only when N >> 4^NX. So they + are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another + inefficient case, because simple binary search (without additional + structures) is much more efficient in such tasks than KD-trees. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreebuild(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t nx, + ae_int_t ny, + ae_int_t normtype, + kdtree* kdt, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tags; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _kdtree_clear(kdt); + ae_vector_init(&tags, 0, DT_INT, _state, ae_true); + + ae_assert(n>=0, "KDTreeBuild: N<0", _state); + ae_assert(nx>=1, "KDTreeBuild: NX<1", _state); + ae_assert(ny>=0, "KDTreeBuild: NY<0", _state); + ae_assert(normtype>=0&&normtype<=2, "KDTreeBuild: incorrect NormType", _state); + ae_assert(xy->rows>=n, "KDTreeBuild: rows(X)cols>=nx+ny||n==0, "KDTreeBuild: cols(X)0 ) + { + ae_vector_set_length(&tags, n, _state); + for(i=0; i<=n-1; i++) + { + tags.ptr.p_int[i] = 0; + } + } + kdtreebuildtagged(xy, &tags, n, nx, ny, normtype, kdt, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +KD-tree creation + +This subroutine creates KD-tree from set of X-values, integer tags and +optional Y-values + +INPUT PARAMETERS + XY - dataset, array[0..N-1,0..NX+NY-1]. + one row corresponds to one point. + first NX columns contain X-values, next NY (NY may be zero) + columns may contain associated Y-values + Tags - tags, array[0..N-1], contains integer tags associated + with points. + N - number of points, N>=0 + NX - space dimension, NX>=1. + NY - number of optional Y-values, NY>=0. + NormType- norm type: + * 0 denotes infinity-norm + * 1 denotes 1-norm + * 2 denotes 2-norm (Euclidean norm) + +OUTPUT PARAMETERS + KDT - KD-tree + +NOTES + +1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory + requirements. +2. Although KD-trees may be used with any combination of N and NX, they + are more efficient than brute-force search only when N >> 4^NX. So they + are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another + inefficient case, because simple binary search (without additional + structures) is much more efficient in such tasks than KD-trees. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreebuildtagged(/* Real */ ae_matrix* xy, + /* Integer */ ae_vector* tags, + ae_int_t n, + ae_int_t nx, + ae_int_t ny, + ae_int_t normtype, + kdtree* kdt, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t maxnodes; + ae_int_t nodesoffs; + ae_int_t splitsoffs; + + _kdtree_clear(kdt); + + ae_assert(n>=0, "KDTreeBuildTagged: N<0", _state); + ae_assert(nx>=1, "KDTreeBuildTagged: NX<1", _state); + ae_assert(ny>=0, "KDTreeBuildTagged: NY<0", _state); + ae_assert(normtype>=0&&normtype<=2, "KDTreeBuildTagged: incorrect NormType", _state); + ae_assert(xy->rows>=n, "KDTreeBuildTagged: rows(X)cols>=nx+ny||n==0, "KDTreeBuildTagged: cols(X)n = n; + kdt->nx = nx; + kdt->ny = ny; + kdt->normtype = normtype; + kdt->kcur = 0; + + /* + * N=0 => quick exit + */ + if( n==0 ) + { + return; + } + + /* + * Allocate + */ + nearestneighbor_kdtreeallocdatasetindependent(kdt, nx, ny, _state); + nearestneighbor_kdtreeallocdatasetdependent(kdt, n, nx, ny, _state); + + /* + * Initial fill + */ + for(i=0; i<=n-1; i++) + { + ae_v_move(&kdt->xy.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx-1)); + ae_v_move(&kdt->xy.ptr.pp_double[i][nx], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(nx,2*nx+ny-1)); + kdt->tags.ptr.p_int[i] = tags->ptr.p_int[i]; + } + + /* + * Determine bounding box + */ + ae_v_move(&kdt->boxmin.ptr.p_double[0], 1, &kdt->xy.ptr.pp_double[0][0], 1, ae_v_len(0,nx-1)); + ae_v_move(&kdt->boxmax.ptr.p_double[0], 1, &kdt->xy.ptr.pp_double[0][0], 1, ae_v_len(0,nx-1)); + for(i=1; i<=n-1; i++) + { + for(j=0; j<=nx-1; j++) + { + kdt->boxmin.ptr.p_double[j] = ae_minreal(kdt->boxmin.ptr.p_double[j], kdt->xy.ptr.pp_double[i][j], _state); + kdt->boxmax.ptr.p_double[j] = ae_maxreal(kdt->boxmax.ptr.p_double[j], kdt->xy.ptr.pp_double[i][j], _state); + } + } + + /* + * prepare tree structure + * * MaxNodes=N because we guarantee no trivial splits, i.e. + * every split will generate two non-empty boxes + */ + maxnodes = n; + ae_vector_set_length(&kdt->nodes, nearestneighbor_splitnodesize*2*maxnodes, _state); + ae_vector_set_length(&kdt->splits, 2*maxnodes, _state); + nodesoffs = 0; + splitsoffs = 0; + ae_v_move(&kdt->curboxmin.ptr.p_double[0], 1, &kdt->boxmin.ptr.p_double[0], 1, ae_v_len(0,nx-1)); + ae_v_move(&kdt->curboxmax.ptr.p_double[0], 1, &kdt->boxmax.ptr.p_double[0], 1, ae_v_len(0,nx-1)); + nearestneighbor_kdtreegeneratetreerec(kdt, &nodesoffs, &splitsoffs, 0, n, 8, _state); +} + + +/************************************************************************* +K-NN query: K nearest neighbors + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + K - number of neighbors to return, K>=1 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + +RESULT + number of actual neighbors found (either K or N, if K>N). + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +these results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryknn(kdtree* kdt, + /* Real */ ae_vector* x, + ae_int_t k, + ae_bool selfmatch, + ae_state *_state) +{ + ae_int_t result; + + + ae_assert(k>=1, "KDTreeQueryKNN: K<1!", _state); + ae_assert(x->cnt>=kdt->nx, "KDTreeQueryKNN: Length(X)nx, _state), "KDTreeQueryKNN: X contains infinite or NaN values!", _state); + result = kdtreequeryaknn(kdt, x, k, selfmatch, 0.0, _state); + return result; +} + + +/************************************************************************* +R-NN query: all points within R-sphere centered at X + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + R - radius of sphere (in corresponding norm), R>0 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + +RESULT + number of neighbors found, >=0 + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +actual results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryrnn(kdtree* kdt, + /* Real */ ae_vector* x, + double r, + ae_bool selfmatch, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t result; + + + ae_assert(ae_fp_greater(r,0), "KDTreeQueryRNN: incorrect R!", _state); + ae_assert(x->cnt>=kdt->nx, "KDTreeQueryRNN: Length(X)nx, _state), "KDTreeQueryRNN: X contains infinite or NaN values!", _state); + + /* + * Handle special case: KDT.N=0 + */ + if( kdt->n==0 ) + { + kdt->kcur = 0; + result = 0; + return result; + } + + /* + * Prepare parameters + */ + kdt->kneeded = 0; + if( kdt->normtype!=2 ) + { + kdt->rneeded = r; + } + else + { + kdt->rneeded = ae_sqr(r, _state); + } + kdt->selfmatch = selfmatch; + kdt->approxf = 1; + kdt->kcur = 0; + + /* + * calculate distance from point to current bounding box + */ + nearestneighbor_kdtreeinitbox(kdt, x, _state); + + /* + * call recursive search + * results are returned as heap + */ + nearestneighbor_kdtreequerynnrec(kdt, 0, _state); + + /* + * pop from heap to generate ordered representation + * + * last element is not pop'ed because it is already in + * its place + */ + result = kdt->kcur; + j = kdt->kcur; + for(i=kdt->kcur; i>=2; i--) + { + tagheappopi(&kdt->r, &kdt->idx, &j, _state); + } + return result; +} + + +/************************************************************************* +K-NN query: approximate K nearest neighbors + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + K - number of neighbors to return, K>=1 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + Eps - approximation factor, Eps>=0. eps-approximate nearest + neighbor is a neighbor whose distance from X is at + most (1+eps) times distance of true nearest neighbor. + +RESULT + number of actual neighbors found (either K or N, if K>N). + +NOTES + significant performance gain may be achieved only when Eps is is on + the order of magnitude of 1 or larger. + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +these results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryaknn(kdtree* kdt, + /* Real */ ae_vector* x, + ae_int_t k, + ae_bool selfmatch, + double eps, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t result; + + + ae_assert(k>0, "KDTreeQueryAKNN: incorrect K!", _state); + ae_assert(ae_fp_greater_eq(eps,0), "KDTreeQueryAKNN: incorrect Eps!", _state); + ae_assert(x->cnt>=kdt->nx, "KDTreeQueryAKNN: Length(X)nx, _state), "KDTreeQueryAKNN: X contains infinite or NaN values!", _state); + + /* + * Handle special case: KDT.N=0 + */ + if( kdt->n==0 ) + { + kdt->kcur = 0; + result = 0; + return result; + } + + /* + * Prepare parameters + */ + k = ae_minint(k, kdt->n, _state); + kdt->kneeded = k; + kdt->rneeded = 0; + kdt->selfmatch = selfmatch; + if( kdt->normtype==2 ) + { + kdt->approxf = 1/ae_sqr(1+eps, _state); + } + else + { + kdt->approxf = 1/(1+eps); + } + kdt->kcur = 0; + + /* + * calculate distance from point to current bounding box + */ + nearestneighbor_kdtreeinitbox(kdt, x, _state); + + /* + * call recursive search + * results are returned as heap + */ + nearestneighbor_kdtreequerynnrec(kdt, 0, _state); + + /* + * pop from heap to generate ordered representation + * + * last element is non pop'ed because it is already in + * its place + */ + result = kdt->kcur; + j = kdt->kcur; + for(i=kdt->kcur; i>=2; i--) + { + tagheappopi(&kdt->r, &kdt->idx, &j, _state); + } + return result; +} + + +/************************************************************************* +X-values from last query + +INPUT PARAMETERS + KDT - KD-tree + X - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + X - rows are filled with X-values + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsTags() tag values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsx(kdtree* kdt, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + + if( kdt->kcur==0 ) + { + return; + } + if( x->rowskcur||x->colsnx ) + { + ae_matrix_set_length(x, kdt->kcur, kdt->nx, _state); + } + k = kdt->kcur; + for(i=0; i<=k-1; i++) + { + ae_v_move(&x->ptr.pp_double[i][0], 1, &kdt->xy.ptr.pp_double[kdt->idx.ptr.p_int[i]][kdt->nx], 1, ae_v_len(0,kdt->nx-1)); + } +} + + +/************************************************************************* +X- and Y-values from last query + +INPUT PARAMETERS + KDT - KD-tree + XY - possibly pre-allocated buffer. If XY is too small to store + result, it is resized. If size(XY) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + XY - rows are filled with points: first NX columns with + X-values, next NY columns - with Y-values. + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsTags() tag values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxy(kdtree* kdt, + /* Real */ ae_matrix* xy, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + + if( kdt->kcur==0 ) + { + return; + } + if( xy->rowskcur||xy->colsnx+kdt->ny ) + { + ae_matrix_set_length(xy, kdt->kcur, kdt->nx+kdt->ny, _state); + } + k = kdt->kcur; + for(i=0; i<=k-1; i++) + { + ae_v_move(&xy->ptr.pp_double[i][0], 1, &kdt->xy.ptr.pp_double[kdt->idx.ptr.p_int[i]][kdt->nx], 1, ae_v_len(0,kdt->nx+kdt->ny-1)); + } +} + + +/************************************************************************* +Tags from last query + +INPUT PARAMETERS + KDT - KD-tree + Tags - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + Tags - filled with tags associated with points, + or, when no tags were supplied, with zeros + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultstags(kdtree* kdt, + /* Integer */ ae_vector* tags, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + + if( kdt->kcur==0 ) + { + return; + } + if( tags->cntkcur ) + { + ae_vector_set_length(tags, kdt->kcur, _state); + } + k = kdt->kcur; + for(i=0; i<=k-1; i++) + { + tags->ptr.p_int[i] = kdt->tags.ptr.p_int[kdt->idx.ptr.p_int[i]]; + } +} + + +/************************************************************************* +Distances from last query + +INPUT PARAMETERS + KDT - KD-tree + R - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + R - filled with distances (in corresponding norm) + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsTags() tag values + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsdistances(kdtree* kdt, + /* Real */ ae_vector* r, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + + if( kdt->kcur==0 ) + { + return; + } + if( r->cntkcur ) + { + ae_vector_set_length(r, kdt->kcur, _state); + } + k = kdt->kcur; + + /* + * unload norms + * + * Abs() call is used to handle cases with negative norms + * (generated during KFN requests) + */ + if( kdt->normtype==0 ) + { + for(i=0; i<=k-1; i++) + { + r->ptr.p_double[i] = ae_fabs(kdt->r.ptr.p_double[i], _state); + } + } + if( kdt->normtype==1 ) + { + for(i=0; i<=k-1; i++) + { + r->ptr.p_double[i] = ae_fabs(kdt->r.ptr.p_double[i], _state); + } + } + if( kdt->normtype==2 ) + { + for(i=0; i<=k-1; i++) + { + r->ptr.p_double[i] = ae_sqrt(ae_fabs(kdt->r.ptr.p_double[i], _state), _state); + } + } +} + + +/************************************************************************* +X-values from last query; 'interactive' variant for languages like Python +which support constructs like "X = KDTreeQueryResultsXI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxi(kdtree* kdt, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + + ae_matrix_clear(x); + + kdtreequeryresultsx(kdt, x, _state); +} + + +/************************************************************************* +XY-values from last query; 'interactive' variant for languages like Python +which support constructs like "XY = KDTreeQueryResultsXYI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxyi(kdtree* kdt, + /* Real */ ae_matrix* xy, + ae_state *_state) +{ + + ae_matrix_clear(xy); + + kdtreequeryresultsxy(kdt, xy, _state); +} + + +/************************************************************************* +Tags from last query; 'interactive' variant for languages like Python +which support constructs like "Tags = KDTreeQueryResultsTagsI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultstagsi(kdtree* kdt, + /* Integer */ ae_vector* tags, + ae_state *_state) +{ + + ae_vector_clear(tags); + + kdtreequeryresultstags(kdt, tags, _state); +} + + +/************************************************************************* +Distances from last query; 'interactive' variant for languages like Python +which support constructs like "R = KDTreeQueryResultsDistancesI(KDT)" +and interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsdistancesi(kdtree* kdt, + /* Real */ ae_vector* r, + ae_state *_state) +{ + + ae_vector_clear(r); + + kdtreequeryresultsdistances(kdt, r, _state); +} + + +/************************************************************************* +Serializer: allocation + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void kdtreealloc(ae_serializer* s, kdtree* tree, ae_state *_state) +{ + + + + /* + * Header + */ + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + + /* + * Data + */ + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + allocrealmatrix(s, &tree->xy, -1, -1, _state); + allocintegerarray(s, &tree->tags, -1, _state); + allocrealarray(s, &tree->boxmin, -1, _state); + allocrealarray(s, &tree->boxmax, -1, _state); + allocintegerarray(s, &tree->nodes, -1, _state); + allocrealarray(s, &tree->splits, -1, _state); +} + + +/************************************************************************* +Serializer: serialization + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void kdtreeserialize(ae_serializer* s, kdtree* tree, ae_state *_state) +{ + + + + /* + * Header + */ + ae_serializer_serialize_int(s, getkdtreeserializationcode(_state), _state); + ae_serializer_serialize_int(s, nearestneighbor_kdtreefirstversion, _state); + + /* + * Data + */ + ae_serializer_serialize_int(s, tree->n, _state); + ae_serializer_serialize_int(s, tree->nx, _state); + ae_serializer_serialize_int(s, tree->ny, _state); + ae_serializer_serialize_int(s, tree->normtype, _state); + serializerealmatrix(s, &tree->xy, -1, -1, _state); + serializeintegerarray(s, &tree->tags, -1, _state); + serializerealarray(s, &tree->boxmin, -1, _state); + serializerealarray(s, &tree->boxmax, -1, _state); + serializeintegerarray(s, &tree->nodes, -1, _state); + serializerealarray(s, &tree->splits, -1, _state); +} + + +/************************************************************************* +Serializer: unserialization + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void kdtreeunserialize(ae_serializer* s, kdtree* tree, ae_state *_state) +{ + ae_int_t i0; + ae_int_t i1; + + _kdtree_clear(tree); + + + /* + * check correctness of header + */ + ae_serializer_unserialize_int(s, &i0, _state); + ae_assert(i0==getkdtreeserializationcode(_state), "KDTreeUnserialize: stream header corrupted", _state); + ae_serializer_unserialize_int(s, &i1, _state); + ae_assert(i1==nearestneighbor_kdtreefirstversion, "KDTreeUnserialize: stream header corrupted", _state); + + /* + * Unserialize data + */ + ae_serializer_unserialize_int(s, &tree->n, _state); + ae_serializer_unserialize_int(s, &tree->nx, _state); + ae_serializer_unserialize_int(s, &tree->ny, _state); + ae_serializer_unserialize_int(s, &tree->normtype, _state); + unserializerealmatrix(s, &tree->xy, _state); + unserializeintegerarray(s, &tree->tags, _state); + unserializerealarray(s, &tree->boxmin, _state); + unserializerealarray(s, &tree->boxmax, _state); + unserializeintegerarray(s, &tree->nodes, _state); + unserializerealarray(s, &tree->splits, _state); + nearestneighbor_kdtreealloctemporaries(tree, tree->n, tree->nx, tree->ny, _state); +} + + +/************************************************************************* +Rearranges nodes [I1,I2) using partition in D-th dimension with S as threshold. +Returns split position I3: [I1,I3) and [I3,I2) are created as result. + +This subroutine doesn't create tree structures, just rearranges nodes. +*************************************************************************/ +static void nearestneighbor_kdtreesplit(kdtree* kdt, + ae_int_t i1, + ae_int_t i2, + ae_int_t d, + double s, + ae_int_t* i3, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t ileft; + ae_int_t iright; + double v; + + *i3 = 0; + + ae_assert(kdt->n>0, "KDTreeSplit: internal error", _state); + + /* + * split XY/Tags in two parts: + * * [ILeft,IRight] is non-processed part of XY/Tags + * + * After cycle is done, we have Ileft=IRight. We deal with + * this element separately. + * + * After this, [I1,ILeft) contains left part, and [ILeft,I2) + * contains right part. + */ + ileft = i1; + iright = i2-1; + while(ileftxy.ptr.pp_double[ileft][d],s) ) + { + + /* + * XY[ILeft] is on its place. + * Advance ILeft. + */ + ileft = ileft+1; + } + else + { + + /* + * XY[ILeft,..] must be at IRight. + * Swap and advance IRight. + */ + for(i=0; i<=2*kdt->nx+kdt->ny-1; i++) + { + v = kdt->xy.ptr.pp_double[ileft][i]; + kdt->xy.ptr.pp_double[ileft][i] = kdt->xy.ptr.pp_double[iright][i]; + kdt->xy.ptr.pp_double[iright][i] = v; + } + j = kdt->tags.ptr.p_int[ileft]; + kdt->tags.ptr.p_int[ileft] = kdt->tags.ptr.p_int[iright]; + kdt->tags.ptr.p_int[iright] = j; + iright = iright-1; + } + } + if( ae_fp_less_eq(kdt->xy.ptr.pp_double[ileft][d],s) ) + { + ileft = ileft+1; + } + else + { + iright = iright-1; + } + *i3 = ileft; +} + + +/************************************************************************* +Recursive kd-tree generation subroutine. + +PARAMETERS + KDT tree + NodesOffs unused part of Nodes[] which must be filled by tree + SplitsOffs unused part of Splits[] + I1, I2 points from [I1,I2) are processed + +NodesOffs[] and SplitsOffs[] must be large enough. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +static void nearestneighbor_kdtreegeneratetreerec(kdtree* kdt, + ae_int_t* nodesoffs, + ae_int_t* splitsoffs, + ae_int_t i1, + ae_int_t i2, + ae_int_t maxleafsize, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nx; + ae_int_t ny; + ae_int_t i; + ae_int_t j; + ae_int_t oldoffs; + ae_int_t i3; + ae_int_t cntless; + ae_int_t cntgreater; + double minv; + double maxv; + ae_int_t minidx; + ae_int_t maxidx; + ae_int_t d; + double ds; + double s; + double v; + double v0; + double v1; + + + ae_assert(kdt->n>0, "KDTreeGenerateTreeRec: internal error", _state); + ae_assert(i2>i1, "KDTreeGenerateTreeRec: internal error", _state); + + /* + * Generate leaf if needed + */ + if( i2-i1<=maxleafsize ) + { + kdt->nodes.ptr.p_int[*nodesoffs+0] = i2-i1; + kdt->nodes.ptr.p_int[*nodesoffs+1] = i1; + *nodesoffs = *nodesoffs+2; + return; + } + + /* + * Load values for easier access + */ + nx = kdt->nx; + ny = kdt->ny; + + /* + * Select dimension to split: + * * D is a dimension number + * In case bounding box has zero size, we enforce creation of the leaf node. + */ + d = 0; + ds = kdt->curboxmax.ptr.p_double[0]-kdt->curboxmin.ptr.p_double[0]; + for(i=1; i<=nx-1; i++) + { + v = kdt->curboxmax.ptr.p_double[i]-kdt->curboxmin.ptr.p_double[i]; + if( ae_fp_greater(v,ds) ) + { + ds = v; + d = i; + } + } + if( ae_fp_eq(ds,0) ) + { + kdt->nodes.ptr.p_int[*nodesoffs+0] = i2-i1; + kdt->nodes.ptr.p_int[*nodesoffs+1] = i1; + *nodesoffs = *nodesoffs+2; + return; + } + + /* + * Select split position S using sliding midpoint rule, + * rearrange points into [I1,I3) and [I3,I2). + * + * In case all points has same value of D-th component + * (MinV=MaxV) we enforce D-th dimension of bounding + * box to become exactly zero and repeat tree construction. + */ + s = kdt->curboxmin.ptr.p_double[d]+0.5*ds; + ae_v_move(&kdt->buf.ptr.p_double[0], 1, &kdt->xy.ptr.pp_double[i1][d], kdt->xy.stride, ae_v_len(0,i2-i1-1)); + n = i2-i1; + cntless = 0; + cntgreater = 0; + minv = kdt->buf.ptr.p_double[0]; + maxv = kdt->buf.ptr.p_double[0]; + minidx = i1; + maxidx = i1; + for(i=0; i<=n-1; i++) + { + v = kdt->buf.ptr.p_double[i]; + if( ae_fp_less(v,minv) ) + { + minv = v; + minidx = i1+i; + } + if( ae_fp_greater(v,maxv) ) + { + maxv = v; + maxidx = i1+i; + } + if( ae_fp_less(v,s) ) + { + cntless = cntless+1; + } + if( ae_fp_greater(v,s) ) + { + cntgreater = cntgreater+1; + } + } + if( ae_fp_eq(minv,maxv) ) + { + + /* + * In case all points has same value of D-th component + * (MinV=MaxV) we enforce D-th dimension of bounding + * box to become exactly zero and repeat tree construction. + */ + v0 = kdt->curboxmin.ptr.p_double[d]; + v1 = kdt->curboxmax.ptr.p_double[d]; + kdt->curboxmin.ptr.p_double[d] = minv; + kdt->curboxmax.ptr.p_double[d] = maxv; + nearestneighbor_kdtreegeneratetreerec(kdt, nodesoffs, splitsoffs, i1, i2, maxleafsize, _state); + kdt->curboxmin.ptr.p_double[d] = v0; + kdt->curboxmax.ptr.p_double[d] = v1; + return; + } + if( cntless>0&&cntgreater>0 ) + { + + /* + * normal midpoint split + */ + nearestneighbor_kdtreesplit(kdt, i1, i2, d, s, &i3, _state); + } + else + { + + /* + * sliding midpoint + */ + if( cntless==0 ) + { + + /* + * 1. move split to MinV, + * 2. place one point to the left bin (move to I1), + * others - to the right bin + */ + s = minv; + if( minidx!=i1 ) + { + for(i=0; i<=2*nx+ny-1; i++) + { + v = kdt->xy.ptr.pp_double[minidx][i]; + kdt->xy.ptr.pp_double[minidx][i] = kdt->xy.ptr.pp_double[i1][i]; + kdt->xy.ptr.pp_double[i1][i] = v; + } + j = kdt->tags.ptr.p_int[minidx]; + kdt->tags.ptr.p_int[minidx] = kdt->tags.ptr.p_int[i1]; + kdt->tags.ptr.p_int[i1] = j; + } + i3 = i1+1; + } + else + { + + /* + * 1. move split to MaxV, + * 2. place one point to the right bin (move to I2-1), + * others - to the left bin + */ + s = maxv; + if( maxidx!=i2-1 ) + { + for(i=0; i<=2*nx+ny-1; i++) + { + v = kdt->xy.ptr.pp_double[maxidx][i]; + kdt->xy.ptr.pp_double[maxidx][i] = kdt->xy.ptr.pp_double[i2-1][i]; + kdt->xy.ptr.pp_double[i2-1][i] = v; + } + j = kdt->tags.ptr.p_int[maxidx]; + kdt->tags.ptr.p_int[maxidx] = kdt->tags.ptr.p_int[i2-1]; + kdt->tags.ptr.p_int[i2-1] = j; + } + i3 = i2-1; + } + } + + /* + * Generate 'split' node + */ + kdt->nodes.ptr.p_int[*nodesoffs+0] = 0; + kdt->nodes.ptr.p_int[*nodesoffs+1] = d; + kdt->nodes.ptr.p_int[*nodesoffs+2] = *splitsoffs; + kdt->splits.ptr.p_double[*splitsoffs+0] = s; + oldoffs = *nodesoffs; + *nodesoffs = *nodesoffs+nearestneighbor_splitnodesize; + *splitsoffs = *splitsoffs+1; + + /* + * Recirsive generation: + * * update CurBox + * * call subroutine + * * restore CurBox + */ + kdt->nodes.ptr.p_int[oldoffs+3] = *nodesoffs; + v = kdt->curboxmax.ptr.p_double[d]; + kdt->curboxmax.ptr.p_double[d] = s; + nearestneighbor_kdtreegeneratetreerec(kdt, nodesoffs, splitsoffs, i1, i3, maxleafsize, _state); + kdt->curboxmax.ptr.p_double[d] = v; + kdt->nodes.ptr.p_int[oldoffs+4] = *nodesoffs; + v = kdt->curboxmin.ptr.p_double[d]; + kdt->curboxmin.ptr.p_double[d] = s; + nearestneighbor_kdtreegeneratetreerec(kdt, nodesoffs, splitsoffs, i3, i2, maxleafsize, _state); + kdt->curboxmin.ptr.p_double[d] = v; +} + + +/************************************************************************* +Recursive subroutine for NN queries. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +static void nearestneighbor_kdtreequerynnrec(kdtree* kdt, + ae_int_t offs, + ae_state *_state) +{ + double ptdist; + ae_int_t i; + ae_int_t j; + ae_int_t nx; + ae_int_t i1; + ae_int_t i2; + ae_int_t d; + double s; + double v; + double t1; + ae_int_t childbestoffs; + ae_int_t childworstoffs; + ae_int_t childoffs; + double prevdist; + ae_bool todive; + ae_bool bestisleft; + ae_bool updatemin; + + + ae_assert(kdt->n>0, "KDTreeQueryNNRec: internal error", _state); + + /* + * Leaf node. + * Process points. + */ + if( kdt->nodes.ptr.p_int[offs]>0 ) + { + i1 = kdt->nodes.ptr.p_int[offs+1]; + i2 = i1+kdt->nodes.ptr.p_int[offs]; + for(i=i1; i<=i2-1; i++) + { + + /* + * Calculate distance + */ + ptdist = 0; + nx = kdt->nx; + if( kdt->normtype==0 ) + { + for(j=0; j<=nx-1; j++) + { + ptdist = ae_maxreal(ptdist, ae_fabs(kdt->xy.ptr.pp_double[i][j]-kdt->x.ptr.p_double[j], _state), _state); + } + } + if( kdt->normtype==1 ) + { + for(j=0; j<=nx-1; j++) + { + ptdist = ptdist+ae_fabs(kdt->xy.ptr.pp_double[i][j]-kdt->x.ptr.p_double[j], _state); + } + } + if( kdt->normtype==2 ) + { + for(j=0; j<=nx-1; j++) + { + ptdist = ptdist+ae_sqr(kdt->xy.ptr.pp_double[i][j]-kdt->x.ptr.p_double[j], _state); + } + } + + /* + * Skip points with zero distance if self-matches are turned off + */ + if( ae_fp_eq(ptdist,0)&&!kdt->selfmatch ) + { + continue; + } + + /* + * We CAN'T process point if R-criterion isn't satisfied, + * i.e. (RNeeded<>0) AND (PtDist>R). + */ + if( ae_fp_eq(kdt->rneeded,0)||ae_fp_less_eq(ptdist,kdt->rneeded) ) + { + + /* + * R-criterion is satisfied, we must either: + * * replace worst point, if (KNeeded<>0) AND (KCur=KNeeded) + * (or skip, if worst point is better) + * * add point without replacement otherwise + */ + if( kdt->kcurkneeded||kdt->kneeded==0 ) + { + + /* + * add current point to heap without replacement + */ + tagheappushi(&kdt->r, &kdt->idx, &kdt->kcur, ptdist, i, _state); + } + else + { + + /* + * New points are added or not, depending on their distance. + * If added, they replace element at the top of the heap + */ + if( ae_fp_less(ptdist,kdt->r.ptr.p_double[0]) ) + { + if( kdt->kneeded==1 ) + { + kdt->idx.ptr.p_int[0] = i; + kdt->r.ptr.p_double[0] = ptdist; + } + else + { + tagheapreplacetopi(&kdt->r, &kdt->idx, kdt->kneeded, ptdist, i, _state); + } + } + } + } + } + return; + } + + /* + * Simple split + */ + if( kdt->nodes.ptr.p_int[offs]==0 ) + { + + /* + * Load: + * * D dimension to split + * * S split position + */ + d = kdt->nodes.ptr.p_int[offs+1]; + s = kdt->splits.ptr.p_double[kdt->nodes.ptr.p_int[offs+2]]; + + /* + * Calculate: + * * ChildBestOffs child box with best chances + * * ChildWorstOffs child box with worst chances + */ + if( ae_fp_less_eq(kdt->x.ptr.p_double[d],s) ) + { + childbestoffs = kdt->nodes.ptr.p_int[offs+3]; + childworstoffs = kdt->nodes.ptr.p_int[offs+4]; + bestisleft = ae_true; + } + else + { + childbestoffs = kdt->nodes.ptr.p_int[offs+4]; + childworstoffs = kdt->nodes.ptr.p_int[offs+3]; + bestisleft = ae_false; + } + + /* + * Navigate through childs + */ + for(i=0; i<=1; i++) + { + + /* + * Select child to process: + * * ChildOffs current child offset in Nodes[] + * * UpdateMin whether minimum or maximum value + * of bounding box is changed on update + */ + if( i==0 ) + { + childoffs = childbestoffs; + updatemin = !bestisleft; + } + else + { + updatemin = bestisleft; + childoffs = childworstoffs; + } + + /* + * Update bounding box and current distance + */ + if( updatemin ) + { + prevdist = kdt->curdist; + t1 = kdt->x.ptr.p_double[d]; + v = kdt->curboxmin.ptr.p_double[d]; + if( ae_fp_less_eq(t1,s) ) + { + if( kdt->normtype==0 ) + { + kdt->curdist = ae_maxreal(kdt->curdist, s-t1, _state); + } + if( kdt->normtype==1 ) + { + kdt->curdist = kdt->curdist-ae_maxreal(v-t1, 0, _state)+s-t1; + } + if( kdt->normtype==2 ) + { + kdt->curdist = kdt->curdist-ae_sqr(ae_maxreal(v-t1, 0, _state), _state)+ae_sqr(s-t1, _state); + } + } + kdt->curboxmin.ptr.p_double[d] = s; + } + else + { + prevdist = kdt->curdist; + t1 = kdt->x.ptr.p_double[d]; + v = kdt->curboxmax.ptr.p_double[d]; + if( ae_fp_greater_eq(t1,s) ) + { + if( kdt->normtype==0 ) + { + kdt->curdist = ae_maxreal(kdt->curdist, t1-s, _state); + } + if( kdt->normtype==1 ) + { + kdt->curdist = kdt->curdist-ae_maxreal(t1-v, 0, _state)+t1-s; + } + if( kdt->normtype==2 ) + { + kdt->curdist = kdt->curdist-ae_sqr(ae_maxreal(t1-v, 0, _state), _state)+ae_sqr(t1-s, _state); + } + } + kdt->curboxmax.ptr.p_double[d] = s; + } + + /* + * Decide: to dive into cell or not to dive + */ + if( ae_fp_neq(kdt->rneeded,0)&&ae_fp_greater(kdt->curdist,kdt->rneeded) ) + { + todive = ae_false; + } + else + { + if( kdt->kcurkneeded||kdt->kneeded==0 ) + { + + /* + * KCurcurdist,kdt->r.ptr.p_double[0]*kdt->approxf); + } + } + if( todive ) + { + nearestneighbor_kdtreequerynnrec(kdt, childoffs, _state); + } + + /* + * Restore bounding box and distance + */ + if( updatemin ) + { + kdt->curboxmin.ptr.p_double[d] = v; + } + else + { + kdt->curboxmax.ptr.p_double[d] = v; + } + kdt->curdist = prevdist; + } + return; + } +} + + +/************************************************************************* +Copies X[] to KDT.X[] +Loads distance from X[] to bounding box. +Initializes CurBox[]. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +static void nearestneighbor_kdtreeinitbox(kdtree* kdt, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t i; + double vx; + double vmin; + double vmax; + + + ae_assert(kdt->n>0, "KDTreeInitBox: internal error", _state); + + /* + * calculate distance from point to current bounding box + */ + kdt->curdist = 0; + if( kdt->normtype==0 ) + { + for(i=0; i<=kdt->nx-1; i++) + { + vx = x->ptr.p_double[i]; + vmin = kdt->boxmin.ptr.p_double[i]; + vmax = kdt->boxmax.ptr.p_double[i]; + kdt->x.ptr.p_double[i] = vx; + kdt->curboxmin.ptr.p_double[i] = vmin; + kdt->curboxmax.ptr.p_double[i] = vmax; + if( ae_fp_less(vx,vmin) ) + { + kdt->curdist = ae_maxreal(kdt->curdist, vmin-vx, _state); + } + else + { + if( ae_fp_greater(vx,vmax) ) + { + kdt->curdist = ae_maxreal(kdt->curdist, vx-vmax, _state); + } + } + } + } + if( kdt->normtype==1 ) + { + for(i=0; i<=kdt->nx-1; i++) + { + vx = x->ptr.p_double[i]; + vmin = kdt->boxmin.ptr.p_double[i]; + vmax = kdt->boxmax.ptr.p_double[i]; + kdt->x.ptr.p_double[i] = vx; + kdt->curboxmin.ptr.p_double[i] = vmin; + kdt->curboxmax.ptr.p_double[i] = vmax; + if( ae_fp_less(vx,vmin) ) + { + kdt->curdist = kdt->curdist+vmin-vx; + } + else + { + if( ae_fp_greater(vx,vmax) ) + { + kdt->curdist = kdt->curdist+vx-vmax; + } + } + } + } + if( kdt->normtype==2 ) + { + for(i=0; i<=kdt->nx-1; i++) + { + vx = x->ptr.p_double[i]; + vmin = kdt->boxmin.ptr.p_double[i]; + vmax = kdt->boxmax.ptr.p_double[i]; + kdt->x.ptr.p_double[i] = vx; + kdt->curboxmin.ptr.p_double[i] = vmin; + kdt->curboxmax.ptr.p_double[i] = vmax; + if( ae_fp_less(vx,vmin) ) + { + kdt->curdist = kdt->curdist+ae_sqr(vmin-vx, _state); + } + else + { + if( ae_fp_greater(vx,vmax) ) + { + kdt->curdist = kdt->curdist+ae_sqr(vx-vmax, _state); + } + } + } + } +} + + +/************************************************************************* +This function allocates all dataset-independent array fields of KDTree, +i.e. such array fields that their dimensions do not depend on dataset +size. + +This function do not sets KDT.NX or KDT.NY - it just allocates arrays + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +static void nearestneighbor_kdtreeallocdatasetindependent(kdtree* kdt, + ae_int_t nx, + ae_int_t ny, + ae_state *_state) +{ + + + ae_assert(kdt->n>0, "KDTreeAllocDatasetIndependent: internal error", _state); + ae_vector_set_length(&kdt->x, nx, _state); + ae_vector_set_length(&kdt->boxmin, nx, _state); + ae_vector_set_length(&kdt->boxmax, nx, _state); + ae_vector_set_length(&kdt->curboxmin, nx, _state); + ae_vector_set_length(&kdt->curboxmax, nx, _state); +} + + +/************************************************************************* +This function allocates all dataset-dependent array fields of KDTree, i.e. +such array fields that their dimensions depend on dataset size. + +This function do not sets KDT.N, KDT.NX or KDT.NY - +it just allocates arrays. + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +static void nearestneighbor_kdtreeallocdatasetdependent(kdtree* kdt, + ae_int_t n, + ae_int_t nx, + ae_int_t ny, + ae_state *_state) +{ + + + ae_assert(n>0, "KDTreeAllocDatasetDependent: internal error", _state); + ae_matrix_set_length(&kdt->xy, n, 2*nx+ny, _state); + ae_vector_set_length(&kdt->tags, n, _state); + ae_vector_set_length(&kdt->idx, n, _state); + ae_vector_set_length(&kdt->r, n, _state); + ae_vector_set_length(&kdt->x, nx, _state); + ae_vector_set_length(&kdt->buf, ae_maxint(n, nx, _state), _state); + ae_vector_set_length(&kdt->nodes, nearestneighbor_splitnodesize*2*n, _state); + ae_vector_set_length(&kdt->splits, 2*n, _state); +} + + +/************************************************************************* +This function allocates temporaries. + +This function do not sets KDT.N, KDT.NX or KDT.NY - +it just allocates arrays. + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +static void nearestneighbor_kdtreealloctemporaries(kdtree* kdt, + ae_int_t n, + ae_int_t nx, + ae_int_t ny, + ae_state *_state) +{ + + + ae_assert(n>0, "KDTreeAllocTemporaries: internal error", _state); + ae_vector_set_length(&kdt->x, nx, _state); + ae_vector_set_length(&kdt->idx, n, _state); + ae_vector_set_length(&kdt->r, n, _state); + ae_vector_set_length(&kdt->buf, ae_maxint(n, nx, _state), _state); + ae_vector_set_length(&kdt->curboxmin, nx, _state); + ae_vector_set_length(&kdt->curboxmax, nx, _state); +} + + +ae_bool _kdtree_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + kdtree *p = (kdtree*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->xy, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tags, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->boxmin, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->boxmax, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->nodes, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->splits, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->idx, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->r, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->buf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->curboxmin, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->curboxmax, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _kdtree_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + kdtree *dst = (kdtree*)_dst; + kdtree *src = (kdtree*)_src; + dst->n = src->n; + dst->nx = src->nx; + dst->ny = src->ny; + dst->normtype = src->normtype; + if( !ae_matrix_init_copy(&dst->xy, &src->xy, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tags, &src->tags, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->boxmin, &src->boxmin, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->boxmax, &src->boxmax, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->nodes, &src->nodes, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->splits, &src->splits, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + dst->kneeded = src->kneeded; + dst->rneeded = src->rneeded; + dst->selfmatch = src->selfmatch; + dst->approxf = src->approxf; + dst->kcur = src->kcur; + if( !ae_vector_init_copy(&dst->idx, &src->idx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->r, &src->r, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->buf, &src->buf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->curboxmin, &src->curboxmin, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->curboxmax, &src->curboxmax, _state, make_automatic) ) + return ae_false; + dst->curdist = src->curdist; + dst->debugcounter = src->debugcounter; + return ae_true; +} + + +void _kdtree_clear(void* _p) +{ + kdtree *p = (kdtree*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->xy); + ae_vector_clear(&p->tags); + ae_vector_clear(&p->boxmin); + ae_vector_clear(&p->boxmax); + ae_vector_clear(&p->nodes); + ae_vector_clear(&p->splits); + ae_vector_clear(&p->x); + ae_vector_clear(&p->idx); + ae_vector_clear(&p->r); + ae_vector_clear(&p->buf); + ae_vector_clear(&p->curboxmin); + ae_vector_clear(&p->curboxmax); +} + + +void _kdtree_destroy(void* _p) +{ + kdtree *p = (kdtree*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->xy); + ae_vector_destroy(&p->tags); + ae_vector_destroy(&p->boxmin); + ae_vector_destroy(&p->boxmax); + ae_vector_destroy(&p->nodes); + ae_vector_destroy(&p->splits); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->idx); + ae_vector_destroy(&p->r); + ae_vector_destroy(&p->buf); + ae_vector_destroy(&p->curboxmin); + ae_vector_destroy(&p->curboxmax); +} + + + +} + diff --git a/psdlag/src/alglibmisc.h b/psdlag/src/alglibmisc.h new file mode 100644 index 0000000..8209ac6 --- /dev/null +++ b/psdlag/src/alglibmisc.h @@ -0,0 +1,769 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _alglibmisc_pkg_h +#define _alglibmisc_pkg_h +#include "ap.h" +#include "alglibinternal.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t magicv; +} hqrndstate; +typedef struct +{ + ae_int_t n; + ae_int_t nx; + ae_int_t ny; + ae_int_t normtype; + ae_matrix xy; + ae_vector tags; + ae_vector boxmin; + ae_vector boxmax; + ae_vector nodes; + ae_vector splits; + ae_vector x; + ae_int_t kneeded; + double rneeded; + ae_bool selfmatch; + double approxf; + ae_int_t kcur; + ae_vector idx; + ae_vector r; + ae_vector buf; + ae_vector curboxmin; + ae_vector curboxmax; + double curdist; + ae_int_t debugcounter; +} kdtree; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + +/************************************************************************* +Portable high quality random number generator state. +Initialized with HQRNDRandomize() or HQRNDSeed(). + +Fields: + S1, S2 - seed values + V - precomputed value + MagicV - 'magic' value used to determine whether State structure + was correctly initialized. +*************************************************************************/ +class _hqrndstate_owner +{ +public: + _hqrndstate_owner(); + _hqrndstate_owner(const _hqrndstate_owner &rhs); + _hqrndstate_owner& operator=(const _hqrndstate_owner &rhs); + virtual ~_hqrndstate_owner(); + alglib_impl::hqrndstate* c_ptr(); + alglib_impl::hqrndstate* c_ptr() const; +protected: + alglib_impl::hqrndstate *p_struct; +}; +class hqrndstate : public _hqrndstate_owner +{ +public: + hqrndstate(); + hqrndstate(const hqrndstate &rhs); + hqrndstate& operator=(const hqrndstate &rhs); + virtual ~hqrndstate(); + +}; + +/************************************************************************* + +*************************************************************************/ +class _kdtree_owner +{ +public: + _kdtree_owner(); + _kdtree_owner(const _kdtree_owner &rhs); + _kdtree_owner& operator=(const _kdtree_owner &rhs); + virtual ~_kdtree_owner(); + alglib_impl::kdtree* c_ptr(); + alglib_impl::kdtree* c_ptr() const; +protected: + alglib_impl::kdtree *p_struct; +}; +class kdtree : public _kdtree_owner +{ +public: + kdtree(); + kdtree(const kdtree &rhs); + kdtree& operator=(const kdtree &rhs); + virtual ~kdtree(); + +}; + +/************************************************************************* +HQRNDState initialization with random values which come from standard +RNG. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndrandomize(hqrndstate &state); + + +/************************************************************************* +HQRNDState initialization with seed values + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndseed(const ae_int_t s1, const ae_int_t s2, hqrndstate &state); + + +/************************************************************************* +This function generates random real number in (0,1), +not including interval boundaries + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double hqrnduniformr(const hqrndstate &state); + + +/************************************************************************* +This function generates random integer number in [0, N) + +1. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() +2. N can be any positive number except for very large numbers: + * close to 2^31 on 32-bit systems + * close to 2^62 on 64-bit systems + An exception will be generated if N is too large. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +ae_int_t hqrnduniformi(const hqrndstate &state, const ae_int_t n); + + +/************************************************************************* +Random number generator: normal numbers + +This function generates one random number from normal distribution. +Its performance is equal to that of HQRNDNormal2() + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double hqrndnormal(const hqrndstate &state); + + +/************************************************************************* +Random number generator: random X and Y such that X^2+Y^2=1 + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndunit2(const hqrndstate &state, double &x, double &y); + + +/************************************************************************* +Random number generator: normal numbers + +This function generates two independent random numbers from normal +distribution. Its performance is equal to that of HQRNDNormal() + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void hqrndnormal2(const hqrndstate &state, double &x1, double &x2); + + +/************************************************************************* +Random number generator: exponential distribution + +State structure must be initialized with HQRNDRandomize() or HQRNDSeed(). + + -- ALGLIB -- + Copyright 11.08.2007 by Bochkanov Sergey +*************************************************************************/ +double hqrndexponential(const hqrndstate &state, const double lambdav); + + +/************************************************************************* +This function generates random number from discrete distribution given by +finite sample X. + +INPUT PARAMETERS + State - high quality random number generator, must be + initialized with HQRNDRandomize() or HQRNDSeed(). + X - finite sample + N - number of elements to use, N>=1 + +RESULT + this function returns one of the X[i] for random i=0..N-1 + + -- ALGLIB -- + Copyright 08.11.2011 by Bochkanov Sergey +*************************************************************************/ +double hqrnddiscrete(const hqrndstate &state, const real_1d_array &x, const ae_int_t n); + + +/************************************************************************* +This function generates random number from continuous distribution given +by finite sample X. + +INPUT PARAMETERS + State - high quality random number generator, must be + initialized with HQRNDRandomize() or HQRNDSeed(). + X - finite sample, array[N] (can be larger, in this case only + leading N elements are used). THIS ARRAY MUST BE SORTED BY + ASCENDING. + N - number of elements to use, N>=1 + +RESULT + this function returns random number from continuous distribution which + tries to approximate X as mush as possible. min(X)<=Result<=max(X). + + -- ALGLIB -- + Copyright 08.11.2011 by Bochkanov Sergey +*************************************************************************/ +double hqrndcontinuous(const hqrndstate &state, const real_1d_array &x, const ae_int_t n); + +/************************************************************************* +This function serializes data structure to string. + +Important properties of s_out: +* it contains alphanumeric characters, dots, underscores, minus signs +* these symbols are grouped into words, which are separated by spaces + and Windows-style (CR+LF) newlines +* although serializer uses spaces and CR+LF as separators, you can + replace any separator character by arbitrary combination of spaces, + tabs, Windows or Unix newlines. It allows flexible reformatting of + the string in case you want to include it into text or XML file. + But you should not insert separators into the middle of the "words" + nor you should change case of letters. +* s_out can be freely moved between 32-bit and 64-bit systems, little + and big endian machines, and so on. You can serialize structure on + 32-bit machine and unserialize it on 64-bit one (or vice versa), or + serialize it on SPARC and unserialize on x86. You can also + serialize it in C++ version of ALGLIB and unserialize in C# one, + and vice versa. +*************************************************************************/ +void kdtreeserialize(kdtree &obj, std::string &s_out); + + +/************************************************************************* +This function unserializes data structure from string. +*************************************************************************/ +void kdtreeunserialize(std::string &s_in, kdtree &obj); + + +/************************************************************************* +KD-tree creation + +This subroutine creates KD-tree from set of X-values and optional Y-values + +INPUT PARAMETERS + XY - dataset, array[0..N-1,0..NX+NY-1]. + one row corresponds to one point. + first NX columns contain X-values, next NY (NY may be zero) + columns may contain associated Y-values + N - number of points, N>=0. + NX - space dimension, NX>=1. + NY - number of optional Y-values, NY>=0. + NormType- norm type: + * 0 denotes infinity-norm + * 1 denotes 1-norm + * 2 denotes 2-norm (Euclidean norm) + +OUTPUT PARAMETERS + KDT - KD-tree + + +NOTES + +1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory + requirements. +2. Although KD-trees may be used with any combination of N and NX, they + are more efficient than brute-force search only when N >> 4^NX. So they + are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another + inefficient case, because simple binary search (without additional + structures) is much more efficient in such tasks than KD-trees. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreebuild(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt); +void kdtreebuild(const real_2d_array &xy, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt); + + +/************************************************************************* +KD-tree creation + +This subroutine creates KD-tree from set of X-values, integer tags and +optional Y-values + +INPUT PARAMETERS + XY - dataset, array[0..N-1,0..NX+NY-1]. + one row corresponds to one point. + first NX columns contain X-values, next NY (NY may be zero) + columns may contain associated Y-values + Tags - tags, array[0..N-1], contains integer tags associated + with points. + N - number of points, N>=0 + NX - space dimension, NX>=1. + NY - number of optional Y-values, NY>=0. + NormType- norm type: + * 0 denotes infinity-norm + * 1 denotes 1-norm + * 2 denotes 2-norm (Euclidean norm) + +OUTPUT PARAMETERS + KDT - KD-tree + +NOTES + +1. KD-tree creation have O(N*logN) complexity and O(N*(2*NX+NY)) memory + requirements. +2. Although KD-trees may be used with any combination of N and NX, they + are more efficient than brute-force search only when N >> 4^NX. So they + are most useful in low-dimensional tasks (NX=2, NX=3). NX=1 is another + inefficient case, because simple binary search (without additional + structures) is much more efficient in such tasks than KD-trees. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreebuildtagged(const real_2d_array &xy, const integer_1d_array &tags, const ae_int_t n, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt); +void kdtreebuildtagged(const real_2d_array &xy, const integer_1d_array &tags, const ae_int_t nx, const ae_int_t ny, const ae_int_t normtype, kdtree &kdt); + + +/************************************************************************* +K-NN query: K nearest neighbors + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + K - number of neighbors to return, K>=1 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + +RESULT + number of actual neighbors found (either K or N, if K>N). + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +these results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const bool selfmatch); +ae_int_t kdtreequeryknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k); + + +/************************************************************************* +R-NN query: all points within R-sphere centered at X + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + R - radius of sphere (in corresponding norm), R>0 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + +RESULT + number of neighbors found, >=0 + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +actual results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryrnn(const kdtree &kdt, const real_1d_array &x, const double r, const bool selfmatch); +ae_int_t kdtreequeryrnn(const kdtree &kdt, const real_1d_array &x, const double r); + + +/************************************************************************* +K-NN query: approximate K nearest neighbors + +INPUT PARAMETERS + KDT - KD-tree + X - point, array[0..NX-1]. + K - number of neighbors to return, K>=1 + SelfMatch - whether self-matches are allowed: + * if True, nearest neighbor may be the point itself + (if it exists in original dataset) + * if False, then only points with non-zero distance + are returned + * if not given, considered True + Eps - approximation factor, Eps>=0. eps-approximate nearest + neighbor is a neighbor whose distance from X is at + most (1+eps) times distance of true nearest neighbor. + +RESULT + number of actual neighbors found (either K or N, if K>N). + +NOTES + significant performance gain may be achieved only when Eps is is on + the order of magnitude of 1 or larger. + +This subroutine performs query and stores its result in the internal +structures of the KD-tree. You can use following subroutines to obtain +these results: +* KDTreeQueryResultsX() to get X-values +* KDTreeQueryResultsXY() to get X- and Y-values +* KDTreeQueryResultsTags() to get tag values +* KDTreeQueryResultsDistances() to get distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +ae_int_t kdtreequeryaknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const bool selfmatch, const double eps); +ae_int_t kdtreequeryaknn(const kdtree &kdt, const real_1d_array &x, const ae_int_t k, const double eps); + + +/************************************************************************* +X-values from last query + +INPUT PARAMETERS + KDT - KD-tree + X - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + X - rows are filled with X-values + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsTags() tag values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsx(const kdtree &kdt, real_2d_array &x); + + +/************************************************************************* +X- and Y-values from last query + +INPUT PARAMETERS + KDT - KD-tree + XY - possibly pre-allocated buffer. If XY is too small to store + result, it is resized. If size(XY) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + XY - rows are filled with points: first NX columns with + X-values, next NY columns - with Y-values. + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsTags() tag values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxy(const kdtree &kdt, real_2d_array &xy); + + +/************************************************************************* +Tags from last query + +INPUT PARAMETERS + KDT - KD-tree + Tags - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + Tags - filled with tags associated with points, + or, when no tags were supplied, with zeros + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsDistances() distances + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultstags(const kdtree &kdt, integer_1d_array &tags); + + +/************************************************************************* +Distances from last query + +INPUT PARAMETERS + KDT - KD-tree + R - possibly pre-allocated buffer. If X is too small to store + result, it is resized. If size(X) is enough to store + result, it is left unchanged. + +OUTPUT PARAMETERS + R - filled with distances (in corresponding norm) + +NOTES +1. points are ordered by distance from the query point (first = closest) +2. if XY is larger than required to store result, only leading part will + be overwritten; trailing part will be left unchanged. So if on input + XY = [[A,B],[C,D]], and result is [1,2], then on exit we will get + XY = [[1,2],[C,D]]. This is done purposely to increase performance; if + you want function to resize array according to result size, use + function with same name and suffix 'I'. + +SEE ALSO +* KDTreeQueryResultsX() X-values +* KDTreeQueryResultsXY() X- and Y-values +* KDTreeQueryResultsTags() tag values + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsdistances(const kdtree &kdt, real_1d_array &r); + + +/************************************************************************* +X-values from last query; 'interactive' variant for languages like Python +which support constructs like "X = KDTreeQueryResultsXI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxi(const kdtree &kdt, real_2d_array &x); + + +/************************************************************************* +XY-values from last query; 'interactive' variant for languages like Python +which support constructs like "XY = KDTreeQueryResultsXYI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsxyi(const kdtree &kdt, real_2d_array &xy); + + +/************************************************************************* +Tags from last query; 'interactive' variant for languages like Python +which support constructs like "Tags = KDTreeQueryResultsTagsI(KDT)" and +interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultstagsi(const kdtree &kdt, integer_1d_array &tags); + + +/************************************************************************* +Distances from last query; 'interactive' variant for languages like Python +which support constructs like "R = KDTreeQueryResultsDistancesI(KDT)" +and interactive mode of interpreter. + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void kdtreequeryresultsdistancesi(const kdtree &kdt, real_1d_array &r); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void hqrndrandomize(hqrndstate* state, ae_state *_state); +void hqrndseed(ae_int_t s1, + ae_int_t s2, + hqrndstate* state, + ae_state *_state); +double hqrnduniformr(hqrndstate* state, ae_state *_state); +ae_int_t hqrnduniformi(hqrndstate* state, ae_int_t n, ae_state *_state); +double hqrndnormal(hqrndstate* state, ae_state *_state); +void hqrndunit2(hqrndstate* state, double* x, double* y, ae_state *_state); +void hqrndnormal2(hqrndstate* state, + double* x1, + double* x2, + ae_state *_state); +double hqrndexponential(hqrndstate* state, + double lambdav, + ae_state *_state); +double hqrnddiscrete(hqrndstate* state, + /* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +double hqrndcontinuous(hqrndstate* state, + /* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +ae_bool _hqrndstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _hqrndstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _hqrndstate_clear(void* _p); +void _hqrndstate_destroy(void* _p); +void kdtreebuild(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t nx, + ae_int_t ny, + ae_int_t normtype, + kdtree* kdt, + ae_state *_state); +void kdtreebuildtagged(/* Real */ ae_matrix* xy, + /* Integer */ ae_vector* tags, + ae_int_t n, + ae_int_t nx, + ae_int_t ny, + ae_int_t normtype, + kdtree* kdt, + ae_state *_state); +ae_int_t kdtreequeryknn(kdtree* kdt, + /* Real */ ae_vector* x, + ae_int_t k, + ae_bool selfmatch, + ae_state *_state); +ae_int_t kdtreequeryrnn(kdtree* kdt, + /* Real */ ae_vector* x, + double r, + ae_bool selfmatch, + ae_state *_state); +ae_int_t kdtreequeryaknn(kdtree* kdt, + /* Real */ ae_vector* x, + ae_int_t k, + ae_bool selfmatch, + double eps, + ae_state *_state); +void kdtreequeryresultsx(kdtree* kdt, + /* Real */ ae_matrix* x, + ae_state *_state); +void kdtreequeryresultsxy(kdtree* kdt, + /* Real */ ae_matrix* xy, + ae_state *_state); +void kdtreequeryresultstags(kdtree* kdt, + /* Integer */ ae_vector* tags, + ae_state *_state); +void kdtreequeryresultsdistances(kdtree* kdt, + /* Real */ ae_vector* r, + ae_state *_state); +void kdtreequeryresultsxi(kdtree* kdt, + /* Real */ ae_matrix* x, + ae_state *_state); +void kdtreequeryresultsxyi(kdtree* kdt, + /* Real */ ae_matrix* xy, + ae_state *_state); +void kdtreequeryresultstagsi(kdtree* kdt, + /* Integer */ ae_vector* tags, + ae_state *_state); +void kdtreequeryresultsdistancesi(kdtree* kdt, + /* Real */ ae_vector* r, + ae_state *_state); +void kdtreealloc(ae_serializer* s, kdtree* tree, ae_state *_state); +void kdtreeserialize(ae_serializer* s, kdtree* tree, ae_state *_state); +void kdtreeunserialize(ae_serializer* s, kdtree* tree, ae_state *_state); +ae_bool _kdtree_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _kdtree_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _kdtree_clear(void* _p); +void _kdtree_destroy(void* _p); + +} +#endif + diff --git a/psdlag/src/ap.cpp b/psdlag/src/ap.cpp new file mode 100644 index 0000000..cc8140e --- /dev/null +++ b/psdlag/src/ap.cpp @@ -0,0 +1,10661 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "ap.h" +#include +#include +using namespace std; + +#if defined(AE_CPU) +#if (AE_CPU==AE_INTEL) + +#if AE_COMPILER==AE_MSVC +#include +#endif + +#endif +#endif + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION IMPLEMENTS BASIC FUNCTIONALITY LIKE +// MEMORY MANAGEMENT FOR VECTORS/MATRICES WHICH IS +// SHARED BETWEEN C++ AND PURE C LIBRARIES +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +/* + * local definitions + */ +#define x_nb 16 +#define AE_DATA_ALIGN 16 +#define AE_PTR_ALIGN sizeof(void*) +#define DYN_BOTTOM ((void*)1) +#define DYN_FRAME ((void*)2) +#define AE_LITTLE_ENDIAN 1 +#define AE_BIG_ENDIAN 2 +#define AE_MIXED_ENDIAN 3 +#define AE_SER_ENTRY_LENGTH 11 +#define AE_SER_ENTRIES_PER_ROW 5 + +#define AE_SM_DEFAULT 0 +#define AE_SM_ALLOC 1 +#define AE_SM_READY2S 2 +#define AE_SM_TO_STRING 10 +#define AE_SM_FROM_STRING 20 +#define AE_SM_TO_CPPSTRING 11 + +#define AE_LOCK_CYCLES 512 +#define AE_LOCK_TESTS_BEFORE_YIELD 16 +#define AE_CRITICAL_ASSERT(x) if( !(x) ) abort() + + +/* + * alloc counter (if used) + */ +#ifdef AE_USE_ALLOC_COUNTER +ae_int64_t _alloc_counter = 0; +#endif +#ifdef AE_DEBUGRNG +static ae_int_t _debug_rng_s0 = 11; +static ae_int_t _debug_rng_s1 = 13; +#endif +#ifdef AE_SMP_DEBUGCOUNTERS +__declspec(align(AE_LOCK_ALIGNMENT)) volatile ae_int64_t _ae_dbg_lock_acquisitions = 0; +__declspec(align(AE_LOCK_ALIGNMENT)) volatile ae_int64_t _ae_dbg_lock_spinwaits = 0; +__declspec(align(AE_LOCK_ALIGNMENT)) volatile ae_int64_t _ae_dbg_lock_yields = 0; +#endif + +/* + * These declarations are used to ensure that + * sizeof(ae_int32_t)==4, sizeof(ae_int64_t)==8, sizeof(ae_int_t)==sizeof(void*). + * they will lead to syntax error otherwise (array size will be negative). + * + * you can remove them, if you want - they are not used anywhere. + * + */ +static char _ae_int32_t_must_be_32_bits_wide[1-2*((int)(sizeof(ae_int32_t))-4)*((int)(sizeof(ae_int32_t))-4)]; +static char _ae_int64_t_must_be_64_bits_wide[1-2*((int)(sizeof(ae_int64_t))-8)*((int)(sizeof(ae_int64_t))-8)]; +static char _ae_int_t_must_be_pointer_sized [1-2*((int)(sizeof(ae_int_t))-(int)sizeof(void*))*((int)(sizeof(ae_int_t))-(int)(sizeof(void*)))]; + +/* + * This variable is used to prevent some tricky optimizations which may degrade multithreaded performance. + * It is touched once in the ae_init_pool() function from smp.c in order to prevent optimizations. + * + */ +static volatile ae_int_t ae_never_change_it = 1; + +ae_int_t ae_misalignment(const void *ptr, size_t alignment) +{ + union _u + { + const void *ptr; + ae_int_t iptr; + } u; + u.ptr = ptr; + return (ae_int_t)(u.iptr%alignment); +} + +void* ae_align(void *ptr, size_t alignment) +{ + char *result = (char*)ptr; + if( (result-(char*)0)%alignment!=0 ) + result += alignment - (result-(char*)0)%alignment; + return result; +} + +void ae_break(ae_state *state, ae_error_type error_type, const char *msg) +{ +#ifndef AE_USE_CPP_ERROR_HANDLING + if( state!=NULL ) + { + if( state->thread_exception_handler!=NULL ) + state->thread_exception_handler(state); + ae_state_clear(state); + state->last_error = error_type; + state->error_msg = msg; + if( state->break_jump!=NULL ) + longjmp(*(state->break_jump), 1); + else + abort(); + } + else + abort(); +#else + if( state!=NULL ) + { + if( state->thread_exception_handler!=NULL ) + state->thread_exception_handler(state); + ae_state_clear(state); + state->last_error = error_type; + state->error_msg = msg; + } + throw error_type; +#endif +} + +void* aligned_malloc(size_t size, size_t alignment) +{ + if( size==0 ) + return NULL; + if( alignment<=1 ) + { + /* no alignment, just call malloc */ + void *block; + void **p; ; + block = malloc(sizeof(void*)+size); + if( block==NULL ) + return NULL; + p = (void**)block; + *p = block; +#ifdef AE_USE_ALLOC_COUNTER + _alloc_counter++; +#endif + return (void*)((char*)block+sizeof(void*)); + } + else + { + /* align */ + void *block; + char *result; + block = malloc(alignment-1+sizeof(void*)+size); + if( block==NULL ) + return NULL; + result = (char*)block+sizeof(void*); + /*if( (result-(char*)0)%alignment!=0 ) + result += alignment - (result-(char*)0)%alignment;*/ + result = (char*)ae_align(result, alignment); + *((void**)(result-sizeof(void*))) = block; +#ifdef AE_USE_ALLOC_COUNTER + _alloc_counter++; +#endif + return result; + } +} + +void aligned_free(void *block) +{ + void *p; + if( block==NULL ) + return; + p = *((void**)((char*)block-sizeof(void*))); + free(p); +#ifdef AE_USE_ALLOC_COUNTER + _alloc_counter--; +#endif +} + +/************************************************************************ +Malloc's memory with automatic alignment. + +Returns NULL when zero size is specified. + +Error handling: +* if state is NULL, returns NULL on allocation error +* if state is not NULL, calls ae_break() on allocation error +************************************************************************/ +void* ae_malloc(size_t size, ae_state *state) +{ + void *result; + if( size==0 ) + return NULL; + result = aligned_malloc(size,AE_DATA_ALIGN); + if( result==NULL && state!=NULL) + { + char buf[256]; + sprintf(buf, "ae_malloc(): out of memory (attempted to allocate %llu bytes)", (unsigned long long)size); + ae_break(state, ERR_OUT_OF_MEMORY, buf); + } + return result; +} + +void ae_free(void *p) +{ + if( p!=NULL ) + aligned_free(p); +} + +/************************************************************************ +Sets pointers to the matrix rows. + +* dst must be correctly initialized matrix +* dst->data.ptr points to the beginning of memory block allocated for + row pointers. +* dst->ptr - undefined (initialized during algorithm processing) +* storage parameter points to the beginning of actual storage +************************************************************************/ +void ae_matrix_update_row_pointers(ae_matrix *dst, void *storage) +{ + char *p_base; + void **pp_ptr; + ae_int_t i; + if( dst->rows>0 && dst->cols>0 ) + { + p_base = (char*)storage; + pp_ptr = (void**)dst->data.ptr; + dst->ptr.pp_void = pp_ptr; + for(i=0; irows; i++, p_base+=dst->stride*ae_sizeof(dst->datatype)) + pp_ptr[i] = p_base; + } + else + dst->ptr.pp_void = NULL; +} + +/************************************************************************ +Returns size of datatype. +Zero for dynamic types like strings or multiple precision types. +************************************************************************/ +ae_int_t ae_sizeof(ae_datatype datatype) +{ + switch(datatype) + { + case DT_BOOL: return (ae_int_t)sizeof(ae_bool); + case DT_INT: return (ae_int_t)sizeof(ae_int_t); + case DT_REAL: return (ae_int_t)sizeof(double); + case DT_COMPLEX: return 2*(ae_int_t)sizeof(double); + default: return 0; + } +} + + +/************************************************************************ +This dummy function is used to prevent compiler messages about unused +locals in automatically generated code. + +It makes nothing - just accepts pointer, "touches" it - and that is all. +It performs several tricky operations without side effects which confuse +compiler so it does not compain about unused locals in THIS function. +************************************************************************/ +void ae_touch_ptr(void *p) +{ + void * volatile fake_variable0 = p; + void * volatile fake_variable1 = fake_variable0; + fake_variable0 = fake_variable1; +} + +/************************************************************************ +This function initializes ALGLIB environment state. + +NOTES: +* stacks contain no frames, so ae_make_frame() must be called before + attaching dynamic blocks. Without it ae_leave_frame() will cycle + forever (which is intended behavior). +************************************************************************/ +void ae_state_init(ae_state *state) +{ + ae_int32_t *vp; + + /* + * p_next points to itself because: + * * correct program should be able to detect end of the list + * by looking at the ptr field. + * * NULL p_next may be used to distinguish automatic blocks + * (in the list) from non-automatic (not in the list) + */ + state->last_block.p_next = &(state->last_block); + state->last_block.deallocator = NULL; + state->last_block.ptr = DYN_BOTTOM; + state->p_top_block = &(state->last_block); +#ifndef AE_USE_CPP_ERROR_HANDLING + state->break_jump = NULL; +#endif + state->error_msg = ""; + + /* + * determine endianness and initialize precomputed IEEE special quantities. + */ + state->endianness = ae_get_endianness(); + if( state->endianness==AE_LITTLE_ENDIAN ) + { + vp = (ae_int32_t*)(&state->v_nan); + vp[0] = 0; + vp[1] = (ae_int32_t)0x7FF80000; + vp = (ae_int32_t*)(&state->v_posinf); + vp[0] = 0; + vp[1] = (ae_int32_t)0x7FF00000; + vp = (ae_int32_t*)(&state->v_neginf); + vp[0] = 0; + vp[1] = (ae_int32_t)0xFFF00000; + } + else if( state->endianness==AE_BIG_ENDIAN ) + { + vp = (ae_int32_t*)(&state->v_nan); + vp[1] = 0; + vp[0] = (ae_int32_t)0x7FF80000; + vp = (ae_int32_t*)(&state->v_posinf); + vp[1] = 0; + vp[0] = (ae_int32_t)0x7FF00000; + vp = (ae_int32_t*)(&state->v_neginf); + vp[1] = 0; + vp[0] = (ae_int32_t)0xFFF00000; + } + else + abort(); + + /* + * set threading information + */ + state->worker_thread = NULL; + state->parent_task = NULL; + state->thread_exception_handler = NULL; +} + + +/************************************************************************ +This function clears ALGLIB environment state. +All dynamic data controlled by state are freed. +************************************************************************/ +void ae_state_clear(ae_state *state) +{ + while( state->p_top_block->ptr!=DYN_BOTTOM ) + ae_frame_leave(state); +} + + +#ifndef AE_USE_CPP_ERROR_HANDLING +/************************************************************************ +This function sets jump buffer for error handling. + +buf may be NULL. +************************************************************************/ +void ae_state_set_break_jump(ae_state *state, jmp_buf *buf) +{ + state->break_jump = buf; +} +#endif + + +/************************************************************************ +This function makes new stack frame. + +This function takes two parameters: environment state and pointer to the +dynamic block which will be used as indicator of the frame beginning. +This dynamic block must be initialized by caller and mustn't be changed/ +deallocated/reused till ae_leave_frame called. It may be global or local +variable (local is even better). +************************************************************************/ +void ae_frame_make(ae_state *state, ae_frame *tmp) +{ + tmp->db_marker.p_next = state->p_top_block; + tmp->db_marker.deallocator = NULL; + tmp->db_marker.ptr = DYN_FRAME; + state->p_top_block = &tmp->db_marker; +} + + +/************************************************************************ +This function leaves current stack frame and deallocates all automatic +dynamic blocks which were attached to this frame. +************************************************************************/ +void ae_frame_leave(ae_state *state) +{ + while( state->p_top_block->ptr!=DYN_FRAME && state->p_top_block->ptr!=DYN_BOTTOM) + { + if( state->p_top_block->ptr!=NULL && state->p_top_block->deallocator!=NULL) + ((ae_deallocator)(state->p_top_block->deallocator))(state->p_top_block->ptr); + state->p_top_block = state->p_top_block->p_next; + } + state->p_top_block = state->p_top_block->p_next; +} + + +/************************************************************************ +This function attaches block to the dynamic block list + +block block +state ALGLIB environment state + +NOTES: +* never call it for special blocks which marks frame boundaries! +************************************************************************/ +void ae_db_attach(ae_dyn_block *block, ae_state *state) +{ + block->p_next = state->p_top_block; + state->p_top_block = block; +} + + +/************************************************************************ +This function malloc's dynamic block: + +block destination block, assumed to be uninitialized +size size (in bytes) +state ALGLIB environment state. May be NULL. +make_automatic if true, vector is added to the dynamic block list + +block is assumed to be uninitialized, its fields are ignored. + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +NOTES: +* never call it for blocks which are already in the list +************************************************************************/ +ae_bool ae_db_malloc(ae_dyn_block *block, ae_int_t size, ae_state *state, ae_bool make_automatic) +{ + /* ensure that size is >=0 + two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ + if( state!=NULL ) + ae_assert(size>=0, "ae_db_malloc(): negative size", state); + if( size<0 ) + return ae_false; + + /* alloc */ + block->ptr = ae_malloc((size_t)size, state); + if( block->ptr==NULL && size!=0 ) + return ae_false; + if( make_automatic && state!=NULL ) + ae_db_attach(block, state); + else + block->p_next = NULL; + block->deallocator = ae_free; + return ae_true; +} + + +/************************************************************************ +This function realloc's dynamic block: + +block destination block (initialized) +size new size (in bytes) +state ALGLIB environment state + +block is assumed to be initialized. + +This function: +* deletes old contents +* preserves automatic state + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +NOTES: +* never call it for special blocks which mark frame boundaries! +************************************************************************/ +ae_bool ae_db_realloc(ae_dyn_block *block, ae_int_t size, ae_state *state) +{ + /* ensure that size is >=0 + two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ + if( state!=NULL ) + ae_assert(size>=0, "ae_db_realloc(): negative size", state); + if( size<0 ) + return ae_false; + + /* realloc */ + if( block->ptr!=NULL ) + ((ae_deallocator)block->deallocator)(block->ptr); + block->ptr = ae_malloc((size_t)size, state); + if( block->ptr==NULL && size!=0 ) + return ae_false; + block->deallocator = ae_free; + return ae_true; +} + + +/************************************************************************ +This function clears dynamic block (releases all dynamically allocated +memory). Dynamic block may be in automatic management list - in this case +it will NOT be removed from list. + +block destination block (initialized) + +NOTES: +* never call it for special blocks which marks frame boundaries! +************************************************************************/ +void ae_db_free(ae_dyn_block *block) +{ + if( block->ptr!=NULL ) + ((ae_deallocator)block->deallocator)(block->ptr); + block->ptr = NULL; + block->deallocator = ae_free; +} + +/************************************************************************ +This function swaps contents of two dynamic blocks (pointers and +deallocators) leaving other parameters (automatic management settings, +etc.) unchanged. + +NOTES: +* never call it for special blocks which marks frame boundaries! +************************************************************************/ +void ae_db_swap(ae_dyn_block *block1, ae_dyn_block *block2) +{ + void (*deallocator)(void*) = NULL; + void * volatile ptr; + ptr = block1->ptr; + deallocator = block1->deallocator; + block1->ptr = block2->ptr; + block1->deallocator = block2->deallocator; + block2->ptr = ptr; + block2->deallocator = deallocator; +} + +/************************************************************************ +This function creates ae_vector. + +Vector size may be zero. Vector contents is uninitialized. + +dst destination vector +size vector size, may be zero +datatype guess what... +state ALGLIB environment state +make_automatic if true, vector is added to the dynamic block list + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +dst is assumed to be uninitialized, its fields are ignored. +************************************************************************/ +ae_bool ae_vector_init(ae_vector *dst, ae_int_t size, ae_datatype datatype, ae_state *state, ae_bool make_automatic) +{ + /* ensure that size is >=0 + two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ + if( state!=NULL ) + ae_assert(size>=0, "ae_vector_init(): negative size", state); + if( size<0 ) + return ae_false; + + /* init */ + dst->cnt = size; + dst->datatype = datatype; + if( !ae_db_malloc(&dst->data, size*ae_sizeof(datatype), state, make_automatic) ) + return ae_false; + dst->ptr.p_ptr = dst->data.ptr; + return ae_true; +} + + +/************************************************************************ +This function creates copy of ae_vector. + +dst destination vector +src well, it is source +state ALGLIB environment state +make_automatic if true, vector is added to the dynamic block list + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +dst is assumed to be uninitialized, its fields are ignored. +************************************************************************/ +ae_bool ae_vector_init_copy(ae_vector *dst, ae_vector *src, ae_state *state, ae_bool make_automatic) +{ + if( !ae_vector_init(dst, src->cnt, src->datatype, state, make_automatic) ) + return ae_false; + if( src->cnt!=0 ) + memcpy(dst->ptr.p_ptr, src->ptr.p_ptr, (size_t)(src->cnt*ae_sizeof(src->datatype))); + return ae_true; +} + +/************************************************************************ +This function creates ae_vector from x_vector: + +dst destination vector +src source, vector in x-format +state ALGLIB environment state +make_automatic if true, vector is added to the dynamic block list + +dst is assumed to be uninitialized, its fields are ignored. +************************************************************************/ +void ae_vector_init_from_x(ae_vector *dst, x_vector *src, ae_state *state, ae_bool make_automatic) +{ + ae_vector_init(dst, (ae_int_t)src->cnt, (ae_datatype)src->datatype, state, make_automatic); + if( src->cnt>0 ) + memcpy(dst->ptr.p_ptr, src->ptr, (size_t)(((ae_int_t)src->cnt)*ae_sizeof((ae_datatype)src->datatype))); +} + + +/************************************************************************ +This function changes length of ae_vector. + +dst destination vector +newsize vector size, may be zero +state ALGLIB environment state + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +NOTES: +* vector must be initialized +* all contents is destroyed during setlength() call +* new size may be zero. +************************************************************************/ +ae_bool ae_vector_set_length(ae_vector *dst, ae_int_t newsize, ae_state *state) +{ + /* ensure that size is >=0 + two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ + if( state!=NULL ) + ae_assert(newsize>=0, "ae_vector_set_length(): negative size", state); + if( newsize<0 ) + return ae_false; + + /* set length */ + if( dst->cnt==newsize ) + return ae_true; + dst->cnt = newsize; + if( !ae_db_realloc(&dst->data, newsize*ae_sizeof(dst->datatype), state) ) + return ae_false; + dst->ptr.p_ptr = dst->data.ptr; + return ae_true; +} + + +/************************************************************************ +This function provides "CLEAR" functionality for vector (contents is +cleared, but structure still left in valid state). + +The function clears vector contents (releases all dynamically allocated +memory). Vector may be in automatic management list - in this case it +will NOT be removed from list. + +IMPORTANT: this function does NOT invalidates dst; it just releases all +dynamically allocated storage, but dst still may be used after call to +ae_vector_set_length(). + +dst destination vector +************************************************************************/ +void ae_vector_clear(ae_vector *dst) +{ + dst->cnt = 0; + ae_db_free(&dst->data); + dst->ptr.p_ptr = 0; +} + + +/************************************************************************ +This function provides "DESTROY" functionality for vector (contents is +cleared, all internal structures are destroyed). For vectors it is same +as CLEAR. + +dst destination vector +************************************************************************/ +void ae_vector_destroy(ae_vector *dst) +{ + ae_vector_clear(dst); +} + + +/************************************************************************ +This function efficiently swaps contents of two vectors, leaving other +pararemeters (automatic management, etc.) unchanged. +************************************************************************/ +void ae_swap_vectors(ae_vector *vec1, ae_vector *vec2) +{ + ae_int_t cnt; + ae_datatype datatype; + void *p_ptr; + + ae_db_swap(&vec1->data, &vec2->data); + + cnt = vec1->cnt; + datatype = vec1->datatype; + p_ptr = vec1->ptr.p_ptr; + vec1->cnt = vec2->cnt; + vec1->datatype = vec2->datatype; + vec1->ptr.p_ptr = vec2->ptr.p_ptr; + vec2->cnt = cnt; + vec2->datatype = datatype; + vec2->ptr.p_ptr = p_ptr; +} + +/************************************************************************ +This function creates ae_matrix. + +Matrix size may be zero, in such cases both rows and cols are zero. +Matrix contents is uninitialized. + +dst destination natrix +rows rows count +cols cols count +datatype element type +state ALGLIB environment state +make_automatic if true, matrix is added to the dynamic block list + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +dst is assumed to be uninitialized, its fields are ignored. +************************************************************************/ +ae_bool ae_matrix_init(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_datatype datatype, ae_state *state, ae_bool make_automatic) +{ + /* ensure that size is >=0 + two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ + if( state!=NULL ) + ae_assert(rows>=0 && cols>=0, "ae_matrix_init(): negative length", state); + if( rows<0 || cols<0 ) + return ae_false; + + /* if one of rows/cols is zero, another MUST be too */ + if( rows==0 || cols==0 ) + { + rows = 0; + cols = 0; + } + + /* init */ + dst->rows = rows; + dst->cols = cols; + dst->stride = cols; + while( dst->stride*ae_sizeof(datatype)%AE_DATA_ALIGN!=0 ) + dst->stride++; + dst->datatype = datatype; + if( !ae_db_malloc(&dst->data, dst->rows*((ae_int_t)sizeof(void*)+dst->stride*ae_sizeof(datatype))+AE_DATA_ALIGN-1, state, make_automatic) ) + return ae_false; + ae_matrix_update_row_pointers(dst, ae_align((char*)dst->data.ptr+dst->rows*sizeof(void*),AE_DATA_ALIGN)); + return ae_true; +} + + +/************************************************************************ +This function creates copy of ae_matrix. + +dst destination matrix +src well, it is source +state ALGLIB environment state +make_automatic if true, matrix is added to the dynamic block list + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +dst is assumed to be uninitialized, its fields are ignored. +************************************************************************/ +ae_bool ae_matrix_init_copy(ae_matrix *dst, ae_matrix *src, ae_state *state, ae_bool make_automatic) +{ + ae_int_t i; + if( !ae_matrix_init(dst, src->rows, src->cols, src->datatype, state, make_automatic) ) + return ae_false; + if( src->rows!=0 && src->cols!=0 ) + { + if( dst->stride==src->stride ) + memcpy(dst->ptr.pp_void[0], src->ptr.pp_void[0], (size_t)(src->rows*src->stride*ae_sizeof(src->datatype))); + else + for(i=0; irows; i++) + memcpy(dst->ptr.pp_void[i], src->ptr.pp_void[i], (size_t)(dst->cols*ae_sizeof(dst->datatype))); + } + return ae_true; +} + + +void ae_matrix_init_from_x(ae_matrix *dst, x_matrix *src, ae_state *state, ae_bool make_automatic) +{ + char *p_src_row; + char *p_dst_row; + ae_int_t row_size; + ae_int_t i; + ae_matrix_init(dst, (ae_int_t)src->rows, (ae_int_t)src->cols, (ae_datatype)src->datatype, state, make_automatic); + if( src->rows!=0 && src->cols!=0 ) + { + p_src_row = (char*)src->ptr; + p_dst_row = (char*)(dst->ptr.pp_void[0]); + row_size = ae_sizeof((ae_datatype)src->datatype)*(ae_int_t)src->cols; + for(i=0; irows; i++, p_src_row+=src->stride*ae_sizeof((ae_datatype)src->datatype), p_dst_row+=dst->stride*ae_sizeof((ae_datatype)src->datatype)) + memcpy(p_dst_row, p_src_row, (size_t)(row_size)); + } +} + + +/************************************************************************ +This function changes length of ae_matrix. + +dst destination matrix +rows size, may be zero +cols size, may be zero +state ALGLIB environment state + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +NOTES: +* matrix must be initialized +* all contents is destroyed during setlength() call +* new size may be zero. +************************************************************************/ +ae_bool ae_matrix_set_length(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_state *state) +{ + /* ensure that size is >=0 + two ways to exit: 1) through ae_assert, if we have non-NULL state, 2) by returning ae_false */ + if( state!=NULL ) + ae_assert(rows>=0 && cols>=0, "ae_matrix_set_length(): negative length", state); + if( rows<0 || cols<0 ) + return ae_false; + + if( dst->rows==rows && dst->cols==cols ) + return ae_true; + dst->rows = rows; + dst->cols = cols; + dst->stride = cols; + while( dst->stride*ae_sizeof(dst->datatype)%AE_DATA_ALIGN!=0 ) + dst->stride++; + if( !ae_db_realloc(&dst->data, dst->rows*((ae_int_t)sizeof(void*)+dst->stride*ae_sizeof(dst->datatype))+AE_DATA_ALIGN-1, state) ) + return ae_false; + ae_matrix_update_row_pointers(dst, ae_align((char*)dst->data.ptr+dst->rows*sizeof(void*),AE_DATA_ALIGN)); + return ae_true; +} + + +/************************************************************************ +This function provides "CLEAR" functionality for vector (contents is +cleared, but structure still left in valid state). + +The function clears matrix contents (releases all dynamically allocated +memory). Matrix may be in automatic management list - in this case it +will NOT be removed from list. + +IMPORTANT: this function does NOT invalidates dst; it just releases all +dynamically allocated storage, but dst still may be used after call to +ae_matrix_set_length(). + +dst destination matrix +************************************************************************/ +void ae_matrix_clear(ae_matrix *dst) +{ + dst->rows = 0; + dst->cols = 0; + dst->stride = 0; + ae_db_free(&dst->data); + dst->ptr.p_ptr = 0; +} + + +/************************************************************************ +This function provides "DESTROY" functionality for matrix (contents is +cleared, but structure still left in valid state). + +For matrices it is same as CLEAR. + +dst destination matrix +************************************************************************/ +void ae_matrix_destroy(ae_matrix *dst) +{ + ae_matrix_clear(dst); +} + + +/************************************************************************ +This function efficiently swaps contents of two vectors, leaving other +pararemeters (automatic management, etc.) unchanged. +************************************************************************/ +void ae_swap_matrices(ae_matrix *mat1, ae_matrix *mat2) +{ + ae_int_t rows; + ae_int_t cols; + ae_int_t stride; + ae_datatype datatype; + void *p_ptr; + + ae_db_swap(&mat1->data, &mat2->data); + + rows = mat1->rows; + cols = mat1->cols; + stride = mat1->stride; + datatype = mat1->datatype; + p_ptr = mat1->ptr.p_ptr; + + mat1->rows = mat2->rows; + mat1->cols = mat2->cols; + mat1->stride = mat2->stride; + mat1->datatype = mat2->datatype; + mat1->ptr.p_ptr = mat2->ptr.p_ptr; + + mat2->rows = rows; + mat2->cols = cols; + mat2->stride = stride; + mat2->datatype = datatype; + mat2->ptr.p_ptr = p_ptr; +} + + +/************************************************************************ +This function creates smart pointer structure. + +dst destination smart pointer. + already allocated, but not initialized. +subscriber pointer to pointer which receives updates in the + internal object stored in ae_smart_ptr. Any update to + dst->ptr is translated to subscriber. Can be NULL. +state ALGLIB environment state +make_automatic if true, smart pointer is added to the dynamic block list + +After initialization, smart pointer stores NULL pointer. + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success +************************************************************************/ +ae_bool ae_smart_ptr_init(ae_smart_ptr *dst, void **subscriber, ae_state *state, ae_bool make_automatic) +{ + dst->subscriber = subscriber; + dst->ptr = NULL; + if( dst->subscriber!=NULL ) + *(dst->subscriber) = dst->ptr; + dst->is_owner = ae_false; + dst->is_dynamic = ae_false; + dst->frame_entry.deallocator = ae_smart_ptr_destroy; + dst->frame_entry.ptr = dst; + if( make_automatic && state!=NULL ) + ae_db_attach(&dst->frame_entry, state); + return ae_true; +} + + +/************************************************************************ +This function clears smart pointer structure. + +dst destination smart pointer. + +After call to this function smart pointer contains NULL reference, which +is propagated to its subscriber (in cases non-NULL subscruber was +specified during pointer creation). +************************************************************************/ +void ae_smart_ptr_clear(void *_dst) +{ + ae_smart_ptr *dst = (ae_smart_ptr*)_dst; + if( dst->is_owner && dst->ptr!=NULL ) + { + dst->destroy(dst->ptr); + if( dst->is_dynamic ) + ae_free(dst->ptr); + } + dst->is_owner = ae_false; + dst->is_dynamic = ae_false; + dst->ptr = NULL; + dst->destroy = NULL; + if( dst->subscriber!=NULL ) + *(dst->subscriber) = NULL; +} + + +/************************************************************************ +This function dstroys smart pointer structure (same as clearing it). + +dst destination smart pointer. +************************************************************************/ +void ae_smart_ptr_destroy(void *_dst) +{ + ae_smart_ptr_clear(_dst); +} + + +/************************************************************************ +This function assigns pointer to ae_smart_ptr structure. + +dst destination smart pointer. +new_ptr new pointer to assign +is_owner whether smart pointer owns new_ptr +is_dynamic whether object is dynamic - clearing such object + requires BOTH calling destructor function AND calling + ae_free() for memory occupied by object. +destroy destructor function + +In case smart pointer already contains non-NULL value and owns this value, +it is freed before assigning new pointer. + +Changes in pointer are propagated to its subscriber (in case non-NULL +subscriber was specified during pointer creation). + +You can specify NULL new_ptr, in which case is_owner/destroy are ignored. +************************************************************************/ +void ae_smart_ptr_assign(ae_smart_ptr *dst, void *new_ptr, ae_bool is_owner, ae_bool is_dynamic, void (*destroy)(void*)) +{ + if( dst->is_owner && dst->ptr!=NULL ) + dst->destroy(dst->ptr); + if( new_ptr!=NULL ) + { + dst->ptr = new_ptr; + dst->is_owner = is_owner; + dst->is_dynamic = is_dynamic; + dst->destroy = destroy; + } + else + { + dst->ptr = NULL; + dst->is_owner = ae_false; + dst->is_dynamic = ae_false; + dst->destroy = NULL; + } + if( dst->subscriber!=NULL ) + *(dst->subscriber) = dst->ptr; +} + + +/************************************************************************ +This function releases pointer owned by ae_smart_ptr structure: +* all internal fields are set to NULL +* destructor function for internal pointer is NOT called even when we own + this pointer. After this call ae_smart_ptr releases ownership of its + pointer and passes it to caller. +* changes in pointer are propagated to its subscriber (in case non-NULL + subscriber was specified during pointer creation). + +dst destination smart pointer. +************************************************************************/ +void ae_smart_ptr_release(ae_smart_ptr *dst) +{ + dst->is_owner = ae_false; + dst->is_dynamic = ae_false; + dst->ptr = NULL; + dst->destroy = NULL; + if( dst->subscriber!=NULL ) + *(dst->subscriber) = NULL; +} + +/************************************************************************ +This function fills x_vector by ae_vector's contents: + +dst destination vector +src source, vector in x-format +state ALGLIB environment state + +NOTES: +* dst is assumed to be initialized. Its contents is freed before copying + data from src (if size / type are different) or overwritten (if + possible given destination size). +************************************************************************/ +void ae_x_set_vector(x_vector *dst, ae_vector *src, ae_state *state) +{ + if( dst->cnt!=src->cnt || dst->datatype!=src->datatype ) + { + if( dst->owner==OWN_AE ) + ae_free(dst->ptr); + dst->ptr = ae_malloc((size_t)(src->cnt*ae_sizeof(src->datatype)), state); + dst->last_action = ACT_NEW_LOCATION; + dst->cnt = src->cnt; + dst->datatype = src->datatype; + dst->owner = OWN_AE; + } + else + dst->last_action = ACT_SAME_LOCATION; + if( src->cnt ) + memcpy(dst->ptr, src->ptr.p_ptr, (size_t)(src->cnt*ae_sizeof(src->datatype))); +} + +/************************************************************************ +This function fills x_matrix by ae_matrix's contents: + +dst destination vector +src source, matrix in x-format +state ALGLIB environment state + +NOTES: +* dst is assumed to be initialized. Its contents is freed before copying + data from src (if size / type are different) or overwritten (if + possible given destination size). +************************************************************************/ +void ae_x_set_matrix(x_matrix *dst, ae_matrix *src, ae_state *state) +{ + char *p_src_row; + char *p_dst_row; + ae_int_t i; + ae_int_t row_size; + if( dst->rows!=src->rows || dst->cols!=src->cols || dst->datatype!=src->datatype ) + { + if( dst->owner==OWN_AE ) + ae_free(dst->ptr); + dst->rows = src->rows; + dst->cols = src->cols; + dst->stride = src->cols; + dst->datatype = src->datatype; + dst->ptr = ae_malloc((size_t)(dst->rows*((ae_int_t)dst->stride)*ae_sizeof(src->datatype)), state); + dst->last_action = ACT_NEW_LOCATION; + dst->owner = OWN_AE; + } + else + dst->last_action = ACT_SAME_LOCATION; + if( src->rows!=0 && src->cols!=0 ) + { + p_src_row = (char*)(src->ptr.pp_void[0]); + p_dst_row = (char*)dst->ptr; + row_size = ae_sizeof(src->datatype)*src->cols; + for(i=0; irows; i++, p_src_row+=src->stride*ae_sizeof(src->datatype), p_dst_row+=dst->stride*ae_sizeof(src->datatype)) + memcpy(p_dst_row, p_src_row, (size_t)(row_size)); + } +} + +/************************************************************************ +This function attaches x_vector to ae_vector's contents. +Ownership of memory allocated is not changed (it is still managed by +ae_matrix). + +dst destination vector +src source, vector in x-format +state ALGLIB environment state + +NOTES: +* dst is assumed to be initialized. Its contents is freed before + attaching to src. +* this function doesn't need ae_state parameter because it can't fail + (assuming correctly initialized src) +************************************************************************/ +void ae_x_attach_to_vector(x_vector *dst, ae_vector *src) +{ + if( dst->owner==OWN_AE ) + ae_free(dst->ptr); + dst->ptr = src->ptr.p_ptr; + dst->last_action = ACT_NEW_LOCATION; + dst->cnt = src->cnt; + dst->datatype = src->datatype; + dst->owner = OWN_CALLER; +} + +/************************************************************************ +This function attaches x_matrix to ae_matrix's contents. +Ownership of memory allocated is not changed (it is still managed by +ae_matrix). + +dst destination vector +src source, matrix in x-format +state ALGLIB environment state + +NOTES: +* dst is assumed to be initialized. Its contents is freed before + attaching to src. +* this function doesn't need ae_state parameter because it can't fail + (assuming correctly initialized src) +************************************************************************/ +void ae_x_attach_to_matrix(x_matrix *dst, ae_matrix *src) +{ + if( dst->owner==OWN_AE ) + ae_free(dst->ptr); + dst->rows = src->rows; + dst->cols = src->cols; + dst->stride = src->stride; + dst->datatype = src->datatype; + dst->ptr = &(src->ptr.pp_double[0][0]); + dst->last_action = ACT_NEW_LOCATION; + dst->owner = OWN_CALLER; +} + +/************************************************************************ +This function clears x_vector. It does nothing if vector is not owned by +ALGLIB environment. + +dst vector +************************************************************************/ +void x_vector_clear(x_vector *dst) +{ + if( dst->owner==OWN_AE ) + aligned_free(dst->ptr); + dst->ptr = NULL; + dst->cnt = 0; +} + +/************************************************************************ +Assertion +************************************************************************/ +void ae_assert(ae_bool cond, const char *msg, ae_state *state) +{ + if( !cond ) + ae_break(state, ERR_ASSERTION_FAILED, msg); +} + +/************************************************************************ +CPUID + +Returns information about features CPU and compiler support. + +You must tell ALGLIB what CPU family is used by defining AE_CPU symbol +(without this hint zero will be returned). + +Note: results of this function depend on both CPU and compiler; +if compiler doesn't support SSE intrinsics, function won't set +corresponding flag. +************************************************************************/ +static volatile ae_bool _ae_cpuid_initialized = ae_false; +static volatile ae_bool _ae_cpuid_has_sse2 = ae_false; +ae_int_t ae_cpuid() +{ + /* + * to speed up CPU detection we cache results from previous attempts + * there is no synchronization, but it is still thread safe. + * + * thread safety is guaranteed on all modern architectures which + * have following property: simultaneous writes by different cores + * to the same location will be executed in serial manner. + * + */ + ae_int_t result; + + /* + * if not initialized, determine system properties + */ + if( !_ae_cpuid_initialized ) + { + /* + * SSE2 + */ +#if defined(AE_CPU) +#if (AE_CPU==AE_INTEL) && defined(AE_HAS_SSE2_INTRINSICS) +#if AE_COMPILER==AE_MSVC + { + int CPUInfo[4]; + __cpuid(CPUInfo, 1); + if( (CPUInfo[3]&0x04000000)!=0 ) + _ae_cpuid_has_sse2 = ae_true; + } +#elif AE_COMPILER==AE_GNUC + { + ae_int_t a,b,c,d; + __asm__ __volatile__ ("cpuid": "=a" (a), "=b" (b), "=c" (c), "=d" (d) : "a" (1)); + if( (d&0x04000000)!=0 ) + _ae_cpuid_has_sse2 = ae_true; + } +#elif AE_COMPILER==AE_SUNC + { + ae_int_t a,b,c,d; + __asm__ __volatile__ ("cpuid": "=a" (a), "=b" (b), "=c" (c), "=d" (d) : "a" (1)); + if( (d&0x04000000)!=0 ) + _ae_cpuid_has_sse2 = ae_true; + } +#else +#endif +#endif +#endif + /* + * set initialization flag + */ + _ae_cpuid_initialized = ae_true; + } + + /* + * return + */ + result = 0; + if( _ae_cpuid_has_sse2 ) + result = result|CPU_SSE2; + return result; +} + +/************************************************************************ +Real math functions +************************************************************************/ +ae_bool ae_fp_eq(double v1, double v2) +{ + /* IEEE-strict floating point comparison */ + volatile double x = v1; + volatile double y = v2; + return x==y; +} + +ae_bool ae_fp_neq(double v1, double v2) +{ + /* IEEE-strict floating point comparison */ + return !ae_fp_eq(v1,v2); +} + +ae_bool ae_fp_less(double v1, double v2) +{ + /* IEEE-strict floating point comparison */ + volatile double x = v1; + volatile double y = v2; + return xy; +} + +ae_bool ae_fp_greater_eq(double v1, double v2) +{ + /* IEEE-strict floating point comparison */ + volatile double x = v1; + volatile double y = v2; + return x>=y; +} + +ae_bool ae_isfinite_stateless(double x, ae_int_t endianness) +{ + union _u + { + double a; + ae_int32_t p[2]; + } u; + ae_int32_t high; + u.a = x; + if( endianness==AE_LITTLE_ENDIAN ) + high = u.p[1]; + else + high = u.p[0]; + return (high & (ae_int32_t)0x7FF00000)!=(ae_int32_t)0x7FF00000; +} + +ae_bool ae_isnan_stateless(double x, ae_int_t endianness) +{ + union _u + { + double a; + ae_int32_t p[2]; + } u; + ae_int32_t high, low; + u.a = x; + if( endianness==AE_LITTLE_ENDIAN ) + { + high = u.p[1]; + low = u.p[0]; + } + else + { + high = u.p[0]; + low = u.p[1]; + } + return ((high &0x7FF00000)==0x7FF00000) && (((high &0x000FFFFF)!=0) || (low!=0)); +} + +ae_bool ae_isinf_stateless(double x, ae_int_t endianness) +{ + union _u + { + double a; + ae_int32_t p[2]; + } u; + ae_int32_t high, low; + u.a = x; + if( endianness==AE_LITTLE_ENDIAN ) + { + high = u.p[1]; + low = u.p[0]; + } + else + { + high = u.p[0]; + low = u.p[1]; + } + + /* 31 least significant bits of high are compared */ + return ((high&0x7FFFFFFF)==0x7FF00000) && (low==0); +} + +ae_bool ae_isposinf_stateless(double x, ae_int_t endianness) +{ + union _u + { + double a; + ae_int32_t p[2]; + } u; + ae_int32_t high, low; + u.a = x; + if( endianness==AE_LITTLE_ENDIAN ) + { + high = u.p[1]; + low = u.p[0]; + } + else + { + high = u.p[0]; + low = u.p[1]; + } + + /* all 32 bits of high are compared */ + return (high==(ae_int32_t)0x7FF00000) && (low==0); +} + +ae_bool ae_isneginf_stateless(double x, ae_int_t endianness) +{ + union _u + { + double a; + ae_int32_t p[2]; + } u; + ae_int32_t high, low; + u.a = x; + if( endianness==AE_LITTLE_ENDIAN ) + { + high = u.p[1]; + low = u.p[0]; + } + else + { + high = u.p[0]; + low = u.p[1]; + } + + /* this code is a bit tricky to avoid comparison of high with 0xFFF00000, which may be unsafe with some buggy compilers */ + return ((high&0x7FFFFFFF)==0x7FF00000) && (high!=(ae_int32_t)0x7FF00000) && (low==0); +} + +ae_int_t ae_get_endianness() +{ + union + { + double a; + ae_int32_t p[2]; + } u; + + /* + * determine endianness + * two types are supported: big-endian and little-endian. + * mixed-endian hardware is NOT supported. + * + * 1983 is used as magic number because its non-periodic double + * representation allow us to easily distinguish between upper + * and lower halfs and to detect mixed endian hardware. + * + */ + u.a = 1.0/1983.0; + if( u.p[1]==(ae_int32_t)0x3f408642 ) + return AE_LITTLE_ENDIAN; + if( u.p[0]==(ae_int32_t)0x3f408642 ) + return AE_BIG_ENDIAN; + return AE_MIXED_ENDIAN; +} + +ae_bool ae_isfinite(double x,ae_state *state) +{ + return ae_isfinite_stateless(x, state->endianness); +} + +ae_bool ae_isnan(double x, ae_state *state) +{ + return ae_isnan_stateless(x, state->endianness); +} + +ae_bool ae_isinf(double x, ae_state *state) +{ + return ae_isinf_stateless(x, state->endianness); +} + +ae_bool ae_isposinf(double x,ae_state *state) +{ + return ae_isposinf_stateless(x, state->endianness); +} + +ae_bool ae_isneginf(double x,ae_state *state) +{ + return ae_isneginf_stateless(x, state->endianness); +} + +double ae_fabs(double x, ae_state *state) +{ + return fabs(x); +} + +ae_int_t ae_iabs(ae_int_t x, ae_state *state) +{ + return x>=0 ? x : -x; +} + +double ae_sqr(double x, ae_state *state) +{ + return x*x; +} + +double ae_sqrt(double x, ae_state *state) +{ + return sqrt(x); +} + +ae_int_t ae_sign(double x, ae_state *state) +{ + if( x>0 ) return 1; + if( x<0 ) return -1; + return 0; +} + +ae_int_t ae_round(double x, ae_state *state) +{ + return (ae_int_t)(ae_ifloor(x+0.5,state)); +} + +ae_int_t ae_trunc(double x, ae_state *state) +{ + return (ae_int_t)(x>0 ? ae_ifloor(x,state) : ae_iceil(x,state)); +} + +ae_int_t ae_ifloor(double x, ae_state *state) +{ + return (ae_int_t)(floor(x)); +} + +ae_int_t ae_iceil(double x, ae_state *state) +{ + return (ae_int_t)(ceil(x)); +} + +ae_int_t ae_maxint(ae_int_t m1, ae_int_t m2, ae_state *state) +{ + return m1>m2 ? m1 : m2; +} + +ae_int_t ae_minint(ae_int_t m1, ae_int_t m2, ae_state *state) +{ + return m1>m2 ? m2 : m1; +} + +double ae_maxreal(double m1, double m2, ae_state *state) +{ + return m1>m2 ? m1 : m2; +} + +double ae_minreal(double m1, double m2, ae_state *state) +{ + return m1>m2 ? m2 : m1; +} + +#ifdef AE_DEBUGRNG +ae_int_t ae_debugrng() +{ + ae_int_t k; + ae_int_t result; + k = _debug_rng_s0/53668; + _debug_rng_s0 = 40014*(_debug_rng_s0-k*53668)-k*12211; + if( _debug_rng_s0<0 ) + _debug_rng_s0 = _debug_rng_s0+2147483563; + k = _debug_rng_s1/52774; + _debug_rng_s1 = 40692*(_debug_rng_s1-k*52774)-k*3791; + if( _debug_rng_s1<0 ) + _debug_rng_s1 = _debug_rng_s1+2147483399; + result = _debug_rng_s0-_debug_rng_s1; + if( result<1 ) + result = result+2147483562; + return result; +} +#endif + +double ae_randomreal(ae_state *state) +{ +#ifdef AE_DEBUGRNG + return ae_debugrng()/2147483563.0; +#else + int i1 = rand(); + int i2 = rand(); + double mx = (double)(RAND_MAX)+1.0; + volatile double tmp0 = i2/mx; + volatile double tmp1 = i1+tmp0; + return tmp1/mx; +#endif +} + +ae_int_t ae_randominteger(ae_int_t maxv, ae_state *state) +{ +#ifdef AE_DEBUGRNG + return (ae_debugrng()-1)%maxv; +#else + return rand()%maxv; +#endif +} + +double ae_sin(double x, ae_state *state) +{ + return sin(x); +} + +double ae_cos(double x, ae_state *state) +{ + return cos(x); +} + +double ae_tan(double x, ae_state *state) +{ + return tan(x); +} + +double ae_sinh(double x, ae_state *state) +{ + return sinh(x); +} + +double ae_cosh(double x, ae_state *state) +{ + return cosh(x); +} +double ae_tanh(double x, ae_state *state) +{ + return tanh(x); +} + +double ae_asin(double x, ae_state *state) +{ + return asin(x); +} + +double ae_acos(double x, ae_state *state) +{ + return acos(x); +} + +double ae_atan(double x, ae_state *state) +{ + return atan(x); +} + +double ae_atan2(double y, double x, ae_state *state) +{ + return atan2(y,x); +} + +double ae_log(double x, ae_state *state) +{ + return log(x); +} + +double ae_pow(double x, double y, ae_state *state) +{ + return pow(x,y); +} + +double ae_exp(double x, ae_state *state) +{ + return exp(x); +} + +/************************************************************************ +Symmetric/Hermitian properties: check and force +************************************************************************/ +static void x_split_length(ae_int_t n, ae_int_t nb, ae_int_t* n1, ae_int_t* n2) +{ + ae_int_t r; + if( n<=nb ) + { + *n1 = n; + *n2 = 0; + } + else + { + if( n%nb!=0 ) + { + *n2 = n%nb; + *n1 = n-(*n2); + } + else + { + *n2 = n/2; + *n1 = n-(*n2); + if( *n1%nb==0 ) + { + return; + } + r = nb-*n1%nb; + *n1 = *n1+r; + *n2 = *n2-r; + } + } +} +static double x_safepythag2(double x, double y) +{ + double w; + double xabs; + double yabs; + double z; + xabs = fabs(x); + yabs = fabs(y); + w = xabs>yabs ? xabs : yabs; + z = xabsx_nb || len1>x_nb ) + { + ae_int_t n1, n2; + if( len0>len1 ) + { + x_split_length(len0, x_nb, &n1, &n2); + is_symmetric_rec_off_stat(a, offset0, offset1, n1, len1, nonfinite, mx, err, _state); + is_symmetric_rec_off_stat(a, offset0+n1, offset1, n2, len1, nonfinite, mx, err, _state); + } + else + { + x_split_length(len1, x_nb, &n1, &n2); + is_symmetric_rec_off_stat(a, offset0, offset1, len0, n1, nonfinite, mx, err, _state); + is_symmetric_rec_off_stat(a, offset0, offset1+n1, len0, n2, nonfinite, mx, err, _state); + } + return; + } + else + { + /* base case */ + double *p1, *p2, *prow, *pcol; + double v; + ae_int_t i, j; + + p1 = (double*)(a->ptr)+offset0*a->stride+offset1; + p2 = (double*)(a->ptr)+offset1*a->stride+offset0; + for(i=0; istride; + for(j=0; jv ? *mx : v; + v = fabs(*prow); + *mx = *mx>v ? *mx : v; + v = fabs(*pcol-*prow); + *err = *err>v ? *err : v; + } + pcol += a->stride; + prow++; + } + } + } +} +/* + * this function checks that diagonal block A0 is symmetric. + * Block A0 is specified by its offset and size. + * + * [ . ] + * [ A0 ] + * A = [ . ] + * [ . ] + * + * this subroutine updates current values of: + * a) mx maximum value of A[i,j] found so far + * b) err componentwise difference between A0 and A0^T + * + */ +static void is_symmetric_rec_diag_stat(x_matrix *a, ae_int_t offset, ae_int_t len, ae_bool *nonfinite, double *mx, double *err, ae_state *_state) +{ + double *p, *prow, *pcol; + double v; + ae_int_t i, j; + + /* try to split problem into two smaller ones */ + if( len>x_nb ) + { + ae_int_t n1, n2; + x_split_length(len, x_nb, &n1, &n2); + is_symmetric_rec_diag_stat(a, offset, n1, nonfinite, mx, err, _state); + is_symmetric_rec_diag_stat(a, offset+n1, n2, nonfinite, mx, err, _state); + is_symmetric_rec_off_stat(a, offset+n1, offset, n2, n1, nonfinite, mx, err, _state); + return; + } + + /* base case */ + p = (double*)(a->ptr)+offset*a->stride+offset; + for(i=0; istride; + for(j=0; jstride,prow++) + { + if( !ae_isfinite(*pcol,_state) || !ae_isfinite(*prow,_state) ) + { + *nonfinite = ae_true; + } + else + { + v = fabs(*pcol); + *mx = *mx>v ? *mx : v; + v = fabs(*prow); + *mx = *mx>v ? *mx : v; + v = fabs(*pcol-*prow); + *err = *err>v ? *err : v; + } + } + v = fabs(p[i+i*a->stride]); + *mx = *mx>v ? *mx : v; + } +} +/* + * this function checks difference between offdiagonal blocks BL and BU + * (see below). Block BL is specified by offsets (offset0,offset1) and + * sizes (len0,len1). + * + * [ . ] + * [ A0 BU ] + * A = [ BL A1 ] + * [ . ] + * + * this subroutine updates current values of: + * a) mx maximum value of A[i,j] found so far + * b) err componentwise difference between elements of BL and BU^H + * + */ +static void is_hermitian_rec_off_stat(x_matrix *a, ae_int_t offset0, ae_int_t offset1, ae_int_t len0, ae_int_t len1, ae_bool *nonfinite, double *mx, double *err, ae_state *_state) +{ + /* try to split problem into two smaller ones */ + if( len0>x_nb || len1>x_nb ) + { + ae_int_t n1, n2; + if( len0>len1 ) + { + x_split_length(len0, x_nb, &n1, &n2); + is_hermitian_rec_off_stat(a, offset0, offset1, n1, len1, nonfinite, mx, err, _state); + is_hermitian_rec_off_stat(a, offset0+n1, offset1, n2, len1, nonfinite, mx, err, _state); + } + else + { + x_split_length(len1, x_nb, &n1, &n2); + is_hermitian_rec_off_stat(a, offset0, offset1, len0, n1, nonfinite, mx, err, _state); + is_hermitian_rec_off_stat(a, offset0, offset1+n1, len0, n2, nonfinite, mx, err, _state); + } + return; + } + else + { + /* base case */ + ae_complex *p1, *p2, *prow, *pcol; + double v; + ae_int_t i, j; + + p1 = (ae_complex*)(a->ptr)+offset0*a->stride+offset1; + p2 = (ae_complex*)(a->ptr)+offset1*a->stride+offset0; + for(i=0; istride; + for(j=0; jx, _state) || !ae_isfinite(pcol->y, _state) || !ae_isfinite(prow->x, _state) || !ae_isfinite(prow->y, _state) ) + { + *nonfinite = ae_true; + } + else + { + v = x_safepythag2(pcol->x, pcol->y); + *mx = *mx>v ? *mx : v; + v = x_safepythag2(prow->x, prow->y); + *mx = *mx>v ? *mx : v; + v = x_safepythag2(pcol->x-prow->x, pcol->y+prow->y); + *err = *err>v ? *err : v; + } + pcol += a->stride; + prow++; + } + } + } +} +/* + * this function checks that diagonal block A0 is Hermitian. + * Block A0 is specified by its offset and size. + * + * [ . ] + * [ A0 ] + * A = [ . ] + * [ . ] + * + * this subroutine updates current values of: + * a) mx maximum value of A[i,j] found so far + * b) err componentwise difference between A0 and A0^H + * + */ +static void is_hermitian_rec_diag_stat(x_matrix *a, ae_int_t offset, ae_int_t len, ae_bool *nonfinite, double *mx, double *err, ae_state *_state) +{ + ae_complex *p, *prow, *pcol; + double v; + ae_int_t i, j; + + /* try to split problem into two smaller ones */ + if( len>x_nb ) + { + ae_int_t n1, n2; + x_split_length(len, x_nb, &n1, &n2); + is_hermitian_rec_diag_stat(a, offset, n1, nonfinite, mx, err, _state); + is_hermitian_rec_diag_stat(a, offset+n1, n2, nonfinite, mx, err, _state); + is_hermitian_rec_off_stat(a, offset+n1, offset, n2, n1, nonfinite, mx, err, _state); + return; + } + + /* base case */ + p = (ae_complex*)(a->ptr)+offset*a->stride+offset; + for(i=0; istride; + for(j=0; jstride,prow++) + { + if( !ae_isfinite(pcol->x, _state) || !ae_isfinite(pcol->y, _state) || !ae_isfinite(prow->x, _state) || !ae_isfinite(prow->y, _state) ) + { + *nonfinite = ae_true; + } + else + { + v = x_safepythag2(pcol->x, pcol->y); + *mx = *mx>v ? *mx : v; + v = x_safepythag2(prow->x, prow->y); + *mx = *mx>v ? *mx : v; + v = x_safepythag2(pcol->x-prow->x, pcol->y+prow->y); + *err = *err>v ? *err : v; + } + } + if( !ae_isfinite(p[i+i*a->stride].x, _state) || !ae_isfinite(p[i+i*a->stride].y, _state) ) + { + *nonfinite = ae_true; + } + else + { + v = fabs(p[i+i*a->stride].x); + *mx = *mx>v ? *mx : v; + v = fabs(p[i+i*a->stride].y); + *err = *err>v ? *err : v; + } + } +} +/* + * this function copies offdiagonal block BL to its symmetric counterpart + * BU (see below). Block BL is specified by offsets (offset0,offset1) + * and sizes (len0,len1). + * + * [ . ] + * [ A0 BU ] + * A = [ BL A1 ] + * [ . ] + * + */ +static void force_symmetric_rec_off_stat(x_matrix *a, ae_int_t offset0, ae_int_t offset1, ae_int_t len0, ae_int_t len1) +{ + /* try to split problem into two smaller ones */ + if( len0>x_nb || len1>x_nb ) + { + ae_int_t n1, n2; + if( len0>len1 ) + { + x_split_length(len0, x_nb, &n1, &n2); + force_symmetric_rec_off_stat(a, offset0, offset1, n1, len1); + force_symmetric_rec_off_stat(a, offset0+n1, offset1, n2, len1); + } + else + { + x_split_length(len1, x_nb, &n1, &n2); + force_symmetric_rec_off_stat(a, offset0, offset1, len0, n1); + force_symmetric_rec_off_stat(a, offset0, offset1+n1, len0, n2); + } + return; + } + else + { + /* base case */ + double *p1, *p2, *prow, *pcol; + ae_int_t i, j; + + p1 = (double*)(a->ptr)+offset0*a->stride+offset1; + p2 = (double*)(a->ptr)+offset1*a->stride+offset0; + for(i=0; istride; + for(j=0; jstride; + prow++; + } + } + } +} +/* + * this function copies lower part of diagonal block A0 to its upper part + * Block is specified by offset and size. + * + * [ . ] + * [ A0 ] + * A = [ . ] + * [ . ] + * + */ +static void force_symmetric_rec_diag_stat(x_matrix *a, ae_int_t offset, ae_int_t len) +{ + double *p, *prow, *pcol; + ae_int_t i, j; + + /* try to split problem into two smaller ones */ + if( len>x_nb ) + { + ae_int_t n1, n2; + x_split_length(len, x_nb, &n1, &n2); + force_symmetric_rec_diag_stat(a, offset, n1); + force_symmetric_rec_diag_stat(a, offset+n1, n2); + force_symmetric_rec_off_stat(a, offset+n1, offset, n2, n1); + return; + } + + /* base case */ + p = (double*)(a->ptr)+offset*a->stride+offset; + for(i=0; istride; + for(j=0; jstride,prow++) + *pcol = *prow; + } +} +/* + * this function copies Hermitian transpose of offdiagonal block BL to + * its symmetric counterpart BU (see below). Block BL is specified by + * offsets (offset0,offset1) and sizes (len0,len1). + * + * [ . ] + * [ A0 BU ] + * A = [ BL A1 ] + * [ . ] + */ +static void force_hermitian_rec_off_stat(x_matrix *a, ae_int_t offset0, ae_int_t offset1, ae_int_t len0, ae_int_t len1) +{ + /* try to split problem into two smaller ones */ + if( len0>x_nb || len1>x_nb ) + { + ae_int_t n1, n2; + if( len0>len1 ) + { + x_split_length(len0, x_nb, &n1, &n2); + force_hermitian_rec_off_stat(a, offset0, offset1, n1, len1); + force_hermitian_rec_off_stat(a, offset0+n1, offset1, n2, len1); + } + else + { + x_split_length(len1, x_nb, &n1, &n2); + force_hermitian_rec_off_stat(a, offset0, offset1, len0, n1); + force_hermitian_rec_off_stat(a, offset0, offset1+n1, len0, n2); + } + return; + } + else + { + /* base case */ + ae_complex *p1, *p2, *prow, *pcol; + ae_int_t i, j; + + p1 = (ae_complex*)(a->ptr)+offset0*a->stride+offset1; + p2 = (ae_complex*)(a->ptr)+offset1*a->stride+offset0; + for(i=0; istride; + for(j=0; jstride; + prow++; + } + } + } +} +/* + * this function copies Hermitian transpose of lower part of + * diagonal block A0 to its upper part Block is specified by offset and size. + * + * [ . ] + * [ A0 ] + * A = [ . ] + * [ . ] + * + */ +static void force_hermitian_rec_diag_stat(x_matrix *a, ae_int_t offset, ae_int_t len) +{ + ae_complex *p, *prow, *pcol; + ae_int_t i, j; + + /* try to split problem into two smaller ones */ + if( len>x_nb ) + { + ae_int_t n1, n2; + x_split_length(len, x_nb, &n1, &n2); + force_hermitian_rec_diag_stat(a, offset, n1); + force_hermitian_rec_diag_stat(a, offset+n1, n2); + force_hermitian_rec_off_stat(a, offset+n1, offset, n2, n1); + return; + } + + /* base case */ + p = (ae_complex*)(a->ptr)+offset*a->stride+offset; + for(i=0; istride; + for(j=0; jstride,prow++) + *pcol = *prow; + } +} +ae_bool x_is_symmetric(x_matrix *a) +{ + double mx, err; + ae_bool nonfinite; + ae_state _alglib_env_state; + if( a->datatype!=DT_REAL ) + return ae_false; + if( a->cols!=a->rows ) + return ae_false; + if( a->cols==0 || a->rows==0 ) + return ae_true; + ae_state_init(&_alglib_env_state); + mx = 0; + err = 0; + nonfinite = ae_false; + is_symmetric_rec_diag_stat(a, 0, (ae_int_t)a->rows, &nonfinite, &mx, &err, &_alglib_env_state); + if( nonfinite ) + return ae_false; + if( mx==0 ) + return ae_true; + return err/mx<=1.0E-14; +} +ae_bool x_is_hermitian(x_matrix *a) +{ + double mx, err; + ae_bool nonfinite; + ae_state _alglib_env_state; + if( a->datatype!=DT_COMPLEX ) + return ae_false; + if( a->cols!=a->rows ) + return ae_false; + if( a->cols==0 || a->rows==0 ) + return ae_true; + ae_state_init(&_alglib_env_state); + mx = 0; + err = 0; + nonfinite = ae_false; + is_hermitian_rec_diag_stat(a, 0, (ae_int_t)a->rows, &nonfinite, &mx, &err, &_alglib_env_state); + if( nonfinite ) + return ae_false; + if( mx==0 ) + return ae_true; + return err/mx<=1.0E-14; +} +ae_bool x_force_symmetric(x_matrix *a) +{ + if( a->datatype!=DT_REAL ) + return ae_false; + if( a->cols!=a->rows ) + return ae_false; + if( a->cols==0 || a->rows==0 ) + return ae_true; + force_symmetric_rec_diag_stat(a, 0, (ae_int_t)a->rows); + return ae_true; +} +ae_bool x_force_hermitian(x_matrix *a) +{ + if( a->datatype!=DT_COMPLEX ) + return ae_false; + if( a->cols!=a->rows ) + return ae_false; + if( a->cols==0 || a->rows==0 ) + return ae_true; + force_hermitian_rec_diag_stat(a, 0, (ae_int_t)a->rows); + return ae_true; +} + +ae_bool ae_is_symmetric(ae_matrix *a) +{ + x_matrix x; + x.owner = OWN_CALLER; + ae_x_attach_to_matrix(&x, a); + return x_is_symmetric(&x); +} + +ae_bool ae_is_hermitian(ae_matrix *a) +{ + x_matrix x; + x.owner = OWN_CALLER; + ae_x_attach_to_matrix(&x, a); + return x_is_hermitian(&x); +} + +ae_bool ae_force_symmetric(ae_matrix *a) +{ + x_matrix x; + x.owner = OWN_CALLER; + ae_x_attach_to_matrix(&x, a); + return x_force_symmetric(&x); +} + +ae_bool ae_force_hermitian(ae_matrix *a) +{ + x_matrix x; + x.owner = OWN_CALLER; + ae_x_attach_to_matrix(&x, a); + return x_force_hermitian(&x); +} + +/************************************************************************ +This function converts six-bit value (from 0 to 63) to character (only +digits, lowercase and uppercase letters, minus and underscore are used). + +If v is negative or greater than 63, this function returns '?'. +************************************************************************/ +static char _sixbits2char_tbl[64] = { + '0', '1', '2', '3', '4', '5', '6', '7', + '8', '9', 'A', 'B', 'C', 'D', 'E', 'F', + 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', + 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', + 'W', 'X', 'Y', 'Z', 'a', 'b', 'c', 'd', + 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', + 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', + 'u', 'v', 'w', 'x', 'y', 'z', '-', '_' }; + +char ae_sixbits2char(ae_int_t v) +{ + + if( v<0 || v>63 ) + return '?'; + return _sixbits2char_tbl[v]; + + /* v is correct, process it */ + /*if( v<10 ) + return '0'+v; + v -= 10; + if( v<26 ) + return 'A'+v; + v -= 26; + if( v<26 ) + return 'a'+v; + v -= 26; + return v==0 ? '-' : '_';*/ +} + +/************************************************************************ +This function converts character to six-bit value (from 0 to 63). + +This function is inverse of ae_sixbits2char() +If c is not correct character, this function returns -1. +************************************************************************/ +static ae_int_t _ae_char2sixbits_tbl[] = { + -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 62, -1, -1, + 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, -1, -1, -1, -1, -1, -1, + -1, 10, 11, 12, 13, 14, 15, 16, + 17, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32, + 33, 34, 35, -1, -1, -1, -1, 63, + -1, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 46, 47, 48, 49, 50, + 51, 52, 53, 54, 55, 56, 57, 58, + 59, 60, 61, -1, -1, -1, -1, -1 }; +ae_int_t ae_char2sixbits(char c) +{ + return (c>=0 && c<127) ? _ae_char2sixbits_tbl[(int)c] : -1; +} + +/************************************************************************ +This function converts three bytes (24 bits) to four six-bit values +(24 bits again). + +src pointer to three bytes +dst pointer to four ints +************************************************************************/ +void ae_threebytes2foursixbits(const unsigned char *src, ae_int_t *dst) +{ + dst[0] = src[0] & 0x3F; + dst[1] = (src[0]>>6) | ((src[1]&0x0F)<<2); + dst[2] = (src[1]>>4) | ((src[2]&0x03)<<4); + dst[3] = src[2]>>2; +} + +/************************************************************************ +This function converts four six-bit values (24 bits) to three bytes +(24 bits again). + +src pointer to four ints +dst pointer to three bytes +************************************************************************/ +void ae_foursixbits2threebytes(const ae_int_t *src, unsigned char *dst) +{ + dst[0] = (unsigned char)( src[0] | ((src[1]&0x03)<<6)); + dst[1] = (unsigned char)((src[1]>>2) | ((src[2]&0x0F)<<4)); + dst[2] = (unsigned char)((src[2]>>4) | (src[3]<<2)); +} + +/************************************************************************ +This function serializes boolean value into buffer + +v boolean value to be serialized +buf buffer, at least 12 characters wide + (11 chars for value, one for trailing zero) +state ALGLIB environment state +************************************************************************/ +void ae_bool2str(ae_bool v, char *buf, ae_state *state) +{ + char c = v ? '1' : '0'; + ae_int_t i; + for(i=0; iendianness==AE_BIG_ENDIAN ) + { + for(i=0; i<(ae_int_t)(sizeof(ae_int_t)/2); i++) + { + unsigned char tc; + tc = u.bytes[i]; + u.bytes[i] = u.bytes[sizeof(ae_int_t)-1-i]; + u.bytes[sizeof(ae_int_t)-1-i] = tc; + } + } + + /* + * convert to six-bit representation, output + * + * NOTE: last 12th element of sixbits is always zero, we do not output it + */ + ae_threebytes2foursixbits(u.bytes+0, sixbits+0); + ae_threebytes2foursixbits(u.bytes+3, sixbits+4); + ae_threebytes2foursixbits(u.bytes+6, sixbits+8); + for(i=0; i=AE_SER_ENTRY_LENGTH ) + ae_break(state, ERR_ASSERTION_FAILED, emsg); + sixbits[sixbitsread] = d; + sixbitsread++; + buf++; + } + *pasttheend = buf; + if( sixbitsread==0 ) + ae_break(state, ERR_ASSERTION_FAILED, emsg); + for(i=sixbitsread; i<12; i++) + sixbits[i] = 0; + ae_foursixbits2threebytes(sixbits+0, u.bytes+0); + ae_foursixbits2threebytes(sixbits+4, u.bytes+3); + ae_foursixbits2threebytes(sixbits+8, u.bytes+6); + if( state->endianness==AE_BIG_ENDIAN ) + { + for(i=0; i<(ae_int_t)(sizeof(ae_int_t)/2); i++) + { + unsigned char tc; + tc = u.bytes[i]; + u.bytes[i] = u.bytes[sizeof(ae_int_t)-1-i]; + u.bytes[sizeof(ae_int_t)-1-i] = tc; + } + } + return u.ival; +} + + +/************************************************************************ +This function serializes double value into buffer + +v double value to be serialized +buf buffer, at least 12 characters wide + (11 chars for value, one for trailing zero) +state ALGLIB environment state +************************************************************************/ +void ae_double2str(double v, char *buf, ae_state *state) +{ + union _u + { + double dval; + unsigned char bytes[9]; + } u; + ae_int_t i; + ae_int_t sixbits[12]; + + /* + * handle special quantities + */ + if( ae_isnan(v, state) ) + { + const char *s = ".nan_______"; + memcpy(buf, s, strlen(s)+1); + return; + } + if( ae_isposinf(v, state) ) + { + const char *s = ".posinf____"; + memcpy(buf, s, strlen(s)+1); + return; + } + if( ae_isneginf(v, state) ) + { + const char *s = ".neginf____"; + memcpy(buf, s, strlen(s)+1); + return; + } + + /* + * process general case: + * 1. copy v to array of chars + * 2. set 9th byte of u.bytes to zero in order to + * simplify conversion to six-bit representation + * 3. convert to little endian (if needed) + * 4. convert to six-bit representation + * (last 12th element of sixbits is always zero, we do not output it) + */ + u.dval = v; + u.bytes[8] = 0; + if( state->endianness==AE_BIG_ENDIAN ) + { + for(i=0; i<(ae_int_t)(sizeof(double)/2); i++) + { + unsigned char tc; + tc = u.bytes[i]; + u.bytes[i] = u.bytes[sizeof(double)-1-i]; + u.bytes[sizeof(double)-1-i] = tc; + } + } + ae_threebytes2foursixbits(u.bytes+0, sixbits+0); + ae_threebytes2foursixbits(u.bytes+3, sixbits+4); + ae_threebytes2foursixbits(u.bytes+6, sixbits+8); + for(i=0; iv_nan; + } + if( strncmp(buf, s_posinf, strlen(s_posinf))==0 ) + { + *pasttheend = buf+strlen(s_posinf); + return state->v_posinf; + } + if( strncmp(buf, s_neginf, strlen(s_neginf))==0 ) + { + *pasttheend = buf+strlen(s_neginf); + return state->v_neginf; + } + ae_break(state, ERR_ASSERTION_FAILED, emsg); + } + + /* + * General case: + * 1. read and decode six-bit digits + * 2. check that all 11 digits were read + * 3. set last 12th digit to zero (needed for simplicity of conversion) + * 4. convert to 8 bytes + * 5. convert to big endian representation, if needed + */ + sixbitsread = 0; + while( *buf!=' ' && *buf!='\t' && *buf!='\n' && *buf!='\r' && *buf!=0 ) + { + ae_int_t d; + d = ae_char2sixbits(*buf); + if( d<0 || sixbitsread>=AE_SER_ENTRY_LENGTH ) + ae_break(state, ERR_ASSERTION_FAILED, emsg); + sixbits[sixbitsread] = d; + sixbitsread++; + buf++; + } + *pasttheend = buf; + if( sixbitsread!=AE_SER_ENTRY_LENGTH ) + ae_break(state, ERR_ASSERTION_FAILED, emsg); + sixbits[AE_SER_ENTRY_LENGTH] = 0; + ae_foursixbits2threebytes(sixbits+0, u.bytes+0); + ae_foursixbits2threebytes(sixbits+4, u.bytes+3); + ae_foursixbits2threebytes(sixbits+8, u.bytes+6); + if( state->endianness==AE_BIG_ENDIAN ) + { + for(i=0; i<(ae_int_t)(sizeof(double)/2); i++) + { + unsigned char tc; + tc = u.bytes[i]; + u.bytes[i] = u.bytes[sizeof(double)-1-i]; + u.bytes[sizeof(double)-1-i] = tc; + } + } + return u.dval; +} + + +/************************************************************************ +This function performs given number of spin-wait iterations +************************************************************************/ +void ae_spin_wait(ae_int_t cnt) +{ + /* + * these strange operations with ae_never_change_it are necessary to + * prevent compiler optimization of the loop. + */ + volatile ae_int_t i; + + /* very unlikely because no one will wait for such amount of cycles */ + if( cnt>0x12345678 ) + ae_never_change_it = cnt%10; + + /* spin wait, test condition which will never be true */ + for(i=0; i0 ) + ae_never_change_it--; +} + + +/************************************************************************ +This function causes the calling thread to relinquish the CPU. The thread +is moved to the end of the queue and some other thread gets to run. + +NOTE: this function should NOT be called when AE_OS is AE_UNKNOWN - the + whole program will be abnormally terminated. +************************************************************************/ +void ae_yield() +{ +#if AE_OS==AE_WINDOWS + if( !SwitchToThread() ) + Sleep(0); +#elif AE_OS==AE_POSIX + sched_yield(); +#else + abort(); +#endif +} + +/************************************************************************ +This function initializes ae_lock structure and sets lock in a free mode. +************************************************************************/ +void ae_init_lock(ae_lock *lock) +{ +#if AE_OS==AE_WINDOWS + lock->p_lock = (ae_int_t*)ae_align((void*)(&lock->buf),AE_LOCK_ALIGNMENT); + lock->p_lock[0] = 0; +#elif AE_OS==AE_POSIX + pthread_mutex_init(&lock->mutex, NULL); +#else + lock->is_locked = ae_false; +#endif +} + + +/************************************************************************ +This function acquires lock. In case lock is busy, we perform several +iterations inside tight loop before trying again. +************************************************************************/ +void ae_acquire_lock(ae_lock *lock) +{ +#if AE_OS==AE_WINDOWS + ae_int_t cnt = 0; +#ifdef AE_SMP_DEBUGCOUNTERS + InterlockedIncrement((LONG volatile *)&_ae_dbg_lock_acquisitions); +#endif + for(;;) + { + if( InterlockedCompareExchange((LONG volatile *)lock->p_lock, 1, 0)==0 ) + return; + ae_spin_wait(AE_LOCK_CYCLES); +#ifdef AE_SMP_DEBUGCOUNTERS + InterlockedIncrement((LONG volatile *)&_ae_dbg_lock_spinwaits); +#endif + cnt++; + if( cnt%AE_LOCK_TESTS_BEFORE_YIELD==0 ) + { +#ifdef AE_SMP_DEBUGCOUNTERS + InterlockedIncrement((LONG volatile *)&_ae_dbg_lock_yields); +#endif + ae_yield(); + } + } +#elif AE_OS==AE_POSIX + ae_int_t cnt = 0; + for(;;) + { + if( pthread_mutex_trylock(&lock->mutex)==0 ) + return; + ae_spin_wait(AE_LOCK_CYCLES); + cnt++; + if( cnt%AE_LOCK_TESTS_BEFORE_YIELD==0 ) + ae_yield(); + } + ; +#else + AE_CRITICAL_ASSERT(!lock->is_locked); + lock->is_locked = ae_true; +#endif +} + + +/************************************************************************ +This function releases lock. +************************************************************************/ +void ae_release_lock(ae_lock *lock) +{ +#if AE_OS==AE_WINDOWS + InterlockedExchange((LONG volatile *)lock->p_lock, 0); +#elif AE_OS==AE_POSIX + pthread_mutex_unlock(&lock->mutex); +#else + lock->is_locked = ae_false; +#endif +} + + +/************************************************************************ +This function frees ae_lock structure. +************************************************************************/ +void ae_free_lock(ae_lock *lock) +{ +#if AE_OS==AE_POSIX + pthread_mutex_destroy(&lock->mutex); +#endif +} + + +/************************************************************************ +This function creates ae_shared_pool structure. + +dst destination shared pool; + already allocated, but not initialized. +state ALGLIB environment state +make_automatic if true, pool is added to the dynamic block list + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +dst is assumed to be uninitialized, its fields are ignored. +************************************************************************/ +ae_bool ae_shared_pool_init(void *_dst, ae_state *state, ae_bool make_automatic) +{ + ae_shared_pool *dst; + + dst = (ae_shared_pool*)_dst; + + /* init */ + dst->seed_object = NULL; + dst->recycled_objects = NULL; + dst->recycled_entries = NULL; + dst->enumeration_counter = NULL; + dst->size_of_object = 0; + dst->init = NULL; + dst->init_copy = NULL; + dst->destroy = NULL; + dst->frame_entry.deallocator = ae_shared_pool_destroy; + dst->frame_entry.ptr = dst; + if( make_automatic && state!=NULL ) + ae_db_attach(&dst->frame_entry, state); + ae_init_lock(&dst->pool_lock); + return ae_true; +} + + +/************************************************************************ +This function clears all dynamically allocated fields of the pool except +for the lock. It does NOT try to acquire pool_lock. + +NOTE: this function is NOT thread-safe, it is not protected by lock. +************************************************************************/ +static void ae_shared_pool_internalclear(ae_shared_pool *dst) +{ + ae_shared_pool_entry *ptr, *tmp; + + /* destroy seed */ + if( dst->seed_object!=NULL ) + { + dst->destroy((void*)dst->seed_object); + ae_free((void*)dst->seed_object); + dst->seed_object = NULL; + } + + /* destroy recycled objects */ + for(ptr=dst->recycled_objects; ptr!=NULL;) + { + tmp = (ae_shared_pool_entry*)ptr->next_entry; + dst->destroy(ptr->obj); + ae_free(ptr->obj); + ae_free(ptr); + ptr = tmp; + } + dst->recycled_objects = NULL; + + /* destroy recycled entries */ + for(ptr=dst->recycled_entries; ptr!=NULL;) + { + tmp = (ae_shared_pool_entry*)ptr->next_entry; + ae_free(ptr); + ptr = tmp; + } + dst->recycled_entries = NULL; +} + + +/************************************************************************ +This function creates copy of ae_shared_pool. + +dst destination pool, allocated but not initialized +src source pool +state ALGLIB environment state +make_automatic if true, pool is added to the dynamic block list + +Error handling: +* if state is NULL, returns ae_false on allocation error +* if state is not NULL, calls ae_break() on allocation error +* returns ae_true on success + +dst is assumed to be uninitialized, its fields are ignored. + +NOTE: this function is NOT thread-safe. It does not acquire pool lock, so + you should NOT call it when lock can be used by another thread. +************************************************************************/ +ae_bool ae_shared_pool_init_copy(void *_dst, void *_src, ae_state *state, ae_bool make_automatic) +{ + ae_shared_pool *dst, *src; + ae_shared_pool_entry *ptr; + + dst = (ae_shared_pool*)_dst; + src = (ae_shared_pool*)_src; + if( !ae_shared_pool_init(dst, state, make_automatic) ) + return ae_false; + + /* copy non-pointer fields */ + dst->size_of_object = src->size_of_object; + dst->init = src->init; + dst->init_copy = src->init_copy; + dst->destroy = src->destroy; + ae_init_lock(&dst->pool_lock); + + /* copy seed object */ + if( src->seed_object!=NULL ) + { + dst->seed_object = ae_malloc(dst->size_of_object, state); + if( dst->seed_object==NULL ) + return ae_false; + if( !dst->init_copy(dst->seed_object, src->seed_object, state, ae_false) ) + return ae_false; + } + + /* copy recycled objects */ + dst->recycled_objects = NULL; + for(ptr=src->recycled_objects; ptr!=NULL; ptr=(ae_shared_pool_entry*)ptr->next_entry) + { + ae_shared_pool_entry *tmp; + tmp = (ae_shared_pool_entry*)ae_malloc(sizeof(ae_shared_pool_entry), state); + if( tmp==NULL ) + return ae_false; + tmp->obj = ae_malloc(dst->size_of_object, state); + if( tmp->obj==NULL ) + return ae_false; + if( !dst->init_copy(tmp->obj, ptr->obj, state, ae_false) ) + return ae_false; + tmp->next_entry = dst->recycled_objects; + dst->recycled_objects = tmp; + } + + /* recycled entries are not copied because they do not store any information */ + dst->recycled_entries = NULL; + + /* enumeration counter is reset on copying */ + dst->enumeration_counter = NULL; + + /* initialize frame record */ + dst->frame_entry.deallocator = ae_shared_pool_destroy; + dst->frame_entry.ptr = dst; + + /* return */ + return ae_true; +} + + +/************************************************************************ +This function clears contents of the pool, but pool remain usable. + +IMPORTANT: this function invalidates dst, it can not be used after it is + cleared. + +NOTE: this function is NOT thread-safe. It does not acquire pool lock, so + you should NOT call it when lock can be used by another thread. +************************************************************************/ +void ae_shared_pool_clear(void *_dst) +{ + ae_shared_pool *dst = (ae_shared_pool*)_dst; + + /* clear seed and lists */ + ae_shared_pool_internalclear(dst); + + /* clear fields */ + dst->seed_object = NULL; + dst->recycled_objects = NULL; + dst->recycled_entries = NULL; + dst->enumeration_counter = NULL; + dst->size_of_object = 0; + dst->init = NULL; + dst->init_copy = NULL; + dst->destroy = NULL; +} + + +/************************************************************************ +This function destroys pool (object is left in invalid state, all +dynamically allocated memory is freed). + +NOTE: this function is NOT thread-safe. It does not acquire pool lock, so + you should NOT call it when lock can be used by another thread. +************************************************************************/ +void ae_shared_pool_destroy(void *_dst) +{ + ae_shared_pool *dst = (ae_shared_pool*)_dst; + ae_shared_pool_clear(_dst); + ae_free_lock(&dst->pool_lock); +} + + +/************************************************************************ +This function returns True, if internal seed object was set. It returns +False for un-seeded pool. + +dst destination pool (initialized by constructor function) + +NOTE: this function is NOT thread-safe. It does not acquire pool lock, so + you should NOT call it when lock can be used by another thread. +************************************************************************/ +ae_bool ae_shared_pool_is_initialized(void *_dst) +{ + ae_shared_pool *dst = (ae_shared_pool*)_dst; + return dst->seed_object!=NULL; +} + + +/************************************************************************ +This function sets internal seed object. All objects owned by the pool +(current seed object, recycled objects) are automatically freed. + +dst destination pool (initialized by constructor function) +seed_object new seed object +size_of_object sizeof(), used to allocate memory +init constructor function +init_copy copy constructor +clear destructor function +state ALGLIB environment state + +NOTE: this function is NOT thread-safe. It does not acquire pool lock, so + you should NOT call it when lock can be used by another thread. +************************************************************************/ +void ae_shared_pool_set_seed( + ae_shared_pool *dst, + void *seed_object, + ae_int_t size_of_object, + ae_bool (*init)(void* dst, ae_state* state, ae_bool make_automatic), + ae_bool (*init_copy)(void* dst, void* src, ae_state* state, ae_bool make_automatic), + void (*destroy)(void* ptr), + ae_state *state) +{ + /* destroy internal objects */ + ae_shared_pool_internalclear(dst); + + /* set non-pointer fields */ + dst->size_of_object = size_of_object; + dst->init = init; + dst->init_copy = init_copy; + dst->destroy = destroy; + + /* set seed object */ + dst->seed_object = ae_malloc(size_of_object, state); + ae_assert(dst->seed_object!=NULL, "ALGLIB: unable to allocate memory for ae_shared_pool_set_seed()", state); + ae_assert( + init_copy(dst->seed_object, seed_object, state, ae_false), + "ALGLIB: unable to initialize seed in ae_shared_pool_set_seed()", + state); +} + + +/************************************************************************ +This function retrieves a copy of the seed object from the pool and +stores it to target smart pointer ptr. + +In case target pointer owns non-NULL value, it is deallocated before +storing value retrieved from pool. Target pointer becomes owner of the +value which was retrieved from pool. + +pool pool +pptr pointer to ae_smart_ptr structure +state ALGLIB environment state + +NOTE: this function IS thread-safe. It acquires pool lock during its + operation and can be used simultaneously from several threads. +************************************************************************/ +void ae_shared_pool_retrieve( + ae_shared_pool *pool, + ae_smart_ptr *pptr, + ae_state *state) +{ + void *new_obj; + + /* assert that pool was seeded */ + ae_assert( + pool->seed_object!=NULL, + "ALGLIB: shared pool is not seeded, PoolRetrieve() failed", + state); + + /* acquire lock */ + ae_acquire_lock(&pool->pool_lock); + + /* try to reuse recycled objects */ + if( pool->recycled_objects!=NULL ) + { + void *new_obj; + ae_shared_pool_entry *result; + + /* retrieve entry/object from list of recycled objects */ + result = pool->recycled_objects; + pool->recycled_objects = (ae_shared_pool_entry*)pool->recycled_objects->next_entry; + new_obj = result->obj; + result->obj = NULL; + + /* move entry to list of recycled entries */ + result->next_entry = pool->recycled_entries; + pool->recycled_entries = result; + + /* release lock */ + ae_release_lock(&pool->pool_lock); + + /* assign object to smart pointer */ + ae_smart_ptr_assign(pptr, new_obj, ae_true, ae_true, pool->destroy); + return; + } + + /* release lock; we do not need it anymore because copy constructor does not modify source variable */ + ae_release_lock(&pool->pool_lock); + + /* create new object from seed */ + new_obj = ae_malloc(pool->size_of_object, state); + ae_assert(new_obj!=NULL, "ALGLIB: unable to allocate memory for ae_shared_pool_retrieve()", state); + ae_assert( + pool->init_copy(new_obj, pool->seed_object, state, ae_false), + "ALGLIB: unable to initialize object in ae_shared_pool_retrieve()", + state); + + /* assign object to smart pointer and return */ + ae_smart_ptr_assign(pptr, new_obj, ae_true, ae_true, pool->destroy); +} + + +/************************************************************************ +This function recycles object owned by smart pointer by moving it to +internal storage of the shared pool. + +Source pointer must own the object. After function is over, it owns NULL +pointer. + +pool pool +pptr pointer to ae_smart_ptr structure +state ALGLIB environment state + +NOTE: this function IS thread-safe. It acquires pool lock during its + operation and can be used simultaneously from several threads. +************************************************************************/ +void ae_shared_pool_recycle( + ae_shared_pool *pool, + ae_smart_ptr *pptr, + ae_state *state) +{ + ae_shared_pool_entry *new_entry; + + /* assert that pool was seeded */ + ae_assert( + pool->seed_object!=NULL, + "ALGLIB: shared pool is not seeded, PoolRecycle() failed", + state); + + /* assert that pointer non-null and owns the object */ + ae_assert(pptr->is_owner, "ALGLIB: pptr in ae_shared_pool_recycle() does not own its pointer", state); + ae_assert(pptr->ptr!=NULL, "ALGLIB: pptr in ae_shared_pool_recycle() is NULL", state); + + /* acquire lock */ + ae_acquire_lock(&pool->pool_lock); + + /* acquire shared pool entry (reuse one from recycled_entries or malloc new one) */ + if( pool->recycled_entries!=NULL ) + { + /* reuse previously allocated entry */ + new_entry = pool->recycled_entries; + pool->recycled_entries = (ae_shared_pool_entry*)new_entry->next_entry; + } + else + { + /* + * Allocate memory for new entry. + * + * NOTE: we release pool lock during allocation because ae_malloc() may raise + * exception and we do not want our pool to be left in the locked state. + */ + ae_release_lock(&pool->pool_lock); + new_entry = (ae_shared_pool_entry*)ae_malloc(sizeof(ae_shared_pool_entry), state); + ae_assert(new_entry!=NULL, "ALGLIB: unable to allocate memory in ae_shared_pool_recycle()", state); + ae_acquire_lock(&pool->pool_lock); + } + + /* add object to the list of recycled objects */ + new_entry->obj = pptr->ptr; + new_entry->next_entry = pool->recycled_objects; + pool->recycled_objects = new_entry; + + /* release lock object */ + ae_release_lock(&pool->pool_lock); + + /* release source pointer */ + ae_smart_ptr_release(pptr); +} + + +/************************************************************************ +This function clears internal list of recycled objects, but does not +change seed object managed by the pool. + +pool pool +state ALGLIB environment state + +NOTE: this function is NOT thread-safe. It does not acquire pool lock, so + you should NOT call it when lock can be used by another thread. +************************************************************************/ +void ae_shared_pool_clear_recycled( + ae_shared_pool *pool, + ae_state *state) +{ + ae_shared_pool_entry *ptr, *tmp; + + /* clear recycled objects */ + for(ptr=pool->recycled_objects; ptr!=NULL;) + { + tmp = (ae_shared_pool_entry*)ptr->next_entry; + pool->destroy(ptr->obj); + ae_free(ptr->obj); + ae_free(ptr); + ptr = tmp; + } + pool->recycled_objects = NULL; +} + + +/************************************************************************ +This function allows to enumerate recycled elements of the shared pool. +It stores pointer to the first recycled object in the smart pointer. + +IMPORTANT: +* in case target pointer owns non-NULL value, it is deallocated before + storing value retrieved from pool. +* recycled object IS NOT removed from pool +* target pointer DOES NOT become owner of the new value +* this function IS NOT thread-safe +* you SHOULD NOT modify shared pool during enumeration (although you can + modify state of the objects retrieved from pool) +* in case there is no recycled objects in the pool, NULL is stored to pptr +* in case pool is not seeded, NULL is stored to pptr + +pool pool +pptr pointer to ae_smart_ptr structure +state ALGLIB environment state +************************************************************************/ +void ae_shared_pool_first_recycled( + ae_shared_pool *pool, + ae_smart_ptr *pptr, + ae_state *state) +{ + /* modify internal enumeration counter */ + pool->enumeration_counter = pool->recycled_objects; + + /* exit on empty list */ + if( pool->enumeration_counter==NULL ) + { + ae_smart_ptr_assign(pptr, NULL, ae_false, ae_false, NULL); + return; + } + + /* assign object to smart pointer */ + ae_smart_ptr_assign(pptr, pool->enumeration_counter->obj, ae_false, ae_false, pool->destroy); +} + + +/************************************************************************ +This function allows to enumerate recycled elements of the shared pool. +It stores pointer to the next recycled object in the smart pointer. + +IMPORTANT: +* in case target pointer owns non-NULL value, it is deallocated before + storing value retrieved from pool. +* recycled object IS NOT removed from pool +* target pointer DOES NOT become owner of the new value +* this function IS NOT thread-safe +* you SHOULD NOT modify shared pool during enumeration (although you can + modify state of the objects retrieved from pool) +* in case there is no recycled objects left in the pool, NULL is stored. +* in case pool is not seeded, NULL is stored. + +pool pool +pptr pointer to ae_smart_ptr structure +state ALGLIB environment state +************************************************************************/ +void ae_shared_pool_next_recycled( + ae_shared_pool *pool, + ae_smart_ptr *pptr, + ae_state *state) +{ + /* exit on end of list */ + if( pool->enumeration_counter==NULL ) + { + ae_smart_ptr_assign(pptr, NULL, ae_false, ae_false, NULL); + return; + } + + /* modify internal enumeration counter */ + pool->enumeration_counter = (ae_shared_pool_entry*)pool->enumeration_counter->next_entry; + + /* exit on empty list */ + if( pool->enumeration_counter==NULL ) + { + ae_smart_ptr_assign(pptr, NULL, ae_false, ae_false, NULL); + return; + } + + /* assign object to smart pointer */ + ae_smart_ptr_assign(pptr, pool->enumeration_counter->obj, ae_false, ae_false, pool->destroy); +} + + + +/************************************************************************ +This function clears internal list of recycled objects and seed object. +However, pool still can be used (after initialization with another seed). + +pool pool +state ALGLIB environment state + +NOTE: this function is NOT thread-safe. It does not acquire pool lock, so + you should NOT call it when lock can be used by another thread. +************************************************************************/ +void ae_shared_pool_reset( + ae_shared_pool *pool, + ae_state *state) +{ + /* clear seed and lists */ + ae_shared_pool_internalclear(pool); + + /* clear fields */ + pool->seed_object = NULL; + pool->recycled_objects = NULL; + pool->recycled_entries = NULL; + pool->enumeration_counter = NULL; + pool->size_of_object = 0; + pool->init = NULL; + pool->init_copy = NULL; + pool->destroy = NULL; +} + + +/************************************************************************ +This function initializes serializer +************************************************************************/ +void ae_serializer_init(ae_serializer *serializer) +{ + serializer->mode = AE_SM_DEFAULT; + serializer->entries_needed = 0; + serializer->bytes_asked = 0; +} + +void ae_serializer_clear(ae_serializer *serializer) +{ +} + +void ae_serializer_alloc_start(ae_serializer *serializer) +{ + serializer->entries_needed = 0; + serializer->bytes_asked = 0; + serializer->mode = AE_SM_ALLOC; +} + +void ae_serializer_alloc_entry(ae_serializer *serializer) +{ + serializer->entries_needed++; +} + +ae_int_t ae_serializer_get_alloc_size(ae_serializer *serializer) +{ + ae_int_t rows, lastrowsize, result; + + serializer->mode = AE_SM_READY2S; + + /* if no entries needes (degenerate case) */ + if( serializer->entries_needed==0 ) + { + serializer->bytes_asked = 1; + return serializer->bytes_asked; + } + + /* non-degenerate case */ + rows = serializer->entries_needed/AE_SER_ENTRIES_PER_ROW; + lastrowsize = AE_SER_ENTRIES_PER_ROW; + if( serializer->entries_needed%AE_SER_ENTRIES_PER_ROW ) + { + lastrowsize = serializer->entries_needed%AE_SER_ENTRIES_PER_ROW; + rows++; + } + + /* calculate result size */ + result = ((rows-1)*AE_SER_ENTRIES_PER_ROW+lastrowsize)*AE_SER_ENTRY_LENGTH; + result += (rows-1)*(AE_SER_ENTRIES_PER_ROW-1)+(lastrowsize-1); + result += rows*2; + serializer->bytes_asked = result; + return result; +} + +#ifdef AE_USE_CPP_SERIALIZATION +void ae_serializer_sstart_str(ae_serializer *serializer, std::string *buf) +{ + serializer->mode = AE_SM_TO_CPPSTRING; + serializer->out_cppstr = buf; + serializer->entries_saved = 0; + serializer->bytes_written = 0; +} +#endif + +#ifdef AE_USE_CPP_SERIALIZATION +void ae_serializer_ustart_str(ae_serializer *serializer, const std::string *buf) +{ + serializer->mode = AE_SM_FROM_STRING; + serializer->in_str = buf->c_str(); +} +#endif + +void ae_serializer_sstart_str(ae_serializer *serializer, char *buf) +{ + serializer->mode = AE_SM_TO_STRING; + serializer->out_str = buf; + serializer->out_str[0] = 0; + serializer->entries_saved = 0; + serializer->bytes_written = 0; +} + +void ae_serializer_ustart_str(ae_serializer *serializer, const char *buf) +{ + serializer->mode = AE_SM_FROM_STRING; + serializer->in_str = buf; +} + +void ae_serializer_serialize_bool(ae_serializer *serializer, ae_bool v, ae_state *state) +{ + char buf[AE_SER_ENTRY_LENGTH+2+1]; + const char *emsg = "ALGLIB: serialization integrity error"; + ae_int_t bytes_appended; + + /* prepare serialization, check consistency */ + ae_bool2str(v, buf, state); + serializer->entries_saved++; + if( serializer->entries_saved%AE_SER_ENTRIES_PER_ROW ) + strcat(buf, " "); + else + strcat(buf, "\r\n"); + bytes_appended = (ae_int_t)strlen(buf); + if( serializer->bytes_written+bytes_appended > serializer->bytes_asked ) + ae_break(state, ERR_ASSERTION_FAILED, emsg); + serializer->bytes_written += bytes_appended; + + /* append to buffer */ +#ifdef AE_USE_CPP_SERIALIZATION + if( serializer->mode==AE_SM_TO_CPPSTRING ) + { + *(serializer->out_cppstr) += buf; + return; + } +#endif + if( serializer->mode==AE_SM_TO_STRING ) + { + strcat(serializer->out_str, buf); + serializer->out_str += bytes_appended; + return; + } + ae_break(state, ERR_ASSERTION_FAILED, emsg); +} + +void ae_serializer_serialize_int(ae_serializer *serializer, ae_int_t v, ae_state *state) +{ + char buf[AE_SER_ENTRY_LENGTH+2+1]; + const char *emsg = "ALGLIB: serialization integrity error"; + ae_int_t bytes_appended; + + /* prepare serialization, check consistency */ + ae_int2str(v, buf, state); + serializer->entries_saved++; + if( serializer->entries_saved%AE_SER_ENTRIES_PER_ROW ) + strcat(buf, " "); + else + strcat(buf, "\r\n"); + bytes_appended = (ae_int_t)strlen(buf); + if( serializer->bytes_written+bytes_appended > serializer->bytes_asked ) + ae_break(state, ERR_ASSERTION_FAILED, emsg); + serializer->bytes_written += bytes_appended; + + /* append to buffer */ +#ifdef AE_USE_CPP_SERIALIZATION + if( serializer->mode==AE_SM_TO_CPPSTRING ) + { + *(serializer->out_cppstr) += buf; + return; + } +#endif + if( serializer->mode==AE_SM_TO_STRING ) + { + strcat(serializer->out_str, buf); + serializer->out_str += bytes_appended; + return; + } + ae_break(state, ERR_ASSERTION_FAILED, emsg); +} + +void ae_serializer_serialize_double(ae_serializer *serializer, double v, ae_state *state) +{ + char buf[AE_SER_ENTRY_LENGTH+2+1]; + const char *emsg = "ALGLIB: serialization integrity error"; + ae_int_t bytes_appended; + + /* prepare serialization, check consistency */ + ae_double2str(v, buf, state); + serializer->entries_saved++; + if( serializer->entries_saved%AE_SER_ENTRIES_PER_ROW ) + strcat(buf, " "); + else + strcat(buf, "\r\n"); + bytes_appended = (ae_int_t)strlen(buf); + if( serializer->bytes_written+bytes_appended > serializer->bytes_asked ) + ae_break(state, ERR_ASSERTION_FAILED, emsg); + serializer->bytes_written += bytes_appended; + + /* append to buffer */ +#ifdef AE_USE_CPP_SERIALIZATION + if( serializer->mode==AE_SM_TO_CPPSTRING ) + { + *(serializer->out_cppstr) += buf; + return; + } +#endif + if( serializer->mode==AE_SM_TO_STRING ) + { + strcat(serializer->out_str, buf); + serializer->out_str += bytes_appended; + return; + } + ae_break(state, ERR_ASSERTION_FAILED, emsg); +} + +void ae_serializer_unserialize_bool(ae_serializer *serializer, ae_bool *v, ae_state *state) +{ + *v = ae_str2bool(serializer->in_str, state, &serializer->in_str); +} + +void ae_serializer_unserialize_int(ae_serializer *serializer, ae_int_t *v, ae_state *state) +{ + *v = ae_str2int(serializer->in_str, state, &serializer->in_str); +} + +void ae_serializer_unserialize_double(ae_serializer *serializer, double *v, ae_state *state) +{ + *v = ae_str2double(serializer->in_str, state, &serializer->in_str); +} + +void ae_serializer_stop(ae_serializer *serializer) +{ +} + + +/************************************************************************ +Complex math functions +************************************************************************/ +ae_complex ae_complex_from_d(double v) +{ + ae_complex r; + r.x = v; + r.y = 0.0; + return r; +} + +ae_complex ae_c_neg(ae_complex lhs) +{ + ae_complex result; + result.x = -lhs.x; + result.y = -lhs.y; + return result; +} + +ae_complex ae_c_conj(ae_complex lhs, ae_state *state) +{ + ae_complex result; + result.x = +lhs.x; + result.y = -lhs.y; + return result; +} + +ae_complex ae_c_sqr(ae_complex lhs, ae_state *state) +{ + ae_complex result; + result.x = lhs.x*lhs.x-lhs.y*lhs.y; + result.y = 2*lhs.x*lhs.y; + return result; +} + +double ae_c_abs(ae_complex z, ae_state *state) +{ + double w; + double xabs; + double yabs; + double v; + + xabs = fabs(z.x); + yabs = fabs(z.y); + w = xabs>yabs ? xabs : yabs; + v = xabsx; + v0y = -v0->y; + v1x = v1->x; + v1y = -v1->y; + rx += v0x*v1x-v0y*v1y; + ry += v0x*v1y+v0y*v1x; + } + } + if( !bconj0 && bconj1 ) + { + double v0x, v0y, v1x, v1y; + for(i=0; ix; + v0y = v0->y; + v1x = v1->x; + v1y = -v1->y; + rx += v0x*v1x-v0y*v1y; + ry += v0x*v1y+v0y*v1x; + } + } + if( bconj0 && !bconj1 ) + { + double v0x, v0y, v1x, v1y; + for(i=0; ix; + v0y = -v0->y; + v1x = v1->x; + v1y = v1->y; + rx += v0x*v1x-v0y*v1y; + ry += v0x*v1y+v0y*v1x; + } + } + if( !bconj0 && !bconj1 ) + { + double v0x, v0y, v1x, v1y; + for(i=0; ix; + v0y = v0->y; + v1x = v1->x; + v1y = v1->y; + rx += v0x*v1x-v0y*v1y; + ry += v0x*v1y+v0y*v1x; + } + } + result.x = rx; + result.y = ry; + return result; +} + +void ae_v_cmove(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n) +{ + ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + /* + * general unoptimized case + */ + if( bconj ) + { + for(i=0; ix = vsrc->x; + vdst->y = -vsrc->y; + } + } + else + { + for(i=0; ix = vsrc->x; + vdst->y = -vsrc->y; + } + } + else + { + for(i=0; ix = -vsrc->x; + vdst->y = vsrc->y; + } + } + else + { + for(i=0; ix = -vsrc->x; + vdst->y = -vsrc->y; + } + } + } + else + { + /* + * optimized case + */ + if( bconj ) + { + for(i=0; ix = -vsrc->x; + vdst->y = vsrc->y; + } + } + else + { + for(i=0; ix = -vsrc->x; + vdst->y = -vsrc->y; + } + } + } +} + +void ae_v_cmoved(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha) +{ + ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + /* + * general unoptimized case + */ + if( bconj ) + { + for(i=0; ix = alpha*vsrc->x; + vdst->y = -alpha*vsrc->y; + } + } + else + { + for(i=0; ix = alpha*vsrc->x; + vdst->y = alpha*vsrc->y; + } + } + } + else + { + /* + * optimized case + */ + if( bconj ) + { + for(i=0; ix = alpha*vsrc->x; + vdst->y = -alpha*vsrc->y; + } + } + else + { + for(i=0; ix = alpha*vsrc->x; + vdst->y = alpha*vsrc->y; + } + } + } +} + +void ae_v_cmovec(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha) +{ + ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + /* + * general unoptimized case + */ + if( bconj ) + { + double ax = alpha.x, ay = alpha.y; + for(i=0; ix = ax*vsrc->x+ay*vsrc->y; + vdst->y = -ax*vsrc->y+ay*vsrc->x; + } + } + else + { + double ax = alpha.x, ay = alpha.y; + for(i=0; ix = ax*vsrc->x-ay*vsrc->y; + vdst->y = ax*vsrc->y+ay*vsrc->x; + } + } + } + else + { + /* + * highly optimized case + */ + if( bconj ) + { + double ax = alpha.x, ay = alpha.y; + for(i=0; ix = ax*vsrc->x+ay*vsrc->y; + vdst->y = -ax*vsrc->y+ay*vsrc->x; + } + } + else + { + double ax = alpha.x, ay = alpha.y; + for(i=0; ix = ax*vsrc->x-ay*vsrc->y; + vdst->y = ax*vsrc->y+ay*vsrc->x; + } + } + } +} + +void ae_v_cadd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n) +{ + ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + /* + * general unoptimized case + */ + if( bconj ) + { + for(i=0; ix += vsrc->x; + vdst->y -= vsrc->y; + } + } + else + { + for(i=0; ix += vsrc->x; + vdst->y += vsrc->y; + } + } + } + else + { + /* + * optimized case + */ + if( bconj ) + { + for(i=0; ix += vsrc->x; + vdst->y -= vsrc->y; + } + } + else + { + for(i=0; ix += vsrc->x; + vdst->y += vsrc->y; + } + } + } +} + +void ae_v_caddd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha) +{ + ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + /* + * general unoptimized case + */ + if( bconj ) + { + for(i=0; ix += alpha*vsrc->x; + vdst->y -= alpha*vsrc->y; + } + } + else + { + for(i=0; ix += alpha*vsrc->x; + vdst->y += alpha*vsrc->y; + } + } + } + else + { + /* + * optimized case + */ + if( bconj ) + { + for(i=0; ix += alpha*vsrc->x; + vdst->y -= alpha*vsrc->y; + } + } + else + { + for(i=0; ix += alpha*vsrc->x; + vdst->y += alpha*vsrc->y; + } + } + } +} + +void ae_v_caddc(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha) +{ + ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + /* + * general unoptimized case + */ + double ax = alpha.x, ay = alpha.y; + if( bconj ) + { + for(i=0; ix += ax*vsrc->x+ay*vsrc->y; + vdst->y -= ax*vsrc->y-ay*vsrc->x; + } + } + else + { + for(i=0; ix += ax*vsrc->x-ay*vsrc->y; + vdst->y += ax*vsrc->y+ay*vsrc->x; + } + } + } + else + { + /* + * highly optimized case + */ + double ax = alpha.x, ay = alpha.y; + if( bconj ) + { + for(i=0; ix += ax*vsrc->x+ay*vsrc->y; + vdst->y -= ax*vsrc->y-ay*vsrc->x; + } + } + else + { + for(i=0; ix += ax*vsrc->x-ay*vsrc->y; + vdst->y += ax*vsrc->y+ay*vsrc->x; + } + } + } +} + +void ae_v_csub(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n) +{ + ae_bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + /* + * general unoptimized case + */ + if( bconj ) + { + for(i=0; ix -= vsrc->x; + vdst->y += vsrc->y; + } + } + else + { + for(i=0; ix -= vsrc->x; + vdst->y -= vsrc->y; + } + } + } + else + { + /* + * highly optimized case + */ + if( bconj ) + { + for(i=0; ix -= vsrc->x; + vdst->y += vsrc->y; + } + } + else + { + for(i=0; ix -= vsrc->x; + vdst->y -= vsrc->y; + } + } + } +} + +void ae_v_csubd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha) +{ + ae_v_caddd(vdst, stride_dst, vsrc, stride_src, conj_src, n, -alpha); +} + +void ae_v_csubc(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha) +{ + alpha.x = -alpha.x; + alpha.y = -alpha.y; + ae_v_caddc(vdst, stride_dst, vsrc, stride_src, conj_src, n, alpha); +} + +void ae_v_cmuld(ae_complex *vdst, ae_int_t stride_dst, ae_int_t n, double alpha) +{ + ae_int_t i; + if( stride_dst!=1 ) + { + /* + * general unoptimized case + */ + for(i=0; ix *= alpha; + vdst->y *= alpha; + } + } + else + { + /* + * optimized case + */ + for(i=0; ix *= alpha; + vdst->y *= alpha; + } + } +} + +void ae_v_cmulc(ae_complex *vdst, ae_int_t stride_dst, ae_int_t n, ae_complex alpha) +{ + ae_int_t i; + if( stride_dst!=1 ) + { + /* + * general unoptimized case + */ + double ax = alpha.x, ay = alpha.y; + for(i=0; ix, dsty = vdst->y; + vdst->x = ax*dstx-ay*dsty; + vdst->y = ax*dsty+ay*dstx; + } + } + else + { + /* + * highly optimized case + */ + double ax = alpha.x, ay = alpha.y; + for(i=0; ix, dsty = vdst->y; + vdst->x = ax*dstx-ay*dsty; + vdst->y = ax*dsty+ay*dstx; + } + } +} + +/************************************************************************ +Real BLAS operations +************************************************************************/ +double ae_v_dotproduct(const double *v0, ae_int_t stride0, const double *v1, ae_int_t stride1, ae_int_t n) +{ + double result = 0; + ae_int_t i; + if( stride0!=1 || stride1!=1 ) + { + /* + * slow general code + */ + for(i=0; iba, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ia, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ra, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ca, 0, DT_COMPLEX, _state, make_automatic) ) + return ae_false; + return ae_true; +} + +ae_bool _rcommstate_init_copy(rcommstate* dst, rcommstate* src, ae_state *_state, ae_bool make_automatic) +{ + if( !ae_vector_init_copy(&dst->ba, &src->ba, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ia, &src->ia, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ra, &src->ra, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ca, &src->ca, _state, make_automatic) ) + return ae_false; + dst->stage = src->stage; + return ae_true; +} + +void _rcommstate_clear(rcommstate* p) +{ + ae_vector_clear(&p->ba); + ae_vector_clear(&p->ia); + ae_vector_clear(&p->ra); + ae_vector_clear(&p->ca); +} + +void _rcommstate_destroy(rcommstate* p) +{ + _rcommstate_clear(p); +} + +#ifdef AE_DEBUG4WINDOWS +int _tickcount() +{ + return GetTickCount(); +} +#endif + +#ifdef AE_DEBUG4POSIX +#include +int _tickcount() +{ + struct timespec now; + if (clock_gettime(CLOCK_MONOTONIC, &now) ) + return 0; + return now.tv_sec * 1000.0 + now.tv_nsec / 1000000.0; +} +#endif + +#ifdef AE_DEBUGRNG +void ae_set_seed(ae_int_t s0, ae_int_t s1) +{ + ae_int_t hqrnd_hqrndm1 = 2147483563; + ae_int_t hqrnd_hqrndm2 = 2147483399; + + while(s0<1) + s0 += hqrnd_hqrndm1-1; + while(s0>hqrnd_hqrndm1-1) + s0 -= hqrnd_hqrndm1-1; + + while(s1<1) + s1 += hqrnd_hqrndm2-1; + while(s1>hqrnd_hqrndm2-1) + s1 -= hqrnd_hqrndm2-1; + + _debug_rng_s0 = s0; + _debug_rng_s1 = s1; +} + +void ae_get_seed(ae_int_t *s0, ae_int_t *s1) +{ + *s0 = _debug_rng_s0; + *s1 = _debug_rng_s1; +} +#endif + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ RELATED FUNCTIONALITY +// +///////////////////////////////////////////////////////////////////////// +/******************************************************************** +Internal forwards +********************************************************************/ +namespace alglib +{ + double get_aenv_nan(); + double get_aenv_posinf(); + double get_aenv_neginf(); + ae_int_t my_stricmp(const char *s1, const char *s2); + char* filter_spaces(const char *s); + void str_vector_create(const char *src, bool match_head_only, std::vector *p_vec); + void str_matrix_create(const char *src, std::vector< std::vector > *p_mat); + + ae_bool parse_bool_delim(const char *s, const char *delim); + ae_int_t parse_int_delim(const char *s, const char *delim); + bool _parse_real_delim(const char *s, const char *delim, double *result, const char **new_s); + double parse_real_delim(const char *s, const char *delim); + alglib::complex parse_complex_delim(const char *s, const char *delim); + + std::string arraytostring(const bool *ptr, ae_int_t n); + std::string arraytostring(const ae_int_t *ptr, ae_int_t n); + std::string arraytostring(const double *ptr, ae_int_t n, int dps); + std::string arraytostring(const alglib::complex *ptr, ae_int_t n, int dps); +} + +/******************************************************************** +Global and local constants +********************************************************************/ +const double alglib::machineepsilon = 5E-16; +const double alglib::maxrealnumber = 1E300; +const double alglib::minrealnumber = 1E-300; +const alglib::ae_int_t alglib::endianness = alglib_impl::ae_get_endianness(); +const double alglib::fp_nan = alglib::get_aenv_nan(); +const double alglib::fp_posinf = alglib::get_aenv_posinf(); +const double alglib::fp_neginf = alglib::get_aenv_neginf(); + + +/******************************************************************** +ap_error +********************************************************************/ +alglib::ap_error::ap_error() +{ +} + +alglib::ap_error::ap_error(const char *s) +{ + msg = s; +} + +void alglib::ap_error::make_assertion(bool bClause) +{ + if(!bClause) + throw ap_error(); +} + +void alglib::ap_error::make_assertion(bool bClause, const char *msg) +{ + if(!bClause) + throw ap_error(msg); +} + + +/******************************************************************** +Complex number with double precision. +********************************************************************/ +alglib::complex::complex():x(0.0),y(0.0) +{ +} + +alglib::complex::complex(const double &_x):x(_x),y(0.0) +{ +} + +alglib::complex::complex(const double &_x, const double &_y):x(_x),y(_y) +{ +} + +alglib::complex::complex(const alglib::complex &z):x(z.x),y(z.y) +{ +} + +alglib::complex& alglib::complex::operator= (const double& v) +{ + x = v; + y = 0.0; + return *this; +} + +alglib::complex& alglib::complex::operator+=(const double& v) +{ + x += v; + return *this; +} + +alglib::complex& alglib::complex::operator-=(const double& v) +{ + x -= v; + return *this; +} + +alglib::complex& alglib::complex::operator*=(const double& v) +{ + x *= v; + y *= v; + return *this; +} + +alglib::complex& alglib::complex::operator/=(const double& v) +{ + x /= v; + y /= v; + return *this; +} + +alglib::complex& alglib::complex::operator= (const alglib::complex& z) +{ + x = z.x; + y = z.y; + return *this; +} + +alglib::complex& alglib::complex::operator+=(const alglib::complex& z) +{ + x += z.x; + y += z.y; + return *this; +} + +alglib::complex& alglib::complex::operator-=(const alglib::complex& z) +{ + x -= z.x; + y -= z.y; + return *this; +} + +alglib::complex& alglib::complex::operator*=(const alglib::complex& z) +{ + double t = x*z.x-y*z.y; + y = x*z.y+y*z.x; + x = t; + return *this; +} + +alglib::complex& alglib::complex::operator/=(const alglib::complex& z) +{ + alglib::complex result; + double e; + double f; + if( fabs(z.y)=0 ? _dps : -_dps; + if( dps<=0 || dps>=20 ) + throw ap_error("complex::tostring(): incorrect dps"); + + // handle IEEE special quantities + if( fp_isnan(x) || fp_isnan(y) ) + return "NAN"; + if( fp_isinf(x) || fp_isinf(y) ) + return "INF"; + + // generate mask + if( sprintf(mask, "%%.%d%s", dps, _dps>=0 ? "f" : "e")>=(int)sizeof(mask) ) + throw ap_error("complex::tostring(): buffer overflow"); + + // print |x|, |y| and zero with same mask and compare + if( sprintf(buf_x, mask, (double)(fabs(x)))>=(int)sizeof(buf_x) ) + throw ap_error("complex::tostring(): buffer overflow"); + if( sprintf(buf_y, mask, (double)(fabs(y)))>=(int)sizeof(buf_y) ) + throw ap_error("complex::tostring(): buffer overflow"); + if( sprintf(buf_zero, mask, (double)0)>=(int)sizeof(buf_zero) ) + throw ap_error("complex::tostring(): buffer overflow"); + + // different zero/nonzero patterns + if( strcmp(buf_x,buf_zero)!=0 && strcmp(buf_y,buf_zero)!=0 ) + return std::string(x>0 ? "" : "-")+buf_x+(y>0 ? "+" : "-")+buf_y+"i"; + if( strcmp(buf_x,buf_zero)!=0 && strcmp(buf_y,buf_zero)==0 ) + return std::string(x>0 ? "" : "-")+buf_x; + if( strcmp(buf_x,buf_zero)==0 && strcmp(buf_y,buf_zero)!=0 ) + return std::string(y>0 ? "" : "-")+buf_y+"i"; + return std::string("0"); +} + +const bool alglib::operator==(const alglib::complex& lhs, const alglib::complex& rhs) +{ + volatile double x1 = lhs.x; + volatile double x2 = rhs.x; + volatile double y1 = lhs.y; + volatile double y2 = rhs.y; + return x1==x2 && y1==y2; +} + +const bool alglib::operator!=(const alglib::complex& lhs, const alglib::complex& rhs) +{ return !(lhs==rhs); } + +const alglib::complex alglib::operator+(const alglib::complex& lhs) +{ return lhs; } + +const alglib::complex alglib::operator-(const alglib::complex& lhs) +{ return alglib::complex(-lhs.x, -lhs.y); } + +const alglib::complex alglib::operator+(const alglib::complex& lhs, const alglib::complex& rhs) +{ alglib::complex r = lhs; r += rhs; return r; } + +const alglib::complex alglib::operator+(const alglib::complex& lhs, const double& rhs) +{ alglib::complex r = lhs; r += rhs; return r; } + +const alglib::complex alglib::operator+(const double& lhs, const alglib::complex& rhs) +{ alglib::complex r = rhs; r += lhs; return r; } + +const alglib::complex alglib::operator-(const alglib::complex& lhs, const alglib::complex& rhs) +{ alglib::complex r = lhs; r -= rhs; return r; } + +const alglib::complex alglib::operator-(const alglib::complex& lhs, const double& rhs) +{ alglib::complex r = lhs; r -= rhs; return r; } + +const alglib::complex alglib::operator-(const double& lhs, const alglib::complex& rhs) +{ alglib::complex r = lhs; r -= rhs; return r; } + +const alglib::complex alglib::operator*(const alglib::complex& lhs, const alglib::complex& rhs) +{ return alglib::complex(lhs.x*rhs.x - lhs.y*rhs.y, lhs.x*rhs.y + lhs.y*rhs.x); } + +const alglib::complex alglib::operator*(const alglib::complex& lhs, const double& rhs) +{ return alglib::complex(lhs.x*rhs, lhs.y*rhs); } + +const alglib::complex alglib::operator*(const double& lhs, const alglib::complex& rhs) +{ return alglib::complex(lhs*rhs.x, lhs*rhs.y); } + +const alglib::complex alglib::operator/(const alglib::complex& lhs, const alglib::complex& rhs) +{ + alglib::complex result; + double e; + double f; + if( fabs(rhs.y)yabs ? xabs : yabs; + v = xabsx; + v0y = -v0->y; + v1x = v1->x; + v1y = -v1->y; + rx += v0x*v1x-v0y*v1y; + ry += v0x*v1y+v0y*v1x; + } + } + if( !bconj0 && bconj1 ) + { + double v0x, v0y, v1x, v1y; + for(i=0; ix; + v0y = v0->y; + v1x = v1->x; + v1y = -v1->y; + rx += v0x*v1x-v0y*v1y; + ry += v0x*v1y+v0y*v1x; + } + } + if( bconj0 && !bconj1 ) + { + double v0x, v0y, v1x, v1y; + for(i=0; ix; + v0y = -v0->y; + v1x = v1->x; + v1y = v1->y; + rx += v0x*v1x-v0y*v1y; + ry += v0x*v1y+v0y*v1x; + } + } + if( !bconj0 && !bconj1 ) + { + double v0x, v0y, v1x, v1y; + for(i=0; ix; + v0y = v0->y; + v1x = v1->x; + v1y = v1->y; + rx += v0x*v1x-v0y*v1y; + ry += v0x*v1y+v0y*v1x; + } + } + return alglib::complex(rx,ry); +} + +alglib::complex alglib::vdotproduct(const alglib::complex *v1, const alglib::complex *v2, ae_int_t N) +{ + return vdotproduct(v1, 1, "N", v2, 1, "N", N); +} + +void alglib::vmove(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n) +{ + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + // + // general unoptimized case + // + for(i=0; ix = vsrc->x; + vdst->y = -vsrc->y; + } + } + else + { + for(i=0; ix = vsrc->x; + vdst->y = -vsrc->y; + } + } + else + { + for(i=0; ix = -vsrc->x; + vdst->y = vsrc->y; + } + } + else + { + for(i=0; ix = -vsrc->x; + vdst->y = -vsrc->y; + } + } + } + else + { + // + // optimized case + // + if( bconj ) + { + for(i=0; ix = -vsrc->x; + vdst->y = vsrc->y; + } + } + else + { + for(i=0; ix = -vsrc->x; + vdst->y = -vsrc->y; + } + } + } +} + +void alglib::vmoveneg(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N) +{ + vmoveneg(vdst, 1, vsrc, 1, "N", N); +} + +void alglib::vmove(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n, double alpha) +{ + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + // + // general unoptimized case + // + for(i=0; ix = alpha*vsrc->x; + vdst->y = -alpha*vsrc->y; + } + } + else + { + for(i=0; ix = alpha*vsrc->x; + vdst->y = alpha*vsrc->y; + } + } + } + else + { + // + // optimized case + // + if( bconj ) + { + for(i=0; ix = alpha*vsrc->x; + vdst->y = -alpha*vsrc->y; + } + } + else + { + for(i=0; ix = alpha*vsrc->x; + vdst->y = alpha*vsrc->y; + } + } + } +} + +void alglib::vmove(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha) +{ + vmove(vdst, 1, vsrc, 1, "N", N, alpha); +} + +void alglib::vmove(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha) +{ + bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + // + // general unoptimized case + // + if( bconj ) + { + double ax = alpha.x, ay = alpha.y; + for(i=0; ix = ax*vsrc->x+ay*vsrc->y; + vdst->y = -ax*vsrc->y+ay*vsrc->x; + } + } + else + { + double ax = alpha.x, ay = alpha.y; + for(i=0; ix = ax*vsrc->x-ay*vsrc->y; + vdst->y = ax*vsrc->y+ay*vsrc->x; + } + } + } + else + { + // + // optimized case + // + if( bconj ) + { + double ax = alpha.x, ay = alpha.y; + for(i=0; ix = ax*vsrc->x+ay*vsrc->y; + vdst->y = -ax*vsrc->y+ay*vsrc->x; + } + } + else + { + double ax = alpha.x, ay = alpha.y; + for(i=0; ix = ax*vsrc->x-ay*vsrc->y; + vdst->y = ax*vsrc->y+ay*vsrc->x; + } + } + } +} + +void alglib::vmove(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha) +{ + vmove(vdst, 1, vsrc, 1, "N", N, alpha); +} + +void alglib::vadd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n) +{ + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + // + // general unoptimized case + // + for(i=0; ix += vsrc->x; + vdst->y -= vsrc->y; + } + } + else + { + for(i=0; ix += vsrc->x; + vdst->y += vsrc->y; + } + } + } + else + { + // + // optimized case + // + if( bconj ) + { + for(i=0; ix += vsrc->x; + vdst->y -= vsrc->y; + } + } + else + { + for(i=0; ix += vsrc->x; + vdst->y += vsrc->y; + } + } + } +} + +void alglib::vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N) +{ + vadd(vdst, 1, vsrc, 1, "N", N); +} + +void alglib::vadd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha) +{ + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + // + // general unoptimized case + // + for(i=0; ix += alpha*vsrc->x; + vdst->y -= alpha*vsrc->y; + } + } + else + { + for(i=0; ix += alpha*vsrc->x; + vdst->y += alpha*vsrc->y; + } + } + } + else + { + // + // optimized case + // + if( bconj ) + { + for(i=0; ix += alpha*vsrc->x; + vdst->y -= alpha*vsrc->y; + } + } + else + { + for(i=0; ix += alpha*vsrc->x; + vdst->y += alpha*vsrc->y; + } + } + } +} + +void alglib::vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha) +{ + vadd(vdst, 1, vsrc, 1, "N", N, alpha); +} + +void alglib::vadd(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha) +{ + bool bconj = !((conj_src[0]=='N') || (conj_src[0]=='n')); + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + // + // general unoptimized case + // + double ax = alpha.x, ay = alpha.y; + if( bconj ) + { + for(i=0; ix += ax*vsrc->x+ay*vsrc->y; + vdst->y -= ax*vsrc->y-ay*vsrc->x; + } + } + else + { + for(i=0; ix += ax*vsrc->x-ay*vsrc->y; + vdst->y += ax*vsrc->y+ay*vsrc->x; + } + } + } + else + { + // + // optimized case + // + double ax = alpha.x, ay = alpha.y; + if( bconj ) + { + for(i=0; ix += ax*vsrc->x+ay*vsrc->y; + vdst->y -= ax*vsrc->y-ay*vsrc->x; + } + } + else + { + for(i=0; ix += ax*vsrc->x-ay*vsrc->y; + vdst->y += ax*vsrc->y+ay*vsrc->x; + } + } + } +} + +void alglib::vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha) +{ + vadd(vdst, 1, vsrc, 1, "N", N, alpha); +} + +void alglib::vsub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n) +{ + ae_int_t i; + if( stride_dst!=1 || stride_src!=1 ) + { + // + // general unoptimized case + // + for(i=0; ix -= vsrc->x; + vdst->y += vsrc->y; + } + } + else + { + for(i=0; ix -= vsrc->x; + vdst->y -= vsrc->y; + } + } + } + else + { + // + // optimized case + // + if( bconj ) + { + for(i=0; ix -= vsrc->x; + vdst->y += vsrc->y; + } + } + else + { + for(i=0; ix -= vsrc->x; + vdst->y -= vsrc->y; + } + } + } +} + +void alglib::vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N) +{ + vsub(vdst, 1, vsrc, 1, "N", N); +} + +void alglib::vsub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha) +{ + vadd(vdst, stride_dst, vsrc, stride_src, n, -alpha); +} + +void alglib::vsub(double *vdst, const double *vsrc, ae_int_t N, double alpha) +{ + vadd(vdst, 1, vsrc, 1, N, -alpha); +} + +void alglib::vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha) +{ + vadd(vdst, stride_dst, vsrc, stride_src, conj_src, n, -alpha); +} + +void alglib::vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t n, double alpha) +{ + vadd(vdst, 1, vsrc, 1, "N", n, -alpha); +} + +void alglib::vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha) +{ + vadd(vdst, stride_dst, vsrc, stride_src, conj_src, n, -alpha); +} + +void alglib::vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t n, alglib::complex alpha) +{ + vadd(vdst, 1, vsrc, 1, "N", n, -alpha); +} +void alglib::vmul(double *vdst, ae_int_t stride_dst, ae_int_t n, double alpha) +{ + ae_int_t i; + if( stride_dst!=1 ) + { + // + // general unoptimized case + // + for(i=0; ix *= alpha; + vdst->y *= alpha; + } + } + else + { + // + // optimized case + // + for(i=0; ix *= alpha; + vdst->y *= alpha; + } + } +} + +void alglib::vmul(alglib::complex *vdst, ae_int_t N, double alpha) +{ + vmul(vdst, 1, N, alpha); +} + +void alglib::vmul(alglib::complex *vdst, ae_int_t stride_dst, ae_int_t n, alglib::complex alpha) +{ + ae_int_t i; + if( stride_dst!=1 ) + { + // + // general unoptimized case + // + double ax = alpha.x, ay = alpha.y; + for(i=0; ix, dsty = vdst->y; + vdst->x = ax*dstx-ay*dsty; + vdst->y = ax*dsty+ay*dstx; + } + } + else + { + // + // optimized case + // + double ax = alpha.x, ay = alpha.y; + for(i=0; ix, dsty = vdst->y; + vdst->x = ax*dstx-ay*dsty; + vdst->y = ax*dsty+ay*dstx; + } + } +} + +void alglib::vmul(alglib::complex *vdst, ae_int_t N, alglib::complex alpha) +{ + vmul(vdst, 1, N, alpha); +} + + +/******************************************************************** +Matrices and vectors +********************************************************************/ +alglib::ae_vector_wrapper::ae_vector_wrapper() +{ + p_vec = NULL; +} + +alglib::ae_vector_wrapper::~ae_vector_wrapper() +{ + if( p_vec==&vec ) + ae_vector_clear(p_vec); +} + +void alglib::ae_vector_wrapper::setlength(ae_int_t iLen) +{ + if( p_vec==NULL ) + throw alglib::ap_error("ALGLIB: setlength() error, p_vec==NULL (array was not correctly initialized)"); + if( p_vec!=&vec ) + throw alglib::ap_error("ALGLIB: setlength() error, p_vec!=&vec (attempt to resize frozen array)"); + if( !ae_vector_set_length(p_vec, iLen, NULL) ) + throw alglib::ap_error("ALGLIB: malloc error"); +} + +alglib::ae_int_t alglib::ae_vector_wrapper::length() const +{ + if( p_vec==NULL ) + return 0; + return p_vec->cnt; +} + +void alglib::ae_vector_wrapper::attach_to(alglib_impl::ae_vector *ptr) +{ + if( ptr==&vec ) + throw alglib::ap_error("ALGLIB: attempt to attach vector to itself"); + if( p_vec==&vec ) + ae_vector_clear(p_vec); + p_vec = ptr; +} + +void alglib::ae_vector_wrapper::allocate_own(ae_int_t size, alglib_impl::ae_datatype datatype) +{ + if( p_vec==&vec ) + ae_vector_clear(p_vec); + p_vec = &vec; + if( !ae_vector_init(p_vec, size, datatype, NULL, false) ) + throw alglib::ap_error("ALGLIB: malloc error"); +} + +const alglib_impl::ae_vector* alglib::ae_vector_wrapper::c_ptr() const +{ + return p_vec; +} + +alglib_impl::ae_vector* alglib::ae_vector_wrapper::c_ptr() +{ + return p_vec; +} + +void alglib::ae_vector_wrapper::create(const alglib::ae_vector_wrapper &rhs) +{ + if( rhs.p_vec!=NULL ) + { + p_vec = &vec; + if( !ae_vector_init_copy(p_vec, rhs.p_vec, NULL, ae_false) ) + throw alglib::ap_error("ALGLIB: malloc error!"); + } + else + p_vec = NULL; +} + +void alglib::ae_vector_wrapper::create(const char *s, alglib_impl::ae_datatype datatype) +{ + std::vector svec; + size_t i; + char *p = filter_spaces(s); + try + { + str_vector_create(p, true, &svec); + allocate_own((ae_int_t)(svec.size()), datatype); + for(i=0; iptr.p_bool[i] = parse_bool_delim(svec[i],",]"); + if( datatype==alglib_impl::DT_INT ) + p_vec->ptr.p_int[i] = parse_int_delim(svec[i],",]"); + if( datatype==alglib_impl::DT_REAL ) + p_vec->ptr.p_double[i] = parse_real_delim(svec[i],",]"); + if( datatype==alglib_impl::DT_COMPLEX ) + { + alglib::complex t = parse_complex_delim(svec[i],",]"); + p_vec->ptr.p_complex[i].x = t.x; + p_vec->ptr.p_complex[i].y = t.y; + } + } + alglib_impl::ae_free(p); + } + catch(...) + { + alglib_impl::ae_free(p); + throw; + } +} + +void alglib::ae_vector_wrapper::assign(const alglib::ae_vector_wrapper &rhs) +{ + if( this==&rhs ) + return; + if( p_vec==&vec || p_vec==NULL ) + { + // + // Assignment to non-proxy object + // + ae_vector_clear(p_vec); + if( rhs.p_vec!=NULL ) + { + p_vec = &vec; + if( !ae_vector_init_copy(p_vec, rhs.p_vec, NULL, ae_false) ) + throw alglib::ap_error("ALGLIB: malloc error!"); + } + else + p_vec = NULL; + } + else + { + // + // Assignment to proxy object + // + if( rhs.p_vec==NULL ) + throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes dont match)"); + if( rhs.p_vec->datatype!=p_vec->datatype ) + throw alglib::ap_error("ALGLIB: incorrect assignment to array (types dont match)"); + if( rhs.p_vec->cnt!=p_vec->cnt ) + throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes dont match)"); + memcpy(p_vec->ptr.p_ptr, rhs.p_vec->ptr.p_ptr, p_vec->cnt*alglib_impl::ae_sizeof(p_vec->datatype)); + } +} + +alglib::boolean_1d_array::boolean_1d_array() +{ + allocate_own(0, alglib_impl::DT_BOOL); +} + +alglib::boolean_1d_array::boolean_1d_array(const char *s) +{ + create(s, alglib_impl::DT_BOOL); +} + +alglib::boolean_1d_array::boolean_1d_array(const alglib::boolean_1d_array &rhs) +{ + create(rhs); +} + +alglib::boolean_1d_array::boolean_1d_array(alglib_impl::ae_vector *p) +{ + p_vec = NULL; + attach_to(p); +} + +const alglib::boolean_1d_array& alglib::boolean_1d_array::operator=(const alglib::boolean_1d_array &rhs) +{ + assign(rhs); + return *this; +} + +alglib::boolean_1d_array::~boolean_1d_array() +{ +} + +const ae_bool& alglib::boolean_1d_array::operator()(ae_int_t i) const +{ + return p_vec->ptr.p_bool[i]; +} + +ae_bool& alglib::boolean_1d_array::operator()(ae_int_t i) +{ + return p_vec->ptr.p_bool[i]; +} + +const ae_bool& alglib::boolean_1d_array::operator[](ae_int_t i) const +{ + return p_vec->ptr.p_bool[i]; +} + +ae_bool& alglib::boolean_1d_array::operator[](ae_int_t i) +{ + return p_vec->ptr.p_bool[i]; +} + +void alglib::boolean_1d_array::setcontent(ae_int_t iLen, const bool *pContent ) +{ + ae_int_t i; + setlength(iLen); + for(i=0; iptr.p_bool[i] = pContent[i]; +} + +ae_bool* alglib::boolean_1d_array::getcontent() +{ + return p_vec->ptr.p_bool; +} + +const ae_bool* alglib::boolean_1d_array::getcontent() const +{ + return p_vec->ptr.p_bool; +} + +std::string alglib::boolean_1d_array::tostring() const +{ + if( length()==0 ) + return "[]"; + return arraytostring(&(operator()(0)), length()); +} + +alglib::integer_1d_array::integer_1d_array() +{ + allocate_own(0, alglib_impl::DT_INT); +} + +alglib::integer_1d_array::integer_1d_array(alglib_impl::ae_vector *p) +{ + p_vec = NULL; + attach_to(p); +} + +alglib::integer_1d_array::integer_1d_array(const char *s) +{ + create(s, alglib_impl::DT_INT); +} + +alglib::integer_1d_array::integer_1d_array(const alglib::integer_1d_array &rhs) +{ + create(rhs); +} + +const alglib::integer_1d_array& alglib::integer_1d_array::operator=(const alglib::integer_1d_array &rhs) +{ + assign(rhs); + return *this; +} + +alglib::integer_1d_array::~integer_1d_array() +{ +} + +const alglib::ae_int_t& alglib::integer_1d_array::operator()(ae_int_t i) const +{ + return p_vec->ptr.p_int[i]; +} + +alglib::ae_int_t& alglib::integer_1d_array::operator()(ae_int_t i) +{ + return p_vec->ptr.p_int[i]; +} + +const alglib::ae_int_t& alglib::integer_1d_array::operator[](ae_int_t i) const +{ + return p_vec->ptr.p_int[i]; +} + +alglib::ae_int_t& alglib::integer_1d_array::operator[](ae_int_t i) +{ + return p_vec->ptr.p_int[i]; +} + +void alglib::integer_1d_array::setcontent(ae_int_t iLen, const ae_int_t *pContent ) +{ + ae_int_t i; + setlength(iLen); + for(i=0; iptr.p_int[i] = pContent[i]; +} + +alglib::ae_int_t* alglib::integer_1d_array::getcontent() +{ + return p_vec->ptr.p_int; +} + +const alglib::ae_int_t* alglib::integer_1d_array::getcontent() const +{ + return p_vec->ptr.p_int; +} + +std::string alglib::integer_1d_array::tostring() const +{ + if( length()==0 ) + return "[]"; + return arraytostring(&operator()(0), length()); +} + +alglib::real_1d_array::real_1d_array() +{ + allocate_own(0, alglib_impl::DT_REAL); +} + +alglib::real_1d_array::real_1d_array(alglib_impl::ae_vector *p) +{ + p_vec = NULL; + attach_to(p); +} + +alglib::real_1d_array::real_1d_array(const char *s) +{ + create(s, alglib_impl::DT_REAL); +} + +alglib::real_1d_array::real_1d_array(const alglib::real_1d_array &rhs) +{ + create(rhs); +} + +const alglib::real_1d_array& alglib::real_1d_array::operator=(const alglib::real_1d_array &rhs) +{ + assign(rhs); + return *this; +} + +alglib::real_1d_array::~real_1d_array() +{ +} + +const double& alglib::real_1d_array::operator()(ae_int_t i) const +{ + return p_vec->ptr.p_double[i]; +} + +double& alglib::real_1d_array::operator()(ae_int_t i) +{ + return p_vec->ptr.p_double[i]; +} + +const double& alglib::real_1d_array::operator[](ae_int_t i) const +{ + return p_vec->ptr.p_double[i]; +} + +double& alglib::real_1d_array::operator[](ae_int_t i) +{ + return p_vec->ptr.p_double[i]; +} + +void alglib::real_1d_array::setcontent(ae_int_t iLen, const double *pContent ) +{ + ae_int_t i; + setlength(iLen); + for(i=0; iptr.p_double[i] = pContent[i]; +} + +double* alglib::real_1d_array::getcontent() +{ + return p_vec->ptr.p_double; +} + +const double* alglib::real_1d_array::getcontent() const +{ + return p_vec->ptr.p_double; +} + +std::string alglib::real_1d_array::tostring(int dps) const +{ + if( length()==0 ) + return "[]"; + return arraytostring(&operator()(0), length(), dps); +} + +alglib::complex_1d_array::complex_1d_array() +{ + allocate_own(0, alglib_impl::DT_COMPLEX); +} + +alglib::complex_1d_array::complex_1d_array(alglib_impl::ae_vector *p) +{ + p_vec = NULL; + attach_to(p); +} + +alglib::complex_1d_array::complex_1d_array(const char *s) +{ + create(s, alglib_impl::DT_COMPLEX); +} + +alglib::complex_1d_array::complex_1d_array(const alglib::complex_1d_array &rhs) +{ + create(rhs); +} + +const alglib::complex_1d_array& alglib::complex_1d_array::operator=(const alglib::complex_1d_array &rhs) +{ + assign(rhs); + return *this; +} + +alglib::complex_1d_array::~complex_1d_array() +{ +} + +const alglib::complex& alglib::complex_1d_array::operator()(ae_int_t i) const +{ + return *((const alglib::complex*)(p_vec->ptr.p_complex+i)); +} + +alglib::complex& alglib::complex_1d_array::operator()(ae_int_t i) +{ + return *((alglib::complex*)(p_vec->ptr.p_complex+i)); +} + +const alglib::complex& alglib::complex_1d_array::operator[](ae_int_t i) const +{ + return *((const alglib::complex*)(p_vec->ptr.p_complex+i)); +} + +alglib::complex& alglib::complex_1d_array::operator[](ae_int_t i) +{ + return *((alglib::complex*)(p_vec->ptr.p_complex+i)); +} + +void alglib::complex_1d_array::setcontent(ae_int_t iLen, const alglib::complex *pContent ) +{ + ae_int_t i; + setlength(iLen); + for(i=0; iptr.p_complex[i].x = pContent[i].x; + p_vec->ptr.p_complex[i].y = pContent[i].y; + } +} + + alglib::complex* alglib::complex_1d_array::getcontent() +{ + return (alglib::complex*)p_vec->ptr.p_complex; +} + +const alglib::complex* alglib::complex_1d_array::getcontent() const +{ + return (const alglib::complex*)p_vec->ptr.p_complex; +} + +std::string alglib::complex_1d_array::tostring(int dps) const +{ + if( length()==0 ) + return "[]"; + return arraytostring(&operator()(0), length(), dps); +} + +alglib::ae_matrix_wrapper::ae_matrix_wrapper() +{ + p_mat = NULL; +} + +alglib::ae_matrix_wrapper::~ae_matrix_wrapper() +{ + if( p_mat==&mat ) + ae_matrix_clear(p_mat); +} + +const alglib::ae_matrix_wrapper& alglib::ae_matrix_wrapper::operator=(const alglib::ae_matrix_wrapper &rhs) +{ + assign(rhs); + return *this; +} + +void alglib::ae_matrix_wrapper::create(const ae_matrix_wrapper &rhs) +{ + if( rhs.p_mat!=NULL ) + { + p_mat = &mat; + if( !ae_matrix_init_copy(p_mat, rhs.p_mat, NULL, ae_false) ) + throw alglib::ap_error("ALGLIB: malloc error!"); + } + else + p_mat = NULL; +} + +void alglib::ae_matrix_wrapper::create(const char *s, alglib_impl::ae_datatype datatype) +{ + std::vector< std::vector > smat; + size_t i, j; + char *p = filter_spaces(s); + try + { + str_matrix_create(p, &smat); + if( smat.size()!=0 ) + { + allocate_own((ae_int_t)(smat.size()), (ae_int_t)(smat[0].size()), datatype); + for(i=0; iptr.pp_bool[i][j] = parse_bool_delim(smat[i][j],",]"); + if( datatype==alglib_impl::DT_INT ) + p_mat->ptr.pp_int[i][j] = parse_int_delim(smat[i][j],",]"); + if( datatype==alglib_impl::DT_REAL ) + p_mat->ptr.pp_double[i][j] = parse_real_delim(smat[i][j],",]"); + if( datatype==alglib_impl::DT_COMPLEX ) + { + alglib::complex t = parse_complex_delim(smat[i][j],",]"); + p_mat->ptr.pp_complex[i][j].x = t.x; + p_mat->ptr.pp_complex[i][j].y = t.y; + } + } + } + else + allocate_own(0, 0, datatype); + alglib_impl::ae_free(p); + } + catch(...) + { + alglib_impl::ae_free(p); + throw; + } +} + +void alglib::ae_matrix_wrapper::assign(const alglib::ae_matrix_wrapper &rhs) +{ + if( this==&rhs ) + return; + if( p_mat==&mat || p_mat==NULL ) + { + // + // Assignment to non-proxy object + // + ae_matrix_clear(p_mat); + if( rhs.p_mat!=NULL ) + { + p_mat = &mat; + if( !ae_matrix_init_copy(p_mat, rhs.p_mat, NULL, ae_false) ) + throw alglib::ap_error("ALGLIB: malloc error!"); + } + else + p_mat = NULL; + } + else + { + // + // Assignment to proxy object + // + ae_int_t i; + if( rhs.p_mat==NULL ) + throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes dont match)"); + if( rhs.p_mat->datatype!=p_mat->datatype ) + throw alglib::ap_error("ALGLIB: incorrect assignment to array (types dont match)"); + if( rhs.p_mat->rows!=p_mat->rows ) + throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes dont match)"); + if( rhs.p_mat->cols!=p_mat->cols ) + throw alglib::ap_error("ALGLIB: incorrect assignment to array (sizes dont match)"); + for(i=0; irows; i++) + memcpy(p_mat->ptr.pp_void[i], rhs.p_mat->ptr.pp_void[i], p_mat->cols*alglib_impl::ae_sizeof(p_mat->datatype)); + } +} + +void alglib::ae_matrix_wrapper::setlength(ae_int_t rows, ae_int_t cols) +{ + if( p_mat==NULL ) + throw alglib::ap_error("ALGLIB: setlength() error, p_mat==NULL (array was not correctly initialized)"); + if( p_mat!=&mat ) + throw alglib::ap_error("ALGLIB: setlength() error, p_mat!=&mat (attempt to resize frozen array)"); + if( !ae_matrix_set_length(p_mat, rows, cols, NULL) ) + throw alglib::ap_error("ALGLIB: malloc error"); +} + +alglib::ae_int_t alglib::ae_matrix_wrapper::rows() const +{ + if( p_mat==NULL ) + return 0; + return p_mat->rows; +} + +alglib::ae_int_t alglib::ae_matrix_wrapper::cols() const +{ + if( p_mat==NULL ) + return 0; + return p_mat->cols; +} + +bool alglib::ae_matrix_wrapper::isempty() const +{ + return rows()==0 || cols()==0; +} + +alglib::ae_int_t alglib::ae_matrix_wrapper::getstride() const +{ + if( p_mat==NULL ) + return 0; + return p_mat->stride; +} + +void alglib::ae_matrix_wrapper::attach_to(alglib_impl::ae_matrix *ptr) +{ + if( ptr==&mat ) + throw alglib::ap_error("ALGLIB: attempt to attach matrix to itself"); + if( p_mat==&mat ) + ae_matrix_clear(p_mat); + p_mat = ptr; +} + +void alglib::ae_matrix_wrapper::allocate_own(ae_int_t rows, ae_int_t cols, alglib_impl::ae_datatype datatype) +{ + if( p_mat==&mat ) + ae_matrix_clear(p_mat); + p_mat = &mat; + if( !ae_matrix_init(p_mat, rows, cols, datatype, NULL, false) ) + throw alglib::ap_error("ALGLIB: malloc error"); +} + +const alglib_impl::ae_matrix* alglib::ae_matrix_wrapper::c_ptr() const +{ + return p_mat; +} + +alglib_impl::ae_matrix* alglib::ae_matrix_wrapper::c_ptr() +{ + return p_mat; +} + +alglib::boolean_2d_array::boolean_2d_array() +{ + allocate_own(0, 0, alglib_impl::DT_BOOL); +} + +alglib::boolean_2d_array::boolean_2d_array(const alglib::boolean_2d_array &rhs) +{ + create(rhs); +} + +alglib::boolean_2d_array::boolean_2d_array(alglib_impl::ae_matrix *p) +{ + p_mat = NULL; + attach_to(p); +} + +alglib::boolean_2d_array::boolean_2d_array(const char *s) +{ + create(s, alglib_impl::DT_BOOL); +} + +alglib::boolean_2d_array::~boolean_2d_array() +{ +} + +const ae_bool& alglib::boolean_2d_array::operator()(ae_int_t i, ae_int_t j) const +{ + return p_mat->ptr.pp_bool[i][j]; +} + +ae_bool& alglib::boolean_2d_array::operator()(ae_int_t i, ae_int_t j) +{ + return p_mat->ptr.pp_bool[i][j]; +} + +const ae_bool* alglib::boolean_2d_array::operator[](ae_int_t i) const +{ + return p_mat->ptr.pp_bool[i]; +} + +ae_bool* alglib::boolean_2d_array::operator[](ae_int_t i) +{ + return p_mat->ptr.pp_bool[i]; +} + +void alglib::boolean_2d_array::setcontent(ae_int_t irows, ae_int_t icols, const bool *pContent ) +{ + ae_int_t i, j; + setlength(irows, icols); + for(i=0; iptr.pp_bool[i][j] = pContent[i*icols+j]; +} + +std::string alglib::boolean_2d_array::tostring() const +{ + std::string result; + ae_int_t i; + if( isempty() ) + return "[[]]"; + result = "["; + for(i=0; iptr.pp_int[i][j]; +} + +alglib::ae_int_t& alglib::integer_2d_array::operator()(ae_int_t i, ae_int_t j) +{ + return p_mat->ptr.pp_int[i][j]; +} + +const alglib::ae_int_t* alglib::integer_2d_array::operator[](ae_int_t i) const +{ + return p_mat->ptr.pp_int[i]; +} + +alglib::ae_int_t* alglib::integer_2d_array::operator[](ae_int_t i) +{ + return p_mat->ptr.pp_int[i]; +} + +void alglib::integer_2d_array::setcontent(ae_int_t irows, ae_int_t icols, const ae_int_t *pContent ) +{ + ae_int_t i, j; + setlength(irows, icols); + for(i=0; iptr.pp_int[i][j] = pContent[i*icols+j]; +} + +std::string alglib::integer_2d_array::tostring() const +{ + std::string result; + ae_int_t i; + if( isempty() ) + return "[[]]"; + result = "["; + for(i=0; iptr.pp_double[i][j]; +} + +double& alglib::real_2d_array::operator()(ae_int_t i, ae_int_t j) +{ + return p_mat->ptr.pp_double[i][j]; +} + +const double* alglib::real_2d_array::operator[](ae_int_t i) const +{ + return p_mat->ptr.pp_double[i]; +} + +double* alglib::real_2d_array::operator[](ae_int_t i) +{ + return p_mat->ptr.pp_double[i]; +} + +void alglib::real_2d_array::setcontent(ae_int_t irows, ae_int_t icols, const double *pContent ) +{ + ae_int_t i, j; + setlength(irows, icols); + for(i=0; iptr.pp_double[i][j] = pContent[i*icols+j]; +} + +std::string alglib::real_2d_array::tostring(int dps) const +{ + std::string result; + ae_int_t i; + if( isempty() ) + return "[[]]"; + result = "["; + for(i=0; iptr.pp_complex[i]+j)); +} + +alglib::complex& alglib::complex_2d_array::operator()(ae_int_t i, ae_int_t j) +{ + return *((alglib::complex*)(p_mat->ptr.pp_complex[i]+j)); +} + +const alglib::complex* alglib::complex_2d_array::operator[](ae_int_t i) const +{ + return (const alglib::complex*)(p_mat->ptr.pp_complex[i]); +} + +alglib::complex* alglib::complex_2d_array::operator[](ae_int_t i) +{ + return (alglib::complex*)(p_mat->ptr.pp_complex[i]); +} + +void alglib::complex_2d_array::setcontent(ae_int_t irows, ae_int_t icols, const alglib::complex *pContent ) +{ + ae_int_t i, j; + setlength(irows, icols); + for(i=0; iptr.pp_complex[i][j].x = pContent[i*icols+j].x; + p_mat->ptr.pp_complex[i][j].y = pContent[i*icols+j].y; + } +} + +std::string alglib::complex_2d_array::tostring(int dps) const +{ + std::string result; + ae_int_t i; + if( isempty() ) + return "[[]]"; + result = "["; + for(i=0; ic2 ) + return +1; + } +} + +char* alglib::filter_spaces(const char *s) +{ + size_t i, n; + char *r; + char *r0; + n = strlen(s); + r = (char*)alglib_impl::ae_malloc(n+1, NULL); + if( r==NULL ) + throw ap_error("malloc error"); + for(i=0,r0=r; i<=n; i++,s++) + if( !isspace(*s) ) + { + *r0 = *s; + r0++; + } + return r; +} + +void alglib::str_vector_create(const char *src, bool match_head_only, std::vector *p_vec) +{ + // + // parse beginning of the string. + // try to handle "[]" string + // + p_vec->clear(); + if( *src!='[' ) + throw alglib::ap_error("Incorrect initializer for vector"); + src++; + if( *src==']' ) + return; + p_vec->push_back(src); + for(;;) + { + if( *src==0 ) + throw alglib::ap_error("Incorrect initializer for vector"); + if( *src==']' ) + { + if( src[1]==0 || !match_head_only) + return; + throw alglib::ap_error("Incorrect initializer for vector"); + } + if( *src==',' ) + { + p_vec->push_back(src+1); + src++; + continue; + } + src++; + } +} + +void alglib::str_matrix_create(const char *src, std::vector< std::vector > *p_mat) +{ + p_mat->clear(); + + // + // Try to handle "[[]]" string + // + if( strcmp(src, "[[]]")==0 ) + return; + + // + // Parse non-empty string + // + if( *src!='[' ) + throw alglib::ap_error("Incorrect initializer for matrix"); + src++; + for(;;) + { + p_mat->push_back(std::vector()); + str_vector_create(src, false, &p_mat->back()); + if( p_mat->back().size()==0 || p_mat->back().size()!=(*p_mat)[0].size() ) + throw alglib::ap_error("Incorrect initializer for matrix"); + src = strchr(src, ']'); + if( src==NULL ) + throw alglib::ap_error("Incorrect initializer for matrix"); + src++; + if( *src==',' ) + { + src++; + continue; + } + if( *src==']' ) + break; + throw alglib::ap_error("Incorrect initializer for matrix"); + } + src++; + if( *src!=0 ) + throw alglib::ap_error("Incorrect initializer for matrix"); +} + +ae_bool alglib::parse_bool_delim(const char *s, const char *delim) +{ + const char *p; + char buf[8]; + + // try to parse false + p = "false"; + memset(buf, 0, sizeof(buf)); + strncpy(buf, s, strlen(p)); + if( my_stricmp(buf, p)==0 ) + { + if( s[strlen(p)]==0 || strchr(delim,s[strlen(p)])==NULL ) + throw alglib::ap_error("Cannot parse value"); + return ae_false; + } + + // try to parse true + p = "true"; + memset(buf, 0, sizeof(buf)); + strncpy(buf, s, strlen(p)); + if( my_stricmp(buf, p)==0 ) + { + if( s[strlen(p)]==0 || strchr(delim,s[strlen(p)])==NULL ) + throw alglib::ap_error("Cannot parse value"); + return ae_true; + } + + // error + throw alglib::ap_error("Cannot parse value"); +} + +alglib::ae_int_t alglib::parse_int_delim(const char *s, const char *delim) +{ + const char *p; + long long_val; + volatile ae_int_t ae_val; + + p = s; + + // + // check string structure: + // * leading sign + // * at least one digit + // * delimiter + // + if( *s=='-' || *s=='+' ) + s++; + if( *s==0 || strchr("1234567890",*s)==NULL) + throw alglib::ap_error("Cannot parse value"); + while( *s!=0 && strchr("1234567890",*s)!=NULL ) + s++; + if( *s==0 || strchr(delim,*s)==NULL ) + throw alglib::ap_error("Cannot parse value"); + + // convert and ensure that value fits into ae_int_t + s = p; + long_val = atol(s); + ae_val = long_val; + if( ae_val!=long_val ) + throw alglib::ap_error("Cannot parse value"); + return ae_val; +} + +bool alglib::_parse_real_delim(const char *s, const char *delim, double *result, const char **new_s) +{ + const char *p; + char *t; + bool has_digits; + char buf[64]; + int isign; + lconv *loc; + + p = s; + + // + // check string structure and decide what to do + // + isign = 1; + if( *s=='-' || *s=='+' ) + { + isign = *s=='-' ? -1 : +1; + s++; + } + memset(buf, 0, sizeof(buf)); + strncpy(buf, s, 3); + if( my_stricmp(buf,"nan")!=0 && my_stricmp(buf,"inf")!=0 ) + { + // + // [sign] [ddd] [.] [ddd] [e|E[sign]ddd] + // + has_digits = false; + if( *s!=0 && strchr("1234567890",*s)!=NULL ) + { + has_digits = true; + while( *s!=0 && strchr("1234567890",*s)!=NULL ) + s++; + } + if( *s=='.' ) + s++; + if( *s!=0 && strchr("1234567890",*s)!=NULL ) + { + has_digits = true; + while( *s!=0 && strchr("1234567890",*s)!=NULL ) + s++; + } + if (!has_digits ) + return false; + if( *s=='e' || *s=='E' ) + { + s++; + if( *s=='-' || *s=='+' ) + s++; + if( *s==0 || strchr("1234567890",*s)==NULL ) + return false; + while( *s!=0 && strchr("1234567890",*s)!=NULL ) + s++; + } + if( *s==0 || strchr(delim,*s)==NULL ) + return false; + *new_s = s; + + // + // finite value conversion + // + if( *new_s-p>=(int)sizeof(buf) ) + return false; + strncpy(buf, p, (size_t)(*new_s-p)); + buf[*new_s-p] = 0; + loc = localeconv(); + t = strchr(buf,'.'); + if( t!=NULL ) + *t = *loc->decimal_point; + *result = atof(buf); + return true; + } + else + { + // + // check delimiter and update *new_s + // + s += 3; + if( *s==0 || strchr(delim,*s)==NULL ) + return false; + *new_s = s; + + // + // NAN, INF conversion + // + if( my_stricmp(buf,"nan")==0 ) + *result = fp_nan; + if( my_stricmp(buf,"inf")==0 ) + *result = isign>0 ? fp_posinf : fp_neginf; + return true; + } +} + +double alglib::parse_real_delim(const char *s, const char *delim) +{ + double result; + const char *new_s; + if( !_parse_real_delim(s, delim, &result, &new_s) ) + throw alglib::ap_error("Cannot parse value"); + return result; +} + +alglib::complex alglib::parse_complex_delim(const char *s, const char *delim) +{ + double d_result; + const char *new_s; + alglib::complex c_result; + + // parse as real value + if( _parse_real_delim(s, delim, &d_result, &new_s) ) + return d_result; + + // parse as "a+bi" or "a-bi" + if( _parse_real_delim(s, "+-", &c_result.x, &new_s) ) + { + s = new_s; + if( !_parse_real_delim(s, "i", &c_result.y, &new_s) ) + throw alglib::ap_error("Cannot parse value"); + s = new_s+1; + if( *s==0 || strchr(delim,*s)==NULL ) + throw alglib::ap_error("Cannot parse value"); + return c_result; + } + + // parse as complex value "bi+a" or "bi-a" + if( _parse_real_delim(s, "i", &c_result.y, &new_s) ) + { + s = new_s+1; + if( *s==0 ) + throw alglib::ap_error("Cannot parse value"); + if( strchr(delim,*s)!=NULL ) + { + c_result.x = 0; + return c_result; + } + if( strchr("+-",*s)!=NULL ) + { + if( !_parse_real_delim(s, delim, &c_result.x, &new_s) ) + throw alglib::ap_error("Cannot parse value"); + return c_result; + } + throw alglib::ap_error("Cannot parse value"); + } + + // error + throw alglib::ap_error("Cannot parse value"); +} + +std::string alglib::arraytostring(const bool *ptr, ae_int_t n) +{ + std::string result; + ae_int_t i; + result = "["; + for(i=0; i=(int)sizeof(buf) ) + throw ap_error("arraytostring(): buffer overflow"); + result += buf; + } + result += "]"; + return result; +} + +std::string alglib::arraytostring(const double *ptr, ae_int_t n, int _dps) +{ + std::string result; + ae_int_t i; + char buf[64]; + char mask1[64]; + char mask2[64]; + int dps = _dps>=0 ? _dps : -_dps; + result = "["; + if( sprintf(mask1, "%%.%d%s", dps, _dps>=0 ? "f" : "e")>=(int)sizeof(mask1) ) + throw ap_error("arraytostring(): buffer overflow"); + if( sprintf(mask2, ",%s", mask1)>=(int)sizeof(mask2) ) + throw ap_error("arraytostring(): buffer overflow"); + for(i=0; i=(int)sizeof(buf) ) + throw ap_error("arraytostring(): buffer overflow"); + } + else if( fp_isnan(ptr[i]) ) + strcpy(buf, i==0 ? "NAN" : ",NAN"); + else if( fp_isposinf(ptr[i]) ) + strcpy(buf, i==0 ? "+INF" : ",+INF"); + else if( fp_isneginf(ptr[i]) ) + strcpy(buf, i==0 ? "-INF" : ",-INF"); + result += buf; + } + result += "]"; + return result; +} + +std::string alglib::arraytostring(const alglib::complex *ptr, ae_int_t n, int dps) +{ + std::string result; + ae_int_t i; + result = "["; + for(i=0; i0 ) return 1; + if( x<0 ) return -1; + return 0; +} + +double alglib::randomreal() +{ +#ifdef AE_DEBUGRNG + return alglib_impl::ae_debugrng()/2147483563.0; +#else + int i1 = rand(); + int i2 = rand(); + double mx = (double)(RAND_MAX)+1.0; + volatile double tmp0 = i2/mx; + volatile double tmp1 = i1+tmp0; + return tmp1/mx; +#endif +} + +alglib::ae_int_t alglib::randominteger(alglib::ae_int_t maxv) +{ +#ifdef AE_DEBUGRNG + return ((alglib::ae_int_t)(alglib_impl::ae_debugrng()-1))%maxv; +#else + return ((alglib::ae_int_t)rand())%maxv; +#endif +} + +int alglib::round(double x) +{ return int(floor(x+0.5)); } + +int alglib::trunc(double x) +{ return int(x>0 ? floor(x) : ceil(x)); } + +int alglib::ifloor(double x) +{ return int(floor(x)); } + +int alglib::iceil(double x) +{ return int(ceil(x)); } + +double alglib::pi() +{ return 3.14159265358979323846; } + +double alglib::sqr(double x) +{ return x*x; } + +int alglib::maxint(int m1, int m2) +{ + return m1>m2 ? m1 : m2; +} + +int alglib::minint(int m1, int m2) +{ + return m1>m2 ? m2 : m1; +} + +double alglib::maxreal(double m1, double m2) +{ + return m1>m2 ? m1 : m2; +} + +double alglib::minreal(double m1, double m2) +{ + return m1>m2 ? m2 : m1; +} + +bool alglib::fp_eq(double v1, double v2) +{ + // IEEE-strict floating point comparison + volatile double x = v1; + volatile double y = v2; + return x==y; +} + +bool alglib::fp_neq(double v1, double v2) +{ + // IEEE-strict floating point comparison + return !fp_eq(v1,v2); +} + +bool alglib::fp_less(double v1, double v2) +{ + // IEEE-strict floating point comparison + volatile double x = v1; + volatile double y = v2; + return xy; +} + +bool alglib::fp_greater_eq(double v1, double v2) +{ + // IEEE-strict floating point comparison + volatile double x = v1; + volatile double y = v2; + return x>=y; +} + +bool alglib::fp_isnan(double x) +{ + return alglib_impl::ae_isnan_stateless(x,endianness); +} + +bool alglib::fp_isposinf(double x) +{ + return alglib_impl::ae_isposinf_stateless(x,endianness); +} + +bool alglib::fp_isneginf(double x) +{ + return alglib_impl::ae_isneginf_stateless(x,endianness); +} + +bool alglib::fp_isinf(double x) +{ + return alglib_impl::ae_isinf_stateless(x,endianness); +} + +bool alglib::fp_isfinite(double x) +{ + return alglib_impl::ae_isfinite_stateless(x,endianness); +} + +/******************************************************************** +Dataset functions +********************************************************************/ +/*bool alglib::readstrings(std::string file, std::list *pOutput) +{ + return readstrings(file, pOutput, ""); +} + +bool alglib::readstrings(std::string file, std::list *pOutput, std::string comment) +{ + std::string cmd, s; + FILE *f; + char buf[32768]; + char *str; + + f = fopen(file.c_str(), "rb"); + if( !f ) + return false; + s = ""; + pOutput->clear(); + while(str=fgets(buf, sizeof(buf), f)) + { + // TODO: read file by small chunks, combine in one large string + if( strlen(str)==0 ) + continue; + + // + // trim trailing newline chars + // + char *eos = str+strlen(str)-1; + if( *eos=='\n' ) + { + *eos = 0; + eos--; + } + if( *eos=='\r' ) + { + *eos = 0; + eos--; + } + s = str; + + // + // skip comments + // + if( comment.length()>0 ) + if( strncmp(s.c_str(), comment.c_str(), comment.length())==0 ) + { + s = ""; + continue; + } + + // + // read data + // + if( s.length()<1 ) + { + fclose(f); + throw alglib::ap_error("internal error in read_strings"); + } + pOutput->push_back(s); + } + fclose(f); + return true; +} + +void alglib::explodestring(std::string s, char sep, std::vector *pOutput) +{ + std::string tmp; + int i; + tmp = ""; + pOutput->clear(); + for(i=0; ipush_back(tmp); + tmp = ""; + } + if( tmp.length()!=0 ) + pOutput->push_back(tmp); +} + +std::string alglib::strtolower(const std::string &s) +{ + std::string r = s; + for(int i=0; i Lines; + std::vector Values, RowsArr, ColsArr, VarsArr, HeadArr; + std::list::iterator i; + std::string s; + int TrnFirst, TrnLast, ValFirst, ValLast, TstFirst, TstLast, LinesRead, j; + + // + // Read data + // + if( pdataset==NULL ) + return false; + if( !readstrings(file, &Lines, "//") ) + return false; + i = Lines.begin(); + *pdataset = dataset(); + + // + // Read header + // + if( i==Lines.end() ) + return false; + s = alglib::xtrim(*i); + alglib::explodestring(s, '#', &HeadArr); + if( HeadArr.size()!=2 ) + return false; + + // + // Rows info + // + alglib::explodestring(alglib::xtrim(HeadArr[0]), ' ', &RowsArr); + if( RowsArr.size()==0 || RowsArr.size()>3 ) + return false; + if( RowsArr.size()==1 ) + { + pdataset->totalsize = atol(RowsArr[0].c_str()); + pdataset->trnsize = pdataset->totalsize; + } + if( RowsArr.size()==2 ) + { + pdataset->trnsize = atol(RowsArr[0].c_str()); + pdataset->tstsize = atol(RowsArr[1].c_str()); + pdataset->totalsize = pdataset->trnsize + pdataset->tstsize; + } + if( RowsArr.size()==3 ) + { + pdataset->trnsize = atol(RowsArr[0].c_str()); + pdataset->valsize = atol(RowsArr[1].c_str()); + pdataset->tstsize = atol(RowsArr[2].c_str()); + pdataset->totalsize = pdataset->trnsize + pdataset->valsize + pdataset->tstsize; + } + if( pdataset->totalsize<=0 || pdataset->trnsize<0 || pdataset->valsize<0 || pdataset->tstsize<0 ) + return false; + TrnFirst = 0; + TrnLast = TrnFirst + pdataset->trnsize; + ValFirst = TrnLast; + ValLast = ValFirst + pdataset->valsize; + TstFirst = ValLast; + TstLast = TstFirst + pdataset->tstsize; + + // + // columns + // + alglib::explodestring(alglib::xtrim(HeadArr[1]), ' ', &ColsArr); + if( ColsArr.size()!=1 && ColsArr.size()!=4 ) + return false; + if( ColsArr.size()==1 ) + { + pdataset->nin = atoi(ColsArr[0].c_str()); + if( pdataset->nin<=0 ) + return false; + } + if( ColsArr.size()==4 ) + { + if( alglib::strtolower(ColsArr[0])!="reg" && alglib::strtolower(ColsArr[0])!="cls" ) + return false; + if( ColsArr[2]!="=>" ) + return false; + pdataset->nin = atol(ColsArr[1].c_str()); + if( pdataset->nin<1 ) + return false; + if( alglib::strtolower(ColsArr[0])=="reg" ) + { + pdataset->nclasses = 0; + pdataset->nout = atol(ColsArr[3].c_str()); + if( pdataset->nout<1 ) + return false; + } + else + { + pdataset->nclasses = atol(ColsArr[3].c_str()); + pdataset->nout = 1; + if( pdataset->nclasses<2 ) + return false; + } + } + + // + // initialize arrays + // + pdataset->all.setlength(pdataset->totalsize, pdataset->nin+pdataset->nout); + if( pdataset->trnsize>0 ) pdataset->trn.setlength(pdataset->trnsize, pdataset->nin+pdataset->nout); + if( pdataset->valsize>0 ) pdataset->val.setlength(pdataset->valsize, pdataset->nin+pdataset->nout); + if( pdataset->tstsize>0 ) pdataset->tst.setlength(pdataset->tstsize, pdataset->nin+pdataset->nout); + + // + // read data + // + for(LinesRead=0, i++; i!=Lines.end() && LinesReadtotalsize; i++, LinesRead++) + { + std::string sss = *i; + alglib::explodestring(alglib::xtrim(*i), ' ', &VarsArr); + if( VarsArr.size()!=pdataset->nin+pdataset->nout ) + return false; + int tmpc = alglib::round(atof(VarsArr[pdataset->nin+pdataset->nout-1].c_str())); + if( pdataset->nclasses>0 && (tmpc<0 || tmpc>=pdataset->nclasses) ) + return false; + for(j=0; jnin+pdataset->nout; j++) + { + pdataset->all(LinesRead,j) = atof(VarsArr[j].c_str()); + if( LinesRead>=TrnFirst && LinesReadtrn(LinesRead-TrnFirst,j) = atof(VarsArr[j].c_str()); + if( LinesRead>=ValFirst && LinesReadval(LinesRead-ValFirst,j) = atof(VarsArr[j].c_str()); + if( LinesRead>=TstFirst && LinesReadtst(LinesRead-TstFirst,j) = atof(VarsArr[j].c_str()); + } + } + if( LinesRead!=pdataset->totalsize ) + return false; + return true; +}*/ + +/* +previous variant +bool alglib::opendataset(std::string file, dataset *pdataset) +{ + std::list Lines; + std::vector Values; + std::list::iterator i; + int nCol, nRow, nSplitted; + int nColumns, nRows; + + // + // Read data + // + if( pdataset==NULL ) + return false; + if( !readstrings(file, &Lines, "//") ) + return false; + i = Lines.begin(); + *pdataset = dataset(); + + // + // Read columns info + // + if( i==Lines.end() ) + return false; + if( sscanf(i->c_str(), " columns = %d %d ", &pdataset->nin, &pdataset->nout)!=2 ) + return false; + if( pdataset->nin<=0 || pdataset->nout==0 || pdataset->nout==-1) + return false; + if( pdataset->nout<0 ) + { + pdataset->nclasses = -pdataset->nout; + pdataset->nout = 1; + pdataset->iscls = true; + } + else + { + pdataset->isreg = true; + } + nColumns = pdataset->nin+pdataset->nout; + i++; + + // + // Read rows info + // + if( i==Lines.end() ) + return false; + if( sscanf(i->c_str(), " rows = %d %d %d ", &pdataset->trnsize, &pdataset->valsize, &pdataset->tstsize)!=3 ) + return false; + if( (pdataset->trnsize<0) || (pdataset->valsize<0) || (pdataset->tstsize<0) ) + return false; + if( (pdataset->trnsize==0) && (pdataset->valsize==0) && (pdataset->tstsize==0) ) + return false; + nRows = pdataset->trnsize+pdataset->valsize+pdataset->tstsize; + pdataset->size = nRows; + if( Lines.size()!=nRows+2 ) + return false; + i++; + + // + // Read all cases + // + alglib::real_2d_array &arr = pdataset->all; + arr.setbounds(0, nRows-1, 0, nColumns-1); + for(nRow=0; nRowiscls && ((round(v)<0) || (round(v)>=pdataset->nclasses)) ) + return false; + if( (nCol==nColumns-1) && pdataset->iscls ) + arr(nRow, nCol) = round(v); + else + arr(nRow, nCol) = v; + } + i++; + } + + // + // Split to training, validation and test sets + // + if( pdataset->trnsize>0 ) + pdataset->trn.setbounds(0, pdataset->trnsize-1, 0, nColumns-1); + if( pdataset->valsize>0 ) + pdataset->val.setbounds(0, pdataset->valsize-1, 0, nColumns-1); + if( pdataset->tstsize>0 ) + pdataset->tst.setbounds(0, pdataset->tstsize-1, 0, nColumns-1); + nSplitted=0; + for(nRow=0; nRow<=pdataset->trnsize-1; nRow++, nSplitted++) + for(nCol=0; nCol<=nColumns-1; nCol++) + pdataset->trn(nRow,nCol) = arr(nSplitted,nCol); + for(nRow=0; nRow<=pdataset->valsize-1; nRow++, nSplitted++) + for(nCol=0; nCol<=nColumns-1; nCol++) + pdataset->val(nRow,nCol) = arr(nSplitted,nCol); + for(nRow=0; nRow<=pdataset->tstsize-1; nRow++, nSplitted++) + for(nCol=0; nCol<=nColumns-1; nCol++) + pdataset->tst(nRow,nCol) = arr(nSplitted,nCol); + return true; +}*/ + +alglib::ae_int_t alglib::vlen(ae_int_t n1, ae_int_t n2) +{ + return n2-n1+1; +} + + + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTIONS CONTAINS OPTIMIZED LINEAR ALGEBRA CODE +// IT IS SHARED BETWEEN C++ AND PURE C LIBRARIES +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +#define alglib_simd_alignment 16 + +#define alglib_r_block 32 +#define alglib_half_r_block 16 +#define alglib_twice_r_block 64 + +#define alglib_c_block 24 +#define alglib_half_c_block 12 +#define alglib_twice_c_block 48 + + +/******************************************************************** +This subroutine calculates fast 32x32 real matrix-vector product: + + y := beta*y + alpha*A*x + +using either generic C code or native optimizations (if available) + +IMPORTANT: +* A must be stored in row-major order, + stride is alglib_r_block, + aligned on alglib_simd_alignment boundary +* X must be aligned on alglib_simd_alignment boundary +* Y may be non-aligned +********************************************************************/ +void _ialglib_mv_32(const double *a, const double *x, double *y, ae_int_t stride, double alpha, double beta) +{ + ae_int_t i, k; + const double *pa0, *pa1, *pb; + + pa0 = a; + pa1 = a+alglib_r_block; + pb = x; + for(i=0; i<16; i++) + { + double v0 = 0, v1 = 0; + for(k=0; k<4; k++) + { + v0 += pa0[0]*pb[0]; + v1 += pa1[0]*pb[0]; + v0 += pa0[1]*pb[1]; + v1 += pa1[1]*pb[1]; + v0 += pa0[2]*pb[2]; + v1 += pa1[2]*pb[2]; + v0 += pa0[3]*pb[3]; + v1 += pa1[3]*pb[3]; + v0 += pa0[4]*pb[4]; + v1 += pa1[4]*pb[4]; + v0 += pa0[5]*pb[5]; + v1 += pa1[5]*pb[5]; + v0 += pa0[6]*pb[6]; + v1 += pa1[6]*pb[6]; + v0 += pa0[7]*pb[7]; + v1 += pa1[7]*pb[7]; + pa0 += 8; + pa1 += 8; + pb += 8; + } + y[0] = beta*y[0]+alpha*v0; + y[stride] = beta*y[stride]+alpha*v1; + + /* + * now we've processed rows I and I+1, + * pa0 and pa1 are pointing to rows I+1 and I+2. + * move to I+2 and I+3. + */ + pa0 += alglib_r_block; + pa1 += alglib_r_block; + pb = x; + y+=2*stride; + } +} + + +/************************************************************************* +This function calculates MxN real matrix-vector product: + + y := beta*y + alpha*A*x + +using generic C code. It calls _ialglib_mv_32 if both M=32 and N=32. + +If beta is zero, we do not use previous values of y (they are overwritten +by alpha*A*x without ever being read). If alpha is zero, no matrix-vector +product is calculated (only beta is updated); however, this update is not +efficient and this function should NOT be used for multiplication of +vector and scalar. + +IMPORTANT: +* 0<=M<=alglib_r_block, 0<=N<=alglib_r_block +* A must be stored in row-major order with stride equal to alglib_r_block +*************************************************************************/ +void _ialglib_rmv(ae_int_t m, ae_int_t n, const double *a, const double *x, double *y, ae_int_t stride, double alpha, double beta) +{ + /* + * Handle special cases: + * - alpha is zero or n is zero + * - m is zero + */ + if( m==0 ) + return; + if( alpha==0.0 || n==0 ) + { + ae_int_t i; + if( beta==0.0 ) + { + for(i=0; ix-beta.y*cy->y)+(alpha.x*v0-alpha.y*v1); + double ty = (beta.x*cy->y+beta.y*cy->x)+(alpha.x*v1+alpha.y*v0); + cy->x = tx; + cy->y = ty; + cy+=stride; + } + else + { + double tx = (beta.x*dy[0]-beta.y*dy[1])+(alpha.x*v0-alpha.y*v1); + double ty = (beta.x*dy[1]+beta.y*dy[0])+(alpha.x*v1+alpha.y*v0); + dy[0] = tx; + dy[1] = ty; + dy += 2*stride; + } + parow += 2*alglib_c_block; + } +} + + +/************************************************************************* +This subroutine calculates fast MxN complex matrix-vector product: + + y := beta*y + alpha*A*x + +using generic C code, where A, x, y, alpha and beta are complex. + +If beta is zero, we do not use previous values of y (they are overwritten +by alpha*A*x without ever being read). However, when alpha is zero, we +still calculate A*x and multiply it by alpha (this distinction can be +important when A or x contain infinities/NANs). + +IMPORTANT: +* 0<=M<=alglib_c_block, 0<=N<=alglib_c_block +* A must be stored in row-major order, as sequence of double precision + pairs. Stride is alglib_c_block (it is measured in pairs of doubles, not + in doubles). +* Y may be referenced by cy (pointer to ae_complex) or + dy (pointer to array of double precision pair) depending on what type of + output you wish. Pass pointer to Y as one of these parameters, + AND SET OTHER PARAMETER TO NULL. +* both A and x must be aligned; y may be non-aligned. + +This function supports SSE2; it can be used when: +1. AE_HAS_SSE2_INTRINSICS was defined (checked at compile-time) +2. ae_cpuid() result contains CPU_SSE2 (checked at run-time) + +If (1) is failed, this function will be undefined. If (2) is failed, call +to this function will probably crash your system. + +If you want to know whether it is safe to call it, you should check +results of ae_cpuid(). If CPU_SSE2 bit is set, this function is callable +and will do its work. +*************************************************************************/ +#if defined(AE_HAS_SSE2_INTRINSICS) +void _ialglib_cmv_sse2(ae_int_t m, ae_int_t n, const double *a, const double *x, ae_complex *cy, double *dy, ae_int_t stride, ae_complex alpha, ae_complex beta) +{ + ae_int_t i, j, m2; + const double *pa0, *pa1, *parow, *pb; + __m128d vbeta, vbetax, vbetay; + __m128d valpha, valphax, valphay; + + m2 = m/2; + parow = a; + if( cy!=NULL ) + { + dy = (double*)cy; + cy = NULL; + } + vbeta = _mm_loadh_pd(_mm_load_sd(&beta.x),&beta.y); + vbetax = _mm_unpacklo_pd(vbeta,vbeta); + vbetay = _mm_unpackhi_pd(vbeta,vbeta); + valpha = _mm_loadh_pd(_mm_load_sd(&alpha.x),&alpha.y); + valphax = _mm_unpacklo_pd(valpha,valpha); + valphay = _mm_unpackhi_pd(valpha,valpha); + for(i=0; ix = 0.0; + p->y = 0.0; + } + } + else + { + for(i=0; ix = 0.0; + p->y = 0.0; + } + } +} + + +/******************************************************************** +This subroutine copies unaligned real vector +********************************************************************/ +void _ialglib_vcopy(ae_int_t n, const double *a, ae_int_t stridea, double *b, ae_int_t strideb) +{ + ae_int_t i, n2; + if( stridea==1 && strideb==1 ) + { + n2 = n/2; + for(i=n2; i!=0; i--, a+=2, b+=2) + { + b[0] = a[0]; + b[1] = a[1]; + } + if( n%2!=0 ) + b[0] = a[0]; + } + else + { + for(i=0; ix; + b[1] = a->y; + } + } + else + { + for(i=0; ix; + b[1] = -a->y; + } + } +} + + +/******************************************************************** +This subroutine copies unaligned complex vector (passed as double*) + +1. strideb is stride measured in complex numbers, not doubles +2. conj may be "N" (no conj.) or "C" (conj.) +********************************************************************/ +void _ialglib_vcopy_dcomplex(ae_int_t n, const double *a, ae_int_t stridea, double *b, ae_int_t strideb, const char *conj) +{ + ae_int_t i; + + /* + * more general case + */ + if( conj[0]=='N' || conj[0]=='n' ) + { + for(i=0; ix; + pdst[1] = psrc->y; + } + } + if( op==1 ) + { + for(i=0,psrc=a; ix; + pdst[1] = psrc->y; + } + } + if( op==2 ) + { + for(i=0,psrc=a; ix; + pdst[1] = -psrc->y; + } + } + if( op==3 ) + { + for(i=0,psrc=a; ix; + pdst[1] = -psrc->y; + } + } +} + + +/******************************************************************** +This subroutine copies matrix from aligned contigous storage to +non-aligned non-contigous storage + +A: +* 2*alglib_c_block*alglib_c_block doubles (only MxN submatrix is used) +* aligned +* stride is alglib_c_block +* pointer to double is passed +* may be transformed during copying (as prescribed by op) + +B: +* MxN +* non-aligned +* non-contigous +* pointer to ae_complex is passed + +Transformation types: +* 0 - no transform +* 1 - transposition +* 2 - conjugate transposition +* 3 - conjugate, but no transposition +********************************************************************/ +void _ialglib_mcopyunblock_complex(ae_int_t m, ae_int_t n, const double *a, ae_int_t op, ae_complex* b, ae_int_t stride) +{ + ae_int_t i, j; + const double *psrc; + ae_complex *pdst; + if( op==0 ) + { + for(i=0,psrc=a; ix = psrc[0]; + pdst->y = psrc[1]; + } + } + if( op==1 ) + { + for(i=0,psrc=a; ix = psrc[0]; + pdst->y = psrc[1]; + } + } + if( op==2 ) + { + for(i=0,psrc=a; ix = psrc[0]; + pdst->y = -psrc[1]; + } + } + if( op==3 ) + { + for(i=0,psrc=a; ix = psrc[0]; + pdst->y = -psrc[1]; + } + } +} + + +/******************************************************************** +Real GEMM kernel +********************************************************************/ +ae_bool _ialglib_rmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + double *_a, + ae_int_t _a_stride, + ae_int_t optypea, + double *_b, + ae_int_t _b_stride, + ae_int_t optypeb, + double beta, + double *_c, + ae_int_t _c_stride) +{ + int i; + double *crow; + double _abuf[alglib_r_block+alglib_simd_alignment]; + double _bbuf[alglib_r_block*alglib_r_block+alglib_simd_alignment]; + double * const abuf = (double * const) ae_align(_abuf,alglib_simd_alignment); + double * const b = (double * const) ae_align(_bbuf,alglib_simd_alignment); + void (*rmv)(ae_int_t, ae_int_t, const double *, const double *, double *, ae_int_t, double, double) = &_ialglib_rmv; + void (*mcopyblock)(ae_int_t, ae_int_t, const double *, ae_int_t, ae_int_t, double *) = &_ialglib_mcopyblock; + + if( m>alglib_r_block || n>alglib_r_block || k>alglib_r_block || m<=0 || n<=0 || k<=0 || alpha==0.0 ) + return ae_false; + + /* + * Check for SSE2 support + */ +#ifdef AE_HAS_SSE2_INTRINSICS + if( ae_cpuid() & CPU_SSE2 ) + { + rmv = &_ialglib_rmv_sse2; + mcopyblock = &_ialglib_mcopyblock_sse2; + } +#endif + + /* + * copy b + */ + if( optypeb==0 ) + mcopyblock(k, n, _b, 1, _b_stride, b); + else + mcopyblock(n, k, _b, 0, _b_stride, b); + + /* + * multiply B by A (from the right, by rows) + * and store result in C + */ + crow = _c; + if( optypea==0 ) + { + const double *arow = _a; + for(i=0; ialglib_c_block || n>alglib_c_block || k>alglib_c_block ) + return ae_false; + + /* + * Check for SSE2 support + */ +#ifdef AE_HAS_SSE2_INTRINSICS + if( ae_cpuid() & CPU_SSE2 ) + { + cmv = &_ialglib_cmv_sse2; + } +#endif + + /* + * copy b + */ + brows = optypeb==0 ? k : n; + bcols = optypeb==0 ? n : k; + if( optypeb==0 ) + _ialglib_mcopyblock_complex(brows, bcols, _b, 1, _b_stride, b); + if( optypeb==1 ) + _ialglib_mcopyblock_complex(brows, bcols, _b, 0, _b_stride, b); + if( optypeb==2 ) + _ialglib_mcopyblock_complex(brows, bcols, _b, 3, _b_stride, b); + + /* + * multiply B by A (from the right, by rows) + * and store result in C + */ + arow = _a; + crow = _c; + for(i=0; ialglib_c_block || n>alglib_c_block ) + return ae_false; + + /* + * Check for SSE2 support + */ +#ifdef AE_HAS_SSE2_INTRINSICS + if( ae_cpuid() & CPU_SSE2 ) + { + cmv = &_ialglib_cmv_sse2; + } +#endif + + /* + * Prepare + */ + _ialglib_mcopyblock_complex(n, n, _a, optype, _a_stride, abuf); + _ialglib_mcopyblock_complex(m, n, _x, 0, _x_stride, xbuf); + if( isunit ) + for(i=0,pdiag=abuf; i=0; i--,pdiag-=2*(alglib_c_block+1)) + { + ae_complex tmp_c; + ae_complex beta; + ae_complex alpha; + tmp_c.x = pdiag[0]; + tmp_c.y = pdiag[1]; + beta = ae_c_d_div(1.0, tmp_c); + alpha.x = -beta.x; + alpha.y = -beta.y; + _ialglib_vcopy_dcomplex(n-1-i, pdiag+2*alglib_c_block, alglib_c_block, tmpbuf, 1, "No conj"); + cmv(m, n-1-i, xbuf+2*(i+1), tmpbuf, NULL, xbuf+2*i, alglib_c_block, alpha, beta); + } + _ialglib_mcopyunblock_complex(m, n, xbuf, 0, _x, _x_stride); + } + return ae_true; +} + + +/******************************************************************** +real TRSM kernel +********************************************************************/ +ae_bool _ialglib_rmatrixrighttrsm(ae_int_t m, + ae_int_t n, + double *_a, + ae_int_t _a_stride, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + double *_x, + ae_int_t _x_stride) +{ + /* + * local buffers + */ + double *pdiag; + ae_int_t i; + double _loc_abuf[alglib_r_block*alglib_r_block+alglib_simd_alignment]; + double _loc_xbuf[alglib_r_block*alglib_r_block+alglib_simd_alignment]; + double _loc_tmpbuf[alglib_r_block+alglib_simd_alignment]; + double * const abuf = (double * const) ae_align(_loc_abuf, alglib_simd_alignment); + double * const xbuf = (double * const) ae_align(_loc_xbuf, alglib_simd_alignment); + double * const tmpbuf = (double * const) ae_align(_loc_tmpbuf,alglib_simd_alignment); + ae_bool uppera; + void (*rmv)(ae_int_t, ae_int_t, const double *, const double *, double *, ae_int_t, double, double) = &_ialglib_rmv; + void (*mcopyblock)(ae_int_t, ae_int_t, const double *, ae_int_t, ae_int_t, double *) = &_ialglib_mcopyblock; + + if( m>alglib_r_block || n>alglib_r_block ) + return ae_false; + + /* + * Check for SSE2 support + */ +#ifdef AE_HAS_SSE2_INTRINSICS + if( ae_cpuid() & CPU_SSE2 ) + { + rmv = &_ialglib_rmv_sse2; + mcopyblock = &_ialglib_mcopyblock_sse2; + } +#endif + + /* + * Prepare + */ + mcopyblock(n, n, _a, optype, _a_stride, abuf); + mcopyblock(m, n, _x, 0, _x_stride, xbuf); + if( isunit ) + for(i=0,pdiag=abuf; i=0; i--,pdiag-=alglib_r_block+1) + { + double beta = 1.0/(*pdiag); + double alpha = -beta; + _ialglib_vcopy(n-1-i, pdiag+alglib_r_block, alglib_r_block, tmpbuf+i+1, 1); + rmv(m, n-1-i, xbuf+i+1, tmpbuf+i+1, xbuf+i, alglib_r_block, alpha, beta); + } + _ialglib_mcopyunblock(m, n, xbuf, 0, _x, _x_stride); + } + return ae_true; +} + + +/******************************************************************** +complex TRSM kernel +********************************************************************/ +ae_bool _ialglib_cmatrixlefttrsm(ae_int_t m, + ae_int_t n, + ae_complex *_a, + ae_int_t _a_stride, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_complex *_x, + ae_int_t _x_stride) +{ + /* + * local buffers + */ + double *pdiag, *arow; + ae_int_t i; + double _loc_abuf[2*alglib_c_block*alglib_c_block+alglib_simd_alignment]; + double _loc_xbuf[2*alglib_c_block*alglib_c_block+alglib_simd_alignment]; + double _loc_tmpbuf[2*alglib_c_block+alglib_simd_alignment]; + double * const abuf = (double * const) ae_align(_loc_abuf, alglib_simd_alignment); + double * const xbuf = (double * const) ae_align(_loc_xbuf, alglib_simd_alignment); + double * const tmpbuf = (double * const) ae_align(_loc_tmpbuf,alglib_simd_alignment); + ae_bool uppera; + void (*cmv)(ae_int_t, ae_int_t, const double *, const double *, ae_complex *, double *, ae_int_t, ae_complex, ae_complex) = &_ialglib_cmv; + + if( m>alglib_c_block || n>alglib_c_block ) + return ae_false; + + /* + * Check for SSE2 support + */ +#ifdef AE_HAS_SSE2_INTRINSICS + if( ae_cpuid() & CPU_SSE2 ) + { + cmv = &_ialglib_cmv_sse2; + } +#endif + + /* + * Prepare + * Transpose X (so we may use mv, which calculates A*x, but not x*A) + */ + _ialglib_mcopyblock_complex(m, m, _a, optype, _a_stride, abuf); + _ialglib_mcopyblock_complex(m, n, _x, 1, _x_stride, xbuf); + if( isunit ) + for(i=0,pdiag=abuf; i=0; i--,pdiag-=2*(alglib_c_block+1)) + { + ae_complex tmp_c; + ae_complex beta; + ae_complex alpha; + tmp_c.x = pdiag[0]; + tmp_c.y = pdiag[1]; + beta = ae_c_d_div(1.0, tmp_c); + alpha.x = -beta.x; + alpha.y = -beta.y; + _ialglib_vcopy_dcomplex(m-1-i, pdiag+2, 1, tmpbuf, 1, "No conj"); + cmv(n, m-1-i, xbuf+2*(i+1), tmpbuf, NULL, xbuf+2*i, alglib_c_block, alpha, beta); + } + _ialglib_mcopyunblock_complex(m, n, xbuf, 1, _x, _x_stride); + } + else + { for(i=0,pdiag=abuf,arow=abuf; ialglib_r_block || n>alglib_r_block ) + return ae_false; + + /* + * Check for SSE2 support + */ +#ifdef AE_HAS_SSE2_INTRINSICS + if( ae_cpuid() & CPU_SSE2 ) + { + rmv = &_ialglib_rmv_sse2; + mcopyblock = &_ialglib_mcopyblock_sse2; + } +#endif + + /* + * Prepare + * Transpose X (so we may use mv, which calculates A*x, but not x*A) + */ + mcopyblock(m, m, _a, optype, _a_stride, abuf); + mcopyblock(m, n, _x, 1, _x_stride, xbuf); + if( isunit ) + for(i=0,pdiag=abuf; i=0; i--,pdiag-=alglib_r_block+1) + { + double beta = 1.0/(*pdiag); + double alpha = -beta; + _ialglib_vcopy(m-1-i, pdiag+1, 1, tmpbuf+i+1, 1); + rmv(n, m-1-i, xbuf+i+1, tmpbuf+i+1, xbuf+i, alglib_r_block, alpha, beta); + } + _ialglib_mcopyunblock(m, n, xbuf, 1, _x, _x_stride); + } + else + { for(i=0,pdiag=abuf,arow=abuf; ialglib_c_block || k>alglib_c_block ) + return ae_false; + if( n==0 ) + return ae_true; + + /* + * copy A and C, task is transformed to "A*A^H"-form. + * if beta==0, then C is filled by zeros (and not referenced) + * + * alpha==0 or k==0 are correctly processed (A is not referenced) + */ + c_alpha.x = alpha; + c_alpha.y = 0; + c_beta.x = beta; + c_beta.y = 0; + if( alpha==0 ) + k = 0; + if( k>0 ) + { + if( optypea==0 ) + _ialglib_mcopyblock_complex(n, k, _a, 3, _a_stride, abuf); + else + _ialglib_mcopyblock_complex(k, n, _a, 1, _a_stride, abuf); + } + _ialglib_mcopyblock_complex(n, n, _c, 0, _c_stride, cbuf); + if( beta==0 ) + { + for(i=0,crow=cbuf; ialglib_r_block || k>alglib_r_block ) + return ae_false; + if( n==0 ) + return ae_true; + + /* + * copy A and C, task is transformed to "A*A^T"-form. + * if beta==0, then C is filled by zeros (and not referenced) + * + * alpha==0 or k==0 are correctly processed (A is not referenced) + */ + if( alpha==0 ) + k = 0; + if( k>0 ) + { + if( optypea==0 ) + _ialglib_mcopyblock(n, k, _a, 0, _a_stride, abuf); + else + _ialglib_mcopyblock(k, n, _a, 1, _a_stride, abuf); + } + _ialglib_mcopyblock(n, n, _c, 0, _c_stride, cbuf); + if( beta==0 ) + { + for(i=0,crow=cbuf; iptr.pp_double[ia]+ja, _a->stride, optypea, _b->ptr.pp_double[ib]+jb, _b->stride, optypeb, beta, _c->ptr.pp_double[ic]+jc, _c->stride); +} + +ae_bool _ialglib_i_cmatrixgemmf(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + ae_matrix *_a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + ae_matrix *_b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + ae_matrix *_c, + ae_int_t ic, + ae_int_t jc) +{ + return _ialglib_cmatrixgemm(m, n, k, alpha, _a->ptr.pp_complex[ia]+ja, _a->stride, optypea, _b->ptr.pp_complex[ib]+jb, _b->stride, optypeb, beta, _c->ptr.pp_complex[ic]+jc, _c->stride); +} + +ae_bool _ialglib_i_cmatrixrighttrsmf(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_matrix *x, + ae_int_t i2, + ae_int_t j2) +{ + return _ialglib_cmatrixrighttrsm(m, n, &a->ptr.pp_complex[i1][j1], a->stride, isupper, isunit, optype, &x->ptr.pp_complex[i2][j2], x->stride); +} + +ae_bool _ialglib_i_rmatrixrighttrsmf(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_matrix *x, + ae_int_t i2, + ae_int_t j2) +{ + return _ialglib_rmatrixrighttrsm(m, n, &a->ptr.pp_double[i1][j1], a->stride, isupper, isunit, optype, &x->ptr.pp_double[i2][j2], x->stride); +} + +ae_bool _ialglib_i_cmatrixlefttrsmf(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_matrix *x, + ae_int_t i2, + ae_int_t j2) +{ + return _ialglib_cmatrixlefttrsm(m, n, &a->ptr.pp_complex[i1][j1], a->stride, isupper, isunit, optype, &x->ptr.pp_complex[i2][j2], x->stride); +} + +ae_bool _ialglib_i_rmatrixlefttrsmf(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_matrix *x, + ae_int_t i2, + ae_int_t j2) +{ + return _ialglib_rmatrixlefttrsm(m, n, &a->ptr.pp_double[i1][j1], a->stride, isupper, isunit, optype, &x->ptr.pp_double[i2][j2], x->stride); +} + +ae_bool _ialglib_i_cmatrixsyrkf(ae_int_t n, + ae_int_t k, + double alpha, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + ae_matrix *c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper) +{ + return _ialglib_cmatrixsyrk(n, k, alpha, &a->ptr.pp_complex[ia][ja], a->stride, optypea, beta, &c->ptr.pp_complex[ic][jc], c->stride, isupper); +} + +ae_bool _ialglib_i_rmatrixsyrkf(ae_int_t n, + ae_int_t k, + double alpha, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + ae_matrix *c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper) +{ + return _ialglib_rmatrixsyrk(n, k, alpha, &a->ptr.pp_double[ia][ja], a->stride, optypea, beta, &c->ptr.pp_double[ic][jc], c->stride, isupper); +} + +ae_bool _ialglib_i_cmatrixrank1f(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_vector *u, + ae_int_t uoffs, + ae_vector *v, + ae_int_t voffs) +{ + return _ialglib_cmatrixrank1(m, n, &a->ptr.pp_complex[ia][ja], a->stride, &u->ptr.p_complex[uoffs], &v->ptr.p_complex[voffs]); +} + +ae_bool _ialglib_i_rmatrixrank1f(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_vector *u, + ae_int_t uoffs, + ae_vector *v, + ae_int_t voffs) +{ + return _ialglib_rmatrixrank1(m, n, &a->ptr.pp_double[ia][ja], a->stride, &u->ptr.p_double[uoffs], &v->ptr.p_double[voffs]); +} + + + + +/******************************************************************** +This function reads rectangular matrix A given by two column pointers +col0 and col1 and stride src_stride and moves it into contiguous row- +by-row storage given by dst. + +It can handle following special cases: +* col1==NULL in this case second column of A is filled by zeros +********************************************************************/ +void _ialglib_pack_n2( + double *col0, + double *col1, + ae_int_t n, + ae_int_t src_stride, + double *dst) +{ + ae_int_t n2, j, stride2; + + /* + * handle special case + */ + if( col1==NULL ) + { + for(j=0; j>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _ap_h +#define _ap_h + +#include +#include +#include +#include +#include +#include + +#ifdef __BORLANDC__ +#include +#include +#else +#include +#include +#endif + +#define AE_USE_CPP +/* Definitions */ +#define AE_UNKNOWN 0 +#define AE_MSVC 1 +#define AE_GNUC 2 +#define AE_SUNC 3 +#define AE_INTEL 1 +#define AE_SPARC 2 +#define AE_WINDOWS 1 +#define AE_POSIX 2 +#define AE_LOCK_ALIGNMENT 16 + +/* in case no OS is defined, use AE_UNKNOWN */ +#ifndef AE_OS +#define AE_OS AE_UNKNOWN +#endif + +/* automatically determine compiler */ +#define AE_COMPILER AE_UNKNOWN +#ifdef __GNUC__ +#undef AE_COMPILER +#define AE_COMPILER AE_GNUC +#endif +#if defined(__SUNPRO_C)||defined(__SUNPRO_CC) +#undef AE_COMPILER +#define AE_COMPILER AE_SUNC +#endif +#ifdef _MSC_VER +#undef AE_COMPILER +#define AE_COMPILER AE_MSVC +#endif + +/* now we are ready to include headers */ +#include +#include +#include +#include +#include +#include + +#if AE_OS==AE_WINDOWS +#include +#include +#elif AE_OS==AE_POSIX +#include +#include +#include +#include +#endif + +#if defined(AE_HAVE_STDINT) +#include +#endif + +/* + * SSE2 intrinsics + * + * Preprocessor directives below: + * - include headers for SSE2 intrinsics + * - define AE_HAS_SSE2_INTRINSICS definition + * + * These actions are performed when we have: + * - x86 architecture definition (AE_CPU==AE_INTEL) + * - compiler which supports intrinsics + * + * Presence of AE_HAS_SSE2_INTRINSICS does NOT mean that our CPU + * actually supports SSE2 - such things should be determined at runtime + * with ae_cpuid() call. It means that we are working under Intel and + * out compiler can issue SSE2-capable code. + * + */ +#if defined(AE_CPU) +#if AE_CPU==AE_INTEL +#if AE_COMPILER==AE_MSVC +#include +#define AE_HAS_SSE2_INTRINSICS +#endif +#if AE_COMPILER==AE_GNUC +#include +#define AE_HAS_SSE2_INTRINSICS +#endif +#if AE_COMPILER==AE_SUNC +#include +#include +#define AE_HAS_SSE2_INTRINSICS +#endif +#endif +#endif + +/* Debugging helpers for Windows */ +#ifdef AE_DEBUG4WINDOWS +#include +#include +#endif + + + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS DECLARATIONS FOR BASIC FUNCTIONALITY +// LIKE MEMORY MANAGEMENT FOR VECTORS/MATRICES WHICH IS SHARED +// BETWEEN C++ AND PURE C LIBRARIES +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ + +/* if we work under C++ environment, define several conditions */ +#ifdef AE_USE_CPP +#define AE_USE_CPP_BOOL +#define AE_USE_CPP_ERROR_HANDLING +#define AE_USE_CPP_SERIALIZATION +#endif + +/* + * define ae_int32_t, ae_int64_t, ae_int_t, ae_bool, ae_complex, ae_error_type and ae_datatype + */ + +#if defined(AE_INT32_T) +typedef AE_INT32_T ae_int32_t; +#endif +#if defined(AE_HAVE_STDINT) && !defined(AE_INT32_T) +typedef int32_t ae_int32_t; +#endif +#if !defined(AE_HAVE_STDINT) && !defined(AE_INT32_T) +#if AE_COMPILER==AE_MSVC +typedef _int32 ae_int32_t; +#endif +#if (AE_COMPILER==AE_GNUC) || (AE_COMPILER==AE_SUNC) || (AE_COMPILER==AE_UNKNOWN) +typedef int ae_int32_t; +#endif +#endif + +#if defined(AE_INT64_T) +typedef AE_INT64_T ae_int64_t; +#endif +#if defined(AE_HAVE_STDINT) && !defined(AE_INT64_T) +typedef int64_t ae_int64_t; +#endif +#if !defined(AE_HAVE_STDINT) && !defined(AE_INT64_T) +#if AE_COMPILER==AE_MSVC +typedef _int64 ae_int64_t; +#endif +#if (AE_COMPILER==AE_GNUC) || (AE_COMPILER==AE_SUNC) || (AE_COMPILER==AE_UNKNOWN) +typedef signed long long ae_int64_t; +#endif +#endif + +#if !defined(AE_INT_T) +typedef ptrdiff_t ae_int_t; +#endif + +#if !defined(AE_USE_CPP_BOOL) +#define ae_bool char +#define ae_true 1 +#define ae_false 0 +#else +#define ae_bool bool +#define ae_true true +#define ae_false false +#endif + +typedef struct { double x, y; } ae_complex; + +typedef enum +{ + ERR_OK = 0, + ERR_OUT_OF_MEMORY = 1, + ERR_XARRAY_TOO_LARGE = 2, + ERR_ASSERTION_FAILED = 3 +} ae_error_type; + +typedef ae_int_t ae_datatype; + +/* + * other definitions + */ +enum { OWN_CALLER=1, OWN_AE=2 }; +enum { ACT_UNCHANGED=1, ACT_SAME_LOCATION=2, ACT_NEW_LOCATION=3 }; +enum { DT_BOOL=1, DT_INT=2, DT_REAL=3, DT_COMPLEX=4 }; +enum { CPU_SSE2=1 }; + +/************************************************************************ +x-string (zero-terminated): + owner OWN_CALLER or OWN_AE. Determines what to do on realloc(). + If vector is owned by caller, X-interface will just set + ptr to NULL before realloc(). If it is owned by X, it + will call ae_free/x_free/aligned_free family functions. + + last_action ACT_UNCHANGED, ACT_SAME_LOCATION, ACT_NEW_LOCATION + contents is either: unchanged, stored at the same location, + stored at the new location. + this field is set on return from X. + + ptr pointer to the actual data + +Members of this structure are ae_int64_t to avoid alignment problems. +************************************************************************/ +typedef struct +{ + ae_int64_t owner; + ae_int64_t last_action; + char *ptr; +} x_string; + +/************************************************************************ +x-vector: + cnt number of elements + + datatype one of the DT_XXXX values + + owner OWN_CALLER or OWN_AE. Determines what to do on realloc(). + If vector is owned by caller, X-interface will just set + ptr to NULL before realloc(). If it is owned by X, it + will call ae_free/x_free/aligned_free family functions. + + last_action ACT_UNCHANGED, ACT_SAME_LOCATION, ACT_NEW_LOCATION + contents is either: unchanged, stored at the same location, + stored at the new location. + this field is set on return from X interface and may be + used by caller as hint when deciding what to do with data + (if it was ACT_UNCHANGED or ACT_SAME_LOCATION, no array + reallocation or copying is required). + + ptr pointer to the actual data + +Members of this structure are ae_int64_t to avoid alignment problems. +************************************************************************/ +typedef struct +{ + ae_int64_t cnt; + ae_int64_t datatype; + ae_int64_t owner; + ae_int64_t last_action; + void *ptr; +} x_vector; + + +/************************************************************************ +x-matrix: + rows number of rows. may be zero only when cols is zero too. + + cols number of columns. may be zero only when rows is zero too. + + stride stride, i.e. distance between first elements of rows (in bytes) + + datatype one of the DT_XXXX values + + owner OWN_CALLER or OWN_AE. Determines what to do on realloc(). + If vector is owned by caller, X-interface will just set + ptr to NULL before realloc(). If it is owned by X, it + will call ae_free/x_free/aligned_free family functions. + + last_action ACT_UNCHANGED, ACT_SAME_LOCATION, ACT_NEW_LOCATION + contents is either: unchanged, stored at the same location, + stored at the new location. + this field is set on return from X interface and may be + used by caller as hint when deciding what to do with data + (if it was ACT_UNCHANGED or ACT_SAME_LOCATION, no array + reallocation or copying is required). + + ptr pointer to the actual data, stored rowwise + +Members of this structure are ae_int64_t to avoid alignment problems. +************************************************************************/ +typedef struct +{ + ae_int64_t rows; + ae_int64_t cols; + ae_int64_t stride; + ae_int64_t datatype; + ae_int64_t owner; + ae_int64_t last_action; + void *ptr; +} x_matrix; + + +/************************************************************************ +dynamic block which may be automatically deallocated during stack unwinding + +p_next next block in the stack unwinding list. + NULL means that this block is not in the list +deallocator deallocator function which should be used to deallocate block. + NULL for "special" blocks (frame/stack boundaries) +ptr pointer which should be passed to the deallocator. + may be null (for zero-size block), DYN_BOTTOM or DYN_FRAME + for "special" blocks (frame/stack boundaries). + +************************************************************************/ +typedef struct ae_dyn_block +{ + struct ae_dyn_block * volatile p_next; + /* void *deallocator; */ + void (*deallocator)(void*); + void * volatile ptr; +} ae_dyn_block; + +/************************************************************************ +frame marker +************************************************************************/ +typedef struct ae_frame +{ + ae_dyn_block db_marker; +} ae_frame; + +/************************************************************************ +ALGLIB environment state +************************************************************************/ +typedef struct ae_state +{ + /* + * endianness type: AE_LITTLE_ENDIAN or AE_BIG_ENDIAN + */ + ae_int_t endianness; + + /* + * double value for NAN + */ + double v_nan; + + /* + * double value for +INF + */ + double v_posinf; + + /* + * double value for -INF + */ + double v_neginf; + + /* + * pointer to the top block in a stack of frames + * which hold dynamically allocated objects + */ + ae_dyn_block * volatile p_top_block; + ae_dyn_block last_block; + + /* + * jmp_buf for cases when C-style exception handling is used + */ +#ifndef AE_USE_CPP_ERROR_HANDLING + jmp_buf * volatile break_jump; +#endif + + /* + * ae_error_type of the last error (filled when exception is thrown) + */ + ae_error_type volatile last_error; + + /* + * human-readable message (filled when exception is thrown) + */ + const char* volatile error_msg; + + /* + * threading information: + * a) current thread pool + * b) current worker thread + * c) parent task (one we are solving right now) + * d) thread exception handler (function which must be called + * by ae_assert before raising exception). + * + * NOTE: we use void* to store pointers in order to avoid explicit dependency on smp.h + */ + void *worker_thread; + void *parent_task; + void (*thread_exception_handler)(void*); + +} ae_state; + +/************************************************************************ +Serializer +************************************************************************/ +typedef struct +{ + ae_int_t mode; + ae_int_t entries_needed; + ae_int_t entries_saved; + ae_int_t bytes_asked; + ae_int_t bytes_written; + +#ifdef AE_USE_CPP_SERIALIZATION + std::string *out_cppstr; +#endif + char *out_str; + const char *in_str; +} ae_serializer; + +typedef void(*ae_deallocator)(void*); + +typedef struct ae_vector +{ + ae_int_t cnt; + ae_datatype datatype; + ae_dyn_block data; + union + { + void *p_ptr; + ae_bool *p_bool; + ae_int_t *p_int; + double *p_double; + ae_complex *p_complex; + } ptr; +} ae_vector; + +typedef struct ae_matrix +{ + ae_int_t rows; + ae_int_t cols; + ae_int_t stride; + ae_datatype datatype; + ae_dyn_block data; + union + { + void *p_ptr; + void **pp_void; + ae_bool **pp_bool; + ae_int_t **pp_int; + double **pp_double; + ae_complex **pp_complex; + } ptr; +} ae_matrix; + +typedef struct ae_smart_ptr +{ + /* pointer to subscriber; all changes in ptr are translated to subscriber */ + void **subscriber; + + /* pointer to object */ + void *ptr; + + /* whether smart pointer owns ptr */ + ae_bool is_owner; + + /* whether object pointed by ptr is dynamic - clearing such object requires BOTH + calling destructor function AND calling ae_free for memory occupied by object. */ + ae_bool is_dynamic; + + /* destructor function for pointer; clears all dynamically allocated memory */ + void (*destroy)(void*); + + /* frame entry; used to ensure automatic deallocation of smart pointer in case of exception/exit */ + ae_dyn_block frame_entry; +} ae_smart_ptr; + + +/************************************************************************* +Lock. + +This structure provides OS-independent non-reentrant lock: +* under Windows/Posix systems it uses system-provided locks +* under Boost it uses OS-independent lock provided by Boost package +* when no OS is defined, it uses "fake lock" (just stub which is not thread-safe): + a) "fake lock" can be in locked or free mode + b) "fake lock" can be used only from one thread - one which created lock + c) when thread acquires free lock, it immediately returns + d) when thread acquires busy lock, program is terminated + (because lock is already acquired and no one else can free it) +*************************************************************************/ +typedef struct +{ +#if AE_OS==AE_WINDOWS + volatile ae_int_t * volatile p_lock; + char buf[sizeof(ae_int_t)+AE_LOCK_ALIGNMENT]; +#elif AE_OS==AE_POSIX + pthread_mutex_t mutex; +#else + ae_bool is_locked; +#endif +} ae_lock; + + +/************************************************************************* +Shared pool: data structure used to provide thread-safe access to pool of +temporary variables. +*************************************************************************/ +typedef struct ae_shared_pool_entry +{ + void * volatile obj; + void * volatile next_entry; +} ae_shared_pool_entry; + +typedef struct ae_shared_pool +{ + /* lock object which protects pool */ + ae_lock pool_lock; + + /* seed object (used to create new instances of temporaries) */ + void * volatile seed_object; + + /* + * list of recycled OBJECTS: + * 1. entries in this list store pointers to recycled objects + * 2. every time we retrieve object, we retrieve first entry from this list, + * move it to recycled_entries and return its obj field to caller/ + */ + ae_shared_pool_entry * volatile recycled_objects; + + /* + * list of recycled ENTRIES: + * 1. this list holds entries which are not used to store recycled objects; + * every time recycled object is retrieved, its entry is moved to this list. + * 2. every time object is recycled, we try to fetch entry for him from this list + * before allocating it with malloc() + */ + ae_shared_pool_entry * volatile recycled_entries; + + /* enumeration pointer, points to current recycled object*/ + ae_shared_pool_entry * volatile enumeration_counter; + + /* size of object; this field is used when we call malloc() for new objects */ + ae_int_t size_of_object; + + /* initializer function; accepts pointer to malloc'ed object, initializes its fields */ + ae_bool (*init)(void* dst, ae_state* state, ae_bool make_automatic); + + /* copy constructor; accepts pointer to malloc'ed, but not initialized object */ + ae_bool (*init_copy)(void* dst, void* src, ae_state* state, ae_bool make_automatic); + + /* destructor function; */ + void (*destroy)(void* ptr); + + /* frame entry; contains pointer to the pool object itself */ + ae_dyn_block frame_entry; +} ae_shared_pool; + +ae_int_t ae_misalignment(const void *ptr, size_t alignment); +void* ae_align(void *ptr, size_t alignment); +void* aligned_malloc(size_t size, size_t alignment); +void aligned_free(void *block); + +void* ae_malloc(size_t size, ae_state *state); +void ae_free(void *p); +ae_int_t ae_sizeof(ae_datatype datatype); +void ae_touch_ptr(void *p); + +void ae_state_init(ae_state *state); +void ae_state_clear(ae_state *state); +#ifndef AE_USE_CPP_ERROR_HANDLING +void ae_state_set_break_jump(ae_state *state, jmp_buf *buf); +#endif +void ae_break(ae_state *state, ae_error_type error_type, const char *msg); + +void ae_frame_make(ae_state *state, ae_frame *tmp); +void ae_frame_leave(ae_state *state); + +void ae_db_attach(ae_dyn_block *block, ae_state *state); +ae_bool ae_db_malloc(ae_dyn_block *block, ae_int_t size, ae_state *state, ae_bool make_automatic); +ae_bool ae_db_realloc(ae_dyn_block *block, ae_int_t size, ae_state *state); +void ae_db_free(ae_dyn_block *block); +void ae_db_swap(ae_dyn_block *block1, ae_dyn_block *block2); + +ae_bool ae_vector_init(ae_vector *dst, ae_int_t size, ae_datatype datatype, ae_state *state, ae_bool make_automatic); +ae_bool ae_vector_init_copy(ae_vector *dst, ae_vector *src, ae_state *state, ae_bool make_automatic); +void ae_vector_init_from_x(ae_vector *dst, x_vector *src, ae_state *state, ae_bool make_automatic); +ae_bool ae_vector_set_length(ae_vector *dst, ae_int_t newsize, ae_state *state); +void ae_vector_clear(ae_vector *dst); +void ae_vector_destroy(ae_vector *dst); +void ae_swap_vectors(ae_vector *vec1, ae_vector *vec2); + +ae_bool ae_matrix_init(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_datatype datatype, ae_state *state, ae_bool make_automatic); +ae_bool ae_matrix_init_copy(ae_matrix *dst, ae_matrix *src, ae_state *state, ae_bool make_automatic); +void ae_matrix_init_from_x(ae_matrix *dst, x_matrix *src, ae_state *state, ae_bool make_automatic); +ae_bool ae_matrix_set_length(ae_matrix *dst, ae_int_t rows, ae_int_t cols, ae_state *state); +void ae_matrix_clear(ae_matrix *dst); +void ae_matrix_destroy(ae_matrix *dst); +void ae_swap_matrices(ae_matrix *mat1, ae_matrix *mat2); + +ae_bool ae_smart_ptr_init(ae_smart_ptr *dst, void **subscriber, ae_state *state, ae_bool make_automatic); +void ae_smart_ptr_clear(void *_dst); /* accepts ae_smart_ptr* */ +void ae_smart_ptr_destroy(void *_dst); +void ae_smart_ptr_assign(ae_smart_ptr *dst, void *new_ptr, ae_bool is_owner, ae_bool is_dynamic, void (*destroy)(void*)); +void ae_smart_ptr_release(ae_smart_ptr *dst); + +void ae_yield(); +void ae_init_lock(ae_lock *lock); +void ae_acquire_lock(ae_lock *lock); +void ae_release_lock(ae_lock *lock); +void ae_free_lock(ae_lock *lock); + +ae_bool ae_shared_pool_init(void *_dst, ae_state *state, ae_bool make_automatic); +ae_bool ae_shared_pool_init_copy(void *_dst, void *_src, ae_state *state, ae_bool make_automatic); +void ae_shared_pool_clear(void *dst); +void ae_shared_pool_destroy(void *dst); +ae_bool ae_shared_pool_is_initialized(void *_dst); +void ae_shared_pool_set_seed( + ae_shared_pool *dst, + void *seed_object, + ae_int_t size_of_object, + ae_bool (*init)(void* dst, ae_state* state, ae_bool make_automatic), + ae_bool (*init_copy)(void* dst, void* src, ae_state* state, ae_bool make_automatic), + void (*destroy)(void* ptr), + ae_state *state); +void ae_shared_pool_retrieve( + ae_shared_pool *pool, + ae_smart_ptr *pptr, + ae_state *state); +void ae_shared_pool_recycle( + ae_shared_pool *pool, + ae_smart_ptr *pptr, + ae_state *state); +void ae_shared_pool_clear_recycled( + ae_shared_pool *pool, + ae_state *state); +void ae_shared_pool_first_recycled( + ae_shared_pool *pool, + ae_smart_ptr *pptr, + ae_state *state); +void ae_shared_pool_next_recycled( + ae_shared_pool *pool, + ae_smart_ptr *pptr, + ae_state *state); +void ae_shared_pool_reset( + ae_shared_pool *pool, + ae_state *state); + +void ae_x_set_vector(x_vector *dst, ae_vector *src, ae_state *state); +void ae_x_set_matrix(x_matrix *dst, ae_matrix *src, ae_state *state); +void ae_x_attach_to_vector(x_vector *dst, ae_vector *src); +void ae_x_attach_to_matrix(x_matrix *dst, ae_matrix *src); + +void x_vector_clear(x_vector *dst); + +ae_bool x_is_symmetric(x_matrix *a); +ae_bool x_is_hermitian(x_matrix *a); +ae_bool x_force_symmetric(x_matrix *a); +ae_bool x_force_hermitian(x_matrix *a); +ae_bool ae_is_symmetric(ae_matrix *a); +ae_bool ae_is_hermitian(ae_matrix *a); +ae_bool ae_force_symmetric(ae_matrix *a); +ae_bool ae_force_hermitian(ae_matrix *a); + +void ae_serializer_init(ae_serializer *serializer); +void ae_serializer_clear(ae_serializer *serializer); + +void ae_serializer_alloc_start(ae_serializer *serializer); +void ae_serializer_alloc_entry(ae_serializer *serializer); +ae_int_t ae_serializer_get_alloc_size(ae_serializer *serializer); + +#ifdef AE_USE_CPP_SERIALIZATION +void ae_serializer_sstart_str(ae_serializer *serializer, std::string *buf); +void ae_serializer_ustart_str(ae_serializer *serializer, const std::string *buf); +#endif +void ae_serializer_sstart_str(ae_serializer *serializer, char *buf); +void ae_serializer_ustart_str(ae_serializer *serializer, const char *buf); + +void ae_serializer_serialize_bool(ae_serializer *serializer, ae_bool v, ae_state *state); +void ae_serializer_serialize_int(ae_serializer *serializer, ae_int_t v, ae_state *state); +void ae_serializer_serialize_double(ae_serializer *serializer, double v, ae_state *state); +void ae_serializer_unserialize_bool(ae_serializer *serializer, ae_bool *v, ae_state *state); +void ae_serializer_unserialize_int(ae_serializer *serializer, ae_int_t *v, ae_state *state); +void ae_serializer_unserialize_double(ae_serializer *serializer, double *v, ae_state *state); + +void ae_serializer_stop(ae_serializer *serializer); + +/************************************************************************ +Service functions +************************************************************************/ +void ae_assert(ae_bool cond, const char *msg, ae_state *state); +ae_int_t ae_cpuid(); + +/************************************************************************ +Real math functions: +* IEEE-compliant floating point comparisons +* standard functions +************************************************************************/ +ae_bool ae_fp_eq(double v1, double v2); +ae_bool ae_fp_neq(double v1, double v2); +ae_bool ae_fp_less(double v1, double v2); +ae_bool ae_fp_less_eq(double v1, double v2); +ae_bool ae_fp_greater(double v1, double v2); +ae_bool ae_fp_greater_eq(double v1, double v2); + +ae_bool ae_isfinite_stateless(double x, ae_int_t endianness); +ae_bool ae_isnan_stateless(double x, ae_int_t endianness); +ae_bool ae_isinf_stateless(double x, ae_int_t endianness); +ae_bool ae_isposinf_stateless(double x, ae_int_t endianness); +ae_bool ae_isneginf_stateless(double x, ae_int_t endianness); + +ae_int_t ae_get_endianness(); + +ae_bool ae_isfinite(double x,ae_state *state); +ae_bool ae_isnan(double x, ae_state *state); +ae_bool ae_isinf(double x, ae_state *state); +ae_bool ae_isposinf(double x,ae_state *state); +ae_bool ae_isneginf(double x,ae_state *state); + +double ae_fabs(double x, ae_state *state); +ae_int_t ae_iabs(ae_int_t x, ae_state *state); +double ae_sqr(double x, ae_state *state); +double ae_sqrt(double x, ae_state *state); + +ae_int_t ae_sign(double x, ae_state *state); +ae_int_t ae_round(double x, ae_state *state); +ae_int_t ae_trunc(double x, ae_state *state); +ae_int_t ae_ifloor(double x, ae_state *state); +ae_int_t ae_iceil(double x, ae_state *state); + +ae_int_t ae_maxint(ae_int_t m1, ae_int_t m2, ae_state *state); +ae_int_t ae_minint(ae_int_t m1, ae_int_t m2, ae_state *state); +double ae_maxreal(double m1, double m2, ae_state *state); +double ae_minreal(double m1, double m2, ae_state *state); +double ae_randomreal(ae_state *state); +ae_int_t ae_randominteger(ae_int_t maxv, ae_state *state); + +double ae_sin(double x, ae_state *state); +double ae_cos(double x, ae_state *state); +double ae_tan(double x, ae_state *state); +double ae_sinh(double x, ae_state *state); +double ae_cosh(double x, ae_state *state); +double ae_tanh(double x, ae_state *state); +double ae_asin(double x, ae_state *state); +double ae_acos(double x, ae_state *state); +double ae_atan(double x, ae_state *state); +double ae_atan2(double y, double x, ae_state *state); + +double ae_log(double x, ae_state *state); +double ae_pow(double x, double y, ae_state *state); +double ae_exp(double x, ae_state *state); + +/************************************************************************ +Complex math functions: +* basic arithmetic operations +* standard functions +************************************************************************/ +ae_complex ae_complex_from_d(double v); + +ae_complex ae_c_neg(ae_complex lhs); +ae_bool ae_c_eq(ae_complex lhs, ae_complex rhs); +ae_bool ae_c_neq(ae_complex lhs, ae_complex rhs); +ae_complex ae_c_add(ae_complex lhs, ae_complex rhs); +ae_complex ae_c_mul(ae_complex lhs, ae_complex rhs); +ae_complex ae_c_sub(ae_complex lhs, ae_complex rhs); +ae_complex ae_c_div(ae_complex lhs, ae_complex rhs); +ae_bool ae_c_eq_d(ae_complex lhs, double rhs); +ae_bool ae_c_neq_d(ae_complex lhs, double rhs); +ae_complex ae_c_add_d(ae_complex lhs, double rhs); +ae_complex ae_c_mul_d(ae_complex lhs, double rhs); +ae_complex ae_c_sub_d(ae_complex lhs, double rhs); +ae_complex ae_c_d_sub(double lhs, ae_complex rhs); +ae_complex ae_c_div_d(ae_complex lhs, double rhs); +ae_complex ae_c_d_div(double lhs, ae_complex rhs); + +ae_complex ae_c_conj(ae_complex lhs, ae_state *state); +ae_complex ae_c_sqr(ae_complex lhs, ae_state *state); +double ae_c_abs(ae_complex z, ae_state *state); + +/************************************************************************ +Complex BLAS operations +************************************************************************/ +ae_complex ae_v_cdotproduct(const ae_complex *v0, ae_int_t stride0, const char *conj0, const ae_complex *v1, ae_int_t stride1, const char *conj1, ae_int_t n); +void ae_v_cmove(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); +void ae_v_cmoveneg(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); +void ae_v_cmoved(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); +void ae_v_cmovec(ae_complex *vdst, ae_int_t stride_dst, const ae_complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha); +void ae_v_cadd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); +void ae_v_caddd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); +void ae_v_caddc(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha); +void ae_v_csub(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); +void ae_v_csubd(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); +void ae_v_csubc(ae_complex *vdst, ae_int_t stride_dst, const ae_complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, ae_complex alpha); +void ae_v_cmuld(ae_complex *vdst, ae_int_t stride_dst, ae_int_t n, double alpha); +void ae_v_cmulc(ae_complex *vdst, ae_int_t stride_dst, ae_int_t n, ae_complex alpha); + +/************************************************************************ +Real BLAS operations +************************************************************************/ +double ae_v_dotproduct(const double *v0, ae_int_t stride0, const double *v1, ae_int_t stride1, ae_int_t n); +void ae_v_move(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n); +void ae_v_moveneg(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n); +void ae_v_moved(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n, double alpha); +void ae_v_add(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n); +void ae_v_addd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha); +void ae_v_sub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n); +void ae_v_subd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha); +void ae_v_muld(double *vdst, ae_int_t stride_dst, ae_int_t n, double alpha); + +/************************************************************************ +Other functions +************************************************************************/ +ae_int_t ae_v_len(ae_int_t a, ae_int_t b); + +/* +extern const double ae_machineepsilon; +extern const double ae_maxrealnumber; +extern const double ae_minrealnumber; +extern const double ae_pi; +*/ +#define ae_machineepsilon 5E-16 +#define ae_maxrealnumber 1E300 +#define ae_minrealnumber 1E-300 +#define ae_pi 3.1415926535897932384626433832795 + + +/************************************************************************ +RComm functions +************************************************************************/ +typedef struct rcommstate +{ + int stage; + ae_vector ia; + ae_vector ba; + ae_vector ra; + ae_vector ca; +} rcommstate; +ae_bool _rcommstate_init(rcommstate* p, ae_state *_state, ae_bool make_automatic); +ae_bool _rcommstate_init_copy(rcommstate* dst, rcommstate* src, ae_state *_state, ae_bool make_automatic); +void _rcommstate_clear(rcommstate* p); +void _rcommstate_destroy(rcommstate* p); + +#ifdef AE_USE_ALLOC_COUNTER +extern ae_int64_t _alloc_counter; +#endif + + +/************************************************************************ +debug functions (must be turned on by preprocessor definitions): +* tickcount(), which is wrapper around GetTickCount() +* flushconsole(), fluches console +* ae_debugrng(), returns random number generated with high-quality random numbers generator +* ae_set_seed(), sets seed of the debug RNG (NON-THREAD-SAFE!!!) +* ae_get_seed(), returns two seed values of the debug RNG (NON-THREAD-SAFE!!!) +************************************************************************/ +#ifdef AE_DEBUG4WINDOWS +#define flushconsole(s) fflush(stdout) +#define tickcount(s) _tickcount() +int _tickcount(); +#endif +#ifdef AE_DEBUG4POSIX +#define flushconsole(s) fflush(stdout) +#define tickcount(s) _tickcount() +int _tickcount(); +#endif +#ifdef AE_DEBUGRNG +ae_int_t ae_debugrng(); +void ae_set_seed(ae_int_t s0, ae_int_t s1); +void ae_get_seed(ae_int_t *s0, ae_int_t *s1); +#endif + + +} + + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS DECLARATIONS FOR C++ RELATED FUNCTIONALITY +// +///////////////////////////////////////////////////////////////////////// + +namespace alglib +{ + +typedef alglib_impl::ae_int_t ae_int_t; + +/******************************************************************** +Class forwards +********************************************************************/ +class complex; + +ae_int_t vlen(ae_int_t n1, ae_int_t n2); + +/******************************************************************** +Exception class. +********************************************************************/ +class ap_error +{ +public: + std::string msg; + + ap_error(); + ap_error(const char *s); + static void make_assertion(bool bClause); + static void make_assertion(bool bClause, const char *msg); +private: +}; + +/******************************************************************** +Complex number with double precision. +********************************************************************/ +class complex +{ +public: + complex(); + complex(const double &_x); + complex(const double &_x, const double &_y); + complex(const complex &z); + + complex& operator= (const double& v); + complex& operator+=(const double& v); + complex& operator-=(const double& v); + complex& operator*=(const double& v); + complex& operator/=(const double& v); + + complex& operator= (const complex& z); + complex& operator+=(const complex& z); + complex& operator-=(const complex& z); + complex& operator*=(const complex& z); + complex& operator/=(const complex& z); + + alglib_impl::ae_complex* c_ptr(); + const alglib_impl::ae_complex* c_ptr() const; + + std::string tostring(int dps) const; + + double x, y; +}; + +const alglib::complex operator/(const alglib::complex& lhs, const alglib::complex& rhs); +const bool operator==(const alglib::complex& lhs, const alglib::complex& rhs); +const bool operator!=(const alglib::complex& lhs, const alglib::complex& rhs); +const alglib::complex operator+(const alglib::complex& lhs); +const alglib::complex operator-(const alglib::complex& lhs); +const alglib::complex operator+(const alglib::complex& lhs, const alglib::complex& rhs); +const alglib::complex operator+(const alglib::complex& lhs, const double& rhs); +const alglib::complex operator+(const double& lhs, const alglib::complex& rhs); +const alglib::complex operator-(const alglib::complex& lhs, const alglib::complex& rhs); +const alglib::complex operator-(const alglib::complex& lhs, const double& rhs); +const alglib::complex operator-(const double& lhs, const alglib::complex& rhs); +const alglib::complex operator*(const alglib::complex& lhs, const alglib::complex& rhs); +const alglib::complex operator*(const alglib::complex& lhs, const double& rhs); +const alglib::complex operator*(const double& lhs, const alglib::complex& rhs); +const alglib::complex operator/(const alglib::complex& lhs, const alglib::complex& rhs); +const alglib::complex operator/(const double& lhs, const alglib::complex& rhs); +const alglib::complex operator/(const alglib::complex& lhs, const double& rhs); +double abscomplex(const alglib::complex &z); +alglib::complex conj(const alglib::complex &z); +alglib::complex csqr(const alglib::complex &z); +void setnworkers(alglib::ae_int_t nworkers); + +/******************************************************************** +Level 1 BLAS functions + +NOTES: +* destination and source should NOT overlap +* stride is assumed to be positive, but it is not + assert'ed within function +* conj_src parameter specifies whether complex source is conjugated + before processing or not. Pass string which starts with 'N' or 'n' + ("No conj", for example) to use unmodified parameter. All other + values will result in conjugation of input, but it is recommended + to use "Conj" in such cases. +********************************************************************/ +double vdotproduct(const double *v0, ae_int_t stride0, const double *v1, ae_int_t stride1, ae_int_t n); +double vdotproduct(const double *v1, const double *v2, ae_int_t N); + +alglib::complex vdotproduct(const alglib::complex *v0, ae_int_t stride0, const char *conj0, const alglib::complex *v1, ae_int_t stride1, const char *conj1, ae_int_t n); +alglib::complex vdotproduct(const alglib::complex *v1, const alglib::complex *v2, ae_int_t N); + +void vmove(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n); +void vmove(double *vdst, const double* vsrc, ae_int_t N); + +void vmove(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); +void vmove(alglib::complex *vdst, const alglib::complex* vsrc, ae_int_t N); + +void vmoveneg(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n); +void vmoveneg(double *vdst, const double *vsrc, ae_int_t N); + +void vmoveneg(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); +void vmoveneg(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N); + +void vmove(double *vdst, ae_int_t stride_dst, const double* vsrc, ae_int_t stride_src, ae_int_t n, double alpha); +void vmove(double *vdst, const double *vsrc, ae_int_t N, double alpha); + +void vmove(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); +void vmove(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha); + +void vmove(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex* vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha); +void vmove(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha); + +void vadd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n); +void vadd(double *vdst, const double *vsrc, ae_int_t N); + +void vadd(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); +void vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N); + +void vadd(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha); +void vadd(double *vdst, const double *vsrc, ae_int_t N, double alpha); + +void vadd(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); +void vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha); + +void vadd(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha); +void vadd(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha); + +void vsub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n); +void vsub(double *vdst, const double *vsrc, ae_int_t N); + +void vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n); +void vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N); + +void vsub(double *vdst, ae_int_t stride_dst, const double *vsrc, ae_int_t stride_src, ae_int_t n, double alpha); +void vsub(double *vdst, const double *vsrc, ae_int_t N, double alpha); + +void vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, double alpha); +void vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, double alpha); + +void vsub(alglib::complex *vdst, ae_int_t stride_dst, const alglib::complex *vsrc, ae_int_t stride_src, const char *conj_src, ae_int_t n, alglib::complex alpha); +void vsub(alglib::complex *vdst, const alglib::complex *vsrc, ae_int_t N, alglib::complex alpha); + +void vmul(double *vdst, ae_int_t stride_dst, ae_int_t n, double alpha); +void vmul(double *vdst, ae_int_t N, double alpha); + +void vmul(alglib::complex *vdst, ae_int_t stride_dst, ae_int_t n, double alpha); +void vmul(alglib::complex *vdst, ae_int_t N, double alpha); + +void vmul(alglib::complex *vdst, ae_int_t stride_dst, ae_int_t n, alglib::complex alpha); +void vmul(alglib::complex *vdst, ae_int_t N, alglib::complex alpha); + + + +/******************************************************************** +string conversion functions !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +********************************************************************/ + +/******************************************************************** +1- and 2-dimensional arrays +********************************************************************/ +class ae_vector_wrapper +{ +public: + ae_vector_wrapper(); + virtual ~ae_vector_wrapper(); + + void setlength(ae_int_t iLen); + ae_int_t length() const; + + void attach_to(alglib_impl::ae_vector *ptr); + void allocate_own(ae_int_t size, alglib_impl::ae_datatype datatype); + const alglib_impl::ae_vector* c_ptr() const; + alglib_impl::ae_vector* c_ptr(); +private: + ae_vector_wrapper(const ae_vector_wrapper &rhs); + const ae_vector_wrapper& operator=(const ae_vector_wrapper &rhs); +protected: + // + // Copies source vector RHS into current object. + // + // Current object is considered empty (this function should be + // called from copy constructor). + // + void create(const ae_vector_wrapper &rhs); + + // + // Copies array given by string into current object. Additional + // parameter DATATYPE contains information about type of the data + // in S and type of the array to create. + // + // Current object is considered empty (this function should be + // called from copy constructor). + // + void create(const char *s, alglib_impl::ae_datatype datatype); + + // + // Assigns RHS to current object. + // + // It has several branches depending on target object status: + // * in case it is proxy object, data are copied into memory pointed by + // proxy. Function checks that source has exactly same size as target + // (exception is thrown on failure). + // * in case it is non-proxy object, data allocated by object are cleared + // and a copy of RHS is created in target. + // + // NOTE: this function correctly handles assignments of the object to itself. + // + void assign(const ae_vector_wrapper &rhs); + + alglib_impl::ae_vector *p_vec; + alglib_impl::ae_vector vec; +}; + +class boolean_1d_array : public ae_vector_wrapper +{ +public: + boolean_1d_array(); + boolean_1d_array(const char *s); + boolean_1d_array(const boolean_1d_array &rhs); + boolean_1d_array(alglib_impl::ae_vector *p); + const boolean_1d_array& operator=(const boolean_1d_array &rhs); + virtual ~boolean_1d_array() ; + + const ae_bool& operator()(ae_int_t i) const; + ae_bool& operator()(ae_int_t i); + + const ae_bool& operator[](ae_int_t i) const; + ae_bool& operator[](ae_int_t i); + + void setcontent(ae_int_t iLen, const bool *pContent ); + ae_bool* getcontent(); + const ae_bool* getcontent() const; + + std::string tostring() const; +}; + +class integer_1d_array : public ae_vector_wrapper +{ +public: + integer_1d_array(); + integer_1d_array(const char *s); + integer_1d_array(const integer_1d_array &rhs); + integer_1d_array(alglib_impl::ae_vector *p); + const integer_1d_array& operator=(const integer_1d_array &rhs); + virtual ~integer_1d_array(); + + const ae_int_t& operator()(ae_int_t i) const; + ae_int_t& operator()(ae_int_t i); + + const ae_int_t& operator[](ae_int_t i) const; + ae_int_t& operator[](ae_int_t i); + + void setcontent(ae_int_t iLen, const ae_int_t *pContent ); + + ae_int_t* getcontent(); + const ae_int_t* getcontent() const; + + std::string tostring() const; +}; + +class real_1d_array : public ae_vector_wrapper +{ +public: + real_1d_array(); + real_1d_array(const char *s); + real_1d_array(const real_1d_array &rhs); + real_1d_array(alglib_impl::ae_vector *p); + const real_1d_array& operator=(const real_1d_array &rhs); + virtual ~real_1d_array(); + + const double& operator()(ae_int_t i) const; + double& operator()(ae_int_t i); + + const double& operator[](ae_int_t i) const; + double& operator[](ae_int_t i); + + void setcontent(ae_int_t iLen, const double *pContent ); + double* getcontent(); + const double* getcontent() const; + + std::string tostring(int dps) const; +}; + +class complex_1d_array : public ae_vector_wrapper +{ +public: + complex_1d_array(); + complex_1d_array(const char *s); + complex_1d_array(const complex_1d_array &rhs); + complex_1d_array(alglib_impl::ae_vector *p); + const complex_1d_array& operator=(const complex_1d_array &rhs); + virtual ~complex_1d_array(); + + const alglib::complex& operator()(ae_int_t i) const; + alglib::complex& operator()(ae_int_t i); + + const alglib::complex& operator[](ae_int_t i) const; + alglib::complex& operator[](ae_int_t i); + + void setcontent(ae_int_t iLen, const alglib::complex *pContent ); + alglib::complex* getcontent(); + const alglib::complex* getcontent() const; + + std::string tostring(int dps) const; +}; + +class ae_matrix_wrapper +{ +public: + ae_matrix_wrapper(); + virtual ~ae_matrix_wrapper(); + const ae_matrix_wrapper& operator=(const ae_matrix_wrapper &rhs); + + void setlength(ae_int_t rows, ae_int_t cols); + ae_int_t rows() const; + ae_int_t cols() const; + bool isempty() const; + ae_int_t getstride() const; + + void attach_to(alglib_impl::ae_matrix *ptr); + void allocate_own(ae_int_t rows, ae_int_t cols, alglib_impl::ae_datatype datatype); + const alglib_impl::ae_matrix* c_ptr() const; + alglib_impl::ae_matrix* c_ptr(); +private: + ae_matrix_wrapper(const ae_matrix_wrapper &rhs); +protected: + // + // Copies source matrix RHS into current object. + // + // Current object is considered empty (this function should be + // called from copy constructor). + // + void create(const ae_matrix_wrapper &rhs); + + // + // Copies array given by string into current object. Additional + // parameter DATATYPE contains information about type of the data + // in S and type of the array to create. + // + // Current object is considered empty (this function should be + // called from copy constructor). + // + void create(const char *s, alglib_impl::ae_datatype datatype); + + // + // Assigns RHS to current object. + // + // It has several branches depending on target object status: + // * in case it is proxy object, data are copied into memory pointed by + // proxy. Function checks that source has exactly same size as target + // (exception is thrown on failure). + // * in case it is non-proxy object, data allocated by object are cleared + // and a copy of RHS is created in target. + // + // NOTE: this function correctly handles assignments of the object to itself. + // + void assign(const ae_matrix_wrapper &rhs); + + alglib_impl::ae_matrix *p_mat; + alglib_impl::ae_matrix mat; +}; + +class boolean_2d_array : public ae_matrix_wrapper +{ +public: + boolean_2d_array(); + boolean_2d_array(const boolean_2d_array &rhs); + boolean_2d_array(alglib_impl::ae_matrix *p); + boolean_2d_array(const char *s); + virtual ~boolean_2d_array(); + + const ae_bool& operator()(ae_int_t i, ae_int_t j) const; + ae_bool& operator()(ae_int_t i, ae_int_t j); + + const ae_bool* operator[](ae_int_t i) const; + ae_bool* operator[](ae_int_t i); + + void setcontent(ae_int_t irows, ae_int_t icols, const bool *pContent ); + + std::string tostring() const ; +}; + +class integer_2d_array : public ae_matrix_wrapper +{ +public: + integer_2d_array(); + integer_2d_array(const integer_2d_array &rhs); + integer_2d_array(alglib_impl::ae_matrix *p); + integer_2d_array(const char *s); + virtual ~integer_2d_array(); + + const ae_int_t& operator()(ae_int_t i, ae_int_t j) const; + ae_int_t& operator()(ae_int_t i, ae_int_t j); + + const ae_int_t* operator[](ae_int_t i) const; + ae_int_t* operator[](ae_int_t i); + + void setcontent(ae_int_t irows, ae_int_t icols, const ae_int_t *pContent ); + + std::string tostring() const; +}; + +class real_2d_array : public ae_matrix_wrapper +{ +public: + real_2d_array(); + real_2d_array(const real_2d_array &rhs); + real_2d_array(alglib_impl::ae_matrix *p); + real_2d_array(const char *s); + virtual ~real_2d_array(); + + const double& operator()(ae_int_t i, ae_int_t j) const; + double& operator()(ae_int_t i, ae_int_t j); + + const double* operator[](ae_int_t i) const; + double* operator[](ae_int_t i); + + void setcontent(ae_int_t irows, ae_int_t icols, const double *pContent ); + + std::string tostring(int dps) const; +}; + +class complex_2d_array : public ae_matrix_wrapper +{ +public: + complex_2d_array(); + complex_2d_array(const complex_2d_array &rhs); + complex_2d_array(alglib_impl::ae_matrix *p); + complex_2d_array(const char *s); + virtual ~complex_2d_array(); + + const alglib::complex& operator()(ae_int_t i, ae_int_t j) const; + alglib::complex& operator()(ae_int_t i, ae_int_t j); + + const alglib::complex* operator[](ae_int_t i) const; + alglib::complex* operator[](ae_int_t i); + + void setcontent(ae_int_t irows, ae_int_t icols, const alglib::complex *pContent ); + + std::string tostring(int dps) const; +}; + + + +/******************************************************************** +dataset information. + +can store regression dataset, classification dataset, or non-labeled +task: +* nout==0 means non-labeled task (clustering, for example) +* nout>0 && nclasses==0 means regression task +* nout>0 && nclasses>0 means classification task +********************************************************************/ +/*class dataset +{ +public: + dataset():nin(0), nout(0), nclasses(0), trnsize(0), valsize(0), tstsize(0), totalsize(0){}; + + int nin, nout, nclasses; + + int trnsize; + int valsize; + int tstsize; + int totalsize; + + alglib::real_2d_array trn; + alglib::real_2d_array val; + alglib::real_2d_array tst; + alglib::real_2d_array all; +}; + +bool opendataset(std::string file, dataset *pdataset); + +// +// internal functions +// +std::string strtolower(const std::string &s); +bool readstrings(std::string file, std::list *pOutput); +bool readstrings(std::string file, std::list *pOutput, std::string comment); +void explodestring(std::string s, char sep, std::vector *pOutput); +std::string xtrim(std::string s);*/ + +/******************************************************************** +Constants and functions introduced for compatibility with AlgoPascal +********************************************************************/ +extern const double machineepsilon; +extern const double maxrealnumber; +extern const double minrealnumber; +extern const double fp_nan; +extern const double fp_posinf; +extern const double fp_neginf; +extern const ae_int_t endianness; + +int sign(double x); +double randomreal(); +ae_int_t randominteger(ae_int_t maxv); +int round(double x); +int trunc(double x); +int ifloor(double x); +int iceil(double x); +double pi(); +double sqr(double x); +int maxint(int m1, int m2); +int minint(int m1, int m2); +double maxreal(double m1, double m2); +double minreal(double m1, double m2); + +bool fp_eq(double v1, double v2); +bool fp_neq(double v1, double v2); +bool fp_less(double v1, double v2); +bool fp_less_eq(double v1, double v2); +bool fp_greater(double v1, double v2); +bool fp_greater_eq(double v1, double v2); + +bool fp_isnan(double x); +bool fp_isposinf(double x); +bool fp_isneginf(double x); +bool fp_isinf(double x); +bool fp_isfinite(double x); + + +}//namespace alglib + + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTIONS CONTAINS DECLARATIONS FOR OPTIMIZED LINEAR ALGEBRA CODES +// IT IS SHARED BETWEEN C++ AND PURE C LIBRARIES +// +///////////////////////////////////////////////////////////////////////// + +namespace alglib_impl +{ +#define ALGLIB_INTERCEPTS_ABLAS +void _ialglib_vzero(ae_int_t n, double *p, ae_int_t stride); +void _ialglib_vzero_complex(ae_int_t n, ae_complex *p, ae_int_t stride); +void _ialglib_vcopy(ae_int_t n, const double *a, ae_int_t stridea, double *b, ae_int_t strideb); +void _ialglib_vcopy_complex(ae_int_t n, const ae_complex *a, ae_int_t stridea, double *b, ae_int_t strideb, const char *conj); +void _ialglib_vcopy_dcomplex(ae_int_t n, const double *a, ae_int_t stridea, double *b, ae_int_t strideb, const char *conj); +void _ialglib_mcopyblock(ae_int_t m, ae_int_t n, const double *a, ae_int_t op, ae_int_t stride, double *b); +void _ialglib_mcopyunblock(ae_int_t m, ae_int_t n, const double *a, ae_int_t op, double *b, ae_int_t stride); +void _ialglib_mcopyblock_complex(ae_int_t m, ae_int_t n, const ae_complex *a, ae_int_t op, ae_int_t stride, double *b); +void _ialglib_mcopyunblock_complex(ae_int_t m, ae_int_t n, const double *a, ae_int_t op, ae_complex* b, ae_int_t stride); + +ae_bool _ialglib_i_rmatrixgemmf(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + ae_matrix *b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + ae_matrix *c, + ae_int_t ic, + ae_int_t jc); +ae_bool _ialglib_i_cmatrixgemmf(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + ae_matrix *b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + ae_matrix *c, + ae_int_t ic, + ae_int_t jc); +ae_bool _ialglib_i_cmatrixrighttrsmf(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_matrix *x, + ae_int_t i2, + ae_int_t j2); +ae_bool _ialglib_i_rmatrixrighttrsmf(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_matrix *x, + ae_int_t i2, + ae_int_t j2); +ae_bool _ialglib_i_cmatrixlefttrsmf(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_matrix *x, + ae_int_t i2, + ae_int_t j2); +ae_bool _ialglib_i_rmatrixlefttrsmf(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + ae_matrix *x, + ae_int_t i2, + ae_int_t j2); +ae_bool _ialglib_i_cmatrixsyrkf(ae_int_t n, + ae_int_t k, + double alpha, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + ae_matrix *c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper); +ae_bool _ialglib_i_rmatrixsyrkf(ae_int_t n, + ae_int_t k, + double alpha, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + ae_matrix *c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper); +ae_bool _ialglib_i_cmatrixrank1f(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_vector *u, + ae_int_t uoffs, + ae_vector *v, + ae_int_t voffs); +ae_bool _ialglib_i_rmatrixrank1f(ae_int_t m, + ae_int_t n, + ae_matrix *a, + ae_int_t ia, + ae_int_t ja, + ae_vector *u, + ae_int_t uoffs, + ae_vector *v, + ae_int_t voffs); + + + +} + + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS PARALLEL SUBROUTINES +// +///////////////////////////////////////////////////////////////////////// + +namespace alglib_impl +{ + +} + + +#endif + diff --git a/psdlag/src/check.dat b/psdlag/src/check.dat new file mode 100644 index 0000000..0dd0f5a --- /dev/null +++ b/psdlag/src/check.dat @@ -0,0 +1,6 @@ +2.5e-5 4.681 +5.5e-5 3.358 +8.5e-5 2.911 +1.5e-4 2.650 +2.5e-4 1.864 +3.5e-4 0.605 diff --git a/psdlag/src/dataanalysis.cpp b/psdlag/src/dataanalysis.cpp new file mode 100644 index 0000000..1ef4452 --- /dev/null +++ b/psdlag/src/dataanalysis.cpp @@ -0,0 +1,35078 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "dataanalysis.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +Optimal binary classification + +Algorithms finds optimal (=with minimal cross-entropy) binary partition. +Internal subroutine. + +INPUT PARAMETERS: + A - array[0..N-1], variable + C - array[0..N-1], class numbers (0 or 1). + N - array size + +OUTPUT PARAMETERS: + Info - completetion code: + * -3, all values of A[] are same (partition is impossible) + * -2, one of C[] is incorrect (<0, >1) + * -1, incorrect pararemets were passed (N<=0). + * 1, OK + Threshold- partiton boundary. Left part contains values which are + strictly less than Threshold. Right part contains values + which are greater than or equal to Threshold. + PAL, PBL- probabilities P(0|v=Threshold) and P(1|v>=Threshold) + CVE - cross-validation estimate of cross-entropy + + -- ALGLIB -- + Copyright 22.05.2008 by Bochkanov Sergey +*************************************************************************/ +void dsoptimalsplit2(const real_1d_array &a, const integer_1d_array &c, const ae_int_t n, ae_int_t &info, double &threshold, double &pal, double &pbl, double &par, double &pbr, double &cve) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::dsoptimalsplit2(const_cast(a.c_ptr()), const_cast(c.c_ptr()), n, &info, &threshold, &pal, &pbl, &par, &pbr, &cve, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Optimal partition, internal subroutine. Fast version. + +Accepts: + A array[0..N-1] array of attributes array[0..N-1] + C array[0..N-1] array of class labels + TiesBuf array[0..N] temporaries (ties) + CntBuf array[0..2*NC-1] temporaries (counts) + Alpha centering factor (0<=alpha<=1, recommended value - 0.05) + BufR array[0..N-1] temporaries + BufI array[0..N-1] temporaries + +Output: + Info error code (">0"=OK, "<0"=bad) + RMS training set RMS error + CVRMS leave-one-out RMS error + +Note: + content of all arrays is changed by subroutine; + it doesn't allocate temporaries. + + -- ALGLIB -- + Copyright 11.12.2008 by Bochkanov Sergey +*************************************************************************/ +void dsoptimalsplit2fast(real_1d_array &a, integer_1d_array &c, integer_1d_array &tiesbuf, integer_1d_array &cntbuf, real_1d_array &bufr, integer_1d_array &bufi, const ae_int_t n, const ae_int_t nc, const double alpha, ae_int_t &info, double &threshold, double &rms, double &cvrms) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::dsoptimalsplit2fast(const_cast(a.c_ptr()), const_cast(c.c_ptr()), const_cast(tiesbuf.c_ptr()), const_cast(cntbuf.c_ptr()), const_cast(bufr.c_ptr()), const_cast(bufi.c_ptr()), n, nc, alpha, &info, &threshold, &rms, &cvrms, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This structure is a clusterization engine. + +You should not try to access its fields directly. +Use ALGLIB functions in order to work with this object. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +_clusterizerstate_owner::_clusterizerstate_owner() +{ + p_struct = (alglib_impl::clusterizerstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::clusterizerstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_clusterizerstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_clusterizerstate_owner::_clusterizerstate_owner(const _clusterizerstate_owner &rhs) +{ + p_struct = (alglib_impl::clusterizerstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::clusterizerstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_clusterizerstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_clusterizerstate_owner& _clusterizerstate_owner::operator=(const _clusterizerstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_clusterizerstate_clear(p_struct); + if( !alglib_impl::_clusterizerstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_clusterizerstate_owner::~_clusterizerstate_owner() +{ + alglib_impl::_clusterizerstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::clusterizerstate* _clusterizerstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::clusterizerstate* _clusterizerstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +clusterizerstate::clusterizerstate() : _clusterizerstate_owner() +{ +} + +clusterizerstate::clusterizerstate(const clusterizerstate &rhs):_clusterizerstate_owner(rhs) +{ +} + +clusterizerstate& clusterizerstate::operator=(const clusterizerstate &rhs) +{ + if( this==&rhs ) + return *this; + _clusterizerstate_owner::operator=(rhs); + return *this; +} + +clusterizerstate::~clusterizerstate() +{ +} + + +/************************************************************************* +This structure is used to store results of the agglomerative hierarchical +clustering (AHC). + +Following information is returned: + +* NPoints contains number of points in the original dataset + +* Z contains information about merges performed (see below). Z contains + indexes from the original (unsorted) dataset and it can be used when you + need to know what points were merged. However, it is not convenient when + you want to build a dendrograd (see below). + +* if you want to build dendrogram, you can use Z, but it is not good + option, because Z contains indexes from unsorted dataset. Dendrogram + built from such dataset is likely to have intersections. So, you have to + reorder you points before building dendrogram. + Permutation which reorders point is returned in P. Another representation + of merges, which is more convenient for dendorgram construction, is + returned in PM. + +* more information on format of Z, P and PM can be found below and in the + examples from ALGLIB Reference Manual. + +FORMAL DESCRIPTION OF FIELDS: + NPoints number of points + Z array[NPoints-1,2], contains indexes of clusters + linked in pairs to form clustering tree. I-th row + corresponds to I-th merge: + * Z[I,0] - index of the first cluster to merge + * Z[I,1] - index of the second cluster to merge + * Z[I,0](rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_ahcreport_owner& _ahcreport_owner::operator=(const _ahcreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_ahcreport_clear(p_struct); + if( !alglib_impl::_ahcreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_ahcreport_owner::~_ahcreport_owner() +{ + alglib_impl::_ahcreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::ahcreport* _ahcreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::ahcreport* _ahcreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +ahcreport::ahcreport() : _ahcreport_owner() ,npoints(p_struct->npoints),p(&p_struct->p),z(&p_struct->z),pz(&p_struct->pz),pm(&p_struct->pm),mergedist(&p_struct->mergedist) +{ +} + +ahcreport::ahcreport(const ahcreport &rhs):_ahcreport_owner(rhs) ,npoints(p_struct->npoints),p(&p_struct->p),z(&p_struct->z),pz(&p_struct->pz),pm(&p_struct->pm),mergedist(&p_struct->mergedist) +{ +} + +ahcreport& ahcreport::operator=(const ahcreport &rhs) +{ + if( this==&rhs ) + return *this; + _ahcreport_owner::operator=(rhs); + return *this; +} + +ahcreport::~ahcreport() +{ +} + + +/************************************************************************* +This structure is used to store results of the k-means++ clustering +algorithm. + +Following information is always returned: +* NPoints contains number of points in the original dataset +* TerminationType contains completion code, negative on failure, positive + on success +* K contains number of clusters + +For positive TerminationType we return: +* NFeatures contains number of variables in the original dataset +* C, which contains centers found by algorithm +* CIdx, which maps points of the original dataset to clusters + +FORMAL DESCRIPTION OF FIELDS: + NPoints number of points, >=0 + NFeatures number of variables, >=1 + TerminationType completion code: + * -5 if distance type is anything different from + Euclidean metric + * -3 for degenerate dataset: a) less than K distinct + points, b) K=0 for non-empty dataset. + * +1 for successful completion + K number of clusters + C array[K,NFeatures], rows of the array store centers + CIdx array[NPoints], which contains cluster indexes + + -- ALGLIB -- + Copyright 27.11.2012 by Bochkanov Sergey +*************************************************************************/ +_kmeansreport_owner::_kmeansreport_owner() +{ + p_struct = (alglib_impl::kmeansreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::kmeansreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_kmeansreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_kmeansreport_owner::_kmeansreport_owner(const _kmeansreport_owner &rhs) +{ + p_struct = (alglib_impl::kmeansreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::kmeansreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_kmeansreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_kmeansreport_owner& _kmeansreport_owner::operator=(const _kmeansreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_kmeansreport_clear(p_struct); + if( !alglib_impl::_kmeansreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_kmeansreport_owner::~_kmeansreport_owner() +{ + alglib_impl::_kmeansreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::kmeansreport* _kmeansreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::kmeansreport* _kmeansreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +kmeansreport::kmeansreport() : _kmeansreport_owner() ,npoints(p_struct->npoints),nfeatures(p_struct->nfeatures),terminationtype(p_struct->terminationtype),k(p_struct->k),c(&p_struct->c),cidx(&p_struct->cidx) +{ +} + +kmeansreport::kmeansreport(const kmeansreport &rhs):_kmeansreport_owner(rhs) ,npoints(p_struct->npoints),nfeatures(p_struct->nfeatures),terminationtype(p_struct->terminationtype),k(p_struct->k),c(&p_struct->c),cidx(&p_struct->cidx) +{ +} + +kmeansreport& kmeansreport::operator=(const kmeansreport &rhs) +{ + if( this==&rhs ) + return *this; + _kmeansreport_owner::operator=(rhs); + return *this; +} + +kmeansreport::~kmeansreport() +{ +} + +/************************************************************************* +This function initializes clusterizer object. Newly initialized object is +empty, i.e. it does not contain dataset. You should use it as follows: +1. creation +2. dataset is added with ClusterizerSetPoints() +3. additional parameters are set +3. clusterization is performed with one of the clustering functions + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizercreate(clusterizerstate &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizercreate(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function adds dataset to the clusterizer structure. + +This function overrides all previous calls of ClusterizerSetPoints() or +ClusterizerSetDistances(). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + XY - array[NPoints,NFeatures], dataset + NPoints - number of points, >=0 + NFeatures- number of features, >=1 + DistType- distance function: + * 0 Chebyshev distance (L-inf norm) + * 1 city block distance (L1 norm) + * 2 Euclidean distance (L2 norm) + * 10 Pearson correlation: + dist(a,b) = 1-corr(a,b) + * 11 Absolute Pearson correlation: + dist(a,b) = 1-|corr(a,b)| + * 12 Uncentered Pearson correlation (cosine of the angle): + dist(a,b) = a'*b/(|a|*|b|) + * 13 Absolute uncentered Pearson correlation + dist(a,b) = |a'*b|/(|a|*|b|) + * 20 Spearman rank correlation: + dist(a,b) = 1-rankcorr(a,b) + * 21 Absolute Spearman rank correlation + dist(a,b) = 1-|rankcorr(a,b)| + +NOTE 1: different distance functions have different performance penalty: + * Euclidean or Pearson correlation distances are the fastest ones + * Spearman correlation distance function is a bit slower + * city block and Chebyshev distances are order of magnitude slower + + The reason behing difference in performance is that correlation-based + distance functions are computed using optimized linear algebra kernels, + while Chebyshev and city block distance functions are computed using + simple nested loops with two branches at each iteration. + +NOTE 2: different clustering algorithms have different limitations: + * agglomerative hierarchical clustering algorithms may be used with + any kind of distance metric + * k-means++ clustering algorithm may be used only with Euclidean + distance function + Thus, list of specific clustering algorithms you may use depends + on distance function you specify when you set your dataset. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetpoints(const clusterizerstate &s, const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizersetpoints(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), npoints, nfeatures, disttype, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function adds dataset to the clusterizer structure. + +This function overrides all previous calls of ClusterizerSetPoints() or +ClusterizerSetDistances(). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + XY - array[NPoints,NFeatures], dataset + NPoints - number of points, >=0 + NFeatures- number of features, >=1 + DistType- distance function: + * 0 Chebyshev distance (L-inf norm) + * 1 city block distance (L1 norm) + * 2 Euclidean distance (L2 norm) + * 10 Pearson correlation: + dist(a,b) = 1-corr(a,b) + * 11 Absolute Pearson correlation: + dist(a,b) = 1-|corr(a,b)| + * 12 Uncentered Pearson correlation (cosine of the angle): + dist(a,b) = a'*b/(|a|*|b|) + * 13 Absolute uncentered Pearson correlation + dist(a,b) = |a'*b|/(|a|*|b|) + * 20 Spearman rank correlation: + dist(a,b) = 1-rankcorr(a,b) + * 21 Absolute Spearman rank correlation + dist(a,b) = 1-|rankcorr(a,b)| + +NOTE 1: different distance functions have different performance penalty: + * Euclidean or Pearson correlation distances are the fastest ones + * Spearman correlation distance function is a bit slower + * city block and Chebyshev distances are order of magnitude slower + + The reason behing difference in performance is that correlation-based + distance functions are computed using optimized linear algebra kernels, + while Chebyshev and city block distance functions are computed using + simple nested loops with two branches at each iteration. + +NOTE 2: different clustering algorithms have different limitations: + * agglomerative hierarchical clustering algorithms may be used with + any kind of distance metric + * k-means++ clustering algorithm may be used only with Euclidean + distance function + Thus, list of specific clustering algorithms you may use depends + on distance function you specify when you set your dataset. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetpoints(const clusterizerstate &s, const real_2d_array &xy, const ae_int_t disttype) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t npoints; + ae_int_t nfeatures; + + npoints = xy.rows(); + nfeatures = xy.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizersetpoints(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), npoints, nfeatures, disttype, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function adds dataset given by distance matrix to the clusterizer +structure. It is important that dataset is not given explicitly - only +distance matrix is given. + +This function overrides all previous calls of ClusterizerSetPoints() or +ClusterizerSetDistances(). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + D - array[NPoints,NPoints], distance matrix given by its upper + or lower triangle (main diagonal is ignored because its + entries are expected to be zero). + NPoints - number of points + IsUpper - whether upper or lower triangle of D is given. + +NOTE 1: different clustering algorithms have different limitations: + * agglomerative hierarchical clustering algorithms may be used with + any kind of distance metric, including one which is given by + distance matrix + * k-means++ clustering algorithm may be used only with Euclidean + distance function and explicitly given points - it can not be + used with dataset given by distance matrix + Thus, if you call this function, you will be unable to use k-means + clustering algorithm to process your problem. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetdistances(const clusterizerstate &s, const real_2d_array &d, const ae_int_t npoints, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizersetdistances(const_cast(s.c_ptr()), const_cast(d.c_ptr()), npoints, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function adds dataset given by distance matrix to the clusterizer +structure. It is important that dataset is not given explicitly - only +distance matrix is given. + +This function overrides all previous calls of ClusterizerSetPoints() or +ClusterizerSetDistances(). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + D - array[NPoints,NPoints], distance matrix given by its upper + or lower triangle (main diagonal is ignored because its + entries are expected to be zero). + NPoints - number of points + IsUpper - whether upper or lower triangle of D is given. + +NOTE 1: different clustering algorithms have different limitations: + * agglomerative hierarchical clustering algorithms may be used with + any kind of distance metric, including one which is given by + distance matrix + * k-means++ clustering algorithm may be used only with Euclidean + distance function and explicitly given points - it can not be + used with dataset given by distance matrix + Thus, if you call this function, you will be unable to use k-means + clustering algorithm to process your problem. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetdistances(const clusterizerstate &s, const real_2d_array &d, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t npoints; + if( (d.rows()!=d.cols())) + throw ap_error("Error while calling 'clusterizersetdistances': looks like one of arguments has wrong size"); + npoints = d.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizersetdistances(const_cast(s.c_ptr()), const_cast(d.c_ptr()), npoints, isupper, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets agglomerative hierarchical clustering algorithm + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + Algo - algorithm type: + * 0 complete linkage (default algorithm) + * 1 single linkage + * 2 unweighted average linkage + * 3 weighted average linkage + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetahcalgo(const clusterizerstate &s, const ae_int_t algo) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizersetahcalgo(const_cast(s.c_ptr()), algo, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets k-means++ properties : number of restarts and maximum +number of iterations per one run. + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + Restarts- restarts count, >=1. + k-means++ algorithm performs several restarts and chooses + best set of centers (one with minimum squared distance). + MaxIts - maximum number of k-means iterations performed during one + run. >=0, zero value means that algorithm performs unlimited + number of iterations. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetkmeanslimits(const clusterizerstate &s, const ae_int_t restarts, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizersetkmeanslimits(const_cast(s.c_ptr()), restarts, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function performs agglomerative hierarchical clustering + +FOR USERS OF SMP EDITION: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Multicore version is pretty efficient on large + ! problems which need more than 1.000.000 operations to be solved, + ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU + ! cycles), but gives no speed-up for small problems (less than 100.000 + ! operations). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + +OUTPUT PARAMETERS: + Rep - clustering results; see description of AHCReport + structure for more information. + +NOTE 1: hierarchical clustering algorithms require large amounts of memory. + In particular, this implementation needs sizeof(double)*NPoints^2 + bytes, which are used to store distance matrix. In case we work + with user-supplied matrix, this amount is multiplied by 2 (we have + to store original matrix and to work with its copy). + + For example, problem with 10000 points would require 800M of RAM, + even when working in a 1-dimensional space. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizerrunahc(const clusterizerstate &s, ahcreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizerrunahc(const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_clusterizerrunahc(const clusterizerstate &s, ahcreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_clusterizerrunahc(const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function performs clustering by k-means++ algorithm. + +You may change algorithm properties like number of restarts or iterations +limit by calling ClusterizerSetKMeansLimits() functions. + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + K - number of clusters, K>=0. + K can be zero only when algorithm is called for empty + dataset, in this case completion code is set to + success (+1). + If K=0 and dataset size is non-zero, we can not + meaningfully assign points to some center (there are no + centers because K=0) and return -3 as completion code + (failure). + +OUTPUT PARAMETERS: + Rep - clustering results; see description of KMeansReport + structure for more information. + +NOTE 1: k-means clustering can be performed only for datasets with + Euclidean distance function. Algorithm will return negative + completion code in Rep.TerminationType in case dataset was added + to clusterizer with DistType other than Euclidean (or dataset was + specified by distance matrix instead of explicitly given points). + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizerrunkmeans(const clusterizerstate &s, const ae_int_t k, kmeansreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizerrunkmeans(const_cast(s.c_ptr()), k, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns distance matrix for dataset + +FOR USERS OF SMP EDITION: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Multicore version is pretty efficient on large + ! problems which need more than 1.000.000 operations to be solved, + ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU + ! cycles), but gives no speed-up for small problems (less than 100.000 + ! operations). + +INPUT PARAMETERS: + XY - array[NPoints,NFeatures], dataset + NPoints - number of points, >=0 + NFeatures- number of features, >=1 + DistType- distance function: + * 0 Chebyshev distance (L-inf norm) + * 1 city block distance (L1 norm) + * 2 Euclidean distance (L2 norm) + * 10 Pearson correlation: + dist(a,b) = 1-corr(a,b) + * 11 Absolute Pearson correlation: + dist(a,b) = 1-|corr(a,b)| + * 12 Uncentered Pearson correlation (cosine of the angle): + dist(a,b) = a'*b/(|a|*|b|) + * 13 Absolute uncentered Pearson correlation + dist(a,b) = |a'*b|/(|a|*|b|) + * 20 Spearman rank correlation: + dist(a,b) = 1-rankcorr(a,b) + * 21 Absolute Spearman rank correlation + dist(a,b) = 1-|rankcorr(a,b)| + +OUTPUT PARAMETERS: + D - array[NPoints,NPoints], distance matrix + (full matrix is returned, with lower and upper triangles) + +NOTES: different distance functions have different performance penalty: + * Euclidean or Pearson correlation distances are the fastest ones + * Spearman correlation distance function is a bit slower + * city block and Chebyshev distances are order of magnitude slower + + The reason behing difference in performance is that correlation-based + distance functions are computed using optimized linear algebra kernels, + while Chebyshev and city block distance functions are computed using + simple nested loops with two branches at each iteration. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizergetdistances(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype, real_2d_array &d) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::clusterizergetdistances(const_cast(xy.c_ptr()), npoints, nfeatures, disttype, const_cast(d.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_clusterizergetdistances(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype, real_2d_array &d) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_clusterizergetdistances(const_cast(xy.c_ptr()), npoints, nfeatures, disttype, const_cast(d.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function takes as input clusterization report Rep, desired clusters +count K, and builds top K clusters from hierarchical clusterization tree. +It returns assignment of points to clusters (array of cluster indexes). + +INPUT PARAMETERS: + Rep - report from ClusterizerRunAHC() performed on XY + K - desired number of clusters, 1<=K<=NPoints. + K can be zero only when NPoints=0. + +OUTPUT PARAMETERS: + CIdx - array[NPoints], I-th element contains cluster index (from + 0 to K-1) for I-th point of the dataset. + CZ - array[K]. This array allows to convert cluster indexes + returned by this function to indexes used by Rep.Z. J-th + cluster returned by this function corresponds to CZ[J]-th + cluster stored in Rep.Z/PZ/PM. + It is guaranteed that CZ[I](rep.c_ptr()), k, const_cast(cidx.c_ptr()), const_cast(cz.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function accepts AHC report Rep, desired minimum intercluster +distance and returns top clusters from hierarchical clusterization tree +which are separated by distance R or HIGHER. + +It returns assignment of points to clusters (array of cluster indexes). + +There is one more function with similar name - ClusterizerSeparatedByCorr, +which returns clusters with intercluster correlation equal to R or LOWER +(note: higher for distance, lower for correlation). + +INPUT PARAMETERS: + Rep - report from ClusterizerRunAHC() performed on XY + R - desired minimum intercluster distance, R>=0 + +OUTPUT PARAMETERS: + K - number of clusters, 1<=K<=NPoints + CIdx - array[NPoints], I-th element contains cluster index (from + 0 to K-1) for I-th point of the dataset. + CZ - array[K]. This array allows to convert cluster indexes + returned by this function to indexes used by Rep.Z. J-th + cluster returned by this function corresponds to CZ[J]-th + cluster stored in Rep.Z/PZ/PM. + It is guaranteed that CZ[I](rep.c_ptr()), r, &k, const_cast(cidx.c_ptr()), const_cast(cz.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function accepts AHC report Rep, desired maximum intercluster +correlation and returns top clusters from hierarchical clusterization tree +which are separated by correlation R or LOWER. + +It returns assignment of points to clusters (array of cluster indexes). + +There is one more function with similar name - ClusterizerSeparatedByDist, +which returns clusters with intercluster distance equal to R or HIGHER +(note: higher for distance, lower for correlation). + +INPUT PARAMETERS: + Rep - report from ClusterizerRunAHC() performed on XY + R - desired maximum intercluster correlation, -1<=R<=+1 + +OUTPUT PARAMETERS: + K - number of clusters, 1<=K<=NPoints + CIdx - array[NPoints], I-th element contains cluster index (from + 0 to K-1) for I-th point of the dataset. + CZ - array[K]. This array allows to convert cluster indexes + returned by this function to indexes used by Rep.Z. J-th + cluster returned by this function corresponds to CZ[J]-th + cluster stored in Rep.Z/PZ/PM. + It is guaranteed that CZ[I](rep.c_ptr()), r, &k, const_cast(cidx.c_ptr()), const_cast(cz.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +k-means++ clusterization. +Backward compatibility function, we recommend to use CLUSTERING subpackage +as better replacement. + + -- ALGLIB -- + Copyright 21.03.2009 by Bochkanov Sergey +*************************************************************************/ +void kmeansgenerate(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t k, const ae_int_t restarts, ae_int_t &info, real_2d_array &c, integer_1d_array &xyc) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::kmeansgenerate(const_cast(xy.c_ptr()), npoints, nvars, k, restarts, &info, const_cast(c.c_ptr()), const_cast(xyc.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +_decisionforest_owner::_decisionforest_owner() +{ + p_struct = (alglib_impl::decisionforest*)alglib_impl::ae_malloc(sizeof(alglib_impl::decisionforest), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_decisionforest_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_decisionforest_owner::_decisionforest_owner(const _decisionforest_owner &rhs) +{ + p_struct = (alglib_impl::decisionforest*)alglib_impl::ae_malloc(sizeof(alglib_impl::decisionforest), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_decisionforest_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_decisionforest_owner& _decisionforest_owner::operator=(const _decisionforest_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_decisionforest_clear(p_struct); + if( !alglib_impl::_decisionforest_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_decisionforest_owner::~_decisionforest_owner() +{ + alglib_impl::_decisionforest_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::decisionforest* _decisionforest_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::decisionforest* _decisionforest_owner::c_ptr() const +{ + return const_cast(p_struct); +} +decisionforest::decisionforest() : _decisionforest_owner() +{ +} + +decisionforest::decisionforest(const decisionforest &rhs):_decisionforest_owner(rhs) +{ +} + +decisionforest& decisionforest::operator=(const decisionforest &rhs) +{ + if( this==&rhs ) + return *this; + _decisionforest_owner::operator=(rhs); + return *this; +} + +decisionforest::~decisionforest() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_dfreport_owner::_dfreport_owner() +{ + p_struct = (alglib_impl::dfreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::dfreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_dfreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_dfreport_owner::_dfreport_owner(const _dfreport_owner &rhs) +{ + p_struct = (alglib_impl::dfreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::dfreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_dfreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_dfreport_owner& _dfreport_owner::operator=(const _dfreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_dfreport_clear(p_struct); + if( !alglib_impl::_dfreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_dfreport_owner::~_dfreport_owner() +{ + alglib_impl::_dfreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::dfreport* _dfreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::dfreport* _dfreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +dfreport::dfreport() : _dfreport_owner() ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),oobrelclserror(p_struct->oobrelclserror),oobavgce(p_struct->oobavgce),oobrmserror(p_struct->oobrmserror),oobavgerror(p_struct->oobavgerror),oobavgrelerror(p_struct->oobavgrelerror) +{ +} + +dfreport::dfreport(const dfreport &rhs):_dfreport_owner(rhs) ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),oobrelclserror(p_struct->oobrelclserror),oobavgce(p_struct->oobavgce),oobrmserror(p_struct->oobrmserror),oobavgerror(p_struct->oobavgerror),oobavgrelerror(p_struct->oobavgrelerror) +{ +} + +dfreport& dfreport::operator=(const dfreport &rhs) +{ + if( this==&rhs ) + return *this; + _dfreport_owner::operator=(rhs); + return *this; +} + +dfreport::~dfreport() +{ +} + + +/************************************************************************* +This function serializes data structure to string. + +Important properties of s_out: +* it contains alphanumeric characters, dots, underscores, minus signs +* these symbols are grouped into words, which are separated by spaces + and Windows-style (CR+LF) newlines +* although serializer uses spaces and CR+LF as separators, you can + replace any separator character by arbitrary combination of spaces, + tabs, Windows or Unix newlines. It allows flexible reformatting of + the string in case you want to include it into text or XML file. + But you should not insert separators into the middle of the "words" + nor you should change case of letters. +* s_out can be freely moved between 32-bit and 64-bit systems, little + and big endian machines, and so on. You can serialize structure on + 32-bit machine and unserialize it on 64-bit one (or vice versa), or + serialize it on SPARC and unserialize on x86. You can also + serialize it in C++ version of ALGLIB and unserialize in C# one, + and vice versa. +*************************************************************************/ +void dfserialize(decisionforest &obj, std::string &s_out) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + alglib_impl::ae_int_t ssize; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_alloc_start(&serializer); + alglib_impl::dfalloc(&serializer, obj.c_ptr(), &state); + ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); + s_out.clear(); + s_out.reserve((size_t)(ssize+1)); + alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); + alglib_impl::dfserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + if( s_out.length()>(size_t)ssize ) + throw ap_error("ALGLIB: serialization integrity error"); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} +/************************************************************************* +This function unserializes data structure from string. +*************************************************************************/ +void dfunserialize(std::string &s_in, decisionforest &obj) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); + alglib_impl::dfunserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} + +/************************************************************************* +This subroutine builds random decision forest. + +INPUT PARAMETERS: + XY - training set + NPoints - training set size, NPoints>=1 + NVars - number of independent variables, NVars>=1 + NClasses - task type: + * NClasses=1 - regression task with one + dependent variable + * NClasses>1 - classification task with + NClasses classes. + NTrees - number of trees in a forest, NTrees>=1. + recommended values: 50-100. + R - percent of a training set used to build + individual trees. 01). + * 1, if task has been solved + DF - model built + Rep - training report, contains error on a training set + and out-of-bag estimates of generalization error. + + -- ALGLIB -- + Copyright 19.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfbuildrandomdecisionforest(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, const ae_int_t ntrees, const double r, ae_int_t &info, decisionforest &df, dfreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::dfbuildrandomdecisionforest(const_cast(xy.c_ptr()), npoints, nvars, nclasses, ntrees, r, &info, const_cast(df.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds random decision forest. +This function gives ability to tune number of variables used when choosing +best split. + +INPUT PARAMETERS: + XY - training set + NPoints - training set size, NPoints>=1 + NVars - number of independent variables, NVars>=1 + NClasses - task type: + * NClasses=1 - regression task with one + dependent variable + * NClasses>1 - classification task with + NClasses classes. + NTrees - number of trees in a forest, NTrees>=1. + recommended values: 50-100. + NRndVars - number of variables used when choosing best split + R - percent of a training set used to build + individual trees. 01). + * 1, if task has been solved + DF - model built + Rep - training report, contains error on a training set + and out-of-bag estimates of generalization error. + + -- ALGLIB -- + Copyright 19.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfbuildrandomdecisionforestx1(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, const ae_int_t ntrees, const ae_int_t nrndvars, const double r, ae_int_t &info, decisionforest &df, dfreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::dfbuildrandomdecisionforestx1(const_cast(xy.c_ptr()), npoints, nvars, nclasses, ntrees, nrndvars, r, &info, const_cast(df.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + DF - decision forest model + X - input vector, array[0..NVars-1]. + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + +See also DFProcessI. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfprocess(const decisionforest &df, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::dfprocess(const_cast(df.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +'interactive' variant of DFProcess for languages like Python which support +constructs like "Y = DFProcessI(DF,X)" and interactive mode of interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void dfprocessi(const decisionforest &df, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::dfprocessi(const_cast(df.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Relative classification error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + percent of incorrectly classified cases. + Zero if model solves regression task. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfrelclserror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::dfrelclserror(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + CrossEntropy/(NPoints*LN(2)). + Zero if model solves regression task. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgce(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::dfavgce(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + root mean square error. + Its meaning for regression task is obvious. As for + classification task, RMS error means error when estimating posterior + probabilities. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfrmserror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::dfrmserror(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for + classification task, it means average error when estimating posterior + probabilities. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgerror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::dfavgerror(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average relative error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for + classification task, it means average relative error when estimating + posterior probability of belonging to the correct class. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgrelerror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::dfavgrelerror(const_cast(df.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +_linearmodel_owner::_linearmodel_owner() +{ + p_struct = (alglib_impl::linearmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::linearmodel), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_linearmodel_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_linearmodel_owner::_linearmodel_owner(const _linearmodel_owner &rhs) +{ + p_struct = (alglib_impl::linearmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::linearmodel), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_linearmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_linearmodel_owner& _linearmodel_owner::operator=(const _linearmodel_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_linearmodel_clear(p_struct); + if( !alglib_impl::_linearmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_linearmodel_owner::~_linearmodel_owner() +{ + alglib_impl::_linearmodel_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::linearmodel* _linearmodel_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::linearmodel* _linearmodel_owner::c_ptr() const +{ + return const_cast(p_struct); +} +linearmodel::linearmodel() : _linearmodel_owner() +{ +} + +linearmodel::linearmodel(const linearmodel &rhs):_linearmodel_owner(rhs) +{ +} + +linearmodel& linearmodel::operator=(const linearmodel &rhs) +{ + if( this==&rhs ) + return *this; + _linearmodel_owner::operator=(rhs); + return *this; +} + +linearmodel::~linearmodel() +{ +} + + +/************************************************************************* +LRReport structure contains additional information about linear model: +* C - covariation matrix, array[0..NVars,0..NVars]. + C[i,j] = Cov(A[i],A[j]) +* RMSError - root mean square error on a training set +* AvgError - average error on a training set +* AvgRelError - average relative error on a training set (excluding + observations with zero function value). +* CVRMSError - leave-one-out cross-validation estimate of + generalization error. Calculated using fast algorithm + with O(NVars*NPoints) complexity. +* CVAvgError - cross-validation estimate of average error +* CVAvgRelError - cross-validation estimate of average relative error + +All other fields of the structure are intended for internal use and should +not be used outside ALGLIB. +*************************************************************************/ +_lrreport_owner::_lrreport_owner() +{ + p_struct = (alglib_impl::lrreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lrreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lrreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lrreport_owner::_lrreport_owner(const _lrreport_owner &rhs) +{ + p_struct = (alglib_impl::lrreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lrreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lrreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lrreport_owner& _lrreport_owner::operator=(const _lrreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_lrreport_clear(p_struct); + if( !alglib_impl::_lrreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_lrreport_owner::~_lrreport_owner() +{ + alglib_impl::_lrreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::lrreport* _lrreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::lrreport* _lrreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +lrreport::lrreport() : _lrreport_owner() ,c(&p_struct->c),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),cvrmserror(p_struct->cvrmserror),cvavgerror(p_struct->cvavgerror),cvavgrelerror(p_struct->cvavgrelerror),ncvdefects(p_struct->ncvdefects),cvdefects(&p_struct->cvdefects) +{ +} + +lrreport::lrreport(const lrreport &rhs):_lrreport_owner(rhs) ,c(&p_struct->c),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),cvrmserror(p_struct->cvrmserror),cvavgerror(p_struct->cvavgerror),cvavgrelerror(p_struct->cvavgrelerror),ncvdefects(p_struct->ncvdefects),cvdefects(&p_struct->cvdefects) +{ +} + +lrreport& lrreport::operator=(const lrreport &rhs) +{ + if( this==&rhs ) + return *this; + _lrreport_owner::operator=(rhs); + return *this; +} + +lrreport::~lrreport() +{ +} + +/************************************************************************* +Linear regression + +Subroutine builds model: + + Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + A(N) + +and model found in ALGLIB format, covariation matrix, training set errors +(rms, average, average relative) and leave-one-out cross-validation +estimate of the generalization error. CV estimate calculated using fast +algorithm with O(NPoints*NVars) complexity. + +When covariation matrix is calculated standard deviations of function +values are assumed to be equal to RMS error on the training set. + +INPUT PARAMETERS: + XY - training set, array [0..NPoints-1,0..NVars]: + * NVars columns - independent variables + * last column - dependent variable + NPoints - training set size, NPoints>NVars+1 + NVars - number of independent variables + +OUTPUT PARAMETERS: + Info - return code: + * -255, in case of unknown internal error + * -4, if internal SVD subroutine haven't converged + * -1, if incorrect parameters was passed (NPoints(xy.c_ptr()), npoints, nvars, &info, const_cast(lm.c_ptr()), const_cast(ar.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Linear regression + +Variant of LRBuild which uses vector of standatd deviations (errors in +function values). + +INPUT PARAMETERS: + XY - training set, array [0..NPoints-1,0..NVars]: + * NVars columns - independent variables + * last column - dependent variable + S - standard deviations (errors in function values) + array[0..NPoints-1], S[i]>0. + NPoints - training set size, NPoints>NVars+1 + NVars - number of independent variables + +OUTPUT PARAMETERS: + Info - return code: + * -255, in case of unknown internal error + * -4, if internal SVD subroutine haven't converged + * -1, if incorrect parameters was passed (NPoints(xy.c_ptr()), const_cast(s.c_ptr()), npoints, nvars, &info, const_cast(lm.c_ptr()), const_cast(ar.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like LRBuildS, but builds model + + Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + +i.e. with zero constant term. + + -- ALGLIB -- + Copyright 30.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lrbuildzs(const real_2d_array &xy, const real_1d_array &s, const ae_int_t npoints, const ae_int_t nvars, ae_int_t &info, linearmodel &lm, lrreport &ar) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lrbuildzs(const_cast(xy.c_ptr()), const_cast(s.c_ptr()), npoints, nvars, &info, const_cast(lm.c_ptr()), const_cast(ar.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like LRBuild but builds model + + Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + +i.e. with zero constant term. + + -- ALGLIB -- + Copyright 30.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lrbuildz(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, ae_int_t &info, linearmodel &lm, lrreport &ar) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lrbuildz(const_cast(xy.c_ptr()), npoints, nvars, &info, const_cast(lm.c_ptr()), const_cast(ar.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Unpacks coefficients of linear model. + +INPUT PARAMETERS: + LM - linear model in ALGLIB format + +OUTPUT PARAMETERS: + V - coefficients, array[0..NVars] + constant term (intercept) is stored in the V[NVars]. + NVars - number of independent variables (one less than number + of coefficients) + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +void lrunpack(const linearmodel &lm, real_1d_array &v, ae_int_t &nvars) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lrunpack(const_cast(lm.c_ptr()), const_cast(v.c_ptr()), &nvars, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +"Packs" coefficients and creates linear model in ALGLIB format (LRUnpack +reversed). + +INPUT PARAMETERS: + V - coefficients, array[0..NVars] + NVars - number of independent variables + +OUTPUT PAREMETERS: + LM - linear model. + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +void lrpack(const real_1d_array &v, const ae_int_t nvars, linearmodel &lm) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lrpack(const_cast(v.c_ptr()), nvars, const_cast(lm.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + LM - linear model + X - input vector, array[0..NVars-1]. + +Result: + value of linear model regression estimate + + -- ALGLIB -- + Copyright 03.09.2008 by Bochkanov Sergey +*************************************************************************/ +double lrprocess(const linearmodel &lm, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::lrprocess(const_cast(lm.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + LM - linear model + XY - test set + NPoints - test set size + +RESULT: + root mean square error. + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double lrrmserror(const linearmodel &lm, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::lrrmserror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + LM - linear model + XY - test set + NPoints - test set size + +RESULT: + average error. + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double lravgerror(const linearmodel &lm, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::lravgerror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + LM - linear model + XY - test set + NPoints - test set size + +RESULT: + average relative error. + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double lravgrelerror(const linearmodel &lm, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::lravgrelerror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Filters: simple moving averages (unsymmetric). + +This filter replaces array by results of SMA(K) filter. SMA(K) is defined +as filter which averages at most K previous points (previous - not points +AROUND central point) - or less, in case of the first K-1 points. + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + K - K>=1 (K can be larger than N , such cases will be + correctly handled). Window width. K=1 corresponds to + identity transformation (nothing changes). + +OUTPUT PARAMETERS: + X - array, whose first N elements were processed with SMA(K) + +NOTE 1: this function uses efficient in-place algorithm which does not + allocate temporary arrays. + +NOTE 2: this algorithm makes only one pass through array and uses running + sum to speed-up calculation of the averages. Additional measures + are taken to ensure that running sum on a long sequence of zero + elements will be correctly reset to zero even in the presence of + round-off error. + +NOTE 3: this is unsymmetric version of the algorithm, which does NOT + averages points after the current one. Only X[i], X[i-1], ... are + used when calculating new value of X[i]. We should also note that + this algorithm uses BOTH previous points and current one, i.e. + new value of X[i] depends on BOTH previous point and X[i] itself. + + -- ALGLIB -- + Copyright 25.10.2011 by Bochkanov Sergey +*************************************************************************/ +void filtersma(real_1d_array &x, const ae_int_t n, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::filtersma(const_cast(x.c_ptr()), n, k, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Filters: simple moving averages (unsymmetric). + +This filter replaces array by results of SMA(K) filter. SMA(K) is defined +as filter which averages at most K previous points (previous - not points +AROUND central point) - or less, in case of the first K-1 points. + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + K - K>=1 (K can be larger than N , such cases will be + correctly handled). Window width. K=1 corresponds to + identity transformation (nothing changes). + +OUTPUT PARAMETERS: + X - array, whose first N elements were processed with SMA(K) + +NOTE 1: this function uses efficient in-place algorithm which does not + allocate temporary arrays. + +NOTE 2: this algorithm makes only one pass through array and uses running + sum to speed-up calculation of the averages. Additional measures + are taken to ensure that running sum on a long sequence of zero + elements will be correctly reset to zero even in the presence of + round-off error. + +NOTE 3: this is unsymmetric version of the algorithm, which does NOT + averages points after the current one. Only X[i], X[i-1], ... are + used when calculating new value of X[i]. We should also note that + this algorithm uses BOTH previous points and current one, i.e. + new value of X[i] depends on BOTH previous point and X[i] itself. + + -- ALGLIB -- + Copyright 25.10.2011 by Bochkanov Sergey +*************************************************************************/ +void filtersma(real_1d_array &x, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::filtersma(const_cast(x.c_ptr()), n, k, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Filters: exponential moving averages. + +This filter replaces array by results of EMA(alpha) filter. EMA(alpha) is +defined as filter which replaces X[] by S[]: + S[0] = X[0] + S[t] = alpha*X[t] + (1-alpha)*S[t-1] + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + alpha - 0(x.c_ptr()), n, alpha, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Filters: exponential moving averages. + +This filter replaces array by results of EMA(alpha) filter. EMA(alpha) is +defined as filter which replaces X[] by S[]: + S[0] = X[0] + S[t] = alpha*X[t] + (1-alpha)*S[t-1] + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + alpha - 0(x.c_ptr()), n, alpha, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Filters: linear regression moving averages. + +This filter replaces array by results of LRMA(K) filter. + +LRMA(K) is defined as filter which, for each data point, builds linear +regression model using K prevous points (point itself is included in +these K points) and calculates value of this linear model at the point in +question. + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + K - K>=1 (K can be larger than N , such cases will be + correctly handled). Window width. K=1 corresponds to + identity transformation (nothing changes). + +OUTPUT PARAMETERS: + X - array, whose first N elements were processed with SMA(K) + +NOTE 1: this function uses efficient in-place algorithm which does not + allocate temporary arrays. + +NOTE 2: this algorithm makes only one pass through array and uses running + sum to speed-up calculation of the averages. Additional measures + are taken to ensure that running sum on a long sequence of zero + elements will be correctly reset to zero even in the presence of + round-off error. + +NOTE 3: this is unsymmetric version of the algorithm, which does NOT + averages points after the current one. Only X[i], X[i-1], ... are + used when calculating new value of X[i]. We should also note that + this algorithm uses BOTH previous points and current one, i.e. + new value of X[i] depends on BOTH previous point and X[i] itself. + + -- ALGLIB -- + Copyright 25.10.2011 by Bochkanov Sergey +*************************************************************************/ +void filterlrma(real_1d_array &x, const ae_int_t n, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::filterlrma(const_cast(x.c_ptr()), n, k, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Filters: linear regression moving averages. + +This filter replaces array by results of LRMA(K) filter. + +LRMA(K) is defined as filter which, for each data point, builds linear +regression model using K prevous points (point itself is included in +these K points) and calculates value of this linear model at the point in +question. + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + K - K>=1 (K can be larger than N , such cases will be + correctly handled). Window width. K=1 corresponds to + identity transformation (nothing changes). + +OUTPUT PARAMETERS: + X - array, whose first N elements were processed with SMA(K) + +NOTE 1: this function uses efficient in-place algorithm which does not + allocate temporary arrays. + +NOTE 2: this algorithm makes only one pass through array and uses running + sum to speed-up calculation of the averages. Additional measures + are taken to ensure that running sum on a long sequence of zero + elements will be correctly reset to zero even in the presence of + round-off error. + +NOTE 3: this is unsymmetric version of the algorithm, which does NOT + averages points after the current one. Only X[i], X[i-1], ... are + used when calculating new value of X[i]. We should also note that + this algorithm uses BOTH previous points and current one, i.e. + new value of X[i] depends on BOTH previous point and X[i] itself. + + -- ALGLIB -- + Copyright 25.10.2011 by Bochkanov Sergey +*************************************************************************/ +void filterlrma(real_1d_array &x, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::filterlrma(const_cast(x.c_ptr()), n, k, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Multiclass Fisher LDA + +Subroutine finds coefficients of linear combination which optimally separates +training set on classes. + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars]. + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + + +OUTPUT PARAMETERS: + Info - return code: + * -4, if internal EVD subroutine hasn't converged + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed (NPoints<0, + NVars<1, NClasses<2) + * 1, if task has been solved + * 2, if there was a multicollinearity in training set, + but task has been solved. + W - linear combination coefficients, array[0..NVars-1] + + -- ALGLIB -- + Copyright 31.05.2008 by Bochkanov Sergey +*************************************************************************/ +void fisherlda(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, ae_int_t &info, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fisherlda(const_cast(xy.c_ptr()), npoints, nvars, nclasses, &info, const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +N-dimensional multiclass Fisher LDA + +Subroutine finds coefficients of linear combinations which optimally separates +training set on classes. It returns N-dimensional basis whose vector are sorted +by quality of training set separation (in descending order). + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars]. + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + + +OUTPUT PARAMETERS: + Info - return code: + * -4, if internal EVD subroutine hasn't converged + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed (NPoints<0, + NVars<1, NClasses<2) + * 1, if task has been solved + * 2, if there was a multicollinearity in training set, + but task has been solved. + W - basis, array[0..NVars-1,0..NVars-1] + columns of matrix stores basis vectors, sorted by + quality of training set separation (in descending order) + + -- ALGLIB -- + Copyright 31.05.2008 by Bochkanov Sergey +*************************************************************************/ +void fisherldan(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, ae_int_t &info, real_2d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fisherldan(const_cast(xy.c_ptr()), npoints, nvars, nclasses, &info, const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Model's errors: + * RelCLSError - fraction of misclassified cases. + * AvgCE - acerage cross-entropy + * RMSError - root-mean-square error + * AvgError - average error + * AvgRelError - average relative error + +NOTE 1: RelCLSError/AvgCE are zero on regression problems. + +NOTE 2: on classification problems RMSError/AvgError/AvgRelError contain + errors in prediction of posterior probabilities +*************************************************************************/ +_modelerrors_owner::_modelerrors_owner() +{ + p_struct = (alglib_impl::modelerrors*)alglib_impl::ae_malloc(sizeof(alglib_impl::modelerrors), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_modelerrors_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_modelerrors_owner::_modelerrors_owner(const _modelerrors_owner &rhs) +{ + p_struct = (alglib_impl::modelerrors*)alglib_impl::ae_malloc(sizeof(alglib_impl::modelerrors), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_modelerrors_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_modelerrors_owner& _modelerrors_owner::operator=(const _modelerrors_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_modelerrors_clear(p_struct); + if( !alglib_impl::_modelerrors_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_modelerrors_owner::~_modelerrors_owner() +{ + alglib_impl::_modelerrors_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::modelerrors* _modelerrors_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::modelerrors* _modelerrors_owner::c_ptr() const +{ + return const_cast(p_struct); +} +modelerrors::modelerrors() : _modelerrors_owner() ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror) +{ +} + +modelerrors::modelerrors(const modelerrors &rhs):_modelerrors_owner(rhs) ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror) +{ +} + +modelerrors& modelerrors::operator=(const modelerrors &rhs) +{ + if( this==&rhs ) + return *this; + _modelerrors_owner::operator=(rhs); + return *this; +} + +modelerrors::~modelerrors() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_multilayerperceptron_owner::_multilayerperceptron_owner() +{ + p_struct = (alglib_impl::multilayerperceptron*)alglib_impl::ae_malloc(sizeof(alglib_impl::multilayerperceptron), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_multilayerperceptron_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_multilayerperceptron_owner::_multilayerperceptron_owner(const _multilayerperceptron_owner &rhs) +{ + p_struct = (alglib_impl::multilayerperceptron*)alglib_impl::ae_malloc(sizeof(alglib_impl::multilayerperceptron), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_multilayerperceptron_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_multilayerperceptron_owner& _multilayerperceptron_owner::operator=(const _multilayerperceptron_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_multilayerperceptron_clear(p_struct); + if( !alglib_impl::_multilayerperceptron_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_multilayerperceptron_owner::~_multilayerperceptron_owner() +{ + alglib_impl::_multilayerperceptron_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::multilayerperceptron* _multilayerperceptron_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::multilayerperceptron* _multilayerperceptron_owner::c_ptr() const +{ + return const_cast(p_struct); +} +multilayerperceptron::multilayerperceptron() : _multilayerperceptron_owner() +{ +} + +multilayerperceptron::multilayerperceptron(const multilayerperceptron &rhs):_multilayerperceptron_owner(rhs) +{ +} + +multilayerperceptron& multilayerperceptron::operator=(const multilayerperceptron &rhs) +{ + if( this==&rhs ) + return *this; + _multilayerperceptron_owner::operator=(rhs); + return *this; +} + +multilayerperceptron::~multilayerperceptron() +{ +} + + +/************************************************************************* +This function serializes data structure to string. + +Important properties of s_out: +* it contains alphanumeric characters, dots, underscores, minus signs +* these symbols are grouped into words, which are separated by spaces + and Windows-style (CR+LF) newlines +* although serializer uses spaces and CR+LF as separators, you can + replace any separator character by arbitrary combination of spaces, + tabs, Windows or Unix newlines. It allows flexible reformatting of + the string in case you want to include it into text or XML file. + But you should not insert separators into the middle of the "words" + nor you should change case of letters. +* s_out can be freely moved between 32-bit and 64-bit systems, little + and big endian machines, and so on. You can serialize structure on + 32-bit machine and unserialize it on 64-bit one (or vice versa), or + serialize it on SPARC and unserialize on x86. You can also + serialize it in C++ version of ALGLIB and unserialize in C# one, + and vice versa. +*************************************************************************/ +void mlpserialize(multilayerperceptron &obj, std::string &s_out) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + alglib_impl::ae_int_t ssize; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_alloc_start(&serializer); + alglib_impl::mlpalloc(&serializer, obj.c_ptr(), &state); + ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); + s_out.clear(); + s_out.reserve((size_t)(ssize+1)); + alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); + alglib_impl::mlpserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + if( s_out.length()>(size_t)ssize ) + throw ap_error("ALGLIB: serialization integrity error"); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} +/************************************************************************* +This function unserializes data structure from string. +*************************************************************************/ +void mlpunserialize(std::string &s_in, multilayerperceptron &obj) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); + alglib_impl::mlpunserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers, with linear output layer. Network weights are filled with small +random values. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate0(const ae_int_t nin, const ae_int_t nout, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreate0(nin, nout, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Same as MLPCreate0, but with one hidden layer (NHid neurons) with +non-linear activation function. Output layer is linear. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreate1(nin, nhid, nout, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Same as MLPCreate0, but with two hidden layers (NHid1 and NHid2 neurons) +with non-linear activation function. Output layer is linear. + $ALL + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreate2(nin, nhid1, nhid2, nout, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers with non-linear output layer. Network weights are filled with small +random values. + +Activation function of the output layer takes values: + + (B, +INF), if D>=0 + +or + + (-INF, B), if D<0. + + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb0(const ae_int_t nin, const ae_int_t nout, const double b, const double d, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreateb0(nin, nout, b, d, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Same as MLPCreateB0 but with non-linear hidden layer. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double b, const double d, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreateb1(nin, nhid, nout, b, d, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Same as MLPCreateB0 but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double b, const double d, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreateb2(nin, nhid1, nhid2, nout, b, d, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers with non-linear output layer. Network weights are filled with small +random values. Activation function of the output layer takes values [A,B]. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater0(const ae_int_t nin, const ae_int_t nout, const double a, const double b, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreater0(nin, nout, a, b, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Same as MLPCreateR0, but with non-linear hidden layer. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double a, const double b, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreater1(nin, nhid, nout, a, b, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Same as MLPCreateR0, but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double a, const double b, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreater2(nin, nhid1, nhid2, nout, a, b, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Creates classifier network with NIn inputs and NOut possible classes. +Network contains no hidden layers and linear output layer with SOFTMAX- +normalization (so outputs sums up to 1.0 and converge to posterior +probabilities). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec0(const ae_int_t nin, const ae_int_t nout, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreatec0(nin, nout, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Same as MLPCreateC0, but with one non-linear hidden layer. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreatec1(nin, nhid, nout, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Same as MLPCreateC0, but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreatec2(nin, nhid1, nhid2, nout, const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Randomization of neural network weights + + -- ALGLIB -- + Copyright 06.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlprandomize(const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlprandomize(const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Randomization of neural network weights and standartisator + + -- ALGLIB -- + Copyright 10.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlprandomizefull(const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlprandomizefull(const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns information about initialized network: number of inputs, outputs, +weights. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpproperties(const multilayerperceptron &network, ae_int_t &nin, ae_int_t &nout, ae_int_t &wcount) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpproperties(const_cast(network.c_ptr()), &nin, &nout, &wcount, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns number of inputs. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetinputscount(const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::mlpgetinputscount(const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns number of outputs. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetoutputscount(const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::mlpgetoutputscount(const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns number of weights. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetweightscount(const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::mlpgetweightscount(const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Tells whether network is SOFTMAX-normalized (i.e. classifier) or not. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +bool mlpissoftmax(const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::mlpissoftmax(const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns total number of layers (including input, hidden and +output layers). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetlayerscount(const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::mlpgetlayerscount(const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns size of K-th layer. + +K=0 corresponds to input layer, K=CNT-1 corresponds to output layer. + +Size of the output layer is always equal to the number of outputs, although +when we have softmax-normalized network, last neuron doesn't have any +connections - it is just zero. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetlayersize(const multilayerperceptron &network, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::mlpgetlayersize(const_cast(network.c_ptr()), k, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns offset/scaling coefficients for I-th input of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + +OUTPUT PARAMETERS: + Mean - mean term + Sigma - sigma term, guaranteed to be nonzero. + +I-th input is passed through linear transformation + IN[i] = (IN[i]-Mean)/Sigma +before feeding to the network + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetinputscaling(const multilayerperceptron &network, const ae_int_t i, double &mean, double &sigma) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgetinputscaling(const_cast(network.c_ptr()), i, &mean, &sigma, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns offset/scaling coefficients for I-th output of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + +OUTPUT PARAMETERS: + Mean - mean term + Sigma - sigma term, guaranteed to be nonzero. + +I-th output is passed through linear transformation + OUT[i] = OUT[i]*Sigma+Mean +before returning it to user. In case we have SOFTMAX-normalized network, +we return (Mean,Sigma)=(0.0,1.0). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetoutputscaling(const multilayerperceptron &network, const ae_int_t i, double &mean, double &sigma) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgetoutputscaling(const_cast(network.c_ptr()), i, &mean, &sigma, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns information about Ith neuron of Kth layer + +INPUT PARAMETERS: + Network - network + K - layer index + I - neuron index (within layer) + +OUTPUT PARAMETERS: + FKind - activation function type (used by MLPActivationFunction()) + this value is zero for input or linear neurons + Threshold - also called offset, bias + zero for input neurons + +NOTE: this function throws exception if layer or neuron with given index +do not exists. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetneuroninfo(const multilayerperceptron &network, const ae_int_t k, const ae_int_t i, ae_int_t &fkind, double &threshold) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgetneuroninfo(const_cast(network.c_ptr()), k, i, &fkind, &threshold, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns information about connection from I0-th neuron of +K0-th layer to I1-th neuron of K1-th layer. + +INPUT PARAMETERS: + Network - network + K0 - layer index + I0 - neuron index (within layer) + K1 - layer index + I1 - neuron index (within layer) + +RESULT: + connection weight (zero for non-existent connections) + +This function: +1. throws exception if layer or neuron with given index do not exists. +2. returns zero if neurons exist, but there is no connection between them + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +double mlpgetweight(const multilayerperceptron &network, const ae_int_t k0, const ae_int_t i0, const ae_int_t k1, const ae_int_t i1) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpgetweight(const_cast(network.c_ptr()), k0, i0, k1, i1, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets offset/scaling coefficients for I-th input of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + Mean - mean term + Sigma - sigma term (if zero, will be replaced by 1.0) + +NTE: I-th input is passed through linear transformation + IN[i] = (IN[i]-Mean)/Sigma +before feeding to the network. This function sets Mean and Sigma. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetinputscaling(const multilayerperceptron &network, const ae_int_t i, const double mean, const double sigma) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetinputscaling(const_cast(network.c_ptr()), i, mean, sigma, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets offset/scaling coefficients for I-th output of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + Mean - mean term + Sigma - sigma term (if zero, will be replaced by 1.0) + +OUTPUT PARAMETERS: + +NOTE: I-th output is passed through linear transformation + OUT[i] = OUT[i]*Sigma+Mean +before returning it to user. This function sets Sigma/Mean. In case we +have SOFTMAX-normalized network, you can not set (Sigma,Mean) to anything +other than(0.0,1.0) - this function will throw exception. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetoutputscaling(const multilayerperceptron &network, const ae_int_t i, const double mean, const double sigma) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetoutputscaling(const_cast(network.c_ptr()), i, mean, sigma, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function modifies information about Ith neuron of Kth layer + +INPUT PARAMETERS: + Network - network + K - layer index + I - neuron index (within layer) + FKind - activation function type (used by MLPActivationFunction()) + this value must be zero for input neurons + (you can not set activation function for input neurons) + Threshold - also called offset, bias + this value must be zero for input neurons + (you can not set threshold for input neurons) + +NOTES: +1. this function throws exception if layer or neuron with given index do + not exists. +2. this function also throws exception when you try to set non-linear + activation function for input neurons (any kind of network) or for output + neurons of classifier network. +3. this function throws exception when you try to set non-zero threshold for + input neurons (any kind of network). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetneuroninfo(const multilayerperceptron &network, const ae_int_t k, const ae_int_t i, const ae_int_t fkind, const double threshold) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetneuroninfo(const_cast(network.c_ptr()), k, i, fkind, threshold, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function modifies information about connection from I0-th neuron of +K0-th layer to I1-th neuron of K1-th layer. + +INPUT PARAMETERS: + Network - network + K0 - layer index + I0 - neuron index (within layer) + K1 - layer index + I1 - neuron index (within layer) + W - connection weight (must be zero for non-existent + connections) + +This function: +1. throws exception if layer or neuron with given index do not exists. +2. throws exception if you try to set non-zero weight for non-existent + connection + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetweight(const multilayerperceptron &network, const ae_int_t k0, const ae_int_t i0, const ae_int_t k1, const ae_int_t i1, const double w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetweight(const_cast(network.c_ptr()), k0, i0, k1, i1, w, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Neural network activation function + +INPUT PARAMETERS: + NET - neuron input + K - function index (zero for linear function) + +OUTPUT PARAMETERS: + F - function + DF - its derivative + D2F - its second derivative + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpactivationfunction(const double net, const ae_int_t k, double &f, double &df, double &d2f) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpactivationfunction(net, k, &f, &df, &d2f, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + Network - neural network + X - input vector, array[0..NIn-1]. + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + +See also MLPProcessI + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpprocess(const multilayerperceptron &network, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpprocess(const_cast(network.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +'interactive' variant of MLPProcess for languages like Python which +support constructs like "Y = MLPProcess(NN,X)" and interactive mode of the +interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 21.09.2010 by Bochkanov Sergey +*************************************************************************/ +void mlpprocessi(const multilayerperceptron &network, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpprocessi(const_cast(network.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x, depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlperror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlperror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlperror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlperror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Error of the neural network on dataset given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x, depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0 + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlperrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlperrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlperrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Natural error function for neural network, internal subroutine. + +NOTE: this function is single-threaded. Unlike other error function, it +receives no speed-up from being executed in SMP mode. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlperrorn(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlperrorn(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Classification error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: + classification error (number of misclassified cases) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::mlpclserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +ae_int_t smp_mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::_pexec_mlpclserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Relative classification error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Percent of incorrectly classified cases. Works both for classifier +networks and general purpose networks used as classifiers. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 25.12.2008 by Bochkanov Sergey +*************************************************************************/ +double mlprelclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlprelclserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlprelclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlprelclserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Relative classification error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. Sparse matrix must use CRS format + for storage. + NPoints - points count, >=0. + +RESULT: +Percent of incorrectly classified cases. Works both for classifier +networks and general purpose networks used as classifiers. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlprelclserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlprelclserrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlprelclserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlprelclserrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +CrossEntropy/(NPoints*LN(2)). +Zero if network solves regression task. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 08.01.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpavgce(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpavgce(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlpavgce(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlpavgce(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set given by +sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +CrossEntropy/(NPoints*LN(2)). +Zero if network solves regression task. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 9.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgcesparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpavgcesparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlpavgcesparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlpavgcesparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +RMS error on the test set given. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Root mean square error. Its meaning for regression task is obvious. As for +classification task, RMS error means error when estimating posterior +probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlprmserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlprmserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlprmserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlprmserror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +RMS error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Root mean square error. Its meaning for regression task is obvious. As for +classification task, RMS error means error when estimating posterior +probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlprmserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlprmserrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlprmserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlprmserrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average absolute error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average error when estimating posterior probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 11.03.2008 by Bochkanov Sergey +*************************************************************************/ +double mlpavgerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpavgerror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlpavgerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlpavgerror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average absolute error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average error when estimating posterior probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpavgerrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlpavgerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlpavgerrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average relative error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average relative error when estimating posterior probability of +belonging to the correct class. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 11.03.2008 by Bochkanov Sergey +*************************************************************************/ +double mlpavgrelerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpavgrelerror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlpavgrelerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlpavgrelerror(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average relative error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average relative error when estimating posterior probability of +belonging to the correct class. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgrelerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpavgrelerrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlpavgrelerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlpavgrelerrorsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Gradient calculation + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + X - input vector, length of array must be at least NIn + DesiredY- desired outputs, length of array must be at least NOut + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgrad(const multilayerperceptron &network, const real_1d_array &x, const real_1d_array &desiredy, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgrad(const_cast(network.c_ptr()), const_cast(x.c_ptr()), const_cast(desiredy.c_ptr()), &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Gradient calculation (natural error function is used) + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + X - input vector, length of array must be at least NIn + DesiredY- desired outputs, length of array must be at least NOut + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, sum-of-squares for regression networks, + cross-entropy for classification networks. + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradn(const multilayerperceptron &network, const real_1d_array &x, const real_1d_array &desiredy, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgradn(const_cast(network.c_ptr()), const_cast(x.c_ptr()), const_cast(desiredy.c_ptr()), &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in dense format; one sample = one row: + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgradbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlpgradbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlpgradbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs given by sparse +matrices + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in sparse format; one sample = one row: + * MATRIX MUST BE STORED IN CRS FORMAT + * first NIn columns contain inputs. + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t ssize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgradbatchsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlpgradbatchsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t ssize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlpgradbatchsparse(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Batch gradient calculation for a subset of dataset + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in dense format; one sample = one row: + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SetSize - real size of XY, SetSize>=0; + Idx - subset of SubsetSize elements, array[SubsetSize]: + * Idx[I] stores row index in the original dataset which is + given by XY. Gradient is calculated with respect to rows + whose indexes are stored in Idx[]. + * Idx[] must store correct indexes; this function throws + an exception in case incorrect index (less than 0 or + larger than rows(XY)) is given + * Idx[] may store indexes in any order and even with + repetitions. + SubsetSize- number of elements in Idx[] array: + * positive value means that subset given by Idx[] is processed + * zero value results in zero gradient + * negative value means that full dataset is processed + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, + array[WCount] + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgradbatchsubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(idx.c_ptr()), subsetsize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlpgradbatchsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlpgradbatchsubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(idx.c_ptr()), subsetsize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs for a subset of +dataset given by set of indexes. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in sparse format; one sample = one row: + * MATRIX MUST BE STORED IN CRS FORMAT + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SetSize - real size of XY, SetSize>=0; + Idx - subset of SubsetSize elements, array[SubsetSize]: + * Idx[I] stores row index in the original dataset which is + given by XY. Gradient is calculated with respect to rows + whose indexes are stored in Idx[]. + * Idx[] must store correct indexes; this function throws + an exception in case incorrect index (less than 0 or + larger than rows(XY)) is given + * Idx[] may store indexes in any order and even with + repetitions. + SubsetSize- number of elements in Idx[] array: + * positive value means that subset given by Idx[] is processed + * zero value results in zero gradient + * negative value means that full dataset is processed + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, + array[WCount] + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatchSparse + function. + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgradbatchsparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(idx.c_ptr()), subsetsize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlpgradbatchsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlpgradbatchsparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(idx.c_ptr()), subsetsize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs +(natural error function is used) + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - set of inputs/outputs; one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, sum-of-squares for regression networks, + cross-entropy for classification networks. + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradnbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpgradnbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Batch Hessian calculation (natural error function) using R-algorithm. +Internal subroutine. + + -- ALGLIB -- + Copyright 26.01.2008 by Bochkanov Sergey. + + Hessian calculation based on R-algorithm described in + "Fast Exact Multiplication by the Hessian", + B. A. Pearlmutter, + Neural Computation, 1994. +*************************************************************************/ +void mlphessiannbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad, real_2d_array &h) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlphessiannbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), const_cast(h.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Batch Hessian calculation using R-algorithm. +Internal subroutine. + + -- ALGLIB -- + Copyright 26.01.2008 by Bochkanov Sergey. + + Hessian calculation based on R-algorithm described in + "Fast Exact Multiplication by the Hessian", + B. A. Pearlmutter, + Neural Computation, 1994. +*************************************************************************/ +void mlphessianbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad, real_2d_array &h) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlphessianbatch(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), ssize, &e, const_cast(grad.c_ptr()), const_cast(h.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of all types of errors. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset; one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +OUTPUT PARAMETERS: + Rep - it contains all type of errors. + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpallerrorssubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpallerrorssubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlpallerrorssubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlpallerrorssubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of all types of errors on sparse dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset given by sparse matrix; + one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +OUTPUT PARAMETERS: + Rep - it contains all type of errors. + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpallerrorssparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpallerrorssparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlpallerrorssparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlpallerrorssparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlperrorsubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlperrorsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlperrorsubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Error of the neural network on sparse dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + SetSize - real size of XY, SetSize>=0; + it is used when SubsetSize<0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlperrorsparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +double smp_mlperrorsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::_pexec_mlperrorsparsesubset(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), setsize, const_cast(subset.c_ptr()), subsetsize, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +_logitmodel_owner::_logitmodel_owner() +{ + p_struct = (alglib_impl::logitmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::logitmodel), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_logitmodel_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_logitmodel_owner::_logitmodel_owner(const _logitmodel_owner &rhs) +{ + p_struct = (alglib_impl::logitmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::logitmodel), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_logitmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_logitmodel_owner& _logitmodel_owner::operator=(const _logitmodel_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_logitmodel_clear(p_struct); + if( !alglib_impl::_logitmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_logitmodel_owner::~_logitmodel_owner() +{ + alglib_impl::_logitmodel_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::logitmodel* _logitmodel_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::logitmodel* _logitmodel_owner::c_ptr() const +{ + return const_cast(p_struct); +} +logitmodel::logitmodel() : _logitmodel_owner() +{ +} + +logitmodel::logitmodel(const logitmodel &rhs):_logitmodel_owner(rhs) +{ +} + +logitmodel& logitmodel::operator=(const logitmodel &rhs) +{ + if( this==&rhs ) + return *this; + _logitmodel_owner::operator=(rhs); + return *this; +} + +logitmodel::~logitmodel() +{ +} + + +/************************************************************************* +MNLReport structure contains information about training process: +* NGrad - number of gradient calculations +* NHess - number of Hessian calculations +*************************************************************************/ +_mnlreport_owner::_mnlreport_owner() +{ + p_struct = (alglib_impl::mnlreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mnlreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mnlreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mnlreport_owner::_mnlreport_owner(const _mnlreport_owner &rhs) +{ + p_struct = (alglib_impl::mnlreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mnlreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mnlreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mnlreport_owner& _mnlreport_owner::operator=(const _mnlreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mnlreport_clear(p_struct); + if( !alglib_impl::_mnlreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mnlreport_owner::~_mnlreport_owner() +{ + alglib_impl::_mnlreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mnlreport* _mnlreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mnlreport* _mnlreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mnlreport::mnlreport() : _mnlreport_owner() ,ngrad(p_struct->ngrad),nhess(p_struct->nhess) +{ +} + +mnlreport::mnlreport(const mnlreport &rhs):_mnlreport_owner(rhs) ,ngrad(p_struct->ngrad),nhess(p_struct->nhess) +{ +} + +mnlreport& mnlreport::operator=(const mnlreport &rhs) +{ + if( this==&rhs ) + return *this; + _mnlreport_owner::operator=(rhs); + return *this; +} + +mnlreport::~mnlreport() +{ +} + +/************************************************************************* +This subroutine trains logit model. + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars] + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=1 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + +OUTPUT PARAMETERS: + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints(xy.c_ptr()), npoints, nvars, nclasses, &info, const_cast(lm.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + LM - logit model, passed by non-constant reference + (some fields of structure are used as temporaries + when calculating model output). + X - input vector, array[0..NVars-1]. + Y - (possibly) preallocated buffer; if size of Y is less than + NClasses, it will be reallocated.If it is large enough, it + is NOT reallocated, so we can save some time on reallocation. + +OUTPUT PARAMETERS: + Y - result, array[0..NClasses-1] + Vector of posterior probabilities for classification task. + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +void mnlprocess(const logitmodel &lm, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mnlprocess(const_cast(lm.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +'interactive' variant of MNLProcess for languages like Python which +support constructs like "Y = MNLProcess(LM,X)" and interactive mode of the +interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +void mnlprocessi(const logitmodel &lm, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mnlprocessi(const_cast(lm.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Unpacks coefficients of logit model. Logit model have form: + + P(class=i) = S(i) / (S(0) + S(1) + ... +S(M-1)) + S(i) = Exp(A[i,0]*X[0] + ... + A[i,N-1]*X[N-1] + A[i,N]), when i(lm.c_ptr()), const_cast(a.c_ptr()), &nvars, &nclasses, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +"Packs" coefficients and creates logit model in ALGLIB format (MNLUnpack +reversed). + +INPUT PARAMETERS: + A - model (see MNLUnpack) + NVars - number of independent variables + NClasses - number of classes + +OUTPUT PARAMETERS: + LM - logit model. + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +void mnlpack(const real_2d_array &a, const ae_int_t nvars, const ae_int_t nclasses, logitmodel &lm) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mnlpack(const_cast(a.c_ptr()), nvars, nclasses, const_cast(lm.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + CrossEntropy/(NPoints*ln(2)). + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlavgce(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mnlavgce(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Relative classification error on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + percent of incorrectly classified cases. + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlrelclserror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mnlrelclserror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + root mean square error (error when estimating posterior probabilities). + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlrmserror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mnlrmserror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + average error (error when estimating posterior probabilities). + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlavgerror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mnlavgerror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average relative error on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + average relative error (error when estimating posterior probabilities). + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlavgrelerror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t ssize) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mnlavgrelerror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), ssize, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Classification error on test set = MNLRelClsError*NPoints + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mnlclserror(const logitmodel &lm, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::mnlclserror(const_cast(lm.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This structure is a MCPD (Markov Chains for Population Data) solver. + +You should use ALGLIB functions in order to work with this object. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +_mcpdstate_owner::_mcpdstate_owner() +{ + p_struct = (alglib_impl::mcpdstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::mcpdstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mcpdstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mcpdstate_owner::_mcpdstate_owner(const _mcpdstate_owner &rhs) +{ + p_struct = (alglib_impl::mcpdstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::mcpdstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mcpdstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mcpdstate_owner& _mcpdstate_owner::operator=(const _mcpdstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mcpdstate_clear(p_struct); + if( !alglib_impl::_mcpdstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mcpdstate_owner::~_mcpdstate_owner() +{ + alglib_impl::_mcpdstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mcpdstate* _mcpdstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mcpdstate* _mcpdstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mcpdstate::mcpdstate() : _mcpdstate_owner() +{ +} + +mcpdstate::mcpdstate(const mcpdstate &rhs):_mcpdstate_owner(rhs) +{ +} + +mcpdstate& mcpdstate::operator=(const mcpdstate &rhs) +{ + if( this==&rhs ) + return *this; + _mcpdstate_owner::operator=(rhs); + return *this; +} + +mcpdstate::~mcpdstate() +{ +} + + +/************************************************************************* +This structure is a MCPD training report: + InnerIterationsCount - number of inner iterations of the + underlying optimization algorithm + OuterIterationsCount - number of outer iterations of the + underlying optimization algorithm + NFEV - number of merit function evaluations + TerminationType - termination type + (same as for MinBLEIC optimizer, positive + values denote success, negative ones - + failure) + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +_mcpdreport_owner::_mcpdreport_owner() +{ + p_struct = (alglib_impl::mcpdreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mcpdreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mcpdreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mcpdreport_owner::_mcpdreport_owner(const _mcpdreport_owner &rhs) +{ + p_struct = (alglib_impl::mcpdreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mcpdreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mcpdreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mcpdreport_owner& _mcpdreport_owner::operator=(const _mcpdreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mcpdreport_clear(p_struct); + if( !alglib_impl::_mcpdreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mcpdreport_owner::~_mcpdreport_owner() +{ + alglib_impl::_mcpdreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mcpdreport* _mcpdreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mcpdreport* _mcpdreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mcpdreport::mcpdreport() : _mcpdreport_owner() ,inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount),nfev(p_struct->nfev),terminationtype(p_struct->terminationtype) +{ +} + +mcpdreport::mcpdreport(const mcpdreport &rhs):_mcpdreport_owner(rhs) ,inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount),nfev(p_struct->nfev),terminationtype(p_struct->terminationtype) +{ +} + +mcpdreport& mcpdreport::operator=(const mcpdreport &rhs) +{ + if( this==&rhs ) + return *this; + _mcpdreport_owner::operator=(rhs); + return *this; +} + +mcpdreport::~mcpdreport() +{ +} + +/************************************************************************* +DESCRIPTION: + +This function creates MCPD (Markov Chains for Population Data) solver. + +This solver can be used to find transition matrix P for N-dimensional +prediction problem where transition from X[i] to X[i+1] is modelled as + X[i+1] = P*X[i] +where X[i] and X[i+1] are N-dimensional population vectors (components of +each X are non-negative), and P is a N*N transition matrix (elements of P +are non-negative, each column sums to 1.0). + +Such models arise when when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is constant, i.e. there is no new individuals and no one + leaves population +* you want to model transitions of individuals from one state into another + +USAGE: + +Here we give very brief outline of the MCPD. We strongly recommend you to +read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide +on data analysis which is available at http://www.alglib.net/dataanalysis/ + +1. User initializes algorithm state with MCPDCreate() call + +2. User adds one or more tracks - sequences of states which describe + evolution of a system being modelled from different starting conditions + +3. User may add optional boundary, equality and/or linear constraints on + the coefficients of P by calling one of the following functions: + * MCPDSetEC() to set equality constraints + * MCPDSetBC() to set bound constraints + * MCPDSetLC() to set linear constraints + +4. Optionally, user may set custom weights for prediction errors (by + default, algorithm assigns non-equal, automatically chosen weights for + errors in the prediction of different components of X). It can be done + with a call of MCPDSetPredictionWeights() function. + +5. User calls MCPDSolve() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. + +6. User calls MCPDResults() to get solution + +INPUT PARAMETERS: + N - problem dimension, N>=1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreate(const ae_int_t n, mcpdstate &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdcreate(n, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Entry-state" model, i.e. model where transition from X[i] to X[i+1] +is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +and one selected component of X[] is called "entry" state and is treated +in a special way: + system state always transits from "entry" state to some another state + system state can not transit from any state into "entry" state +Such conditions basically mean that row of P which corresponds to "entry" +state is zero. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant - at every moment of time there is some + (unpredictable) amount of "new" individuals, which can transit into one + of the states at the next turn, but still no one leaves population +* you want to model transitions of individuals from one state into another +* but you do NOT want to predict amount of "new" individuals because it + does not depends on individuals already present (hence system can not + transit INTO entry state - it can only transit FROM it). + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + EntryState- index of entry state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateentry(const ae_int_t n, const ae_int_t entrystate, mcpdstate &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdcreateentry(n, entrystate, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Exit-state" model, i.e. model where transition from X[i] to X[i+1] +is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +and one selected component of X[] is called "exit" state and is treated +in a special way: + system state can transit from any state into "exit" state + system state can not transit from "exit" state into any other state + transition operator discards "exit" state (makes it zero at each turn) +Such conditions basically mean that column of P which corresponds to +"exit" state is zero. Multiplication by such P may decrease sum of vector +components. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant - individuals can move into "exit" state + and leave population at the next turn, but there are no new individuals +* amount of individuals which leave population can be predicted +* you want to model transitions of individuals from one state into another + (including transitions into the "exit" state) + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + ExitState- index of exit state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateexit(const ae_int_t n, const ae_int_t exitstate, mcpdstate &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdcreateexit(n, exitstate, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Entry-Exit-states" model, i.e. model where transition from X[i] to +X[i+1] is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +one selected component of X[] is called "entry" state and is treated in a +special way: + system state always transits from "entry" state to some another state + system state can not transit from any state into "entry" state +and another one component of X[] is called "exit" state and is treated in +a special way too: + system state can transit from any state into "exit" state + system state can not transit from "exit" state into any other state + transition operator discards "exit" state (makes it zero at each turn) +Such conditions basically mean that: + row of P which corresponds to "entry" state is zero + column of P which corresponds to "exit" state is zero +Multiplication by such P may decrease sum of vector components. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant +* at every moment of time there is some (unpredictable) amount of "new" + individuals, which can transit into one of the states at the next turn +* some individuals can move (predictably) into "exit" state and leave + population at the next turn +* you want to model transitions of individuals from one state into another, + including transitions from the "entry" state and into the "exit" state. +* but you do NOT want to predict amount of "new" individuals because it + does not depends on individuals already present (hence system can not + transit INTO entry state - it can only transit FROM it). + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + EntryState- index of entry state, in 0..N-1 + ExitState- index of exit state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateentryexit(const ae_int_t n, const ae_int_t entrystate, const ae_int_t exitstate, mcpdstate &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdcreateentryexit(n, entrystate, exitstate, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to add a track - sequence of system states at the +different moments of its evolution. + +You may add one or several tracks to the MCPD solver. In case you have +several tracks, they won't overwrite each other. For example, if you pass +two tracks, A1-A2-A3 (system at t=A+1, t=A+2 and t=A+3) and B1-B2-B3, then +solver will try to model transitions from t=A+1 to t=A+2, t=A+2 to t=A+3, +t=B+1 to t=B+2, t=B+2 to t=B+3. But it WONT mix these two tracks - i.e. it +wont try to model transition from t=A+3 to t=B+1. + +INPUT PARAMETERS: + S - solver + XY - track, array[K,N]: + * I-th row is a state at t=I + * elements of XY must be non-negative (exception will be + thrown on negative elements) + K - number of points in a track + * if given, only leading K rows of XY are used + * if not given, automatically determined from size of XY + +NOTES: + +1. Track may contain either proportional or population data: + * with proportional data all rows of XY must sum to 1.0, i.e. we have + proportions instead of absolute population values + * with population data rows of XY contain population counts and generally + do not sum to 1.0 (although they still must be non-negative) + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdaddtrack(const mcpdstate &s, const real_2d_array &xy, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdaddtrack(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), k, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to add a track - sequence of system states at the +different moments of its evolution. + +You may add one or several tracks to the MCPD solver. In case you have +several tracks, they won't overwrite each other. For example, if you pass +two tracks, A1-A2-A3 (system at t=A+1, t=A+2 and t=A+3) and B1-B2-B3, then +solver will try to model transitions from t=A+1 to t=A+2, t=A+2 to t=A+3, +t=B+1 to t=B+2, t=B+2 to t=B+3. But it WONT mix these two tracks - i.e. it +wont try to model transition from t=A+3 to t=B+1. + +INPUT PARAMETERS: + S - solver + XY - track, array[K,N]: + * I-th row is a state at t=I + * elements of XY must be non-negative (exception will be + thrown on negative elements) + K - number of points in a track + * if given, only leading K rows of XY are used + * if not given, automatically determined from size of XY + +NOTES: + +1. Track may contain either proportional or population data: + * with proportional data all rows of XY must sum to 1.0, i.e. we have + proportions instead of absolute population values + * with population data rows of XY contain population counts and generally + do not sum to 1.0 (although they still must be non-negative) + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdaddtrack(const mcpdstate &s, const real_2d_array &xy) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t k; + + k = xy.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdaddtrack(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), k, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to add equality constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to place equality constraints on arbitrary +subset of elements of P. Set of constraints is specified by EC, which may +contain either NAN's or finite numbers from [0,1]. NAN denotes absence of +constraint, finite number denotes equality constraint on specific element +of P. + +You can also use MCPDAddEC() function which allows to ADD equality +constraint for one element of P without changing constraints for other +elements. + +These functions (MCPDSetEC and MCPDAddEC) interact as follows: +* there is internal matrix of equality constraints which is stored in the + MCPD solver +* MCPDSetEC() replaces this matrix by another one (SET) +* MCPDAddEC() modifies one element of this matrix and leaves other ones + unchanged (ADD) +* thus MCPDAddEC() call preserves all modifications done by previous + calls, while MCPDSetEC() completely discards all changes done to the + equality constraints. + +INPUT PARAMETERS: + S - solver + EC - equality constraints, array[N,N]. Elements of EC can be + either NAN's or finite numbers from [0,1]. NAN denotes + absence of constraints, while finite value denotes + equality constraint on the corresponding element of P. + +NOTES: + +1. infinite values of EC will lead to exception being thrown. Values less +than 0.0 or greater than 1.0 will lead to error code being returned after +call to MCPDSolve(). + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetec(const mcpdstate &s, const real_2d_array &ec) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdsetec(const_cast(s.c_ptr()), const_cast(ec.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to add equality constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to ADD equality constraint for one element of P +without changing constraints for other elements. + +You can also use MCPDSetEC() function which allows you to specify +arbitrary set of equality constraints in one call. + +These functions (MCPDSetEC and MCPDAddEC) interact as follows: +* there is internal matrix of equality constraints which is stored in the + MCPD solver +* MCPDSetEC() replaces this matrix by another one (SET) +* MCPDAddEC() modifies one element of this matrix and leaves other ones + unchanged (ADD) +* thus MCPDAddEC() call preserves all modifications done by previous + calls, while MCPDSetEC() completely discards all changes done to the + equality constraints. + +INPUT PARAMETERS: + S - solver + I - row index of element being constrained + J - column index of element being constrained + C - value (constraint for P[I,J]). Can be either NAN (no + constraint) or finite value from [0,1]. + +NOTES: + +1. infinite values of C will lead to exception being thrown. Values less +than 0.0 or greater than 1.0 will lead to error code being returned after +call to MCPDSolve(). + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdaddec(const mcpdstate &s, const ae_int_t i, const ae_int_t j, const double c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdaddec(const_cast(s.c_ptr()), i, j, c, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to add bound constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to place bound constraints on arbitrary +subset of elements of P. Set of constraints is specified by BndL/BndU +matrices, which may contain arbitrary combination of finite numbers or +infinities (like -INF(s.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to add bound constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to ADD bound constraint for one element of P +without changing constraints for other elements. + +You can also use MCPDSetBC() function which allows to place bound +constraints on arbitrary subset of elements of P. Set of constraints is +specified by BndL/BndU matrices, which may contain arbitrary combination +of finite numbers or infinities (like -INF(s.c_ptr()), i, j, bndl, bndu, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to set linear equality/inequality constraints on the +elements of the transition matrix P. + +This function can be used to set one or several general linear constraints +on the elements of P. Two types of constraints are supported: +* equality constraints +* inequality constraints (both less-or-equal and greater-or-equal) + +Coefficients of constraints are specified by matrix C (one of the +parameters). One row of C corresponds to one constraint. Because +transition matrix P has N*N elements, we need N*N columns to store all +coefficients (they are stored row by row), and one more column to store +right part - hence C has N*N+1 columns. Constraint kind is stored in the +CT array. + +Thus, I-th linear constraint is + P[0,0]*C[I,0] + P[0,1]*C[I,1] + .. + P[0,N-1]*C[I,N-1] + + + P[1,0]*C[I,N] + P[1,1]*C[I,N+1] + ... + + + P[N-1,N-1]*C[I,N*N-1] ?=? C[I,N*N] +where ?=? can be either "=" (CT[i]=0), "<=" (CT[i]<0) or ">=" (CT[i]>0). + +Your constraint may involve only some subset of P (less than N*N elements). +For example it can be something like + P[0,0] + P[0,1] = 0.5 +In this case you still should pass matrix with N*N+1 columns, but all its +elements (except for C[0,0], C[0,1] and C[0,N*N-1]) will be zero. + +INPUT PARAMETERS: + S - solver + C - array[K,N*N+1] - coefficients of constraints + (see above for complete description) + CT - array[K] - constraint types + (see above for complete description) + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetlc(const mcpdstate &s, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdsetlc(const_cast(s.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to set linear equality/inequality constraints on the +elements of the transition matrix P. + +This function can be used to set one or several general linear constraints +on the elements of P. Two types of constraints are supported: +* equality constraints +* inequality constraints (both less-or-equal and greater-or-equal) + +Coefficients of constraints are specified by matrix C (one of the +parameters). One row of C corresponds to one constraint. Because +transition matrix P has N*N elements, we need N*N columns to store all +coefficients (they are stored row by row), and one more column to store +right part - hence C has N*N+1 columns. Constraint kind is stored in the +CT array. + +Thus, I-th linear constraint is + P[0,0]*C[I,0] + P[0,1]*C[I,1] + .. + P[0,N-1]*C[I,N-1] + + + P[1,0]*C[I,N] + P[1,1]*C[I,N+1] + ... + + + P[N-1,N-1]*C[I,N*N-1] ?=? C[I,N*N] +where ?=? can be either "=" (CT[i]=0), "<=" (CT[i]<0) or ">=" (CT[i]>0). + +Your constraint may involve only some subset of P (less than N*N elements). +For example it can be something like + P[0,0] + P[0,1] = 0.5 +In this case you still should pass matrix with N*N+1 columns, but all its +elements (except for C[0,0], C[0,1] and C[0,N*N-1]) will be zero. + +INPUT PARAMETERS: + S - solver + C - array[K,N*N+1] - coefficients of constraints + (see above for complete description) + CT - array[K] - constraint types + (see above for complete description) + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetlc(const mcpdstate &s, const real_2d_array &c, const integer_1d_array &ct) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t k; + if( (c.rows()!=ct.length())) + throw ap_error("Error while calling 'mcpdsetlc': looks like one of arguments has wrong size"); + k = c.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdsetlc(const_cast(s.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function allows to tune amount of Tikhonov regularization being +applied to your problem. + +By default, regularizing term is equal to r*||P-prior_P||^2, where r is a +small non-zero value, P is transition matrix, prior_P is identity matrix, +||X||^2 is a sum of squared elements of X. + +This function allows you to change coefficient r. You can also change +prior values with MCPDSetPrior() function. + +INPUT PARAMETERS: + S - solver + V - regularization coefficient, finite non-negative value. It + is not recommended to specify zero value unless you are + pretty sure that you want it. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsettikhonovregularizer(const mcpdstate &s, const double v) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdsettikhonovregularizer(const_cast(s.c_ptr()), v, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function allows to set prior values used for regularization of your +problem. + +By default, regularizing term is equal to r*||P-prior_P||^2, where r is a +small non-zero value, P is transition matrix, prior_P is identity matrix, +||X||^2 is a sum of squared elements of X. + +This function allows you to change prior values prior_P. You can also +change r with MCPDSetTikhonovRegularizer() function. + +INPUT PARAMETERS: + S - solver + PP - array[N,N], matrix of prior values: + 1. elements must be real numbers from [0,1] + 2. columns must sum to 1.0. + First property is checked (exception is thrown otherwise), + while second one is not checked/enforced. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetprior(const mcpdstate &s, const real_2d_array &pp) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdsetprior(const_cast(s.c_ptr()), const_cast(pp.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to change prediction weights + +MCPD solver scales prediction errors as follows + Error(P) = ||W*(y-P*x)||^2 +where + x is a system state at time t + y is a system state at time t+1 + P is a transition matrix + W is a diagonal scaling matrix + +By default, weights are chosen in order to minimize relative prediction +error instead of absolute one. For example, if one component of state is +about 0.5 in magnitude and another one is about 0.05, then algorithm will +make corresponding weights equal to 2.0 and 20.0. + +INPUT PARAMETERS: + S - solver + PW - array[N], weights: + * must be non-negative values (exception will be thrown otherwise) + * zero values will be replaced by automatically chosen values + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetpredictionweights(const mcpdstate &s, const real_1d_array &pw) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdsetpredictionweights(const_cast(s.c_ptr()), const_cast(pw.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to start solution of the MCPD problem. + +After return from this function, you can use MCPDResults() to get solution +and completion code. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsolve(const mcpdstate &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdsolve(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +MCPD results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + P - array[N,N], transition matrix + Rep - optimization report. You should check Rep.TerminationType + in order to distinguish successful termination from + unsuccessful one. Speaking short, positive values denote + success, negative ones are failures. + More information about fields of this structure can be + found in the comments on MCPDReport datatype. + + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdresults(const mcpdstate &s, real_2d_array &p, mcpdreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mcpdresults(const_cast(s.c_ptr()), const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Neural networks ensemble +*************************************************************************/ +_mlpensemble_owner::_mlpensemble_owner() +{ + p_struct = (alglib_impl::mlpensemble*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpensemble), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mlpensemble_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mlpensemble_owner::_mlpensemble_owner(const _mlpensemble_owner &rhs) +{ + p_struct = (alglib_impl::mlpensemble*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpensemble), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mlpensemble_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mlpensemble_owner& _mlpensemble_owner::operator=(const _mlpensemble_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mlpensemble_clear(p_struct); + if( !alglib_impl::_mlpensemble_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mlpensemble_owner::~_mlpensemble_owner() +{ + alglib_impl::_mlpensemble_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mlpensemble* _mlpensemble_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mlpensemble* _mlpensemble_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mlpensemble::mlpensemble() : _mlpensemble_owner() +{ +} + +mlpensemble::mlpensemble(const mlpensemble &rhs):_mlpensemble_owner(rhs) +{ +} + +mlpensemble& mlpensemble::operator=(const mlpensemble &rhs) +{ + if( this==&rhs ) + return *this; + _mlpensemble_owner::operator=(rhs); + return *this; +} + +mlpensemble::~mlpensemble() +{ +} + + +/************************************************************************* +This function serializes data structure to string. + +Important properties of s_out: +* it contains alphanumeric characters, dots, underscores, minus signs +* these symbols are grouped into words, which are separated by spaces + and Windows-style (CR+LF) newlines +* although serializer uses spaces and CR+LF as separators, you can + replace any separator character by arbitrary combination of spaces, + tabs, Windows or Unix newlines. It allows flexible reformatting of + the string in case you want to include it into text or XML file. + But you should not insert separators into the middle of the "words" + nor you should change case of letters. +* s_out can be freely moved between 32-bit and 64-bit systems, little + and big endian machines, and so on. You can serialize structure on + 32-bit machine and unserialize it on 64-bit one (or vice versa), or + serialize it on SPARC and unserialize on x86. You can also + serialize it in C++ version of ALGLIB and unserialize in C# one, + and vice versa. +*************************************************************************/ +void mlpeserialize(mlpensemble &obj, std::string &s_out) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + alglib_impl::ae_int_t ssize; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_alloc_start(&serializer); + alglib_impl::mlpealloc(&serializer, obj.c_ptr(), &state); + ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); + s_out.clear(); + s_out.reserve((size_t)(ssize+1)); + alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); + alglib_impl::mlpeserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + if( s_out.length()>(size_t)ssize ) + throw ap_error("ALGLIB: serialization integrity error"); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} +/************************************************************************* +This function unserializes data structure from string. +*************************************************************************/ +void mlpeunserialize(std::string &s_in, mlpensemble &obj) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); + alglib_impl::mlpeunserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} + +/************************************************************************* +Like MLPCreate0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate0(const ae_int_t nin, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreate0(nin, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreate1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreate1(nin, nhid, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreate2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreate2(nin, nhid1, nhid2, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateB0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb0(const ae_int_t nin, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreateb0(nin, nout, b, d, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateB1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreateb1(nin, nhid, nout, b, d, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateB2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreateb2(nin, nhid1, nhid2, nout, b, d, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateR0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater0(const ae_int_t nin, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreater0(nin, nout, a, b, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateR1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreater1(nin, nhid, nout, a, b, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateR2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreater2(nin, nhid1, nhid2, nout, a, b, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateC0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec0(const ae_int_t nin, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreatec0(nin, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateC1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreatec1(nin, nhid, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Like MLPCreateC2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreatec2(nin, nhid1, nhid2, nout, ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Creates ensemble from network. Only network geometry is copied. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatefromnetwork(const multilayerperceptron &network, const ae_int_t ensemblesize, mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpecreatefromnetwork(const_cast(network.c_ptr()), ensemblesize, const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Randomization of MLP ensemble + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlperandomize(const mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlperandomize(const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Return ensemble properties (number of inputs and outputs). + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeproperties(const mlpensemble &ensemble, ae_int_t &nin, ae_int_t &nout) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpeproperties(const_cast(ensemble.c_ptr()), &nin, &nout, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Return normalization type (whether ensemble is SOFTMAX-normalized or not). + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +bool mlpeissoftmax(const mlpensemble &ensemble) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::mlpeissoftmax(const_cast(ensemble.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + Ensemble- neural networks ensemble + X - input vector, array[0..NIn-1]. + Y - (possibly) preallocated buffer; if size of Y is less than + NOut, it will be reallocated. If it is large enough, it + is NOT reallocated, so we can save some time on reallocation. + + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeprocess(const mlpensemble &ensemble, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpeprocess(const_cast(ensemble.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +'interactive' variant of MLPEProcess for languages like Python which +support constructs like "Y = MLPEProcess(LM,X)" and interactive mode of the +interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeprocessi(const mlpensemble &ensemble, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpeprocessi(const_cast(ensemble.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Relative classification error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + percent of incorrectly classified cases. + Works both for classifier betwork and for regression networks which +are used as classifiers. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlperelclserror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlperelclserror(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + CrossEntropy/(NPoints*LN(2)). + Zero if ensemble solves regression task. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgce(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpeavgce(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + root mean square error. + Its meaning for regression task is obvious. As for classification task +RMS error means error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpermserror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpermserror(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for classification task +it means average error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgerror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpeavgerror(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Average relative error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for classification task +it means average relative error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgrelerror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::mlpeavgrelerror(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Training report: + * RelCLSError - fraction of misclassified cases. + * AvgCE - acerage cross-entropy + * RMSError - root-mean-square error + * AvgError - average error + * AvgRelError - average relative error + * NGrad - number of gradient calculations + * NHess - number of Hessian calculations + * NCholesky - number of Cholesky decompositions + +NOTE 1: RelCLSError/AvgCE are zero on regression problems. + +NOTE 2: on classification problems RMSError/AvgError/AvgRelError contain + errors in prediction of posterior probabilities +*************************************************************************/ +_mlpreport_owner::_mlpreport_owner() +{ + p_struct = (alglib_impl::mlpreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mlpreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mlpreport_owner::_mlpreport_owner(const _mlpreport_owner &rhs) +{ + p_struct = (alglib_impl::mlpreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mlpreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mlpreport_owner& _mlpreport_owner::operator=(const _mlpreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mlpreport_clear(p_struct); + if( !alglib_impl::_mlpreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mlpreport_owner::~_mlpreport_owner() +{ + alglib_impl::_mlpreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mlpreport* _mlpreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mlpreport* _mlpreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mlpreport::mlpreport() : _mlpreport_owner() ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),ngrad(p_struct->ngrad),nhess(p_struct->nhess),ncholesky(p_struct->ncholesky) +{ +} + +mlpreport::mlpreport(const mlpreport &rhs):_mlpreport_owner(rhs) ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),ngrad(p_struct->ngrad),nhess(p_struct->nhess),ncholesky(p_struct->ncholesky) +{ +} + +mlpreport& mlpreport::operator=(const mlpreport &rhs) +{ + if( this==&rhs ) + return *this; + _mlpreport_owner::operator=(rhs); + return *this; +} + +mlpreport::~mlpreport() +{ +} + + +/************************************************************************* +Cross-validation estimates of generalization error +*************************************************************************/ +_mlpcvreport_owner::_mlpcvreport_owner() +{ + p_struct = (alglib_impl::mlpcvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpcvreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mlpcvreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mlpcvreport_owner::_mlpcvreport_owner(const _mlpcvreport_owner &rhs) +{ + p_struct = (alglib_impl::mlpcvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlpcvreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mlpcvreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mlpcvreport_owner& _mlpcvreport_owner::operator=(const _mlpcvreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mlpcvreport_clear(p_struct); + if( !alglib_impl::_mlpcvreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mlpcvreport_owner::~_mlpcvreport_owner() +{ + alglib_impl::_mlpcvreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mlpcvreport* _mlpcvreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mlpcvreport* _mlpcvreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mlpcvreport::mlpcvreport() : _mlpcvreport_owner() ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror) +{ +} + +mlpcvreport::mlpcvreport(const mlpcvreport &rhs):_mlpcvreport_owner(rhs) ,relclserror(p_struct->relclserror),avgce(p_struct->avgce),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror) +{ +} + +mlpcvreport& mlpcvreport::operator=(const mlpcvreport &rhs) +{ + if( this==&rhs ) + return *this; + _mlpcvreport_owner::operator=(rhs); + return *this; +} + +mlpcvreport::~mlpcvreport() +{ +} + + +/************************************************************************* +Trainer object for neural network. + +You should not try to access fields of this object directly - use ALGLIB +functions to work with this object. +*************************************************************************/ +_mlptrainer_owner::_mlptrainer_owner() +{ + p_struct = (alglib_impl::mlptrainer*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlptrainer), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mlptrainer_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mlptrainer_owner::_mlptrainer_owner(const _mlptrainer_owner &rhs) +{ + p_struct = (alglib_impl::mlptrainer*)alglib_impl::ae_malloc(sizeof(alglib_impl::mlptrainer), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mlptrainer_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mlptrainer_owner& _mlptrainer_owner::operator=(const _mlptrainer_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mlptrainer_clear(p_struct); + if( !alglib_impl::_mlptrainer_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mlptrainer_owner::~_mlptrainer_owner() +{ + alglib_impl::_mlptrainer_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mlptrainer* _mlptrainer_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mlptrainer* _mlptrainer_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mlptrainer::mlptrainer() : _mlptrainer_owner() +{ +} + +mlptrainer::mlptrainer(const mlptrainer &rhs):_mlptrainer_owner(rhs) +{ +} + +mlptrainer& mlptrainer::operator=(const mlptrainer &rhs) +{ + if( this==&rhs ) + return *this; + _mlptrainer_owner::operator=(rhs); + return *this; +} + +mlptrainer::~mlptrainer() +{ +} + +/************************************************************************* +Neural network training using modified Levenberg-Marquardt with exact +Hessian calculation and regularization. Subroutine trains neural network +with restarts from random positions. Algorithm is well suited for small +and medium scale problems (hundreds of weights). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts from random position, >0. + If you don't know what Restarts to choose, use 2. + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -9, if internal matrix inverse subroutine failed + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlptrainlm(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlptrainlm(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Neural network training using L-BFGS algorithm with regularization. +Subroutine trains neural network with restarts from random positions. +Algorithm is well suited for problems of any dimensionality (memory +requirements and step complexity are linear by weights number). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts from random position, >0. + If you don't know what Restarts to choose, use 2. + WStep - stopping criterion. Algorithm stops if step size is + less than WStep. Recommended value - 0.01. Zero step + size means stopping after MaxIts iterations. + MaxIts - stopping criterion. Algorithm stops after MaxIts + iterations (NOT gradient calculations). Zero MaxIts + means stopping when step is sufficiently small. + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -8, if both WStep=0 and MaxIts=0 + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlptrainlbfgs(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, ae_int_t &info, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlptrainlbfgs(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, wstep, maxits, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Neural network training using early stopping (base algorithm - L-BFGS with +regularization). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + TrnXY - training set + TrnSize - training set size, TrnSize>0 + ValXY - validation set + ValSize - validation set size, ValSize>0 + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts, either: + * strictly positive number - algorithm make specified + number of restarts from random position. + * -1, in which case algorithm makes exactly one run + from the initial state of the network (no randomization). + If you don't know what Restarts to choose, choose one + one the following: + * -1 (deterministic start) + * +1 (one random restart) + * +5 (moderate amount of random restarts) + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1, ...). + * 2, task has been solved, stopping criterion met - + sufficiently small step size. Not expected (we + use EARLY stopping) but possible and not an + error. + * 6, task has been solved, stopping criterion met - + increasing of validation set error. + Rep - training report + +NOTE: + +Algorithm stops if validation set error increases for a long enough or +step size is small enought (there are task where validation set may +decrease for eternity). In any case solution returned corresponds to the +minimum of validation set error. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlptraines(const multilayerperceptron &network, const real_2d_array &trnxy, const ae_int_t trnsize, const real_2d_array &valxy, const ae_int_t valsize, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlptraines(const_cast(network.c_ptr()), const_cast(trnxy.c_ptr()), trnsize, const_cast(valxy.c_ptr()), valsize, decay, restarts, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Cross-validation estimate of generalization error. + +Base algorithm - L-BFGS. + +INPUT PARAMETERS: + Network - neural network with initialized geometry. Network is + not changed during cross-validation - it is used only + as a representative of its architecture. + XY - training set. + SSize - training set size + Decay - weight decay, same as in MLPTrainLBFGS + Restarts - number of restarts, >0. + restarts are counted for each partition separately, so + total number of restarts will be Restarts*FoldsCount. + WStep - stopping criterion, same as in MLPTrainLBFGS + MaxIts - stopping criterion, same as in MLPTrainLBFGS + FoldsCount - number of folds in k-fold cross-validation, + 2<=FoldsCount<=SSize. + recommended value: 10. + +OUTPUT PARAMETERS: + Info - return code, same as in MLPTrainLBFGS + Rep - report, same as in MLPTrainLM/MLPTrainLBFGS + CVRep - generalization error estimates + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcvlbfgs(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, const ae_int_t foldscount, ae_int_t &info, mlpreport &rep, mlpcvreport &cvrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpkfoldcvlbfgs(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, wstep, maxits, foldscount, &info, const_cast(rep.c_ptr()), const_cast(cvrep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Cross-validation estimate of generalization error. + +Base algorithm - Levenberg-Marquardt. + +INPUT PARAMETERS: + Network - neural network with initialized geometry. Network is + not changed during cross-validation - it is used only + as a representative of its architecture. + XY - training set. + SSize - training set size + Decay - weight decay, same as in MLPTrainLBFGS + Restarts - number of restarts, >0. + restarts are counted for each partition separately, so + total number of restarts will be Restarts*FoldsCount. + FoldsCount - number of folds in k-fold cross-validation, + 2<=FoldsCount<=SSize. + recommended value: 10. + +OUTPUT PARAMETERS: + Info - return code, same as in MLPTrainLBFGS + Rep - report, same as in MLPTrainLM/MLPTrainLBFGS + CVRep - generalization error estimates + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcvlm(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const ae_int_t foldscount, ae_int_t &info, mlpreport &rep, mlpcvreport &cvrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpkfoldcvlm(const_cast(network.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, foldscount, &info, const_cast(rep.c_ptr()), const_cast(cvrep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function estimates generalization error using cross-validation on the +current dataset with current training settings. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * FoldsCount cross-validation rounds (always) + ! * NRestarts training sessions performed within each of + ! cross-validation rounds (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. Network is not changed during cross- + validation and is not trained - it is used only as + representative of its architecture. I.e., we estimate + generalization properties of ARCHITECTURE, not some + specific network. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that for each cross-validation + round specified number of random restarts is + performed, with best network being chosen after + training. + * NRestarts=0 is same as NRestarts=1 + FoldsCount - number of folds in k-fold cross-validation: + * 2<=FoldsCount<=size of dataset + * recommended value: 10. + * values larger than dataset size will be silently + truncated down to dataset size + +OUTPUT PARAMETERS: + Rep - structure which contains cross-validation estimates: + * Rep.RelCLSError - fraction of misclassified cases. + * Rep.AvgCE - acerage cross-entropy + * Rep.RMSError - root-mean-square error + * Rep.AvgError - average error + * Rep.AvgRelError - average relative error + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + or subset with only one point was given, zeros are returned as + estimates. + +NOTE: this method performs FoldsCount cross-validation rounds, each one + with NRestarts random starts. Thus, FoldsCount*NRestarts networks + are trained in total. + +NOTE: Rep.RelCLSError/Rep.AvgCE are zero on regression problems. + +NOTE: on classification problems Rep.RMSError/Rep.AvgError/Rep.AvgRelError + contain errors in prediction of posterior probabilities. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcv(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, const ae_int_t foldscount, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpkfoldcv(const_cast(s.c_ptr()), const_cast(network.c_ptr()), nrestarts, foldscount, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlpkfoldcv(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, const ae_int_t foldscount, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlpkfoldcv(const_cast(s.c_ptr()), const_cast(network.c_ptr()), nrestarts, foldscount, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Creation of the network trainer object for regression networks + +INPUT PARAMETERS: + NIn - number of inputs, NIn>=1 + NOut - number of outputs, NOut>=1 + +OUTPUT PARAMETERS: + S - neural network trainer object. + This structure can be used to train any regression + network with NIn inputs and NOut outputs. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatetrainer(const ae_int_t nin, const ae_int_t nout, mlptrainer &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreatetrainer(nin, nout, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Creation of the network trainer object for classification networks + +INPUT PARAMETERS: + NIn - number of inputs, NIn>=1 + NClasses - number of classes, NClasses>=2 + +OUTPUT PARAMETERS: + S - neural network trainer object. + This structure can be used to train any classification + network with NIn inputs and NOut outputs. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatetrainercls(const ae_int_t nin, const ae_int_t nclasses, mlptrainer &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpcreatetrainercls(nin, nclasses, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets "current dataset" of the trainer object to one passed +by user. + +INPUT PARAMETERS: + S - trainer object + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. + NPoints - points count, >=0. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +datasetformat is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetdataset(const mlptrainer &s, const real_2d_array &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetdataset(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets "current dataset" of the trainer object to one passed +by user (sparse matrix is used to store dataset). + +INPUT PARAMETERS: + S - trainer object + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Any sparse storage format can be used: + Hash-table, CRS... + NPoints - points count, >=0 + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +datasetformat is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetsparsedataset(const mlptrainer &s, const sparsematrix &xy, const ae_int_t npoints) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetsparsedataset(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), npoints, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets weight decay coefficient which is used for training. + +INPUT PARAMETERS: + S - trainer object + Decay - weight decay coefficient, >=0. Weight decay term + 'Decay*||Weights||^2' is added to error function. If + you don't know what Decay to choose, use 1.0E-3. + Weight decay can be set to zero, in this case network + is trained without weight decay. + +NOTE: by default network uses some small nonzero value for weight decay. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetdecay(const mlptrainer &s, const double decay) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetdecay(const_cast(s.c_ptr()), decay, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets stopping criteria for the optimizer. + +INPUT PARAMETERS: + S - trainer object + WStep - stopping criterion. Algorithm stops if step size is + less than WStep. Recommended value - 0.01. Zero step + size means stopping after MaxIts iterations. + WStep>=0. + MaxIts - stopping criterion. Algorithm stops after MaxIts + epochs (full passes over entire dataset). Zero MaxIts + means stopping when step is sufficiently small. + MaxIts>=0. + +NOTE: by default, WStep=0.005 and MaxIts=0 are used. These values are also + used when MLPSetCond() is called with WStep=0 and MaxIts=0. + +NOTE: these stopping criteria are used for all kinds of neural training - + from "conventional" networks to early stopping ensembles. When used + for "conventional" networks, they are used as the only stopping + criteria. When combined with early stopping, they used as ADDITIONAL + stopping criteria which can terminate early stopping algorithm. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetcond(const mlptrainer &s, const double wstep, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetcond(const_cast(s.c_ptr()), wstep, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets training algorithm: batch training using L-BFGS will be +used. + +This algorithm: +* the most robust for small-scale problems, but may be too slow for large + scale ones. +* perfoms full pass through the dataset before performing step +* uses conditions specified by MLPSetCond() for stopping +* is default one used by trainer object + +INPUT PARAMETERS: + S - trainer object + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetalgobatch(const mlptrainer &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpsetalgobatch(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function trains neural network passed to this function, using current +dataset (one which was passed to MLPSetDataset() or MLPSetSparseDataset()) +and current training settings. Training from NRestarts random starting +positions is performed, best network is chosen. + +Training is performed using current training algorithm. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * NRestarts training sessions performed within each of + ! cross-validation rounds (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that specified number of random + restarts are performed, best network is chosen after + training + * NRestarts=0 means that current state of the network + is used for training. + +OUTPUT PARAMETERS: + Network - trained network + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + network is filled by zero values. Same behavior for functions + MLPStartTraining and MLPContinueTraining. + +NOTE: this method uses sum-of-squares error function for training. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlptrainnetwork(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlptrainnetwork(const_cast(s.c_ptr()), const_cast(network.c_ptr()), nrestarts, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlptrainnetwork(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlptrainnetwork(const_cast(s.c_ptr()), const_cast(network.c_ptr()), nrestarts, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +IMPORTANT: this is an "expert" version of the MLPTrain() function. We do + not recommend you to use it unless you are pretty sure that you + need ability to monitor training progress. + +This function performs step-by-step training of the neural network. Here +"step-by-step" means that training starts with MLPStartTraining() call, +and then user subsequently calls MLPContinueTraining() to perform one more +iteration of the training. + +After call to this function trainer object remembers network and is ready +to train it. However, no training is performed until first call to +MLPContinueTraining() function. Subsequent calls to MLPContinueTraining() +will advance training progress one iteration further. + +EXAMPLE: + > + > ...initialize network and trainer object.... + > + > MLPStartTraining(Trainer, Network, True) + > while MLPContinueTraining(Trainer, Network) do + > ...visualize training progress... + > + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. + RandomStart - randomize network before training or not: + * True means that network is randomized and its + initial state (one which was passed to the trainer + object) is lost. + * False means that training is started from the + current state of the network + +OUTPUT PARAMETERS: + Network - neural network which is ready to training (weights are + initialized, preprocessor is initialized using current + training set) + +NOTE: this method uses sum-of-squares error function for training. + +NOTE: it is expected that trainer object settings are NOT changed during + step-by-step training, i.e. no one changes stopping criteria or + training set during training. It is possible and there is no defense + against such actions, but algorithm behavior in such cases is + undefined and can be unpredictable. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpstarttraining(const mlptrainer &s, const multilayerperceptron &network, const bool randomstart) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpstarttraining(const_cast(s.c_ptr()), const_cast(network.c_ptr()), randomstart, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +IMPORTANT: this is an "expert" version of the MLPTrain() function. We do + not recommend you to use it unless you are pretty sure that you + need ability to monitor training progress. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +This function performs step-by-step training of the neural network. Here +"step-by-step" means that training starts with MLPStartTraining() call, +and then user subsequently calls MLPContinueTraining() to perform one more +iteration of the training. + +This function performs one more iteration of the training and returns +either True (training continues) or False (training stopped). In case True +was returned, Network weights are updated according to the current state +of the optimization progress. In case False was returned, no additional +updates is performed (previous update of the network weights moved us to +the final point, and no additional updates is needed). + +EXAMPLE: + > + > [initialize network and trainer object] + > + > MLPStartTraining(Trainer, Network, True) + > while MLPContinueTraining(Trainer, Network) do + > [visualize training progress] + > + +INPUT PARAMETERS: + S - trainer object + Network - neural network structure, which is used to store + current state of the training process. + +OUTPUT PARAMETERS: + Network - weights of the neural network are rewritten by the + current approximation. + +NOTE: this method uses sum-of-squares error function for training. + +NOTE: it is expected that trainer object settings are NOT changed during + step-by-step training, i.e. no one changes stopping criteria or + training set during training. It is possible and there is no defense + against such actions, but algorithm behavior in such cases is + undefined and can be unpredictable. + +NOTE: It is expected that Network is the same one which was passed to + MLPStartTraining() function. However, THIS function checks only + following: + * that number of network inputs is consistent with trainer object + settings + * that number of network outputs/classes is consistent with trainer + object settings + * that number of network weights is the same as number of weights in + the network passed to MLPStartTraining() function + Exception is thrown when these conditions are violated. + + It is also expected that you do not change state of the network on + your own - the only party who has right to change network during its + training is a trainer object. Any attempt to interfere with trainer + may lead to unpredictable results. + + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +bool mlpcontinuetraining(const mlptrainer &s, const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::mlpcontinuetraining(const_cast(s.c_ptr()), const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +bool smp_mlpcontinuetraining(const mlptrainer &s, const multilayerperceptron &network) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::_pexec_mlpcontinuetraining(const_cast(s.c_ptr()), const_cast(network.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Training neural networks ensemble using bootstrap aggregating (bagging). +Modified Levenberg-Marquardt algorithm is used as base training method. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpebagginglm(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep, mlpcvreport &ooberrors) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpebagginglm(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, &info, const_cast(rep.c_ptr()), const_cast(ooberrors.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Training neural networks ensemble using bootstrap aggregating (bagging). +L-BFGS algorithm is used as base training method. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + WStep - stopping criterion, same as in MLPTrainLBFGS + MaxIts - stopping criterion, same as in MLPTrainLBFGS + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -8, if both WStep=0 and MaxIts=0 + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpebagginglbfgs(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, ae_int_t &info, mlpreport &rep, mlpcvreport &ooberrors) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpebagginglbfgs(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, wstep, maxits, &info, const_cast(rep.c_ptr()), const_cast(ooberrors.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Training neural networks ensemble using early stopping. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 6, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpetraines(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlpetraines(const_cast(ensemble.c_ptr()), const_cast(xy.c_ptr()), npoints, decay, restarts, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function trains neural network ensemble passed to this function using +current dataset and early stopping training algorithm. Each early stopping +round performs NRestarts random restarts (thus, EnsembleSize*NRestarts +training rounds is performed in total). + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * EnsembleSize training sessions performed for each of ensemble + ! members (always parallelized) + ! * NRestarts training sessions performed within each of training + ! sessions (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object; + Ensemble - neural network ensemble. It must have same number of + inputs and outputs/classes as was specified during + creation of the trainer object. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that specified number of random + restarts are performed during each ES round; + * NRestarts=0 is silently replaced by 1. + +OUTPUT PARAMETERS: + Ensemble - trained ensemble; + Rep - it contains all type of errors. + +NOTE: this training method uses BOTH early stopping and weight decay! So, + you should select weight decay before starting training just as you + select it before training "conventional" networks. + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + or single-point dataset was passed, ensemble is filled by zero + values. + +NOTE: this method uses sum-of-squares error function for training. + + -- ALGLIB -- + Copyright 22.08.2012 by Bochkanov Sergey +*************************************************************************/ +void mlptrainensemblees(const mlptrainer &s, const mlpensemble &ensemble, const ae_int_t nrestarts, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mlptrainensemblees(const_cast(s.c_ptr()), const_cast(ensemble.c_ptr()), nrestarts, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_mlptrainensemblees(const mlptrainer &s, const mlpensemble &ensemble, const ae_int_t nrestarts, mlpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_mlptrainensemblees(const_cast(s.c_ptr()), const_cast(ensemble.c_ptr()), nrestarts, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Principal components analysis + +Subroutine builds orthogonal basis where first axis corresponds to +direction with maximum variance, second axis maximizes variance in subspace +orthogonal to first axis and so on. + +It should be noted that, unlike LDA, PCA does not use class labels. + +INPUT PARAMETERS: + X - dataset, array[0..NPoints-1,0..NVars-1]. + matrix contains ONLY INDEPENDENT VARIABLES. + NPoints - dataset size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + +ÂÛÕÎÄÍÛÅ ÏÀÐÀÌÅÒÐÛ: + Info - return code: + * -4, if SVD subroutine haven't converged + * -1, if wrong parameters has been passed (NPoints<0, + NVars<1) + * 1, if task is solved + S2 - array[0..NVars-1]. variance values corresponding + to basis vectors. + V - array[0..NVars-1,0..NVars-1] + matrix, whose columns store basis vectors. + + -- ALGLIB -- + Copyright 25.08.2008 by Bochkanov Sergey +*************************************************************************/ +void pcabuildbasis(const real_2d_array &x, const ae_int_t npoints, const ae_int_t nvars, ae_int_t &info, real_1d_array &s2, real_2d_array &v) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pcabuildbasis(const_cast(x.c_ptr()), npoints, nvars, &info, const_cast(s2.c_ptr()), const_cast(v.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +static double bdss_xlny(double x, double y, ae_state *_state); +static double bdss_getcv(/* Integer */ ae_vector* cnt, + ae_int_t nc, + ae_state *_state); +static void bdss_tieaddc(/* Integer */ ae_vector* c, + /* Integer */ ae_vector* ties, + ae_int_t ntie, + ae_int_t nc, + /* Integer */ ae_vector* cnt, + ae_state *_state); +static void bdss_tiesubc(/* Integer */ ae_vector* c, + /* Integer */ ae_vector* ties, + ae_int_t ntie, + ae_int_t nc, + /* Integer */ ae_vector* cnt, + ae_state *_state); + + +static ae_int_t clustering_parallelcomplexity = 200000; +static ae_bool clustering_selectcenterpp(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + /* Real */ ae_matrix* centers, + /* Boolean */ ae_vector* busycenters, + ae_int_t ccnt, + /* Real */ ae_vector* d2, + /* Real */ ae_vector* p, + /* Real */ ae_vector* tmp, + ae_state *_state); +static void clustering_clusterizerrunahcinternal(clusterizerstate* s, + /* Real */ ae_matrix* d, + ahcreport* rep, + ae_state *_state); +static void clustering_evaluatedistancematrixrec(/* Real */ ae_matrix* xy, + ae_int_t nfeatures, + ae_int_t disttype, + /* Real */ ae_matrix* d, + ae_int_t i0, + ae_int_t i1, + ae_int_t j0, + ae_int_t j1, + ae_state *_state); + + + + +static ae_int_t dforest_innernodewidth = 3; +static ae_int_t dforest_leafnodewidth = 2; +static ae_int_t dforest_dfusestrongsplits = 1; +static ae_int_t dforest_dfuseevs = 2; +static ae_int_t dforest_dffirstversion = 0; +static ae_int_t dforest_dfclserror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +static void dforest_dfprocessinternal(decisionforest* df, + ae_int_t offs, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +static void dforest_dfbuildtree(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t nfeatures, + ae_int_t nvarsinpool, + ae_int_t flags, + dfinternalbuffers* bufs, + hqrndstate* rs, + ae_state *_state); +static void dforest_dfbuildtreerec(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t nfeatures, + ae_int_t nvarsinpool, + ae_int_t flags, + ae_int_t* numprocessed, + ae_int_t idx1, + ae_int_t idx2, + dfinternalbuffers* bufs, + hqrndstate* rs, + ae_state *_state); +static void dforest_dfsplitc(/* Real */ ae_vector* x, + /* Integer */ ae_vector* c, + /* Integer */ ae_vector* cntbuf, + ae_int_t n, + ae_int_t nc, + ae_int_t flags, + ae_int_t* info, + double* threshold, + double* e, + /* Real */ ae_vector* sortrbuf, + /* Integer */ ae_vector* sortibuf, + ae_state *_state); +static void dforest_dfsplitr(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t flags, + ae_int_t* info, + double* threshold, + double* e, + /* Real */ ae_vector* sortrbuf, + /* Real */ ae_vector* sortrbuf2, + ae_state *_state); + + +static ae_int_t linreg_lrvnum = 5; +static void linreg_lrinternal(/* Real */ ae_matrix* xy, + /* Real */ ae_vector* s, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + linearmodel* lm, + lrreport* ar, + ae_state *_state); + + + + + + +static ae_int_t mlpbase_mlpvnum = 7; +static ae_int_t mlpbase_mlpfirstversion = 0; +static ae_int_t mlpbase_nfieldwidth = 4; +static ae_int_t mlpbase_hlconnfieldwidth = 5; +static ae_int_t mlpbase_hlnfieldwidth = 4; +static ae_int_t mlpbase_gradbasecasecost = 50000; +static ae_int_t mlpbase_microbatchsize = 64; +static void mlpbase_addinputlayer(ae_int_t ncount, + /* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t* lastproc, + ae_state *_state); +static void mlpbase_addbiasedsummatorlayer(ae_int_t ncount, + /* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t* lastproc, + ae_state *_state); +static void mlpbase_addactivationlayer(ae_int_t functype, + /* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t* lastproc, + ae_state *_state); +static void mlpbase_addzerolayer(/* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t* lastproc, + ae_state *_state); +static void mlpbase_hladdinputlayer(multilayerperceptron* network, + ae_int_t* connidx, + ae_int_t* neuroidx, + ae_int_t* structinfoidx, + ae_int_t nin, + ae_state *_state); +static void mlpbase_hladdoutputlayer(multilayerperceptron* network, + ae_int_t* connidx, + ae_int_t* neuroidx, + ae_int_t* structinfoidx, + ae_int_t* weightsidx, + ae_int_t k, + ae_int_t nprev, + ae_int_t nout, + ae_bool iscls, + ae_bool islinearout, + ae_state *_state); +static void mlpbase_hladdhiddenlayer(multilayerperceptron* network, + ae_int_t* connidx, + ae_int_t* neuroidx, + ae_int_t* structinfoidx, + ae_int_t* weightsidx, + ae_int_t k, + ae_int_t nprev, + ae_int_t ncur, + ae_state *_state); +static void mlpbase_fillhighlevelinformation(multilayerperceptron* network, + ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + ae_bool iscls, + ae_bool islinearout, + ae_state *_state); +static void mlpbase_mlpcreate(ae_int_t nin, + ae_int_t nout, + /* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t layerscount, + ae_bool isclsnet, + multilayerperceptron* network, + ae_state *_state); +static void mlpbase_mlphessianbatchinternal(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + ae_bool naturalerr, + double* e, + /* Real */ ae_vector* grad, + /* Real */ ae_matrix* h, + ae_state *_state); +static void mlpbase_mlpinternalcalculategradient(multilayerperceptron* network, + /* Real */ ae_vector* neurons, + /* Real */ ae_vector* weights, + /* Real */ ae_vector* derror, + /* Real */ ae_vector* grad, + ae_bool naturalerrorfunc, + ae_state *_state); +static void mlpbase_mlpchunkedgradient(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + /* Real */ ae_vector* batch4buf, + /* Real */ ae_vector* hpcbuf, + double* e, + ae_bool naturalerrorfunc, + ae_state *_state); +static void mlpbase_mlpchunkedprocess(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + /* Real */ ae_vector* batch4buf, + /* Real */ ae_vector* hpcbuf, + ae_state *_state); +static double mlpbase_safecrossentropy(double t, + double z, + ae_state *_state); +static void mlpbase_randomizebackwardpass(multilayerperceptron* network, + ae_int_t neuronidx, + double v, + ae_state *_state); + + +static double logit_xtol = 100*ae_machineepsilon; +static double logit_ftol = 0.0001; +static double logit_gtol = 0.3; +static ae_int_t logit_maxfev = 20; +static double logit_stpmin = 1.0E-2; +static double logit_stpmax = 1.0E5; +static ae_int_t logit_logitvnum = 6; +static void logit_mnliexp(/* Real */ ae_vector* w, + /* Real */ ae_vector* x, + ae_state *_state); +static void logit_mnlallerrors(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double* relcls, + double* avgce, + double* rms, + double* avg, + double* avgrel, + ae_state *_state); +static void logit_mnlmcsrch(ae_int_t n, + /* Real */ ae_vector* x, + double* f, + /* Real */ ae_vector* g, + /* Real */ ae_vector* s, + double* stp, + ae_int_t* info, + ae_int_t* nfev, + /* Real */ ae_vector* wa, + logitmcstate* state, + ae_int_t* stage, + ae_state *_state); +static void logit_mnlmcstep(double* stx, + double* fx, + double* dx, + double* sty, + double* fy, + double* dy, + double* stp, + double fp, + double dp, + ae_bool* brackt, + double stmin, + double stmax, + ae_int_t* info, + ae_state *_state); + + +static double mcpd_xtol = 1.0E-8; +static void mcpd_mcpdinit(ae_int_t n, + ae_int_t entrystate, + ae_int_t exitstate, + mcpdstate* s, + ae_state *_state); + + +static ae_int_t mlpe_mlpefirstversion = 1; + + +static double mlptrain_mindecay = 0.001; +static ae_int_t mlptrain_defaultlbfgsfactor = 6; +static void mlptrain_mlpkfoldcvgeneral(multilayerperceptron* n, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t foldscount, + ae_bool lmalgorithm, + double wstep, + ae_int_t maxits, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* cvrep, + ae_state *_state); +static void mlptrain_mlpkfoldsplit(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nclasses, + ae_int_t foldscount, + ae_bool stratifiedsplits, + /* Integer */ ae_vector* folds, + ae_state *_state); +static void mlptrain_mthreadcv(mlptrainer* s, + ae_int_t rowsize, + ae_int_t nrestarts, + /* Integer */ ae_vector* folds, + ae_int_t fold, + ae_int_t dfold, + /* Real */ ae_matrix* cvy, + ae_shared_pool* pooldatacv, + ae_state *_state); +static void mlptrain_mlptrainnetworkx(mlptrainer* s, + ae_int_t nrestarts, + ae_int_t algokind, + /* Integer */ ae_vector* trnsubset, + ae_int_t trnsubsetsize, + /* Integer */ ae_vector* valsubset, + ae_int_t valsubsetsize, + multilayerperceptron* network, + mlpreport* rep, + ae_bool isrootcall, + ae_shared_pool* sessions, + ae_state *_state); +static void mlptrain_mlptrainensemblex(mlptrainer* s, + mlpensemble* ensemble, + ae_int_t idx0, + ae_int_t idx1, + ae_int_t nrestarts, + ae_int_t trainingmethod, + sinteger* ngrad, + ae_bool isrootcall, + ae_shared_pool* esessions, + ae_state *_state); +static void mlptrain_mlpstarttrainingx(mlptrainer* s, + ae_bool randomstart, + ae_int_t algokind, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + smlptrnsession* session, + ae_state *_state); +static ae_bool mlptrain_mlpcontinuetrainingx(mlptrainer* s, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_int_t* ngradbatch, + smlptrnsession* session, + ae_state *_state); +static void mlptrain_mlpebagginginternal(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + double wstep, + ae_int_t maxits, + ae_bool lmalgorithm, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* ooberrors, + ae_state *_state); +static void mlptrain_initmlptrnsession(multilayerperceptron* networktrained, + ae_bool randomizenetwork, + mlptrainer* trainer, + smlptrnsession* session, + ae_state *_state); +static void mlptrain_initmlptrnsessions(multilayerperceptron* networktrained, + ae_bool randomizenetwork, + mlptrainer* trainer, + ae_shared_pool* sessions, + ae_state *_state); +static void mlptrain_initmlpetrnsession(multilayerperceptron* individualnetwork, + mlptrainer* trainer, + mlpetrnsession* session, + ae_state *_state); +static void mlptrain_initmlpetrnsessions(multilayerperceptron* individualnetwork, + mlptrainer* trainer, + ae_shared_pool* sessions, + ae_state *_state); + + + + + + + +/************************************************************************* +This set of routines (DSErrAllocate, DSErrAccumulate, DSErrFinish) +calculates different error functions (classification error, cross-entropy, +rms, avg, avg.rel errors). + +1. DSErrAllocate prepares buffer. +2. DSErrAccumulate accumulates individual errors: + * Y contains predicted output (posterior probabilities for classification) + * DesiredY contains desired output (class number for classification) +3. DSErrFinish outputs results: + * Buf[0] contains relative classification error (zero for regression tasks) + * Buf[1] contains avg. cross-entropy (zero for regression tasks) + * Buf[2] contains rms error (regression, classification) + * Buf[3] contains average error (regression, classification) + * Buf[4] contains average relative error (regression, classification) + +NOTES(1): + "NClasses>0" means that we have classification task. + "NClasses<0" means regression task with -NClasses real outputs. + +NOTES(2): + rms. avg, avg.rel errors for classification tasks are interpreted as + errors in posterior probabilities with respect to probabilities given + by training/test set. + + -- ALGLIB -- + Copyright 11.01.2009 by Bochkanov Sergey +*************************************************************************/ +void dserrallocate(ae_int_t nclasses, + /* Real */ ae_vector* buf, + ae_state *_state) +{ + + ae_vector_clear(buf); + + ae_vector_set_length(buf, 7+1, _state); + buf->ptr.p_double[0] = 0; + buf->ptr.p_double[1] = 0; + buf->ptr.p_double[2] = 0; + buf->ptr.p_double[3] = 0; + buf->ptr.p_double[4] = 0; + buf->ptr.p_double[5] = nclasses; + buf->ptr.p_double[6] = 0; + buf->ptr.p_double[7] = 0; +} + + +/************************************************************************* +See DSErrAllocate for comments on this routine. + + -- ALGLIB -- + Copyright 11.01.2009 by Bochkanov Sergey +*************************************************************************/ +void dserraccumulate(/* Real */ ae_vector* buf, + /* Real */ ae_vector* y, + /* Real */ ae_vector* desiredy, + ae_state *_state) +{ + ae_int_t nclasses; + ae_int_t nout; + ae_int_t offs; + ae_int_t mmax; + ae_int_t rmax; + ae_int_t j; + double v; + double ev; + + + offs = 5; + nclasses = ae_round(buf->ptr.p_double[offs], _state); + if( nclasses>0 ) + { + + /* + * Classification + */ + rmax = ae_round(desiredy->ptr.p_double[0], _state); + mmax = 0; + for(j=1; j<=nclasses-1; j++) + { + if( ae_fp_greater(y->ptr.p_double[j],y->ptr.p_double[mmax]) ) + { + mmax = j; + } + } + if( mmax!=rmax ) + { + buf->ptr.p_double[0] = buf->ptr.p_double[0]+1; + } + if( ae_fp_greater(y->ptr.p_double[rmax],0) ) + { + buf->ptr.p_double[1] = buf->ptr.p_double[1]-ae_log(y->ptr.p_double[rmax], _state); + } + else + { + buf->ptr.p_double[1] = buf->ptr.p_double[1]+ae_log(ae_maxrealnumber, _state); + } + for(j=0; j<=nclasses-1; j++) + { + v = y->ptr.p_double[j]; + if( j==rmax ) + { + ev = 1; + } + else + { + ev = 0; + } + buf->ptr.p_double[2] = buf->ptr.p_double[2]+ae_sqr(v-ev, _state); + buf->ptr.p_double[3] = buf->ptr.p_double[3]+ae_fabs(v-ev, _state); + if( ae_fp_neq(ev,0) ) + { + buf->ptr.p_double[4] = buf->ptr.p_double[4]+ae_fabs((v-ev)/ev, _state); + buf->ptr.p_double[offs+2] = buf->ptr.p_double[offs+2]+1; + } + } + buf->ptr.p_double[offs+1] = buf->ptr.p_double[offs+1]+1; + } + else + { + + /* + * Regression + */ + nout = -nclasses; + rmax = 0; + for(j=1; j<=nout-1; j++) + { + if( ae_fp_greater(desiredy->ptr.p_double[j],desiredy->ptr.p_double[rmax]) ) + { + rmax = j; + } + } + mmax = 0; + for(j=1; j<=nout-1; j++) + { + if( ae_fp_greater(y->ptr.p_double[j],y->ptr.p_double[mmax]) ) + { + mmax = j; + } + } + if( mmax!=rmax ) + { + buf->ptr.p_double[0] = buf->ptr.p_double[0]+1; + } + for(j=0; j<=nout-1; j++) + { + v = y->ptr.p_double[j]; + ev = desiredy->ptr.p_double[j]; + buf->ptr.p_double[2] = buf->ptr.p_double[2]+ae_sqr(v-ev, _state); + buf->ptr.p_double[3] = buf->ptr.p_double[3]+ae_fabs(v-ev, _state); + if( ae_fp_neq(ev,0) ) + { + buf->ptr.p_double[4] = buf->ptr.p_double[4]+ae_fabs((v-ev)/ev, _state); + buf->ptr.p_double[offs+2] = buf->ptr.p_double[offs+2]+1; + } + } + buf->ptr.p_double[offs+1] = buf->ptr.p_double[offs+1]+1; + } +} + + +/************************************************************************* +See DSErrAllocate for comments on this routine. + + -- ALGLIB -- + Copyright 11.01.2009 by Bochkanov Sergey +*************************************************************************/ +void dserrfinish(/* Real */ ae_vector* buf, ae_state *_state) +{ + ae_int_t nout; + ae_int_t offs; + + + offs = 5; + nout = ae_iabs(ae_round(buf->ptr.p_double[offs], _state), _state); + if( ae_fp_neq(buf->ptr.p_double[offs+1],0) ) + { + buf->ptr.p_double[0] = buf->ptr.p_double[0]/buf->ptr.p_double[offs+1]; + buf->ptr.p_double[1] = buf->ptr.p_double[1]/buf->ptr.p_double[offs+1]; + buf->ptr.p_double[2] = ae_sqrt(buf->ptr.p_double[2]/(nout*buf->ptr.p_double[offs+1]), _state); + buf->ptr.p_double[3] = buf->ptr.p_double[3]/(nout*buf->ptr.p_double[offs+1]); + } + if( ae_fp_neq(buf->ptr.p_double[offs+2],0) ) + { + buf->ptr.p_double[4] = buf->ptr.p_double[4]/buf->ptr.p_double[offs+2]; + } +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 19.05.2008 by Bochkanov Sergey +*************************************************************************/ +void dsnormalize(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + /* Real */ ae_vector* means, + /* Real */ ae_vector* sigmas, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector tmp; + double mean; + double variance; + double skewness; + double kurtosis; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(means); + ae_vector_clear(sigmas); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + + /* + * Test parameters + */ + if( npoints<=0||nvars<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * Standartization + */ + ae_vector_set_length(means, nvars-1+1, _state); + ae_vector_set_length(sigmas, nvars-1+1, _state); + ae_vector_set_length(&tmp, npoints-1+1, _state); + for(j=0; j<=nvars-1; j++) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][j], xy->stride, ae_v_len(0,npoints-1)); + samplemoments(&tmp, npoints, &mean, &variance, &skewness, &kurtosis, _state); + means->ptr.p_double[j] = mean; + sigmas->ptr.p_double[j] = ae_sqrt(variance, _state); + if( ae_fp_eq(sigmas->ptr.p_double[j],0) ) + { + sigmas->ptr.p_double[j] = 1; + } + for(i=0; i<=npoints-1; i++) + { + xy->ptr.pp_double[i][j] = (xy->ptr.pp_double[i][j]-means->ptr.p_double[j])/sigmas->ptr.p_double[j]; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 19.05.2008 by Bochkanov Sergey +*************************************************************************/ +void dsnormalizec(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + /* Real */ ae_vector* means, + /* Real */ ae_vector* sigmas, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t j; + ae_vector tmp; + double mean; + double variance; + double skewness; + double kurtosis; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(means); + ae_vector_clear(sigmas); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + + /* + * Test parameters + */ + if( npoints<=0||nvars<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * Standartization + */ + ae_vector_set_length(means, nvars-1+1, _state); + ae_vector_set_length(sigmas, nvars-1+1, _state); + ae_vector_set_length(&tmp, npoints-1+1, _state); + for(j=0; j<=nvars-1; j++) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][j], xy->stride, ae_v_len(0,npoints-1)); + samplemoments(&tmp, npoints, &mean, &variance, &skewness, &kurtosis, _state); + means->ptr.p_double[j] = mean; + sigmas->ptr.p_double[j] = ae_sqrt(variance, _state); + if( ae_fp_eq(sigmas->ptr.p_double[j],0) ) + { + sigmas->ptr.p_double[j] = 1; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 19.05.2008 by Bochkanov Sergey +*************************************************************************/ +double dsgetmeanmindistance(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector tmp; + ae_vector tmp2; + double v; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp2, 0, DT_REAL, _state, ae_true); + + + /* + * Test parameters + */ + if( npoints<=0||nvars<1 ) + { + result = 0; + ae_frame_leave(_state); + return result; + } + + /* + * Process + */ + ae_vector_set_length(&tmp, npoints-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + tmp.ptr.p_double[i] = ae_maxrealnumber; + } + ae_vector_set_length(&tmp2, nvars-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + for(j=i+1; j<=npoints-1; j++) + { + ae_v_move(&tmp2.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + ae_v_sub(&tmp2.ptr.p_double[0], 1, &xy->ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); + v = ae_v_dotproduct(&tmp2.ptr.p_double[0], 1, &tmp2.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); + v = ae_sqrt(v, _state); + tmp.ptr.p_double[i] = ae_minreal(tmp.ptr.p_double[i], v, _state); + tmp.ptr.p_double[j] = ae_minreal(tmp.ptr.p_double[j], v, _state); + } + } + result = 0; + for(i=0; i<=npoints-1; i++) + { + result = result+tmp.ptr.p_double[i]/npoints; + } + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 19.05.2008 by Bochkanov Sergey +*************************************************************************/ +void dstie(/* Real */ ae_vector* a, + ae_int_t n, + /* Integer */ ae_vector* ties, + ae_int_t* tiecount, + /* Integer */ ae_vector* p1, + /* Integer */ ae_vector* p2, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t k; + ae_vector tmp; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(ties); + *tiecount = 0; + ae_vector_clear(p1); + ae_vector_clear(p2); + ae_vector_init(&tmp, 0, DT_INT, _state, ae_true); + + + /* + * Special case + */ + if( n<=0 ) + { + *tiecount = 0; + ae_frame_leave(_state); + return; + } + + /* + * Sort A + */ + tagsort(a, n, p1, p2, _state); + + /* + * Process ties + */ + *tiecount = 1; + for(i=1; i<=n-1; i++) + { + if( ae_fp_neq(a->ptr.p_double[i],a->ptr.p_double[i-1]) ) + { + *tiecount = *tiecount+1; + } + } + ae_vector_set_length(ties, *tiecount+1, _state); + ties->ptr.p_int[0] = 0; + k = 1; + for(i=1; i<=n-1; i++) + { + if( ae_fp_neq(a->ptr.p_double[i],a->ptr.p_double[i-1]) ) + { + ties->ptr.p_int[k] = i; + k = k+1; + } + } + ties->ptr.p_int[*tiecount] = n; + ae_frame_leave(_state); +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 11.12.2008 by Bochkanov Sergey +*************************************************************************/ +void dstiefasti(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + ae_int_t n, + /* Integer */ ae_vector* ties, + ae_int_t* tiecount, + /* Real */ ae_vector* bufr, + /* Integer */ ae_vector* bufi, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t k; + ae_vector tmp; + + ae_frame_make(_state, &_frame_block); + *tiecount = 0; + ae_vector_init(&tmp, 0, DT_INT, _state, ae_true); + + + /* + * Special case + */ + if( n<=0 ) + { + *tiecount = 0; + ae_frame_leave(_state); + return; + } + + /* + * Sort A + */ + tagsortfasti(a, b, bufr, bufi, n, _state); + + /* + * Process ties + */ + ties->ptr.p_int[0] = 0; + k = 1; + for(i=1; i<=n-1; i++) + { + if( ae_fp_neq(a->ptr.p_double[i],a->ptr.p_double[i-1]) ) + { + ties->ptr.p_int[k] = i; + k = k+1; + } + } + ties->ptr.p_int[k] = n; + *tiecount = k; + ae_frame_leave(_state); +} + + +/************************************************************************* +Optimal binary classification + +Algorithms finds optimal (=with minimal cross-entropy) binary partition. +Internal subroutine. + +INPUT PARAMETERS: + A - array[0..N-1], variable + C - array[0..N-1], class numbers (0 or 1). + N - array size + +OUTPUT PARAMETERS: + Info - completetion code: + * -3, all values of A[] are same (partition is impossible) + * -2, one of C[] is incorrect (<0, >1) + * -1, incorrect pararemets were passed (N<=0). + * 1, OK + Threshold- partiton boundary. Left part contains values which are + strictly less than Threshold. Right part contains values + which are greater than or equal to Threshold. + PAL, PBL- probabilities P(0|v=Threshold) and P(1|v>=Threshold) + CVE - cross-validation estimate of cross-entropy + + -- ALGLIB -- + Copyright 22.05.2008 by Bochkanov Sergey +*************************************************************************/ +void dsoptimalsplit2(/* Real */ ae_vector* a, + /* Integer */ ae_vector* c, + ae_int_t n, + ae_int_t* info, + double* threshold, + double* pal, + double* pbl, + double* par, + double* pbr, + double* cve, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _a; + ae_vector _c; + ae_int_t i; + ae_int_t t; + double s; + ae_vector ties; + ae_int_t tiecount; + ae_vector p1; + ae_vector p2; + ae_int_t k; + ae_int_t koptimal; + double pak; + double pbk; + double cvoptimal; + double cv; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init_copy(&_c, c, _state, ae_true); + c = &_c; + *info = 0; + *threshold = 0; + *pal = 0; + *pbl = 0; + *par = 0; + *pbr = 0; + *cve = 0; + ae_vector_init(&ties, 0, DT_INT, _state, ae_true); + ae_vector_init(&p1, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + + + /* + * Test for errors in inputs + */ + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=n-1; i++) + { + if( c->ptr.p_int[i]!=0&&c->ptr.p_int[i]!=1 ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + *info = 1; + + /* + * Tie + */ + dstie(a, n, &ties, &tiecount, &p1, &p2, _state); + for(i=0; i<=n-1; i++) + { + if( p2.ptr.p_int[i]!=i ) + { + t = c->ptr.p_int[i]; + c->ptr.p_int[i] = c->ptr.p_int[p2.ptr.p_int[i]]; + c->ptr.p_int[p2.ptr.p_int[i]] = t; + } + } + + /* + * Special case: number of ties is 1. + * + * NOTE: we assume that P[i,j] equals to 0 or 1, + * intermediate values are not allowed. + */ + if( tiecount==1 ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * General case, number of ties > 1 + * + * NOTE: we assume that P[i,j] equals to 0 or 1, + * intermediate values are not allowed. + */ + *pal = 0; + *pbl = 0; + *par = 0; + *pbr = 0; + for(i=0; i<=n-1; i++) + { + if( c->ptr.p_int[i]==0 ) + { + *par = *par+1; + } + if( c->ptr.p_int[i]==1 ) + { + *pbr = *pbr+1; + } + } + koptimal = -1; + cvoptimal = ae_maxrealnumber; + for(k=0; k<=tiecount-2; k++) + { + + /* + * first, obtain information about K-th tie which is + * moved from R-part to L-part + */ + pak = 0; + pbk = 0; + for(i=ties.ptr.p_int[k]; i<=ties.ptr.p_int[k+1]-1; i++) + { + if( c->ptr.p_int[i]==0 ) + { + pak = pak+1; + } + if( c->ptr.p_int[i]==1 ) + { + pbk = pbk+1; + } + } + + /* + * Calculate cross-validation CE + */ + cv = 0; + cv = cv-bdss_xlny(*pal+pak, (*pal+pak)/(*pal+pak+(*pbl)+pbk+1), _state); + cv = cv-bdss_xlny(*pbl+pbk, (*pbl+pbk)/(*pal+pak+1+(*pbl)+pbk), _state); + cv = cv-bdss_xlny(*par-pak, (*par-pak)/(*par-pak+(*pbr)-pbk+1), _state); + cv = cv-bdss_xlny(*pbr-pbk, (*pbr-pbk)/(*par-pak+1+(*pbr)-pbk), _state); + + /* + * Compare with best + */ + if( ae_fp_less(cv,cvoptimal) ) + { + cvoptimal = cv; + koptimal = k; + } + + /* + * update + */ + *pal = *pal+pak; + *pbl = *pbl+pbk; + *par = *par-pak; + *pbr = *pbr-pbk; + } + *cve = cvoptimal; + *threshold = 0.5*(a->ptr.p_double[ties.ptr.p_int[koptimal]]+a->ptr.p_double[ties.ptr.p_int[koptimal+1]]); + *pal = 0; + *pbl = 0; + *par = 0; + *pbr = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_less(a->ptr.p_double[i],*threshold) ) + { + if( c->ptr.p_int[i]==0 ) + { + *pal = *pal+1; + } + else + { + *pbl = *pbl+1; + } + } + else + { + if( c->ptr.p_int[i]==0 ) + { + *par = *par+1; + } + else + { + *pbr = *pbr+1; + } + } + } + s = *pal+(*pbl); + *pal = *pal/s; + *pbl = *pbl/s; + s = *par+(*pbr); + *par = *par/s; + *pbr = *pbr/s; + ae_frame_leave(_state); +} + + +/************************************************************************* +Optimal partition, internal subroutine. Fast version. + +Accepts: + A array[0..N-1] array of attributes array[0..N-1] + C array[0..N-1] array of class labels + TiesBuf array[0..N] temporaries (ties) + CntBuf array[0..2*NC-1] temporaries (counts) + Alpha centering factor (0<=alpha<=1, recommended value - 0.05) + BufR array[0..N-1] temporaries + BufI array[0..N-1] temporaries + +Output: + Info error code (">0"=OK, "<0"=bad) + RMS training set RMS error + CVRMS leave-one-out RMS error + +Note: + content of all arrays is changed by subroutine; + it doesn't allocate temporaries. + + -- ALGLIB -- + Copyright 11.12.2008 by Bochkanov Sergey +*************************************************************************/ +void dsoptimalsplit2fast(/* Real */ ae_vector* a, + /* Integer */ ae_vector* c, + /* Integer */ ae_vector* tiesbuf, + /* Integer */ ae_vector* cntbuf, + /* Real */ ae_vector* bufr, + /* Integer */ ae_vector* bufi, + ae_int_t n, + ae_int_t nc, + double alpha, + ae_int_t* info, + double* threshold, + double* rms, + double* cvrms, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + ae_int_t cl; + ae_int_t tiecount; + double cbest; + double cc; + ae_int_t koptimal; + ae_int_t sl; + ae_int_t sr; + double v; + double w; + double x; + + *info = 0; + *threshold = 0; + *rms = 0; + *cvrms = 0; + + + /* + * Test for errors in inputs + */ + if( n<=0||nc<2 ) + { + *info = -1; + return; + } + for(i=0; i<=n-1; i++) + { + if( c->ptr.p_int[i]<0||c->ptr.p_int[i]>=nc ) + { + *info = -2; + return; + } + } + *info = 1; + + /* + * Tie + */ + dstiefasti(a, c, n, tiesbuf, &tiecount, bufr, bufi, _state); + + /* + * Special case: number of ties is 1. + */ + if( tiecount==1 ) + { + *info = -3; + return; + } + + /* + * General case, number of ties > 1 + */ + for(i=0; i<=2*nc-1; i++) + { + cntbuf->ptr.p_int[i] = 0; + } + for(i=0; i<=n-1; i++) + { + cntbuf->ptr.p_int[nc+c->ptr.p_int[i]] = cntbuf->ptr.p_int[nc+c->ptr.p_int[i]]+1; + } + koptimal = -1; + *threshold = a->ptr.p_double[n-1]; + cbest = ae_maxrealnumber; + sl = 0; + sr = n; + for(k=0; k<=tiecount-2; k++) + { + + /* + * first, move Kth tie from right to left + */ + for(i=tiesbuf->ptr.p_int[k]; i<=tiesbuf->ptr.p_int[k+1]-1; i++) + { + cl = c->ptr.p_int[i]; + cntbuf->ptr.p_int[cl] = cntbuf->ptr.p_int[cl]+1; + cntbuf->ptr.p_int[nc+cl] = cntbuf->ptr.p_int[nc+cl]-1; + } + sl = sl+(tiesbuf->ptr.p_int[k+1]-tiesbuf->ptr.p_int[k]); + sr = sr-(tiesbuf->ptr.p_int[k+1]-tiesbuf->ptr.p_int[k]); + + /* + * Calculate RMS error + */ + v = 0; + for(i=0; i<=nc-1; i++) + { + w = cntbuf->ptr.p_int[i]; + v = v+w*ae_sqr(w/sl-1, _state); + v = v+(sl-w)*ae_sqr(w/sl, _state); + w = cntbuf->ptr.p_int[nc+i]; + v = v+w*ae_sqr(w/sr-1, _state); + v = v+(sr-w)*ae_sqr(w/sr, _state); + } + v = ae_sqrt(v/(nc*n), _state); + + /* + * Compare with best + */ + x = (double)(2*sl)/(double)(sl+sr)-1; + cc = v*(1-alpha+alpha*ae_sqr(x, _state)); + if( ae_fp_less(cc,cbest) ) + { + + /* + * store split + */ + *rms = v; + koptimal = k; + cbest = cc; + + /* + * calculate CVRMS error + */ + *cvrms = 0; + for(i=0; i<=nc-1; i++) + { + if( sl>1 ) + { + w = cntbuf->ptr.p_int[i]; + *cvrms = *cvrms+w*ae_sqr((w-1)/(sl-1)-1, _state); + *cvrms = *cvrms+(sl-w)*ae_sqr(w/(sl-1), _state); + } + else + { + w = cntbuf->ptr.p_int[i]; + *cvrms = *cvrms+w*ae_sqr((double)1/(double)nc-1, _state); + *cvrms = *cvrms+(sl-w)*ae_sqr((double)1/(double)nc, _state); + } + if( sr>1 ) + { + w = cntbuf->ptr.p_int[nc+i]; + *cvrms = *cvrms+w*ae_sqr((w-1)/(sr-1)-1, _state); + *cvrms = *cvrms+(sr-w)*ae_sqr(w/(sr-1), _state); + } + else + { + w = cntbuf->ptr.p_int[nc+i]; + *cvrms = *cvrms+w*ae_sqr((double)1/(double)nc-1, _state); + *cvrms = *cvrms+(sr-w)*ae_sqr((double)1/(double)nc, _state); + } + } + *cvrms = ae_sqrt(*cvrms/(nc*n), _state); + } + } + + /* + * Calculate threshold. + * Code is a bit complicated because there can be such + * numbers that 0.5(A+B) equals to A or B (if A-B=epsilon) + */ + *threshold = 0.5*(a->ptr.p_double[tiesbuf->ptr.p_int[koptimal]]+a->ptr.p_double[tiesbuf->ptr.p_int[koptimal+1]]); + if( ae_fp_less_eq(*threshold,a->ptr.p_double[tiesbuf->ptr.p_int[koptimal]]) ) + { + *threshold = a->ptr.p_double[tiesbuf->ptr.p_int[koptimal+1]]; + } +} + + +/************************************************************************* +Automatic non-optimal discretization, internal subroutine. + + -- ALGLIB -- + Copyright 22.05.2008 by Bochkanov Sergey +*************************************************************************/ +void dssplitk(/* Real */ ae_vector* a, + /* Integer */ ae_vector* c, + ae_int_t n, + ae_int_t nc, + ae_int_t kmax, + ae_int_t* info, + /* Real */ ae_vector* thresholds, + ae_int_t* ni, + double* cve, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _a; + ae_vector _c; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t k; + ae_vector ties; + ae_int_t tiecount; + ae_vector p1; + ae_vector p2; + ae_vector cnt; + double v2; + ae_int_t bestk; + double bestcve; + ae_vector bestsizes; + double curcve; + ae_vector cursizes; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init_copy(&_c, c, _state, ae_true); + c = &_c; + *info = 0; + ae_vector_clear(thresholds); + *ni = 0; + *cve = 0; + ae_vector_init(&ties, 0, DT_INT, _state, ae_true); + ae_vector_init(&p1, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + ae_vector_init(&cnt, 0, DT_INT, _state, ae_true); + ae_vector_init(&bestsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(&cursizes, 0, DT_INT, _state, ae_true); + + + /* + * Test for errors in inputs + */ + if( (n<=0||nc<2)||kmax<2 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=n-1; i++) + { + if( c->ptr.p_int[i]<0||c->ptr.p_int[i]>=nc ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + *info = 1; + + /* + * Tie + */ + dstie(a, n, &ties, &tiecount, &p1, &p2, _state); + for(i=0; i<=n-1; i++) + { + if( p2.ptr.p_int[i]!=i ) + { + k = c->ptr.p_int[i]; + c->ptr.p_int[i] = c->ptr.p_int[p2.ptr.p_int[i]]; + c->ptr.p_int[p2.ptr.p_int[i]] = k; + } + } + + /* + * Special cases + */ + if( tiecount==1 ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * General case: + * 0. allocate arrays + */ + kmax = ae_minint(kmax, tiecount, _state); + ae_vector_set_length(&bestsizes, kmax-1+1, _state); + ae_vector_set_length(&cursizes, kmax-1+1, _state); + ae_vector_set_length(&cnt, nc-1+1, _state); + + /* + * General case: + * 1. prepare "weak" solution (two subintervals, divided at median) + */ + v2 = ae_maxrealnumber; + j = -1; + for(i=1; i<=tiecount-1; i++) + { + if( ae_fp_less(ae_fabs(ties.ptr.p_int[i]-0.5*(n-1), _state),v2) ) + { + v2 = ae_fabs(ties.ptr.p_int[i]-0.5*n, _state); + j = i; + } + } + ae_assert(j>0, "DSSplitK: internal error #1!", _state); + bestk = 2; + bestsizes.ptr.p_int[0] = ties.ptr.p_int[j]; + bestsizes.ptr.p_int[1] = n-j; + bestcve = 0; + for(i=0; i<=nc-1; i++) + { + cnt.ptr.p_int[i] = 0; + } + for(i=0; i<=j-1; i++) + { + bdss_tieaddc(c, &ties, i, nc, &cnt, _state); + } + bestcve = bestcve+bdss_getcv(&cnt, nc, _state); + for(i=0; i<=nc-1; i++) + { + cnt.ptr.p_int[i] = 0; + } + for(i=j; i<=tiecount-1; i++) + { + bdss_tieaddc(c, &ties, i, nc, &cnt, _state); + } + bestcve = bestcve+bdss_getcv(&cnt, nc, _state); + + /* + * General case: + * 2. Use greedy algorithm to find sub-optimal split in O(KMax*N) time + */ + for(k=2; k<=kmax; k++) + { + + /* + * Prepare greedy K-interval split + */ + for(i=0; i<=k-1; i++) + { + cursizes.ptr.p_int[i] = 0; + } + i = 0; + j = 0; + while(j<=tiecount-1&&i<=k-1) + { + + /* + * Rule: I-th bin is empty, fill it + */ + if( cursizes.ptr.p_int[i]==0 ) + { + cursizes.ptr.p_int[i] = ties.ptr.p_int[j+1]-ties.ptr.p_int[j]; + j = j+1; + continue; + } + + /* + * Rule: (K-1-I) bins left, (K-1-I) ties left (1 tie per bin); next bin + */ + if( tiecount-j==k-1-i ) + { + i = i+1; + continue; + } + + /* + * Rule: last bin, always place in current + */ + if( i==k-1 ) + { + cursizes.ptr.p_int[i] = cursizes.ptr.p_int[i]+ties.ptr.p_int[j+1]-ties.ptr.p_int[j]; + j = j+1; + continue; + } + + /* + * Place J-th tie in I-th bin, or leave for I+1-th bin. + */ + if( ae_fp_less(ae_fabs(cursizes.ptr.p_int[i]+ties.ptr.p_int[j+1]-ties.ptr.p_int[j]-(double)n/(double)k, _state),ae_fabs(cursizes.ptr.p_int[i]-(double)n/(double)k, _state)) ) + { + cursizes.ptr.p_int[i] = cursizes.ptr.p_int[i]+ties.ptr.p_int[j+1]-ties.ptr.p_int[j]; + j = j+1; + } + else + { + i = i+1; + } + } + ae_assert(cursizes.ptr.p_int[k-1]!=0&&j==tiecount, "DSSplitK: internal error #1", _state); + + /* + * Calculate CVE + */ + curcve = 0; + j = 0; + for(i=0; i<=k-1; i++) + { + for(j1=0; j1<=nc-1; j1++) + { + cnt.ptr.p_int[j1] = 0; + } + for(j1=j; j1<=j+cursizes.ptr.p_int[i]-1; j1++) + { + cnt.ptr.p_int[c->ptr.p_int[j1]] = cnt.ptr.p_int[c->ptr.p_int[j1]]+1; + } + curcve = curcve+bdss_getcv(&cnt, nc, _state); + j = j+cursizes.ptr.p_int[i]; + } + + /* + * Choose best variant + */ + if( ae_fp_less(curcve,bestcve) ) + { + for(i=0; i<=k-1; i++) + { + bestsizes.ptr.p_int[i] = cursizes.ptr.p_int[i]; + } + bestcve = curcve; + bestk = k; + } + } + + /* + * Transform from sizes to thresholds + */ + *cve = bestcve; + *ni = bestk; + ae_vector_set_length(thresholds, *ni-2+1, _state); + j = bestsizes.ptr.p_int[0]; + for(i=1; i<=bestk-1; i++) + { + thresholds->ptr.p_double[i-1] = 0.5*(a->ptr.p_double[j-1]+a->ptr.p_double[j]); + j = j+bestsizes.ptr.p_int[i]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Automatic optimal discretization, internal subroutine. + + -- ALGLIB -- + Copyright 22.05.2008 by Bochkanov Sergey +*************************************************************************/ +void dsoptimalsplitk(/* Real */ ae_vector* a, + /* Integer */ ae_vector* c, + ae_int_t n, + ae_int_t nc, + ae_int_t kmax, + ae_int_t* info, + /* Real */ ae_vector* thresholds, + ae_int_t* ni, + double* cve, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _a; + ae_vector _c; + ae_int_t i; + ae_int_t j; + ae_int_t s; + ae_int_t jl; + ae_int_t jr; + double v2; + ae_vector ties; + ae_int_t tiecount; + ae_vector p1; + ae_vector p2; + double cvtemp; + ae_vector cnt; + ae_vector cnt2; + ae_matrix cv; + ae_matrix splits; + ae_int_t k; + ae_int_t koptimal; + double cvoptimal; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init_copy(&_c, c, _state, ae_true); + c = &_c; + *info = 0; + ae_vector_clear(thresholds); + *ni = 0; + *cve = 0; + ae_vector_init(&ties, 0, DT_INT, _state, ae_true); + ae_vector_init(&p1, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + ae_vector_init(&cnt, 0, DT_INT, _state, ae_true); + ae_vector_init(&cnt2, 0, DT_INT, _state, ae_true); + ae_matrix_init(&cv, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&splits, 0, 0, DT_INT, _state, ae_true); + + + /* + * Test for errors in inputs + */ + if( (n<=0||nc<2)||kmax<2 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=n-1; i++) + { + if( c->ptr.p_int[i]<0||c->ptr.p_int[i]>=nc ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + *info = 1; + + /* + * Tie + */ + dstie(a, n, &ties, &tiecount, &p1, &p2, _state); + for(i=0; i<=n-1; i++) + { + if( p2.ptr.p_int[i]!=i ) + { + k = c->ptr.p_int[i]; + c->ptr.p_int[i] = c->ptr.p_int[p2.ptr.p_int[i]]; + c->ptr.p_int[p2.ptr.p_int[i]] = k; + } + } + + /* + * Special cases + */ + if( tiecount==1 ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * General case + * Use dynamic programming to find best split in O(KMax*NC*TieCount^2) time + */ + kmax = ae_minint(kmax, tiecount, _state); + ae_matrix_set_length(&cv, kmax-1+1, tiecount-1+1, _state); + ae_matrix_set_length(&splits, kmax-1+1, tiecount-1+1, _state); + ae_vector_set_length(&cnt, nc-1+1, _state); + ae_vector_set_length(&cnt2, nc-1+1, _state); + for(j=0; j<=nc-1; j++) + { + cnt.ptr.p_int[j] = 0; + } + for(j=0; j<=tiecount-1; j++) + { + bdss_tieaddc(c, &ties, j, nc, &cnt, _state); + splits.ptr.pp_int[0][j] = 0; + cv.ptr.pp_double[0][j] = bdss_getcv(&cnt, nc, _state); + } + for(k=1; k<=kmax-1; k++) + { + for(j=0; j<=nc-1; j++) + { + cnt.ptr.p_int[j] = 0; + } + + /* + * Subtask size J in [K..TieCount-1]: + * optimal K-splitting on ties from 0-th to J-th. + */ + for(j=k; j<=tiecount-1; j++) + { + + /* + * Update Cnt - let it contain classes of ties from K-th to J-th + */ + bdss_tieaddc(c, &ties, j, nc, &cnt, _state); + + /* + * Search for optimal split point S in [K..J] + */ + for(i=0; i<=nc-1; i++) + { + cnt2.ptr.p_int[i] = cnt.ptr.p_int[i]; + } + cv.ptr.pp_double[k][j] = cv.ptr.pp_double[k-1][j-1]+bdss_getcv(&cnt2, nc, _state); + splits.ptr.pp_int[k][j] = j; + for(s=k+1; s<=j; s++) + { + + /* + * Update Cnt2 - let it contain classes of ties from S-th to J-th + */ + bdss_tiesubc(c, &ties, s-1, nc, &cnt2, _state); + + /* + * Calculate CVE + */ + cvtemp = cv.ptr.pp_double[k-1][s-1]+bdss_getcv(&cnt2, nc, _state); + if( ae_fp_less(cvtemp,cv.ptr.pp_double[k][j]) ) + { + cv.ptr.pp_double[k][j] = cvtemp; + splits.ptr.pp_int[k][j] = s; + } + } + } + } + + /* + * Choose best partition, output result + */ + koptimal = -1; + cvoptimal = ae_maxrealnumber; + for(k=0; k<=kmax-1; k++) + { + if( ae_fp_less(cv.ptr.pp_double[k][tiecount-1],cvoptimal) ) + { + cvoptimal = cv.ptr.pp_double[k][tiecount-1]; + koptimal = k; + } + } + ae_assert(koptimal>=0, "DSOptimalSplitK: internal error #1!", _state); + if( koptimal==0 ) + { + + /* + * Special case: best partition is one big interval. + * Even 2-partition is not better. + * This is possible when dealing with "weak" predictor variables. + * + * Make binary split as close to the median as possible. + */ + v2 = ae_maxrealnumber; + j = -1; + for(i=1; i<=tiecount-1; i++) + { + if( ae_fp_less(ae_fabs(ties.ptr.p_int[i]-0.5*(n-1), _state),v2) ) + { + v2 = ae_fabs(ties.ptr.p_int[i]-0.5*(n-1), _state); + j = i; + } + } + ae_assert(j>0, "DSOptimalSplitK: internal error #2!", _state); + ae_vector_set_length(thresholds, 0+1, _state); + thresholds->ptr.p_double[0] = 0.5*(a->ptr.p_double[ties.ptr.p_int[j-1]]+a->ptr.p_double[ties.ptr.p_int[j]]); + *ni = 2; + *cve = 0; + for(i=0; i<=nc-1; i++) + { + cnt.ptr.p_int[i] = 0; + } + for(i=0; i<=j-1; i++) + { + bdss_tieaddc(c, &ties, i, nc, &cnt, _state); + } + *cve = *cve+bdss_getcv(&cnt, nc, _state); + for(i=0; i<=nc-1; i++) + { + cnt.ptr.p_int[i] = 0; + } + for(i=j; i<=tiecount-1; i++) + { + bdss_tieaddc(c, &ties, i, nc, &cnt, _state); + } + *cve = *cve+bdss_getcv(&cnt, nc, _state); + } + else + { + + /* + * General case: 2 or more intervals + * + * NOTE: we initialize both JL and JR (left and right bounds), + * altough algorithm needs only JL. + */ + ae_vector_set_length(thresholds, koptimal-1+1, _state); + *ni = koptimal+1; + *cve = cv.ptr.pp_double[koptimal][tiecount-1]; + jl = splits.ptr.pp_int[koptimal][tiecount-1]; + jr = tiecount-1; + for(k=koptimal; k>=1; k--) + { + thresholds->ptr.p_double[k-1] = 0.5*(a->ptr.p_double[ties.ptr.p_int[jl-1]]+a->ptr.p_double[ties.ptr.p_int[jl]]); + jr = jl-1; + jl = splits.ptr.pp_int[k-1][jl-1]; + } + touchint(&jr, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal function +*************************************************************************/ +static double bdss_xlny(double x, double y, ae_state *_state) +{ + double result; + + + if( ae_fp_eq(x,0) ) + { + result = 0; + } + else + { + result = x*ae_log(y, _state); + } + return result; +} + + +/************************************************************************* +Internal function, +returns number of samples of class I in Cnt[I] +*************************************************************************/ +static double bdss_getcv(/* Integer */ ae_vector* cnt, + ae_int_t nc, + ae_state *_state) +{ + ae_int_t i; + double s; + double result; + + + s = 0; + for(i=0; i<=nc-1; i++) + { + s = s+cnt->ptr.p_int[i]; + } + result = 0; + for(i=0; i<=nc-1; i++) + { + result = result-bdss_xlny(cnt->ptr.p_int[i], cnt->ptr.p_int[i]/(s+nc-1), _state); + } + return result; +} + + +/************************************************************************* +Internal function, adds number of samples of class I in tie NTie to Cnt[I] +*************************************************************************/ +static void bdss_tieaddc(/* Integer */ ae_vector* c, + /* Integer */ ae_vector* ties, + ae_int_t ntie, + ae_int_t nc, + /* Integer */ ae_vector* cnt, + ae_state *_state) +{ + ae_int_t i; + + + for(i=ties->ptr.p_int[ntie]; i<=ties->ptr.p_int[ntie+1]-1; i++) + { + cnt->ptr.p_int[c->ptr.p_int[i]] = cnt->ptr.p_int[c->ptr.p_int[i]]+1; + } +} + + +/************************************************************************* +Internal function, subtracts number of samples of class I in tie NTie to Cnt[I] +*************************************************************************/ +static void bdss_tiesubc(/* Integer */ ae_vector* c, + /* Integer */ ae_vector* ties, + ae_int_t ntie, + ae_int_t nc, + /* Integer */ ae_vector* cnt, + ae_state *_state) +{ + ae_int_t i; + + + for(i=ties->ptr.p_int[ntie]; i<=ties->ptr.p_int[ntie+1]-1; i++) + { + cnt->ptr.p_int[c->ptr.p_int[i]] = cnt->ptr.p_int[c->ptr.p_int[i]]-1; + } +} + + +ae_bool _cvreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + cvreport *p = (cvreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _cvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + cvreport *dst = (cvreport*)_dst; + cvreport *src = (cvreport*)_src; + dst->relclserror = src->relclserror; + dst->avgce = src->avgce; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + return ae_true; +} + + +void _cvreport_clear(void* _p) +{ + cvreport *p = (cvreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _cvreport_destroy(void* _p) +{ + cvreport *p = (cvreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* +This function initializes clusterizer object. Newly initialized object is +empty, i.e. it does not contain dataset. You should use it as follows: +1. creation +2. dataset is added with ClusterizerSetPoints() +3. additional parameters are set +3. clusterization is performed with one of the clustering functions + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizercreate(clusterizerstate* s, ae_state *_state) +{ + + _clusterizerstate_clear(s); + + s->npoints = 0; + s->nfeatures = 0; + s->disttype = 2; + s->ahcalgo = 0; + s->kmeansrestarts = 1; + s->kmeansmaxits = 0; +} + + +/************************************************************************* +This function adds dataset to the clusterizer structure. + +This function overrides all previous calls of ClusterizerSetPoints() or +ClusterizerSetDistances(). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + XY - array[NPoints,NFeatures], dataset + NPoints - number of points, >=0 + NFeatures- number of features, >=1 + DistType- distance function: + * 0 Chebyshev distance (L-inf norm) + * 1 city block distance (L1 norm) + * 2 Euclidean distance (L2 norm) + * 10 Pearson correlation: + dist(a,b) = 1-corr(a,b) + * 11 Absolute Pearson correlation: + dist(a,b) = 1-|corr(a,b)| + * 12 Uncentered Pearson correlation (cosine of the angle): + dist(a,b) = a'*b/(|a|*|b|) + * 13 Absolute uncentered Pearson correlation + dist(a,b) = |a'*b|/(|a|*|b|) + * 20 Spearman rank correlation: + dist(a,b) = 1-rankcorr(a,b) + * 21 Absolute Spearman rank correlation + dist(a,b) = 1-|rankcorr(a,b)| + +NOTE 1: different distance functions have different performance penalty: + * Euclidean or Pearson correlation distances are the fastest ones + * Spearman correlation distance function is a bit slower + * city block and Chebyshev distances are order of magnitude slower + + The reason behing difference in performance is that correlation-based + distance functions are computed using optimized linear algebra kernels, + while Chebyshev and city block distance functions are computed using + simple nested loops with two branches at each iteration. + +NOTE 2: different clustering algorithms have different limitations: + * agglomerative hierarchical clustering algorithms may be used with + any kind of distance metric + * k-means++ clustering algorithm may be used only with Euclidean + distance function + Thus, list of specific clustering algorithms you may use depends + on distance function you specify when you set your dataset. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetpoints(clusterizerstate* s, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_int_t disttype, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert((((((((disttype==0||disttype==1)||disttype==2)||disttype==10)||disttype==11)||disttype==12)||disttype==13)||disttype==20)||disttype==21, "ClusterizerSetPoints: incorrect DistType", _state); + ae_assert(npoints>=0, "ClusterizerSetPoints: NPoints<0", _state); + ae_assert(nfeatures>=1, "ClusterizerSetPoints: NFeatures<1", _state); + ae_assert(xy->rows>=npoints, "ClusterizerSetPoints: Rows(XY)cols>=nfeatures, "ClusterizerSetPoints: Cols(XY)npoints = npoints; + s->nfeatures = nfeatures; + s->disttype = disttype; + rmatrixsetlengthatleast(&s->xy, npoints, nfeatures, _state); + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&s->xy.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1)); + } +} + + +/************************************************************************* +This function adds dataset given by distance matrix to the clusterizer +structure. It is important that dataset is not given explicitly - only +distance matrix is given. + +This function overrides all previous calls of ClusterizerSetPoints() or +ClusterizerSetDistances(). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + D - array[NPoints,NPoints], distance matrix given by its upper + or lower triangle (main diagonal is ignored because its + entries are expected to be zero). + NPoints - number of points + IsUpper - whether upper or lower triangle of D is given. + +NOTE 1: different clustering algorithms have different limitations: + * agglomerative hierarchical clustering algorithms may be used with + any kind of distance metric, including one which is given by + distance matrix + * k-means++ clustering algorithm may be used only with Euclidean + distance function and explicitly given points - it can not be + used with dataset given by distance matrix + Thus, if you call this function, you will be unable to use k-means + clustering algorithm to process your problem. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetdistances(clusterizerstate* s, + /* Real */ ae_matrix* d, + ae_int_t npoints, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t j0; + ae_int_t j1; + + + ae_assert(npoints>=0, "ClusterizerSetDistances: NPoints<0", _state); + ae_assert(d->rows>=npoints, "ClusterizerSetDistances: Rows(D)cols>=npoints, "ClusterizerSetDistances: Cols(D)npoints = npoints; + s->nfeatures = 0; + s->disttype = -1; + rmatrixsetlengthatleast(&s->d, npoints, npoints, _state); + for(i=0; i<=npoints-1; i++) + { + if( isupper ) + { + j0 = i+1; + j1 = npoints-1; + } + else + { + j0 = 0; + j1 = i-1; + } + for(j=j0; j<=j1; j++) + { + ae_assert(ae_isfinite(d->ptr.pp_double[i][j], _state)&&ae_fp_greater_eq(d->ptr.pp_double[i][j],0), "ClusterizerSetDistances: D contains infinite, NAN or negative elements", _state); + s->d.ptr.pp_double[i][j] = d->ptr.pp_double[i][j]; + s->d.ptr.pp_double[j][i] = d->ptr.pp_double[i][j]; + } + s->d.ptr.pp_double[i][i] = 0; + } +} + + +/************************************************************************* +This function sets agglomerative hierarchical clustering algorithm + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + Algo - algorithm type: + * 0 complete linkage (default algorithm) + * 1 single linkage + * 2 unweighted average linkage + * 3 weighted average linkage + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetahcalgo(clusterizerstate* s, + ae_int_t algo, + ae_state *_state) +{ + + + ae_assert(((algo==0||algo==1)||algo==2)||algo==3, "ClusterizerSetHCAlgo: incorrect algorithm type", _state); + s->ahcalgo = algo; +} + + +/************************************************************************* +This function sets k-means++ properties : number of restarts and maximum +number of iterations per one run. + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + Restarts- restarts count, >=1. + k-means++ algorithm performs several restarts and chooses + best set of centers (one with minimum squared distance). + MaxIts - maximum number of k-means iterations performed during one + run. >=0, zero value means that algorithm performs unlimited + number of iterations. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetkmeanslimits(clusterizerstate* s, + ae_int_t restarts, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(restarts>=1, "ClusterizerSetKMeansLimits: Restarts<=0", _state); + ae_assert(maxits>=0, "ClusterizerSetKMeansLimits: MaxIts<0", _state); + s->kmeansrestarts = restarts; + s->kmeansmaxits = maxits; +} + + +/************************************************************************* +This function performs agglomerative hierarchical clustering + +FOR USERS OF SMP EDITION: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Multicore version is pretty efficient on large + ! problems which need more than 1.000.000 operations to be solved, + ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU + ! cycles), but gives no speed-up for small problems (less than 100.000 + ! operations). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + +OUTPUT PARAMETERS: + Rep - clustering results; see description of AHCReport + structure for more information. + +NOTE 1: hierarchical clustering algorithms require large amounts of memory. + In particular, this implementation needs sizeof(double)*NPoints^2 + bytes, which are used to store distance matrix. In case we work + with user-supplied matrix, this amount is multiplied by 2 (we have + to store original matrix and to work with its copy). + + For example, problem with 10000 points would require 800M of RAM, + even when working in a 1-dimensional space. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizerrunahc(clusterizerstate* s, + ahcreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t npoints; + ae_int_t nfeatures; + ae_matrix d; + + ae_frame_make(_state, &_frame_block); + _ahcreport_clear(rep); + ae_matrix_init(&d, 0, 0, DT_REAL, _state, ae_true); + + npoints = s->npoints; + nfeatures = s->nfeatures; + + /* + * Fill Rep.NPoints, quick exit when NPoints<=1 + */ + rep->npoints = npoints; + if( npoints==0 ) + { + ae_vector_set_length(&rep->p, 0, _state); + ae_matrix_set_length(&rep->z, 0, 0, _state); + ae_matrix_set_length(&rep->pz, 0, 0, _state); + ae_matrix_set_length(&rep->pm, 0, 0, _state); + ae_vector_set_length(&rep->mergedist, 0, _state); + ae_frame_leave(_state); + return; + } + if( npoints==1 ) + { + ae_vector_set_length(&rep->p, 1, _state); + ae_matrix_set_length(&rep->z, 0, 0, _state); + ae_matrix_set_length(&rep->pz, 0, 0, _state); + ae_matrix_set_length(&rep->pm, 0, 0, _state); + ae_vector_set_length(&rep->mergedist, 0, _state); + rep->p.ptr.p_int[0] = 0; + ae_frame_leave(_state); + return; + } + + /* + * More than one point + */ + if( s->disttype==-1 ) + { + + /* + * Run clusterizer with user-supplied distance matrix + */ + clustering_clusterizerrunahcinternal(s, &s->d, rep, _state); + ae_frame_leave(_state); + return; + } + else + { + + /* + * Build distance matrix D. + */ + clusterizergetdistances(&s->xy, npoints, nfeatures, s->disttype, &d, _state); + + /* + * Run clusterizer + */ + clustering_clusterizerrunahcinternal(s, &d, rep, _state); + ae_frame_leave(_state); + return; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_clusterizerrunahc(clusterizerstate* s, + ahcreport* rep, ae_state *_state) +{ + clusterizerrunahc(s,rep, _state); +} + + +/************************************************************************* +This function performs clustering by k-means++ algorithm. + +You may change algorithm properties like number of restarts or iterations +limit by calling ClusterizerSetKMeansLimits() functions. + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + K - number of clusters, K>=0. + K can be zero only when algorithm is called for empty + dataset, in this case completion code is set to + success (+1). + If K=0 and dataset size is non-zero, we can not + meaningfully assign points to some center (there are no + centers because K=0) and return -3 as completion code + (failure). + +OUTPUT PARAMETERS: + Rep - clustering results; see description of KMeansReport + structure for more information. + +NOTE 1: k-means clustering can be performed only for datasets with + Euclidean distance function. Algorithm will return negative + completion code in Rep.TerminationType in case dataset was added + to clusterizer with DistType other than Euclidean (or dataset was + specified by distance matrix instead of explicitly given points). + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizerrunkmeans(clusterizerstate* s, + ae_int_t k, + kmeansreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix dummy; + + ae_frame_make(_state, &_frame_block); + _kmeansreport_clear(rep); + ae_matrix_init(&dummy, 0, 0, DT_REAL, _state, ae_true); + + ae_assert(k>=0, "ClusterizerRunKMeans: K<0", _state); + + /* + * Incorrect distance type + */ + if( s->disttype!=2 ) + { + rep->npoints = s->npoints; + rep->terminationtype = -5; + rep->k = k; + ae_frame_leave(_state); + return; + } + + /* + * K>NPoints or (K=0 and NPoints>0) + */ + if( k>s->npoints||(k==0&&s->npoints>0) ) + { + rep->npoints = s->npoints; + rep->terminationtype = -3; + rep->k = k; + ae_frame_leave(_state); + return; + } + + /* + * No points + */ + if( s->npoints==0 ) + { + rep->npoints = 0; + rep->terminationtype = 1; + rep->k = k; + ae_frame_leave(_state); + return; + } + + /* + * Normal case: + * 1<=K<=NPoints, Euclidean distance + */ + rep->npoints = s->npoints; + rep->nfeatures = s->nfeatures; + rep->k = k; + rep->npoints = s->npoints; + rep->nfeatures = s->nfeatures; + kmeansgenerateinternal(&s->xy, s->npoints, s->nfeatures, k, s->kmeansmaxits, s->kmeansrestarts, &rep->terminationtype, &dummy, ae_false, &rep->c, ae_true, &rep->cidx, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function returns distance matrix for dataset + +FOR USERS OF SMP EDITION: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Multicore version is pretty efficient on large + ! problems which need more than 1.000.000 operations to be solved, + ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU + ! cycles), but gives no speed-up for small problems (less than 100.000 + ! operations). + +INPUT PARAMETERS: + XY - array[NPoints,NFeatures], dataset + NPoints - number of points, >=0 + NFeatures- number of features, >=1 + DistType- distance function: + * 0 Chebyshev distance (L-inf norm) + * 1 city block distance (L1 norm) + * 2 Euclidean distance (L2 norm) + * 10 Pearson correlation: + dist(a,b) = 1-corr(a,b) + * 11 Absolute Pearson correlation: + dist(a,b) = 1-|corr(a,b)| + * 12 Uncentered Pearson correlation (cosine of the angle): + dist(a,b) = a'*b/(|a|*|b|) + * 13 Absolute uncentered Pearson correlation + dist(a,b) = |a'*b|/(|a|*|b|) + * 20 Spearman rank correlation: + dist(a,b) = 1-rankcorr(a,b) + * 21 Absolute Spearman rank correlation + dist(a,b) = 1-|rankcorr(a,b)| + +OUTPUT PARAMETERS: + D - array[NPoints,NPoints], distance matrix + (full matrix is returned, with lower and upper triangles) + +NOTES: different distance functions have different performance penalty: + * Euclidean or Pearson correlation distances are the fastest ones + * Spearman correlation distance function is a bit slower + * city block and Chebyshev distances are order of magnitude slower + + The reason behing difference in performance is that correlation-based + distance functions are computed using optimized linear algebra kernels, + while Chebyshev and city block distance functions are computed using + simple nested loops with two branches at each iteration. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizergetdistances(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_int_t disttype, + /* Real */ ae_matrix* d, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double v; + double vv; + double vr; + ae_matrix tmpxy; + ae_vector tmpx; + ae_vector tmpy; + ae_vector diagbuf; + apbuffers buf; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(d); + ae_matrix_init(&tmpxy, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpy, 0, DT_REAL, _state, ae_true); + ae_vector_init(&diagbuf, 0, DT_REAL, _state, ae_true); + _apbuffers_init(&buf, _state, ae_true); + + ae_assert(nfeatures>=1, "ClusterizerGetDistances: NFeatures<1", _state); + ae_assert(npoints>=0, "ClusterizerGetDistances: NPoints<1", _state); + ae_assert((((((((disttype==0||disttype==1)||disttype==2)||disttype==10)||disttype==11)||disttype==12)||disttype==13)||disttype==20)||disttype==21, "ClusterizerGetDistances: incorrect DistType", _state); + ae_assert(xy->rows>=npoints, "ClusterizerGetDistances: Rows(XY)cols>=nfeatures, "ClusterizerGetDistances: Cols(XY)ptr.pp_double[0][0] = 0; + ae_frame_leave(_state); + return; + } + + /* + * Build distance matrix D. + */ + if( disttype==0||disttype==1 ) + { + + /* + * Chebyshev or city-block distances: + * * recursively calculate upper triangle (with main diagonal) + * * copy it to the bottom part of the matrix + */ + ae_matrix_set_length(d, npoints, npoints, _state); + clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, 0, npoints, 0, npoints, _state); + rmatrixenforcesymmetricity(d, npoints, ae_true, _state); + ae_frame_leave(_state); + return; + } + if( disttype==2 ) + { + + /* + * Euclidean distance + * + * NOTE: parallelization is done within RMatrixSYRK + */ + ae_matrix_set_length(d, npoints, npoints, _state); + ae_matrix_set_length(&tmpxy, npoints, nfeatures, _state); + ae_vector_set_length(&tmpx, nfeatures, _state); + ae_vector_set_length(&diagbuf, npoints, _state); + for(j=0; j<=nfeatures-1; j++) + { + tmpx.ptr.p_double[j] = 0.0; + } + v = (double)1/(double)npoints; + for(i=0; i<=npoints-1; i++) + { + ae_v_addd(&tmpx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1), v); + } + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&tmpxy.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1)); + ae_v_sub(&tmpxy.ptr.pp_double[i][0], 1, &tmpx.ptr.p_double[0], 1, ae_v_len(0,nfeatures-1)); + } + rmatrixsyrk(npoints, nfeatures, 1.0, &tmpxy, 0, 0, 0, 0.0, d, 0, 0, ae_true, _state); + for(i=0; i<=npoints-1; i++) + { + diagbuf.ptr.p_double[i] = d->ptr.pp_double[i][i]; + } + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + for(j=i+1; j<=npoints-1; j++) + { + v = ae_sqrt(ae_maxreal(diagbuf.ptr.p_double[i]+diagbuf.ptr.p_double[j]-2*d->ptr.pp_double[i][j], 0.0, _state), _state); + d->ptr.pp_double[i][j] = v; + } + } + rmatrixenforcesymmetricity(d, npoints, ae_true, _state); + ae_frame_leave(_state); + return; + } + if( disttype==10||disttype==11 ) + { + + /* + * Absolute/nonabsolute Pearson correlation distance + * + * NOTE: parallelization is done within PearsonCorrM, which calls RMatrixSYRK internally + */ + ae_matrix_set_length(d, npoints, npoints, _state); + ae_vector_set_length(&diagbuf, npoints, _state); + ae_matrix_set_length(&tmpxy, npoints, nfeatures, _state); + for(i=0; i<=npoints-1; i++) + { + v = 0.0; + for(j=0; j<=nfeatures-1; j++) + { + v = v+xy->ptr.pp_double[i][j]; + } + v = v/nfeatures; + for(j=0; j<=nfeatures-1; j++) + { + tmpxy.ptr.pp_double[i][j] = xy->ptr.pp_double[i][j]-v; + } + } + rmatrixsyrk(npoints, nfeatures, 1.0, &tmpxy, 0, 0, 0, 0.0, d, 0, 0, ae_true, _state); + for(i=0; i<=npoints-1; i++) + { + diagbuf.ptr.p_double[i] = d->ptr.pp_double[i][i]; + } + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + for(j=i+1; j<=npoints-1; j++) + { + v = d->ptr.pp_double[i][j]/ae_sqrt(diagbuf.ptr.p_double[i]*diagbuf.ptr.p_double[j], _state); + if( disttype==10 ) + { + v = 1-v; + } + else + { + v = 1-ae_fabs(v, _state); + } + v = ae_maxreal(v, 0.0, _state); + d->ptr.pp_double[i][j] = v; + } + } + rmatrixenforcesymmetricity(d, npoints, ae_true, _state); + ae_frame_leave(_state); + return; + } + if( disttype==12||disttype==13 ) + { + + /* + * Absolute/nonabsolute uncentered Pearson correlation distance + * + * NOTE: parallelization is done within RMatrixSYRK + */ + ae_matrix_set_length(d, npoints, npoints, _state); + ae_vector_set_length(&diagbuf, npoints, _state); + rmatrixsyrk(npoints, nfeatures, 1.0, xy, 0, 0, 0, 0.0, d, 0, 0, ae_true, _state); + for(i=0; i<=npoints-1; i++) + { + diagbuf.ptr.p_double[i] = d->ptr.pp_double[i][i]; + } + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + for(j=i+1; j<=npoints-1; j++) + { + v = d->ptr.pp_double[i][j]/ae_sqrt(diagbuf.ptr.p_double[i]*diagbuf.ptr.p_double[j], _state); + if( disttype==13 ) + { + v = ae_fabs(v, _state); + } + v = ae_minreal(v, 1.0, _state); + d->ptr.pp_double[i][j] = 1-v; + } + } + rmatrixenforcesymmetricity(d, npoints, ae_true, _state); + ae_frame_leave(_state); + return; + } + if( disttype==20||disttype==21 ) + { + + /* + * Spearman rank correlation + * + * NOTE: parallelization of correlation matrix is done within + * PearsonCorrM, which calls RMatrixSYRK internally + */ + ae_matrix_set_length(d, npoints, npoints, _state); + ae_vector_set_length(&diagbuf, npoints, _state); + ae_matrix_set_length(&tmpxy, npoints, nfeatures, _state); + rmatrixcopy(npoints, nfeatures, xy, 0, 0, &tmpxy, 0, 0, _state); + rankdatacentered(&tmpxy, npoints, nfeatures, _state); + rmatrixsyrk(npoints, nfeatures, 1.0, &tmpxy, 0, 0, 0, 0.0, d, 0, 0, ae_true, _state); + for(i=0; i<=npoints-1; i++) + { + if( ae_fp_greater(d->ptr.pp_double[i][i],0) ) + { + diagbuf.ptr.p_double[i] = 1/ae_sqrt(d->ptr.pp_double[i][i], _state); + } + else + { + diagbuf.ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=npoints-1; i++) + { + v = diagbuf.ptr.p_double[i]; + d->ptr.pp_double[i][i] = 0.0; + for(j=i+1; j<=npoints-1; j++) + { + vv = d->ptr.pp_double[i][j]*v*diagbuf.ptr.p_double[j]; + if( disttype==20 ) + { + vr = 1-vv; + } + else + { + vr = 1-ae_fabs(vv, _state); + } + if( ae_fp_less(vr,0) ) + { + vr = 0.0; + } + d->ptr.pp_double[i][j] = vr; + } + } + rmatrixenforcesymmetricity(d, npoints, ae_true, _state); + ae_frame_leave(_state); + return; + } + ae_assert(ae_false, "Assertion failed", _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_clusterizergetdistances(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_int_t disttype, + /* Real */ ae_matrix* d, ae_state *_state) +{ + clusterizergetdistances(xy,npoints,nfeatures,disttype,d, _state); +} + + +/************************************************************************* +This function takes as input clusterization report Rep, desired clusters +count K, and builds top K clusters from hierarchical clusterization tree. +It returns assignment of points to clusters (array of cluster indexes). + +INPUT PARAMETERS: + Rep - report from ClusterizerRunAHC() performed on XY + K - desired number of clusters, 1<=K<=NPoints. + K can be zero only when NPoints=0. + +OUTPUT PARAMETERS: + CIdx - array[NPoints], I-th element contains cluster index (from + 0 to K-1) for I-th point of the dataset. + CZ - array[K]. This array allows to convert cluster indexes + returned by this function to indexes used by Rep.Z. J-th + cluster returned by this function corresponds to CZ[J]-th + cluster stored in Rep.Z/PZ/PM. + It is guaranteed that CZ[I]npoints; + ae_assert(npoints>=0, "ClusterizerGetKClusters: internal error in Rep integrity", _state); + ae_assert(k>=0, "ClusterizerGetKClusters: K<=0", _state); + ae_assert(k<=npoints, "ClusterizerGetKClusters: K>NPoints", _state); + ae_assert(k>0||npoints==0, "ClusterizerGetKClusters: K<=0", _state); + ae_assert(npoints==rep->npoints, "ClusterizerGetKClusters: NPoints<>Rep.NPoints", _state); + + /* + * Quick exit + */ + if( npoints==0 ) + { + ae_frame_leave(_state); + return; + } + if( npoints==1 ) + { + ae_vector_set_length(cz, 1, _state); + ae_vector_set_length(cidx, 1, _state); + cz->ptr.p_int[0] = 0; + cidx->ptr.p_int[0] = 0; + ae_frame_leave(_state); + return; + } + + /* + * Replay merges, from top to bottom, + * keep track of clusters being present at the moment + */ + ae_vector_set_length(&presentclusters, 2*npoints-1, _state); + ae_vector_set_length(&tmpidx, npoints, _state); + for(i=0; i<=2*npoints-3; i++) + { + presentclusters.ptr.p_bool[i] = ae_false; + } + presentclusters.ptr.p_bool[2*npoints-2] = ae_true; + for(i=0; i<=npoints-1; i++) + { + tmpidx.ptr.p_int[i] = 2*npoints-2; + } + for(mergeidx=npoints-2; mergeidx>=npoints-k; mergeidx--) + { + + /* + * Update information about clusters being present at the moment + */ + presentclusters.ptr.p_bool[npoints+mergeidx] = ae_false; + presentclusters.ptr.p_bool[rep->z.ptr.pp_int[mergeidx][0]] = ae_true; + presentclusters.ptr.p_bool[rep->z.ptr.pp_int[mergeidx][1]] = ae_true; + + /* + * Update TmpIdx according to the current state of the dataset + * + * NOTE: TmpIdx contains cluster indexes from [0..2*NPoints-2]; + * we will convert them to [0..K-1] later. + */ + i0 = rep->pm.ptr.pp_int[mergeidx][0]; + i1 = rep->pm.ptr.pp_int[mergeidx][1]; + t = rep->z.ptr.pp_int[mergeidx][0]; + for(i=i0; i<=i1; i++) + { + tmpidx.ptr.p_int[i] = t; + } + i0 = rep->pm.ptr.pp_int[mergeidx][2]; + i1 = rep->pm.ptr.pp_int[mergeidx][3]; + t = rep->z.ptr.pp_int[mergeidx][1]; + for(i=i0; i<=i1; i++) + { + tmpidx.ptr.p_int[i] = t; + } + } + + /* + * Fill CZ - array which allows us to convert cluster indexes + * from one system to another. + */ + ae_vector_set_length(cz, k, _state); + ae_vector_set_length(&clusterindexes, 2*npoints-1, _state); + t = 0; + for(i=0; i<=2*npoints-2; i++) + { + if( presentclusters.ptr.p_bool[i] ) + { + cz->ptr.p_int[t] = i; + clusterindexes.ptr.p_int[i] = t; + t = t+1; + } + } + ae_assert(t==k, "ClusterizerGetKClusters: internal error", _state); + + /* + * Convert indexes stored in CIdx + */ + ae_vector_set_length(cidx, npoints, _state); + for(i=0; i<=npoints-1; i++) + { + cidx->ptr.p_int[i] = clusterindexes.ptr.p_int[tmpidx.ptr.p_int[rep->p.ptr.p_int[i]]]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function accepts AHC report Rep, desired minimum intercluster +distance and returns top clusters from hierarchical clusterization tree +which are separated by distance R or HIGHER. + +It returns assignment of points to clusters (array of cluster indexes). + +There is one more function with similar name - ClusterizerSeparatedByCorr, +which returns clusters with intercluster correlation equal to R or LOWER +(note: higher for distance, lower for correlation). + +INPUT PARAMETERS: + Rep - report from ClusterizerRunAHC() performed on XY + R - desired minimum intercluster distance, R>=0 + +OUTPUT PARAMETERS: + K - number of clusters, 1<=K<=NPoints + CIdx - array[NPoints], I-th element contains cluster index (from + 0 to K-1) for I-th point of the dataset. + CZ - array[K]. This array allows to convert cluster indexes + returned by this function to indexes used by Rep.Z. J-th + cluster returned by this function corresponds to CZ[J]-th + cluster stored in Rep.Z/PZ/PM. + It is guaranteed that CZ[I]npoints&&ae_fp_greater_eq(rep->mergedist.ptr.p_double[rep->npoints-1-(*k)],r)) + { + *k = *k+1; + } + clusterizergetkclusters(rep, *k, cidx, cz, _state); +} + + +/************************************************************************* +This function accepts AHC report Rep, desired maximum intercluster +correlation and returns top clusters from hierarchical clusterization tree +which are separated by correlation R or LOWER. + +It returns assignment of points to clusters (array of cluster indexes). + +There is one more function with similar name - ClusterizerSeparatedByDist, +which returns clusters with intercluster distance equal to R or HIGHER +(note: higher for distance, lower for correlation). + +INPUT PARAMETERS: + Rep - report from ClusterizerRunAHC() performed on XY + R - desired maximum intercluster correlation, -1<=R<=+1 + +OUTPUT PARAMETERS: + K - number of clusters, 1<=K<=NPoints + CIdx - array[NPoints], I-th element contains cluster index (from + 0 to K-1) for I-th point of the dataset. + CZ - array[K]. This array allows to convert cluster indexes + returned by this function to indexes used by Rep.Z. J-th + cluster returned by this function corresponds to CZ[J]-th + cluster stored in Rep.Z/PZ/PM. + It is guaranteed that CZ[I]npoints&&ae_fp_greater_eq(rep->mergedist.ptr.p_double[rep->npoints-1-(*k)],1-r)) + { + *k = *k+1; + } + clusterizergetkclusters(rep, *k, cidx, cz, _state); +} + + +/************************************************************************* +K-means++ clusterization + +INPUT PARAMETERS: + XY - dataset, array [0..NPoints-1,0..NVars-1]. + NPoints - dataset size, NPoints>=K + NVars - number of variables, NVars>=1 + K - desired number of clusters, K>=1 + Restarts - number of restarts, Restarts>=1 + +OUTPUT PARAMETERS: + Info - return code: + * -3, if task is degenerate (number of distinct points is + less than K) + * -1, if incorrect NPoints/NFeatures/K/Restarts was passed + * 1, if subroutine finished successfully + CCol - array[0..NVars-1,0..K-1].matrix whose columns store + cluster's centers + NeedCCol - True in case caller requires to store result in CCol + CRow - array[0..K-1,0..NVars-1], same as CCol, but centers are + stored in rows + NeedCRow - True in case caller requires to store result in CCol + XYC - array[NPoints], which contains cluster indexes + + -- ALGLIB -- + Copyright 21.03.2009 by Bochkanov Sergey +*************************************************************************/ +void kmeansgenerateinternal(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t k, + ae_int_t maxits, + ae_int_t restarts, + ae_int_t* info, + /* Real */ ae_matrix* ccol, + ae_bool needccol, + /* Real */ ae_matrix* crow, + ae_bool needcrow, + /* Integer */ ae_vector* xyc, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_matrix ct; + ae_matrix ctbest; + ae_vector xycbest; + double e; + double eprev; + double ebest; + ae_vector x; + ae_vector tmp; + ae_vector d2; + ae_vector p; + ae_vector csizes; + ae_vector cbusy; + double v; + ae_int_t cclosest; + double dclosest; + ae_vector work; + ae_bool waschanges; + ae_bool zerosizeclusters; + ae_int_t pass; + ae_int_t itcnt; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_matrix_clear(ccol); + ae_matrix_clear(crow); + ae_vector_clear(xyc); + ae_matrix_init(&ct, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&ctbest, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xycbest, 0, DT_INT, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_REAL, _state, ae_true); + ae_vector_init(&csizes, 0, DT_INT, _state, ae_true); + ae_vector_init(&cbusy, 0, DT_BOOL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + _hqrndstate_init(&rs, _state, ae_true); + + + /* + * Test parameters + */ + if( ((npointsptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + cbusy.ptr.p_bool[0] = ae_true; + for(i=1; i<=k-1; i++) + { + cbusy.ptr.p_bool[i] = ae_false; + } + if( !clustering_selectcenterpp(xy, npoints, nvars, &ct, &cbusy, k, &d2, &p, &tmp, _state) ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Update centers: + * 2. update center positions + */ + for(i=0; i<=npoints-1; i++) + { + xyc->ptr.p_int[i] = -1; + } + eprev = ae_maxrealnumber; + itcnt = 0; + e = 0; + while(maxits==0||itcntptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + ae_v_sub(&tmp.ptr.p_double[0], 1, &ct.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); + v = ae_v_dotproduct(&tmp.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); + if( ae_fp_less(v,dclosest) ) + { + cclosest = j; + dclosest = v; + } + } + if( xyc->ptr.p_int[i]!=cclosest ) + { + waschanges = ae_true; + } + xyc->ptr.p_int[i] = cclosest; + } + + /* + * Update centers + */ + for(j=0; j<=k-1; j++) + { + csizes.ptr.p_int[j] = 0; + } + for(i=0; i<=k-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + ct.ptr.pp_double[i][j] = 0; + } + } + for(i=0; i<=npoints-1; i++) + { + csizes.ptr.p_int[xyc->ptr.p_int[i]] = csizes.ptr.p_int[xyc->ptr.p_int[i]]+1; + ae_v_add(&ct.ptr.pp_double[xyc->ptr.p_int[i]][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + } + zerosizeclusters = ae_false; + for(j=0; j<=k-1; j++) + { + if( csizes.ptr.p_int[j]!=0 ) + { + v = (double)1/(double)csizes.ptr.p_int[j]; + ae_v_muld(&ct.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1), v); + } + cbusy.ptr.p_bool[j] = csizes.ptr.p_int[j]!=0; + zerosizeclusters = zerosizeclusters||csizes.ptr.p_int[j]==0; + } + if( zerosizeclusters ) + { + + /* + * Some clusters have zero size - rare, but possible. + * We'll choose new centers for such clusters using k-means++ rule + * and restart algorithm + */ + if( !clustering_selectcenterpp(xy, npoints, nvars, &ct, &cbusy, k, &d2, &p, &tmp, _state) ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + continue; + } + + /* + * Stop if one of two conditions is met: + * 1. nothing has changed during iteration + * 2. energy function increased + */ + e = 0; + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + ae_v_sub(&tmp.ptr.p_double[0], 1, &ct.ptr.pp_double[xyc->ptr.p_int[i]][0], 1, ae_v_len(0,nvars-1)); + v = ae_v_dotproduct(&tmp.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); + e = e+v; + } + if( !waschanges||ae_fp_greater_eq(e,eprev) ) + { + break; + } + + /* + * Update EPrev + */ + eprev = e; + } + + /* + * 3. Calculate E, compare with best centers found so far + */ + if( ae_fp_less(e,ebest) ) + { + + /* + * store partition. + */ + ebest = e; + copymatrix(&ct, 0, k-1, 0, nvars-1, &ctbest, 0, k-1, 0, nvars-1, _state); + for(i=0; i<=npoints-1; i++) + { + xycbest.ptr.p_int[i] = xyc->ptr.p_int[i]; + } + } + } + + /* + * Copy and transpose + */ + if( needccol ) + { + ae_matrix_set_length(ccol, nvars, k, _state); + copyandtranspose(&ctbest, 0, k-1, 0, nvars-1, ccol, 0, nvars-1, 0, k-1, _state); + } + if( needcrow ) + { + ae_matrix_set_length(crow, k, nvars, _state); + rmatrixcopy(k, nvars, &ctbest, 0, 0, crow, 0, 0, _state); + } + for(i=0; i<=npoints-1; i++) + { + xyc->ptr.p_int[i] = xycbest.ptr.p_int[i]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Select center for a new cluster using k-means++ rule +*************************************************************************/ +static ae_bool clustering_selectcenterpp(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + /* Real */ ae_matrix* centers, + /* Boolean */ ae_vector* busycenters, + ae_int_t ccnt, + /* Real */ ae_vector* d2, + /* Real */ ae_vector* p, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t cc; + double v; + double s; + ae_bool result; + + + result = ae_true; + for(cc=0; cc<=ccnt-1; cc++) + { + if( !busycenters->ptr.p_bool[cc] ) + { + + /* + * fill D2 + */ + for(i=0; i<=npoints-1; i++) + { + d2->ptr.p_double[i] = ae_maxrealnumber; + for(j=0; j<=ccnt-1; j++) + { + if( busycenters->ptr.p_bool[j] ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + ae_v_sub(&tmp->ptr.p_double[0], 1, ¢ers->ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); + v = ae_v_dotproduct(&tmp->ptr.p_double[0], 1, &tmp->ptr.p_double[0], 1, ae_v_len(0,nvars-1)); + if( ae_fp_less(v,d2->ptr.p_double[i]) ) + { + d2->ptr.p_double[i] = v; + } + } + } + } + + /* + * calculate P (non-cumulative) + */ + s = 0; + for(i=0; i<=npoints-1; i++) + { + s = s+d2->ptr.p_double[i]; + } + if( ae_fp_eq(s,0) ) + { + result = ae_false; + return result; + } + s = 1/s; + ae_v_moved(&p->ptr.p_double[0], 1, &d2->ptr.p_double[0], 1, ae_v_len(0,npoints-1), s); + + /* + * choose one of points with probability P + * random number within (0,1) is generated and + * inverse empirical CDF is used to randomly choose a point. + */ + s = 0; + v = ae_randomreal(_state); + for(i=0; i<=npoints-1; i++) + { + s = s+p->ptr.p_double[i]; + if( ae_fp_less_eq(v,s)||i==npoints-1 ) + { + ae_v_move(¢ers->ptr.pp_double[cc][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + busycenters->ptr.p_bool[cc] = ae_true; + break; + } + } + } + } + return result; +} + + +/************************************************************************* +This function performs agglomerative hierarchical clustering using +precomputed distance matrix. Internal function, should not be called +directly. + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + D - distance matrix, array[S.NFeatures,S.NFeatures] + Contents of the matrix is destroyed during + algorithm operation. + +OUTPUT PARAMETERS: + Rep - clustering results; see description of AHCReport + structure for more information. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +static void clustering_clusterizerrunahcinternal(clusterizerstate* s, + /* Real */ ae_matrix* d, + ahcreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double v; + ae_int_t mergeidx; + ae_int_t c0; + ae_int_t c1; + ae_int_t s0; + ae_int_t s1; + ae_int_t ar; + ae_int_t br; + ae_int_t npoints; + ae_vector cidx; + ae_vector csizes; + ae_vector nnidx; + ae_matrix cinfo; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&cidx, 0, DT_INT, _state, ae_true); + ae_vector_init(&csizes, 0, DT_INT, _state, ae_true); + ae_vector_init(&nnidx, 0, DT_INT, _state, ae_true); + ae_matrix_init(&cinfo, 0, 0, DT_INT, _state, ae_true); + + npoints = s->npoints; + + /* + * Fill Rep.NPoints, quick exit when NPoints<=1 + */ + rep->npoints = npoints; + if( npoints==0 ) + { + ae_vector_set_length(&rep->p, 0, _state); + ae_matrix_set_length(&rep->z, 0, 0, _state); + ae_matrix_set_length(&rep->pz, 0, 0, _state); + ae_matrix_set_length(&rep->pm, 0, 0, _state); + ae_vector_set_length(&rep->mergedist, 0, _state); + ae_frame_leave(_state); + return; + } + if( npoints==1 ) + { + ae_vector_set_length(&rep->p, 1, _state); + ae_matrix_set_length(&rep->z, 0, 0, _state); + ae_matrix_set_length(&rep->pz, 0, 0, _state); + ae_matrix_set_length(&rep->pm, 0, 0, _state); + ae_vector_set_length(&rep->mergedist, 0, _state); + rep->p.ptr.p_int[0] = 0; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&rep->z, npoints-1, 2, _state); + ae_vector_set_length(&rep->mergedist, npoints-1, _state); + + /* + * Build list of nearest neighbors + */ + ae_vector_set_length(&nnidx, npoints, _state); + for(i=0; i<=npoints-1; i++) + { + + /* + * Calculate index of the nearest neighbor + */ + k = -1; + v = ae_maxrealnumber; + for(j=0; j<=npoints-1; j++) + { + if( j!=i&&ae_fp_less(d->ptr.pp_double[i][j],v) ) + { + k = j; + v = d->ptr.pp_double[i][j]; + } + } + ae_assert(ae_fp_less(v,ae_maxrealnumber), "ClusterizerRunAHC: internal error", _state); + nnidx.ptr.p_int[i] = k; + } + + /* + * Distance matrix is built, perform merges. + * + * NOTE 1: CIdx is array[NPoints] which maps rows/columns of the + * distance matrix D to indexes of clusters. Values of CIdx + * from [0,NPoints) denote single-point clusters, and values + * from [NPoints,2*NPoints-1) denote ones obtained by merging + * smaller clusters. Negative calues correspond to absent clusters. + * + * Initially it contains [0...NPoints-1], after each merge + * one element of CIdx (one with index C0) is replaced by + * NPoints+MergeIdx, and another one with index C1 is + * rewritten by -1. + * + * NOTE 2: CSizes is array[NPoints] which stores sizes of clusters. + * + */ + ae_vector_set_length(&cidx, npoints, _state); + ae_vector_set_length(&csizes, npoints, _state); + for(i=0; i<=npoints-1; i++) + { + cidx.ptr.p_int[i] = i; + csizes.ptr.p_int[i] = 1; + } + for(mergeidx=0; mergeidx<=npoints-2; mergeidx++) + { + + /* + * Select pair of clusters (C0,C1) with CIdx[C0]=0 ) + { + if( ae_fp_less(d->ptr.pp_double[i][nnidx.ptr.p_int[i]],v) ) + { + c0 = i; + c1 = nnidx.ptr.p_int[i]; + v = d->ptr.pp_double[i][nnidx.ptr.p_int[i]]; + } + } + } + ae_assert(ae_fp_less(v,ae_maxrealnumber), "ClusterizerRunAHC: internal error", _state); + if( cidx.ptr.p_int[c0]>cidx.ptr.p_int[c1] ) + { + i = c1; + c1 = c0; + c0 = i; + } + + /* + * Fill one row of Rep.Z and one element of Rep.MergeDist + */ + rep->z.ptr.pp_int[mergeidx][0] = cidx.ptr.p_int[c0]; + rep->z.ptr.pp_int[mergeidx][1] = cidx.ptr.p_int[c1]; + rep->mergedist.ptr.p_double[mergeidx] = v; + + /* + * Update distance matrix: + * * row/column C0 are updated by distances to the new cluster + * * row/column C1 are considered empty (we can fill them by zeros, + * but do not want to spend time - we just ignore them) + * + * NOTE: it is important to update distance matrix BEFORE CIdx/CSizes + * are updated. + */ + ae_assert(((s->ahcalgo==0||s->ahcalgo==1)||s->ahcalgo==2)||s->ahcalgo==3, "ClusterizerRunAHC: internal error", _state); + for(i=0; i<=npoints-1; i++) + { + if( i!=c0&&i!=c1 ) + { + if( s->ahcalgo==0 ) + { + d->ptr.pp_double[i][c0] = ae_maxreal(d->ptr.pp_double[i][c0], d->ptr.pp_double[i][c1], _state); + } + if( s->ahcalgo==1 ) + { + d->ptr.pp_double[i][c0] = ae_minreal(d->ptr.pp_double[i][c0], d->ptr.pp_double[i][c1], _state); + } + if( s->ahcalgo==2 ) + { + d->ptr.pp_double[i][c0] = (csizes.ptr.p_int[c0]*d->ptr.pp_double[i][c0]+csizes.ptr.p_int[c1]*d->ptr.pp_double[i][c1])/(csizes.ptr.p_int[c0]+csizes.ptr.p_int[c1]); + } + if( s->ahcalgo==3 ) + { + d->ptr.pp_double[i][c0] = (d->ptr.pp_double[i][c0]+d->ptr.pp_double[i][c1])/2; + } + d->ptr.pp_double[c0][i] = d->ptr.pp_double[i][c0]; + } + } + + /* + * Update CIdx and CSizes + */ + cidx.ptr.p_int[c0] = npoints+mergeidx; + cidx.ptr.p_int[c1] = -1; + csizes.ptr.p_int[c0] = csizes.ptr.p_int[c0]+csizes.ptr.p_int[c1]; + csizes.ptr.p_int[c1] = 0; + + /* + * Update nearest neighbors array: + * * update nearest neighbors of everything except for C0/C1 + * * update neighbors of C0/C1 + */ + for(i=0; i<=npoints-1; i++) + { + if( (cidx.ptr.p_int[i]>=0&&i!=c0)&&(nnidx.ptr.p_int[i]==c0||nnidx.ptr.p_int[i]==c1) ) + { + + /* + * I-th cluster which is distinct from C0/C1 has former C0/C1 cluster as its nearest + * neighbor. We handle this issue depending on specific AHC algorithm being used. + */ + if( s->ahcalgo==1 ) + { + + /* + * Single linkage. Merging of two clusters together + * does NOT change distances between new cluster and + * other clusters. + * + * The only thing we have to do is to update nearest neighbor index + */ + nnidx.ptr.p_int[i] = c0; + } + else + { + + /* + * Something other than single linkage. We have to re-examine + * all the row to find nearest neighbor. + */ + k = -1; + v = ae_maxrealnumber; + for(j=0; j<=npoints-1; j++) + { + if( (cidx.ptr.p_int[j]>=0&&j!=i)&&ae_fp_less(d->ptr.pp_double[i][j],v) ) + { + k = j; + v = d->ptr.pp_double[i][j]; + } + } + ae_assert(ae_fp_less(v,ae_maxrealnumber)||mergeidx==npoints-2, "ClusterizerRunAHC: internal error", _state); + nnidx.ptr.p_int[i] = k; + } + } + } + k = -1; + v = ae_maxrealnumber; + for(j=0; j<=npoints-1; j++) + { + if( (cidx.ptr.p_int[j]>=0&&j!=c0)&&ae_fp_less(d->ptr.pp_double[c0][j],v) ) + { + k = j; + v = d->ptr.pp_double[c0][j]; + } + } + ae_assert(ae_fp_less(v,ae_maxrealnumber)||mergeidx==npoints-2, "ClusterizerRunAHC: internal error", _state); + nnidx.ptr.p_int[c0] = k; + } + + /* + * Calculate Rep.P and Rep.PM. + * + * In order to do that, we fill CInfo matrix - (2*NPoints-1)*3 matrix, + * with I-th row containing: + * * CInfo[I,0] - size of I-th cluster + * * CInfo[I,1] - beginning of I-th cluster + * * CInfo[I,2] - end of I-th cluster + * * CInfo[I,3] - height of I-th cluster + * + * We perform it as follows: + * * first NPoints clusters have unit size (CInfo[I,0]=1) and zero + * height (CInfo[I,3]=0) + * * we replay NPoints-1 merges from first to last and fill sizes of + * corresponding clusters (new size is a sum of sizes of clusters + * being merged) and height (new height is max(heights)+1). + * * now we ready to determine locations of clusters. Last cluster + * spans entire dataset, we know it. We replay merges from last to + * first, during each merge we already know location of the merge + * result, and we can position first cluster to the left part of + * the result, and second cluster to the right part. + */ + ae_vector_set_length(&rep->p, npoints, _state); + ae_matrix_set_length(&rep->pm, npoints-1, 6, _state); + ae_matrix_set_length(&cinfo, 2*npoints-1, 4, _state); + for(i=0; i<=npoints-1; i++) + { + cinfo.ptr.pp_int[i][0] = 1; + cinfo.ptr.pp_int[i][3] = 0; + } + for(i=0; i<=npoints-2; i++) + { + cinfo.ptr.pp_int[npoints+i][0] = cinfo.ptr.pp_int[rep->z.ptr.pp_int[i][0]][0]+cinfo.ptr.pp_int[rep->z.ptr.pp_int[i][1]][0]; + cinfo.ptr.pp_int[npoints+i][3] = ae_maxint(cinfo.ptr.pp_int[rep->z.ptr.pp_int[i][0]][3], cinfo.ptr.pp_int[rep->z.ptr.pp_int[i][1]][3], _state)+1; + } + cinfo.ptr.pp_int[2*npoints-2][1] = 0; + cinfo.ptr.pp_int[2*npoints-2][2] = npoints-1; + for(i=npoints-2; i>=0; i--) + { + + /* + * We merge C0 which spans [A0,B0] and C1 (spans [A1,B1]), + * with unknown A0, B0, A1, B1. However, we know that result + * is CR, which spans [AR,BR] with known AR/BR, and we know + * sizes of C0, C1, CR (denotes as S0, S1, SR). + */ + c0 = rep->z.ptr.pp_int[i][0]; + c1 = rep->z.ptr.pp_int[i][1]; + s0 = cinfo.ptr.pp_int[c0][0]; + s1 = cinfo.ptr.pp_int[c1][0]; + ar = cinfo.ptr.pp_int[npoints+i][1]; + br = cinfo.ptr.pp_int[npoints+i][2]; + cinfo.ptr.pp_int[c0][1] = ar; + cinfo.ptr.pp_int[c0][2] = ar+s0-1; + cinfo.ptr.pp_int[c1][1] = br-(s1-1); + cinfo.ptr.pp_int[c1][2] = br; + rep->pm.ptr.pp_int[i][0] = cinfo.ptr.pp_int[c0][1]; + rep->pm.ptr.pp_int[i][1] = cinfo.ptr.pp_int[c0][2]; + rep->pm.ptr.pp_int[i][2] = cinfo.ptr.pp_int[c1][1]; + rep->pm.ptr.pp_int[i][3] = cinfo.ptr.pp_int[c1][2]; + rep->pm.ptr.pp_int[i][4] = cinfo.ptr.pp_int[c0][3]; + rep->pm.ptr.pp_int[i][5] = cinfo.ptr.pp_int[c1][3]; + } + for(i=0; i<=npoints-1; i++) + { + ae_assert(cinfo.ptr.pp_int[i][1]==cinfo.ptr.pp_int[i][2], "Assertion failed", _state); + rep->p.ptr.p_int[i] = cinfo.ptr.pp_int[i][1]; + } + + /* + * Calculate Rep.PZ + */ + ae_matrix_set_length(&rep->pz, npoints-1, 2, _state); + for(i=0; i<=npoints-2; i++) + { + rep->pz.ptr.pp_int[i][0] = rep->z.ptr.pp_int[i][0]; + rep->pz.ptr.pp_int[i][1] = rep->z.ptr.pp_int[i][1]; + if( rep->pz.ptr.pp_int[i][0]pz.ptr.pp_int[i][0] = rep->p.ptr.p_int[rep->pz.ptr.pp_int[i][0]]; + } + if( rep->pz.ptr.pp_int[i][1]pz.ptr.pp_int[i][1] = rep->p.ptr.p_int[rep->pz.ptr.pp_int[i][1]]; + } + } + ae_frame_leave(_state); +} + + +static void clustering_evaluatedistancematrixrec(/* Real */ ae_matrix* xy, + ae_int_t nfeatures, + ae_int_t disttype, + /* Real */ ae_matrix* d, + ae_int_t i0, + ae_int_t i1, + ae_int_t j0, + ae_int_t j1, + ae_state *_state) +{ + double rcomplexity; + ae_int_t len0; + ae_int_t len1; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double v; + double vv; + + + ae_assert(disttype==0||disttype==1, "EvaluateDistanceMatrixRec: incorrect DistType", _state); + + /* + * Normalize J0/J1: + * * J0:=max(J0,I0) - we ignore lower triangle + * * J1:=max(J1,J0) - normalize J1 + */ + j0 = ae_maxint(j0, i0, _state); + j1 = ae_maxint(j1, j0, _state); + if( j1<=j0||i1<=i0 ) + { + return; + } + + /* + * Try to process in parallel. Two condtions must hold in order to + * activate parallel processing: + * 1. I1-I0>2 or J1-J0>2 + * 2. (I1-I0)*(J1-J0)*NFeatures>=ParallelComplexity + * + * NOTE: all quantities are converted to reals in order to avoid + * integer overflow during multiplication + * + * NOTE: strict inequality in (1) is necessary to reduce task to 2x2 + * basecases. In future versions we will be able to handle such + * basecases more efficiently than 1x1 cases. + */ + rcomplexity = i1-i0; + rcomplexity = rcomplexity*(j1-j0); + rcomplexity = rcomplexity*nfeatures; + if( ae_fp_greater_eq(rcomplexity,clustering_parallelcomplexity)&&(i1-i0>2||j1-j0>2) ) + { + + /* + * Recursive division along largest of dimensions + */ + if( i1-i0>j1-j0 ) + { + splitlengtheven(i1-i0, &len0, &len1, _state); + clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, i0, i0+len0, j0, j1, _state); + clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, i0+len0, i1, j0, j1, _state); + } + else + { + splitlengtheven(j1-j0, &len0, &len1, _state); + clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, i0, i1, j0, j0+len0, _state); + clustering_evaluatedistancematrixrec(xy, nfeatures, disttype, d, i0, i1, j0+len0, j1, _state); + } + return; + } + + /* + * Sequential processing + */ + for(i=i0; i<=i1-1; i++) + { + for(j=j0; j<=j1-1; j++) + { + if( j>=i ) + { + v = 0.0; + if( disttype==0 ) + { + for(k=0; k<=nfeatures-1; k++) + { + vv = xy->ptr.pp_double[i][k]-xy->ptr.pp_double[j][k]; + if( ae_fp_less(vv,0) ) + { + vv = -vv; + } + if( ae_fp_greater(vv,v) ) + { + v = vv; + } + } + } + if( disttype==1 ) + { + for(k=0; k<=nfeatures-1; k++) + { + vv = xy->ptr.pp_double[i][k]-xy->ptr.pp_double[j][k]; + if( ae_fp_less(vv,0) ) + { + vv = -vv; + } + v = v+vv; + } + } + d->ptr.pp_double[i][j] = v; + } + } + } +} + + +ae_bool _clusterizerstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + clusterizerstate *p = (clusterizerstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->xy, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->d, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _clusterizerstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + clusterizerstate *dst = (clusterizerstate*)_dst; + clusterizerstate *src = (clusterizerstate*)_src; + dst->npoints = src->npoints; + dst->nfeatures = src->nfeatures; + dst->disttype = src->disttype; + if( !ae_matrix_init_copy(&dst->xy, &src->xy, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->d, &src->d, _state, make_automatic) ) + return ae_false; + dst->ahcalgo = src->ahcalgo; + dst->kmeansrestarts = src->kmeansrestarts; + dst->kmeansmaxits = src->kmeansmaxits; + return ae_true; +} + + +void _clusterizerstate_clear(void* _p) +{ + clusterizerstate *p = (clusterizerstate*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->xy); + ae_matrix_clear(&p->d); +} + + +void _clusterizerstate_destroy(void* _p) +{ + clusterizerstate *p = (clusterizerstate*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->xy); + ae_matrix_destroy(&p->d); +} + + +ae_bool _ahcreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + ahcreport *p = (ahcreport*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->p, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->z, 0, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->pz, 0, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->pm, 0, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->mergedist, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _ahcreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + ahcreport *dst = (ahcreport*)_dst; + ahcreport *src = (ahcreport*)_src; + dst->npoints = src->npoints; + if( !ae_vector_init_copy(&dst->p, &src->p, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->z, &src->z, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->pz, &src->pz, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->pm, &src->pm, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->mergedist, &src->mergedist, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _ahcreport_clear(void* _p) +{ + ahcreport *p = (ahcreport*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->p); + ae_matrix_clear(&p->z); + ae_matrix_clear(&p->pz); + ae_matrix_clear(&p->pm); + ae_vector_clear(&p->mergedist); +} + + +void _ahcreport_destroy(void* _p) +{ + ahcreport *p = (ahcreport*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->p); + ae_matrix_destroy(&p->z); + ae_matrix_destroy(&p->pz); + ae_matrix_destroy(&p->pm); + ae_vector_destroy(&p->mergedist); +} + + +ae_bool _kmeansreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + kmeansreport *p = (kmeansreport*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->c, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cidx, 0, DT_INT, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _kmeansreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + kmeansreport *dst = (kmeansreport*)_dst; + kmeansreport *src = (kmeansreport*)_src; + dst->npoints = src->npoints; + dst->nfeatures = src->nfeatures; + dst->terminationtype = src->terminationtype; + dst->k = src->k; + if( !ae_matrix_init_copy(&dst->c, &src->c, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->cidx, &src->cidx, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _kmeansreport_clear(void* _p) +{ + kmeansreport *p = (kmeansreport*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->c); + ae_vector_clear(&p->cidx); +} + + +void _kmeansreport_destroy(void* _p) +{ + kmeansreport *p = (kmeansreport*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->c); + ae_vector_destroy(&p->cidx); +} + + + + +/************************************************************************* +k-means++ clusterization. +Backward compatibility function, we recommend to use CLUSTERING subpackage +as better replacement. + + -- ALGLIB -- + Copyright 21.03.2009 by Bochkanov Sergey +*************************************************************************/ +void kmeansgenerate(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t k, + ae_int_t restarts, + ae_int_t* info, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* xyc, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix dummy; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_matrix_clear(c); + ae_vector_clear(xyc); + ae_matrix_init(&dummy, 0, 0, DT_REAL, _state, ae_true); + + kmeansgenerateinternal(xy, npoints, nvars, k, 0, restarts, info, c, ae_true, &dummy, ae_false, xyc, _state); + ae_frame_leave(_state); +} + + + + +/************************************************************************* +This subroutine builds random decision forest. + +INPUT PARAMETERS: + XY - training set + NPoints - training set size, NPoints>=1 + NVars - number of independent variables, NVars>=1 + NClasses - task type: + * NClasses=1 - regression task with one + dependent variable + * NClasses>1 - classification task with + NClasses classes. + NTrees - number of trees in a forest, NTrees>=1. + recommended values: 50-100. + R - percent of a training set used to build + individual trees. 01). + * 1, if task has been solved + DF - model built + Rep - training report, contains error on a training set + and out-of-bag estimates of generalization error. + + -- ALGLIB -- + Copyright 19.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfbuildrandomdecisionforest(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t ntrees, + double r, + ae_int_t* info, + decisionforest* df, + dfreport* rep, + ae_state *_state) +{ + ae_int_t samplesize; + + *info = 0; + _decisionforest_clear(df); + _dfreport_clear(rep); + + if( ae_fp_less_eq(r,0)||ae_fp_greater(r,1) ) + { + *info = -1; + return; + } + samplesize = ae_maxint(ae_round(r*npoints, _state), 1, _state); + dfbuildinternal(xy, npoints, nvars, nclasses, ntrees, samplesize, ae_maxint(nvars/2, 1, _state), dforest_dfusestrongsplits+dforest_dfuseevs, info, df, rep, _state); +} + + +/************************************************************************* +This subroutine builds random decision forest. +This function gives ability to tune number of variables used when choosing +best split. + +INPUT PARAMETERS: + XY - training set + NPoints - training set size, NPoints>=1 + NVars - number of independent variables, NVars>=1 + NClasses - task type: + * NClasses=1 - regression task with one + dependent variable + * NClasses>1 - classification task with + NClasses classes. + NTrees - number of trees in a forest, NTrees>=1. + recommended values: 50-100. + NRndVars - number of variables used when choosing best split + R - percent of a training set used to build + individual trees. 01). + * 1, if task has been solved + DF - model built + Rep - training report, contains error on a training set + and out-of-bag estimates of generalization error. + + -- ALGLIB -- + Copyright 19.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfbuildrandomdecisionforestx1(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t ntrees, + ae_int_t nrndvars, + double r, + ae_int_t* info, + decisionforest* df, + dfreport* rep, + ae_state *_state) +{ + ae_int_t samplesize; + + *info = 0; + _decisionforest_clear(df); + _dfreport_clear(rep); + + if( ae_fp_less_eq(r,0)||ae_fp_greater(r,1) ) + { + *info = -1; + return; + } + if( nrndvars<=0||nrndvars>nvars ) + { + *info = -1; + return; + } + samplesize = ae_maxint(ae_round(r*npoints, _state), 1, _state); + dfbuildinternal(xy, npoints, nvars, nclasses, ntrees, samplesize, nrndvars, dforest_dfusestrongsplits+dforest_dfuseevs, info, df, rep, _state); +} + + +void dfbuildinternal(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t ntrees, + ae_int_t samplesize, + ae_int_t nfeatures, + ae_int_t flags, + ae_int_t* info, + decisionforest* df, + dfreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t tmpi; + ae_int_t lasttreeoffs; + ae_int_t offs; + ae_int_t ooboffs; + ae_int_t treesize; + ae_int_t nvarsinpool; + ae_bool useevs; + dfinternalbuffers bufs; + ae_vector permbuf; + ae_vector oobbuf; + ae_vector oobcntbuf; + ae_matrix xys; + ae_vector x; + ae_vector y; + ae_int_t oobcnt; + ae_int_t oobrelcnt; + double v; + double vmin; + double vmax; + ae_bool bflag; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _decisionforest_clear(df); + _dfreport_clear(rep); + _dfinternalbuffers_init(&bufs, _state, ae_true); + ae_vector_init(&permbuf, 0, DT_INT, _state, ae_true); + ae_vector_init(&oobbuf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&oobcntbuf, 0, DT_INT, _state, ae_true); + ae_matrix_init(&xys, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + _hqrndstate_init(&rs, _state, ae_true); + + + /* + * Test for inputs + */ + if( (((((npoints<1||samplesize<1)||samplesize>npoints)||nvars<1)||nclasses<1)||ntrees<1)||nfeatures<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( nclasses>1 ) + { + for(i=0; i<=npoints-1; i++) + { + if( ae_round(xy->ptr.pp_double[i][nvars], _state)<0||ae_round(xy->ptr.pp_double[i][nvars], _state)>=nclasses ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + } + *info = 1; + + /* + * Flags + */ + useevs = flags/dforest_dfuseevs%2!=0; + + /* + * Allocate data, prepare header + */ + treesize = 1+dforest_innernodewidth*(samplesize-1)+dforest_leafnodewidth*samplesize; + ae_vector_set_length(&permbuf, npoints-1+1, _state); + ae_vector_set_length(&bufs.treebuf, treesize-1+1, _state); + ae_vector_set_length(&bufs.idxbuf, npoints-1+1, _state); + ae_vector_set_length(&bufs.tmpbufr, npoints-1+1, _state); + ae_vector_set_length(&bufs.tmpbufr2, npoints-1+1, _state); + ae_vector_set_length(&bufs.tmpbufi, npoints-1+1, _state); + ae_vector_set_length(&bufs.sortrbuf, npoints, _state); + ae_vector_set_length(&bufs.sortrbuf2, npoints, _state); + ae_vector_set_length(&bufs.sortibuf, npoints, _state); + ae_vector_set_length(&bufs.varpool, nvars-1+1, _state); + ae_vector_set_length(&bufs.evsbin, nvars-1+1, _state); + ae_vector_set_length(&bufs.evssplits, nvars-1+1, _state); + ae_vector_set_length(&bufs.classibuf, 2*nclasses-1+1, _state); + ae_vector_set_length(&oobbuf, nclasses*npoints-1+1, _state); + ae_vector_set_length(&oobcntbuf, npoints-1+1, _state); + ae_vector_set_length(&df->trees, ntrees*treesize-1+1, _state); + ae_matrix_set_length(&xys, samplesize-1+1, nvars+1, _state); + ae_vector_set_length(&x, nvars-1+1, _state); + ae_vector_set_length(&y, nclasses-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + permbuf.ptr.p_int[i] = i; + } + for(i=0; i<=npoints*nclasses-1; i++) + { + oobbuf.ptr.p_double[i] = 0; + } + for(i=0; i<=npoints-1; i++) + { + oobcntbuf.ptr.p_int[i] = 0; + } + + /* + * Prepare variable pool and EVS (extended variable selection/splitting) buffers + * (whether EVS is turned on or not): + * 1. detect binary variables and pre-calculate splits for them + * 2. detect variables with non-distinct values and exclude them from pool + */ + for(i=0; i<=nvars-1; i++) + { + bufs.varpool.ptr.p_int[i] = i; + } + nvarsinpool = nvars; + if( useevs ) + { + for(j=0; j<=nvars-1; j++) + { + vmin = xy->ptr.pp_double[0][j]; + vmax = vmin; + for(i=0; i<=npoints-1; i++) + { + v = xy->ptr.pp_double[i][j]; + vmin = ae_minreal(vmin, v, _state); + vmax = ae_maxreal(vmax, v, _state); + } + if( ae_fp_eq(vmin,vmax) ) + { + + /* + * exclude variable from pool + */ + bufs.varpool.ptr.p_int[j] = bufs.varpool.ptr.p_int[nvarsinpool-1]; + bufs.varpool.ptr.p_int[nvarsinpool-1] = -1; + nvarsinpool = nvarsinpool-1; + continue; + } + bflag = ae_false; + for(i=0; i<=npoints-1; i++) + { + v = xy->ptr.pp_double[i][j]; + if( ae_fp_neq(v,vmin)&&ae_fp_neq(v,vmax) ) + { + bflag = ae_true; + break; + } + } + if( bflag ) + { + + /* + * non-binary variable + */ + bufs.evsbin.ptr.p_bool[j] = ae_false; + } + else + { + + /* + * Prepare + */ + bufs.evsbin.ptr.p_bool[j] = ae_true; + bufs.evssplits.ptr.p_double[j] = 0.5*(vmin+vmax); + if( ae_fp_less_eq(bufs.evssplits.ptr.p_double[j],vmin) ) + { + bufs.evssplits.ptr.p_double[j] = vmax; + } + } + } + } + + /* + * RANDOM FOREST FORMAT + * W[0] - size of array + * W[1] - version number + * W[2] - NVars + * W[3] - NClasses (1 for regression) + * W[4] - NTrees + * W[5] - trees offset + * + * + * TREE FORMAT + * W[Offs] - size of sub-array + * node info: + * W[K+0] - variable number (-1 for leaf mode) + * W[K+1] - threshold (class/value for leaf node) + * W[K+2] - ">=" branch index (absent for leaf node) + * + */ + df->nvars = nvars; + df->nclasses = nclasses; + df->ntrees = ntrees; + + /* + * Build forest + */ + hqrndrandomize(&rs, _state); + offs = 0; + for(i=0; i<=ntrees-1; i++) + { + + /* + * Prepare sample + */ + for(k=0; k<=samplesize-1; k++) + { + j = k+hqrnduniformi(&rs, npoints-k, _state); + tmpi = permbuf.ptr.p_int[k]; + permbuf.ptr.p_int[k] = permbuf.ptr.p_int[j]; + permbuf.ptr.p_int[j] = tmpi; + j = permbuf.ptr.p_int[k]; + ae_v_move(&xys.ptr.pp_double[k][0], 1, &xy->ptr.pp_double[j][0], 1, ae_v_len(0,nvars)); + } + + /* + * build tree, copy + */ + dforest_dfbuildtree(&xys, samplesize, nvars, nclasses, nfeatures, nvarsinpool, flags, &bufs, &rs, _state); + j = ae_round(bufs.treebuf.ptr.p_double[0], _state); + ae_v_move(&df->trees.ptr.p_double[offs], 1, &bufs.treebuf.ptr.p_double[0], 1, ae_v_len(offs,offs+j-1)); + lasttreeoffs = offs; + offs = offs+j; + + /* + * OOB estimates + */ + for(k=samplesize; k<=npoints-1; k++) + { + for(j=0; j<=nclasses-1; j++) + { + y.ptr.p_double[j] = 0; + } + j = permbuf.ptr.p_int[k]; + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); + dforest_dfprocessinternal(df, lasttreeoffs, &x, &y, _state); + ae_v_add(&oobbuf.ptr.p_double[j*nclasses], 1, &y.ptr.p_double[0], 1, ae_v_len(j*nclasses,(j+1)*nclasses-1)); + oobcntbuf.ptr.p_int[j] = oobcntbuf.ptr.p_int[j]+1; + } + } + df->bufsize = offs; + + /* + * Normalize OOB results + */ + for(i=0; i<=npoints-1; i++) + { + if( oobcntbuf.ptr.p_int[i]!=0 ) + { + v = (double)1/(double)oobcntbuf.ptr.p_int[i]; + ae_v_muld(&oobbuf.ptr.p_double[i*nclasses], 1, ae_v_len(i*nclasses,i*nclasses+nclasses-1), v); + } + } + + /* + * Calculate training set estimates + */ + rep->relclserror = dfrelclserror(df, xy, npoints, _state); + rep->avgce = dfavgce(df, xy, npoints, _state); + rep->rmserror = dfrmserror(df, xy, npoints, _state); + rep->avgerror = dfavgerror(df, xy, npoints, _state); + rep->avgrelerror = dfavgrelerror(df, xy, npoints, _state); + + /* + * Calculate OOB estimates. + */ + rep->oobrelclserror = 0; + rep->oobavgce = 0; + rep->oobrmserror = 0; + rep->oobavgerror = 0; + rep->oobavgrelerror = 0; + oobcnt = 0; + oobrelcnt = 0; + for(i=0; i<=npoints-1; i++) + { + if( oobcntbuf.ptr.p_int[i]!=0 ) + { + ooboffs = i*nclasses; + if( nclasses>1 ) + { + + /* + * classification-specific code + */ + k = ae_round(xy->ptr.pp_double[i][nvars], _state); + tmpi = 0; + for(j=1; j<=nclasses-1; j++) + { + if( ae_fp_greater(oobbuf.ptr.p_double[ooboffs+j],oobbuf.ptr.p_double[ooboffs+tmpi]) ) + { + tmpi = j; + } + } + if( tmpi!=k ) + { + rep->oobrelclserror = rep->oobrelclserror+1; + } + if( ae_fp_neq(oobbuf.ptr.p_double[ooboffs+k],0) ) + { + rep->oobavgce = rep->oobavgce-ae_log(oobbuf.ptr.p_double[ooboffs+k], _state); + } + else + { + rep->oobavgce = rep->oobavgce-ae_log(ae_minrealnumber, _state); + } + for(j=0; j<=nclasses-1; j++) + { + if( j==k ) + { + rep->oobrmserror = rep->oobrmserror+ae_sqr(oobbuf.ptr.p_double[ooboffs+j]-1, _state); + rep->oobavgerror = rep->oobavgerror+ae_fabs(oobbuf.ptr.p_double[ooboffs+j]-1, _state); + rep->oobavgrelerror = rep->oobavgrelerror+ae_fabs(oobbuf.ptr.p_double[ooboffs+j]-1, _state); + oobrelcnt = oobrelcnt+1; + } + else + { + rep->oobrmserror = rep->oobrmserror+ae_sqr(oobbuf.ptr.p_double[ooboffs+j], _state); + rep->oobavgerror = rep->oobavgerror+ae_fabs(oobbuf.ptr.p_double[ooboffs+j], _state); + } + } + } + else + { + + /* + * regression-specific code + */ + rep->oobrmserror = rep->oobrmserror+ae_sqr(oobbuf.ptr.p_double[ooboffs]-xy->ptr.pp_double[i][nvars], _state); + rep->oobavgerror = rep->oobavgerror+ae_fabs(oobbuf.ptr.p_double[ooboffs]-xy->ptr.pp_double[i][nvars], _state); + if( ae_fp_neq(xy->ptr.pp_double[i][nvars],0) ) + { + rep->oobavgrelerror = rep->oobavgrelerror+ae_fabs((oobbuf.ptr.p_double[ooboffs]-xy->ptr.pp_double[i][nvars])/xy->ptr.pp_double[i][nvars], _state); + oobrelcnt = oobrelcnt+1; + } + } + + /* + * update OOB estimates count. + */ + oobcnt = oobcnt+1; + } + } + if( oobcnt>0 ) + { + rep->oobrelclserror = rep->oobrelclserror/oobcnt; + rep->oobavgce = rep->oobavgce/oobcnt; + rep->oobrmserror = ae_sqrt(rep->oobrmserror/(oobcnt*nclasses), _state); + rep->oobavgerror = rep->oobavgerror/(oobcnt*nclasses); + if( oobrelcnt>0 ) + { + rep->oobavgrelerror = rep->oobavgrelerror/oobrelcnt; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + DF - decision forest model + X - input vector, array[0..NVars-1]. + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + +See also DFProcessI. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfprocess(decisionforest* df, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t offs; + ae_int_t i; + double v; + + + + /* + * Proceed + */ + if( y->cntnclasses ) + { + ae_vector_set_length(y, df->nclasses, _state); + } + offs = 0; + for(i=0; i<=df->nclasses-1; i++) + { + y->ptr.p_double[i] = 0; + } + for(i=0; i<=df->ntrees-1; i++) + { + + /* + * Process basic tree + */ + dforest_dfprocessinternal(df, offs, x, y, _state); + + /* + * Next tree + */ + offs = offs+ae_round(df->trees.ptr.p_double[offs], _state); + } + v = (double)1/(double)df->ntrees; + ae_v_muld(&y->ptr.p_double[0], 1, ae_v_len(0,df->nclasses-1), v); +} + + +/************************************************************************* +'interactive' variant of DFProcess for languages like Python which support +constructs like "Y = DFProcessI(DF,X)" and interactive mode of interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void dfprocessi(decisionforest* df, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + + ae_vector_clear(y); + + dfprocess(df, x, y, _state); +} + + +/************************************************************************* +Relative classification error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + percent of incorrectly classified cases. + Zero if model solves regression task. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfrelclserror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + result = (double)dforest_dfclserror(df, xy, npoints, _state)/(double)npoints; + return result; +} + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + CrossEntropy/(NPoints*LN(2)). + Zero if model solves regression task. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgce(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t tmpi; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&x, df->nvars-1+1, _state); + ae_vector_set_length(&y, df->nclasses-1+1, _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); + dfprocess(df, &x, &y, _state); + if( df->nclasses>1 ) + { + + /* + * classification-specific code + */ + k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); + tmpi = 0; + for(j=1; j<=df->nclasses-1; j++) + { + if( ae_fp_greater(y.ptr.p_double[j],y.ptr.p_double[tmpi]) ) + { + tmpi = j; + } + } + if( ae_fp_neq(y.ptr.p_double[k],0) ) + { + result = result-ae_log(y.ptr.p_double[k], _state); + } + else + { + result = result-ae_log(ae_minrealnumber, _state); + } + } + } + result = result/npoints; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + root mean square error. + Its meaning for regression task is obvious. As for + classification task, RMS error means error when estimating posterior + probabilities. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfrmserror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t tmpi; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&x, df->nvars-1+1, _state); + ae_vector_set_length(&y, df->nclasses-1+1, _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); + dfprocess(df, &x, &y, _state); + if( df->nclasses>1 ) + { + + /* + * classification-specific code + */ + k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); + tmpi = 0; + for(j=1; j<=df->nclasses-1; j++) + { + if( ae_fp_greater(y.ptr.p_double[j],y.ptr.p_double[tmpi]) ) + { + tmpi = j; + } + } + for(j=0; j<=df->nclasses-1; j++) + { + if( j==k ) + { + result = result+ae_sqr(y.ptr.p_double[j]-1, _state); + } + else + { + result = result+ae_sqr(y.ptr.p_double[j], _state); + } + } + } + else + { + + /* + * regression-specific code + */ + result = result+ae_sqr(y.ptr.p_double[0]-xy->ptr.pp_double[i][df->nvars], _state); + } + } + result = ae_sqrt(result/(npoints*df->nclasses), _state); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for + classification task, it means average error when estimating posterior + probabilities. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgerror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&x, df->nvars-1+1, _state); + ae_vector_set_length(&y, df->nclasses-1+1, _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); + dfprocess(df, &x, &y, _state); + if( df->nclasses>1 ) + { + + /* + * classification-specific code + */ + k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); + for(j=0; j<=df->nclasses-1; j++) + { + if( j==k ) + { + result = result+ae_fabs(y.ptr.p_double[j]-1, _state); + } + else + { + result = result+ae_fabs(y.ptr.p_double[j], _state); + } + } + } + else + { + + /* + * regression-specific code + */ + result = result+ae_fabs(y.ptr.p_double[0]-xy->ptr.pp_double[i][df->nvars], _state); + } + } + result = result/(npoints*df->nclasses); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Average relative error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for + classification task, it means average relative error when estimating + posterior probability of belonging to the correct class. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgrelerror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_int_t relcnt; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&x, df->nvars-1+1, _state); + ae_vector_set_length(&y, df->nclasses-1+1, _state); + result = 0; + relcnt = 0; + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); + dfprocess(df, &x, &y, _state); + if( df->nclasses>1 ) + { + + /* + * classification-specific code + */ + k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); + for(j=0; j<=df->nclasses-1; j++) + { + if( j==k ) + { + result = result+ae_fabs(y.ptr.p_double[j]-1, _state); + relcnt = relcnt+1; + } + } + } + else + { + + /* + * regression-specific code + */ + if( ae_fp_neq(xy->ptr.pp_double[i][df->nvars],0) ) + { + result = result+ae_fabs((y.ptr.p_double[0]-xy->ptr.pp_double[i][df->nvars])/xy->ptr.pp_double[i][df->nvars], _state); + relcnt = relcnt+1; + } + } + } + if( relcnt>0 ) + { + result = result/relcnt; + } + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Copying of DecisionForest strucure + +INPUT PARAMETERS: + DF1 - original + +OUTPUT PARAMETERS: + DF2 - copy + + -- ALGLIB -- + Copyright 13.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfcopy(decisionforest* df1, decisionforest* df2, ae_state *_state) +{ + + _decisionforest_clear(df2); + + df2->nvars = df1->nvars; + df2->nclasses = df1->nclasses; + df2->ntrees = df1->ntrees; + df2->bufsize = df1->bufsize; + ae_vector_set_length(&df2->trees, df1->bufsize-1+1, _state); + ae_v_move(&df2->trees.ptr.p_double[0], 1, &df1->trees.ptr.p_double[0], 1, ae_v_len(0,df1->bufsize-1)); +} + + +/************************************************************************* +Serializer: allocation + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void dfalloc(ae_serializer* s, decisionforest* forest, ae_state *_state) +{ + + + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + allocrealarray(s, &forest->trees, forest->bufsize, _state); +} + + +/************************************************************************* +Serializer: serialization + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void dfserialize(ae_serializer* s, + decisionforest* forest, + ae_state *_state) +{ + + + ae_serializer_serialize_int(s, getrdfserializationcode(_state), _state); + ae_serializer_serialize_int(s, dforest_dffirstversion, _state); + ae_serializer_serialize_int(s, forest->nvars, _state); + ae_serializer_serialize_int(s, forest->nclasses, _state); + ae_serializer_serialize_int(s, forest->ntrees, _state); + ae_serializer_serialize_int(s, forest->bufsize, _state); + serializerealarray(s, &forest->trees, forest->bufsize, _state); +} + + +/************************************************************************* +Serializer: unserialization + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void dfunserialize(ae_serializer* s, + decisionforest* forest, + ae_state *_state) +{ + ae_int_t i0; + ae_int_t i1; + + _decisionforest_clear(forest); + + + /* + * check correctness of header + */ + ae_serializer_unserialize_int(s, &i0, _state); + ae_assert(i0==getrdfserializationcode(_state), "DFUnserialize: stream header corrupted", _state); + ae_serializer_unserialize_int(s, &i1, _state); + ae_assert(i1==dforest_dffirstversion, "DFUnserialize: stream header corrupted", _state); + + /* + * Unserialize data + */ + ae_serializer_unserialize_int(s, &forest->nvars, _state); + ae_serializer_unserialize_int(s, &forest->nclasses, _state); + ae_serializer_unserialize_int(s, &forest->ntrees, _state); + ae_serializer_unserialize_int(s, &forest->bufsize, _state); + unserializerealarray(s, &forest->trees, _state); +} + + +/************************************************************************* +Classification error +*************************************************************************/ +static ae_int_t dforest_dfclserror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t tmpi; + ae_int_t result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + + if( df->nclasses<=1 ) + { + result = 0; + ae_frame_leave(_state); + return result; + } + ae_vector_set_length(&x, df->nvars-1+1, _state); + ae_vector_set_length(&y, df->nclasses-1+1, _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,df->nvars-1)); + dfprocess(df, &x, &y, _state); + k = ae_round(xy->ptr.pp_double[i][df->nvars], _state); + tmpi = 0; + for(j=1; j<=df->nclasses-1; j++) + { + if( ae_fp_greater(y.ptr.p_double[j],y.ptr.p_double[tmpi]) ) + { + tmpi = j; + } + } + if( tmpi!=k ) + { + result = result+1; + } + } + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Internal subroutine for processing one decision tree starting at Offs +*************************************************************************/ +static void dforest_dfprocessinternal(decisionforest* df, + ae_int_t offs, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t k; + ae_int_t idx; + + + + /* + * Set pointer to the root + */ + k = offs+1; + + /* + * Navigate through the tree + */ + for(;;) + { + if( ae_fp_eq(df->trees.ptr.p_double[k],-1) ) + { + if( df->nclasses==1 ) + { + y->ptr.p_double[0] = y->ptr.p_double[0]+df->trees.ptr.p_double[k+1]; + } + else + { + idx = ae_round(df->trees.ptr.p_double[k+1], _state); + y->ptr.p_double[idx] = y->ptr.p_double[idx]+1; + } + break; + } + if( ae_fp_less(x->ptr.p_double[ae_round(df->trees.ptr.p_double[k], _state)],df->trees.ptr.p_double[k+1]) ) + { + k = k+dforest_innernodewidth; + } + else + { + k = offs+ae_round(df->trees.ptr.p_double[k+2], _state); + } + } +} + + +/************************************************************************* +Builds one decision tree. Just a wrapper for the DFBuildTreeRec. +*************************************************************************/ +static void dforest_dfbuildtree(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t nfeatures, + ae_int_t nvarsinpool, + ae_int_t flags, + dfinternalbuffers* bufs, + hqrndstate* rs, + ae_state *_state) +{ + ae_int_t numprocessed; + ae_int_t i; + + + ae_assert(npoints>0, "Assertion failed", _state); + + /* + * Prepare IdxBuf. It stores indices of the training set elements. + * When training set is being split, contents of IdxBuf is + * correspondingly reordered so we can know which elements belong + * to which branch of decision tree. + */ + for(i=0; i<=npoints-1; i++) + { + bufs->idxbuf.ptr.p_int[i] = i; + } + + /* + * Recursive procedure + */ + numprocessed = 1; + dforest_dfbuildtreerec(xy, npoints, nvars, nclasses, nfeatures, nvarsinpool, flags, &numprocessed, 0, npoints-1, bufs, rs, _state); + bufs->treebuf.ptr.p_double[0] = numprocessed; +} + + +/************************************************************************* +Builds one decision tree (internal recursive subroutine) + +Parameters: + TreeBuf - large enough array, at least TreeSize + IdxBuf - at least NPoints elements + TmpBufR - at least NPoints + TmpBufR2 - at least NPoints + TmpBufI - at least NPoints + TmpBufI2 - at least NPoints+1 +*************************************************************************/ +static void dforest_dfbuildtreerec(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t nfeatures, + ae_int_t nvarsinpool, + ae_int_t flags, + ae_int_t* numprocessed, + ae_int_t idx1, + ae_int_t idx2, + dfinternalbuffers* bufs, + hqrndstate* rs, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_bool bflag; + ae_int_t i1; + ae_int_t i2; + ae_int_t info; + double sl; + double sr; + double w; + ae_int_t idxbest; + double ebest; + double tbest; + ae_int_t varcur; + double s; + double v; + double v1; + double v2; + double threshold; + ae_int_t oldnp; + double currms; + ae_bool useevs; + + + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + tbest = 0; + + /* + * Prepare + */ + ae_assert(npoints>0, "Assertion failed", _state); + ae_assert(idx2>=idx1, "Assertion failed", _state); + useevs = flags/dforest_dfuseevs%2!=0; + + /* + * Leaf node + */ + if( idx2==idx1 ) + { + bufs->treebuf.ptr.p_double[*numprocessed] = -1; + bufs->treebuf.ptr.p_double[*numprocessed+1] = xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[idx1]][nvars]; + *numprocessed = *numprocessed+dforest_leafnodewidth; + return; + } + + /* + * Non-leaf node. + * Select random variable, prepare split: + * 1. prepare default solution - no splitting, class at random + * 2. investigate possible splits, compare with default/best + */ + idxbest = -1; + if( nclasses>1 ) + { + + /* + * default solution for classification + */ + for(i=0; i<=nclasses-1; i++) + { + bufs->classibuf.ptr.p_int[i] = 0; + } + s = idx2-idx1+1; + for(i=idx1; i<=idx2; i++) + { + j = ae_round(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i]][nvars], _state); + bufs->classibuf.ptr.p_int[j] = bufs->classibuf.ptr.p_int[j]+1; + } + ebest = 0; + for(i=0; i<=nclasses-1; i++) + { + ebest = ebest+bufs->classibuf.ptr.p_int[i]*ae_sqr(1-bufs->classibuf.ptr.p_int[i]/s, _state)+(s-bufs->classibuf.ptr.p_int[i])*ae_sqr(bufs->classibuf.ptr.p_int[i]/s, _state); + } + ebest = ae_sqrt(ebest/(nclasses*(idx2-idx1+1)), _state); + } + else + { + + /* + * default solution for regression + */ + v = 0; + for(i=idx1; i<=idx2; i++) + { + v = v+xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i]][nvars]; + } + v = v/(idx2-idx1+1); + ebest = 0; + for(i=idx1; i<=idx2; i++) + { + ebest = ebest+ae_sqr(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i]][nvars]-v, _state); + } + ebest = ae_sqrt(ebest/(idx2-idx1+1), _state); + } + i = 0; + while(i<=ae_minint(nfeatures, nvarsinpool, _state)-1) + { + + /* + * select variables from pool + */ + j = i+hqrnduniformi(rs, nvarsinpool-i, _state); + k = bufs->varpool.ptr.p_int[i]; + bufs->varpool.ptr.p_int[i] = bufs->varpool.ptr.p_int[j]; + bufs->varpool.ptr.p_int[j] = k; + varcur = bufs->varpool.ptr.p_int[i]; + + /* + * load variable values to working array + * + * apply EVS preprocessing: if all variable values are same, + * variable is excluded from pool. + * + * This is necessary for binary pre-splits (see later) to work. + */ + for(j=idx1; j<=idx2; j++) + { + bufs->tmpbufr.ptr.p_double[j-idx1] = xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[j]][varcur]; + } + if( useevs ) + { + bflag = ae_false; + v = bufs->tmpbufr.ptr.p_double[0]; + for(j=0; j<=idx2-idx1; j++) + { + if( ae_fp_neq(bufs->tmpbufr.ptr.p_double[j],v) ) + { + bflag = ae_true; + break; + } + } + if( !bflag ) + { + + /* + * exclude variable from pool, + * go to the next iteration. + * I is not increased. + */ + k = bufs->varpool.ptr.p_int[i]; + bufs->varpool.ptr.p_int[i] = bufs->varpool.ptr.p_int[nvarsinpool-1]; + bufs->varpool.ptr.p_int[nvarsinpool-1] = k; + nvarsinpool = nvarsinpool-1; + continue; + } + } + + /* + * load labels to working array + */ + if( nclasses>1 ) + { + for(j=idx1; j<=idx2; j++) + { + bufs->tmpbufi.ptr.p_int[j-idx1] = ae_round(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[j]][nvars], _state); + } + } + else + { + for(j=idx1; j<=idx2; j++) + { + bufs->tmpbufr2.ptr.p_double[j-idx1] = xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[j]][nvars]; + } + } + + /* + * calculate split + */ + if( useevs&&bufs->evsbin.ptr.p_bool[varcur] ) + { + + /* + * Pre-calculated splits for binary variables. + * Threshold is already known, just calculate RMS error + */ + threshold = bufs->evssplits.ptr.p_double[varcur]; + if( nclasses>1 ) + { + + /* + * classification-specific code + */ + for(j=0; j<=2*nclasses-1; j++) + { + bufs->classibuf.ptr.p_int[j] = 0; + } + sl = 0; + sr = 0; + for(j=0; j<=idx2-idx1; j++) + { + k = bufs->tmpbufi.ptr.p_int[j]; + if( ae_fp_less(bufs->tmpbufr.ptr.p_double[j],threshold) ) + { + bufs->classibuf.ptr.p_int[k] = bufs->classibuf.ptr.p_int[k]+1; + sl = sl+1; + } + else + { + bufs->classibuf.ptr.p_int[k+nclasses] = bufs->classibuf.ptr.p_int[k+nclasses]+1; + sr = sr+1; + } + } + ae_assert(ae_fp_neq(sl,0)&&ae_fp_neq(sr,0), "DFBuildTreeRec: something strange!", _state); + currms = 0; + for(j=0; j<=nclasses-1; j++) + { + w = bufs->classibuf.ptr.p_int[j]; + currms = currms+w*ae_sqr(w/sl-1, _state); + currms = currms+(sl-w)*ae_sqr(w/sl, _state); + w = bufs->classibuf.ptr.p_int[nclasses+j]; + currms = currms+w*ae_sqr(w/sr-1, _state); + currms = currms+(sr-w)*ae_sqr(w/sr, _state); + } + currms = ae_sqrt(currms/(nclasses*(idx2-idx1+1)), _state); + } + else + { + + /* + * regression-specific code + */ + sl = 0; + sr = 0; + v1 = 0; + v2 = 0; + for(j=0; j<=idx2-idx1; j++) + { + if( ae_fp_less(bufs->tmpbufr.ptr.p_double[j],threshold) ) + { + v1 = v1+bufs->tmpbufr2.ptr.p_double[j]; + sl = sl+1; + } + else + { + v2 = v2+bufs->tmpbufr2.ptr.p_double[j]; + sr = sr+1; + } + } + ae_assert(ae_fp_neq(sl,0)&&ae_fp_neq(sr,0), "DFBuildTreeRec: something strange!", _state); + v1 = v1/sl; + v2 = v2/sr; + currms = 0; + for(j=0; j<=idx2-idx1; j++) + { + if( ae_fp_less(bufs->tmpbufr.ptr.p_double[j],threshold) ) + { + currms = currms+ae_sqr(v1-bufs->tmpbufr2.ptr.p_double[j], _state); + } + else + { + currms = currms+ae_sqr(v2-bufs->tmpbufr2.ptr.p_double[j], _state); + } + } + currms = ae_sqrt(currms/(idx2-idx1+1), _state); + } + info = 1; + } + else + { + + /* + * Generic splits + */ + if( nclasses>1 ) + { + dforest_dfsplitc(&bufs->tmpbufr, &bufs->tmpbufi, &bufs->classibuf, idx2-idx1+1, nclasses, dforest_dfusestrongsplits, &info, &threshold, &currms, &bufs->sortrbuf, &bufs->sortibuf, _state); + } + else + { + dforest_dfsplitr(&bufs->tmpbufr, &bufs->tmpbufr2, idx2-idx1+1, dforest_dfusestrongsplits, &info, &threshold, &currms, &bufs->sortrbuf, &bufs->sortrbuf2, _state); + } + } + if( info>0 ) + { + if( ae_fp_less_eq(currms,ebest) ) + { + ebest = currms; + idxbest = varcur; + tbest = threshold; + } + } + + /* + * Next iteration + */ + i = i+1; + } + + /* + * to split or not to split + */ + if( idxbest<0 ) + { + + /* + * All values are same, cannot split. + */ + bufs->treebuf.ptr.p_double[*numprocessed] = -1; + if( nclasses>1 ) + { + + /* + * Select random class label (randomness allows us to + * approximate distribution of the classes) + */ + bufs->treebuf.ptr.p_double[*numprocessed+1] = ae_round(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[idx1+hqrnduniformi(rs, idx2-idx1+1, _state)]][nvars], _state); + } + else + { + + /* + * Select average (for regression task). + */ + v = 0; + for(i=idx1; i<=idx2; i++) + { + v = v+xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i]][nvars]/(idx2-idx1+1); + } + bufs->treebuf.ptr.p_double[*numprocessed+1] = v; + } + *numprocessed = *numprocessed+dforest_leafnodewidth; + } + else + { + + /* + * we can split + */ + bufs->treebuf.ptr.p_double[*numprocessed] = idxbest; + bufs->treebuf.ptr.p_double[*numprocessed+1] = tbest; + i1 = idx1; + i2 = idx2; + while(i1<=i2) + { + + /* + * Reorder indices so that left partition is in [Idx1..I1-1], + * and right partition is in [I2+1..Idx2] + */ + if( ae_fp_less(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i1]][idxbest],tbest) ) + { + i1 = i1+1; + continue; + } + if( ae_fp_greater_eq(xy->ptr.pp_double[bufs->idxbuf.ptr.p_int[i2]][idxbest],tbest) ) + { + i2 = i2-1; + continue; + } + j = bufs->idxbuf.ptr.p_int[i1]; + bufs->idxbuf.ptr.p_int[i1] = bufs->idxbuf.ptr.p_int[i2]; + bufs->idxbuf.ptr.p_int[i2] = j; + i1 = i1+1; + i2 = i2-1; + } + oldnp = *numprocessed; + *numprocessed = *numprocessed+dforest_innernodewidth; + dforest_dfbuildtreerec(xy, npoints, nvars, nclasses, nfeatures, nvarsinpool, flags, numprocessed, idx1, i1-1, bufs, rs, _state); + bufs->treebuf.ptr.p_double[oldnp+2] = *numprocessed; + dforest_dfbuildtreerec(xy, npoints, nvars, nclasses, nfeatures, nvarsinpool, flags, numprocessed, i2+1, idx2, bufs, rs, _state); + } +} + + +/************************************************************************* +Makes split on attribute +*************************************************************************/ +static void dforest_dfsplitc(/* Real */ ae_vector* x, + /* Integer */ ae_vector* c, + /* Integer */ ae_vector* cntbuf, + ae_int_t n, + ae_int_t nc, + ae_int_t flags, + ae_int_t* info, + double* threshold, + double* e, + /* Real */ ae_vector* sortrbuf, + /* Integer */ ae_vector* sortibuf, + ae_state *_state) +{ + ae_int_t i; + ae_int_t neq; + ae_int_t nless; + ae_int_t ngreater; + ae_int_t q; + ae_int_t qmin; + ae_int_t qmax; + ae_int_t qcnt; + double cursplit; + ae_int_t nleft; + double v; + double cure; + double w; + double sl; + double sr; + + *info = 0; + *threshold = 0; + *e = 0; + + tagsortfasti(x, c, sortrbuf, sortibuf, n, _state); + *e = ae_maxrealnumber; + *threshold = 0.5*(x->ptr.p_double[0]+x->ptr.p_double[n-1]); + *info = -3; + if( flags/dforest_dfusestrongsplits%2==0 ) + { + + /* + * weak splits, split at half + */ + qcnt = 2; + qmin = 1; + qmax = 1; + } + else + { + + /* + * strong splits: choose best quartile + */ + qcnt = 4; + qmin = 1; + qmax = 3; + } + for(q=qmin; q<=qmax; q++) + { + cursplit = x->ptr.p_double[n*q/qcnt]; + neq = 0; + nless = 0; + ngreater = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_less(x->ptr.p_double[i],cursplit) ) + { + nless = nless+1; + } + if( ae_fp_eq(x->ptr.p_double[i],cursplit) ) + { + neq = neq+1; + } + if( ae_fp_greater(x->ptr.p_double[i],cursplit) ) + { + ngreater = ngreater+1; + } + } + ae_assert(neq!=0, "DFSplitR: NEq=0, something strange!!!", _state); + if( nless!=0||ngreater!=0 ) + { + + /* + * set threshold between two partitions, with + * some tweaking to avoid problems with floating point + * arithmetics. + * + * The problem is that when you calculates C = 0.5*(A+B) there + * can be no C which lies strictly between A and B (for example, + * there is no floating point number which is + * greater than 1 and less than 1+eps). In such situations + * we choose right side as theshold (remember that + * points which lie on threshold falls to the right side). + */ + if( nlessptr.p_double[nless+neq-1]+x->ptr.p_double[nless+neq]); + nleft = nless+neq; + if( ae_fp_less_eq(cursplit,x->ptr.p_double[nless+neq-1]) ) + { + cursplit = x->ptr.p_double[nless+neq]; + } + } + else + { + cursplit = 0.5*(x->ptr.p_double[nless-1]+x->ptr.p_double[nless]); + nleft = nless; + if( ae_fp_less_eq(cursplit,x->ptr.p_double[nless-1]) ) + { + cursplit = x->ptr.p_double[nless]; + } + } + *info = 1; + cure = 0; + for(i=0; i<=2*nc-1; i++) + { + cntbuf->ptr.p_int[i] = 0; + } + for(i=0; i<=nleft-1; i++) + { + cntbuf->ptr.p_int[c->ptr.p_int[i]] = cntbuf->ptr.p_int[c->ptr.p_int[i]]+1; + } + for(i=nleft; i<=n-1; i++) + { + cntbuf->ptr.p_int[nc+c->ptr.p_int[i]] = cntbuf->ptr.p_int[nc+c->ptr.p_int[i]]+1; + } + sl = nleft; + sr = n-nleft; + v = 0; + for(i=0; i<=nc-1; i++) + { + w = cntbuf->ptr.p_int[i]; + v = v+w*ae_sqr(w/sl-1, _state); + v = v+(sl-w)*ae_sqr(w/sl, _state); + w = cntbuf->ptr.p_int[nc+i]; + v = v+w*ae_sqr(w/sr-1, _state); + v = v+(sr-w)*ae_sqr(w/sr, _state); + } + cure = ae_sqrt(v/(nc*n), _state); + if( ae_fp_less(cure,*e) ) + { + *threshold = cursplit; + *e = cure; + } + } + } +} + + +/************************************************************************* +Makes split on attribute +*************************************************************************/ +static void dforest_dfsplitr(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t flags, + ae_int_t* info, + double* threshold, + double* e, + /* Real */ ae_vector* sortrbuf, + /* Real */ ae_vector* sortrbuf2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t neq; + ae_int_t nless; + ae_int_t ngreater; + ae_int_t q; + ae_int_t qmin; + ae_int_t qmax; + ae_int_t qcnt; + double cursplit; + ae_int_t nleft; + double v; + double cure; + + *info = 0; + *threshold = 0; + *e = 0; + + tagsortfastr(x, y, sortrbuf, sortrbuf2, n, _state); + *e = ae_maxrealnumber; + *threshold = 0.5*(x->ptr.p_double[0]+x->ptr.p_double[n-1]); + *info = -3; + if( flags/dforest_dfusestrongsplits%2==0 ) + { + + /* + * weak splits, split at half + */ + qcnt = 2; + qmin = 1; + qmax = 1; + } + else + { + + /* + * strong splits: choose best quartile + */ + qcnt = 4; + qmin = 1; + qmax = 3; + } + for(q=qmin; q<=qmax; q++) + { + cursplit = x->ptr.p_double[n*q/qcnt]; + neq = 0; + nless = 0; + ngreater = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_less(x->ptr.p_double[i],cursplit) ) + { + nless = nless+1; + } + if( ae_fp_eq(x->ptr.p_double[i],cursplit) ) + { + neq = neq+1; + } + if( ae_fp_greater(x->ptr.p_double[i],cursplit) ) + { + ngreater = ngreater+1; + } + } + ae_assert(neq!=0, "DFSplitR: NEq=0, something strange!!!", _state); + if( nless!=0||ngreater!=0 ) + { + + /* + * set threshold between two partitions, with + * some tweaking to avoid problems with floating point + * arithmetics. + * + * The problem is that when you calculates C = 0.5*(A+B) there + * can be no C which lies strictly between A and B (for example, + * there is no floating point number which is + * greater than 1 and less than 1+eps). In such situations + * we choose right side as theshold (remember that + * points which lie on threshold falls to the right side). + */ + if( nlessptr.p_double[nless+neq-1]+x->ptr.p_double[nless+neq]); + nleft = nless+neq; + if( ae_fp_less_eq(cursplit,x->ptr.p_double[nless+neq-1]) ) + { + cursplit = x->ptr.p_double[nless+neq]; + } + } + else + { + cursplit = 0.5*(x->ptr.p_double[nless-1]+x->ptr.p_double[nless]); + nleft = nless; + if( ae_fp_less_eq(cursplit,x->ptr.p_double[nless-1]) ) + { + cursplit = x->ptr.p_double[nless]; + } + } + *info = 1; + cure = 0; + v = 0; + for(i=0; i<=nleft-1; i++) + { + v = v+y->ptr.p_double[i]; + } + v = v/nleft; + for(i=0; i<=nleft-1; i++) + { + cure = cure+ae_sqr(y->ptr.p_double[i]-v, _state); + } + v = 0; + for(i=nleft; i<=n-1; i++) + { + v = v+y->ptr.p_double[i]; + } + v = v/(n-nleft); + for(i=nleft; i<=n-1; i++) + { + cure = cure+ae_sqr(y->ptr.p_double[i]-v, _state); + } + cure = ae_sqrt(cure/n, _state); + if( ae_fp_less(cure,*e) ) + { + *threshold = cursplit; + *e = cure; + } + } + } +} + + +ae_bool _decisionforest_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + decisionforest *p = (decisionforest*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->trees, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _decisionforest_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + decisionforest *dst = (decisionforest*)_dst; + decisionforest *src = (decisionforest*)_src; + dst->nvars = src->nvars; + dst->nclasses = src->nclasses; + dst->ntrees = src->ntrees; + dst->bufsize = src->bufsize; + if( !ae_vector_init_copy(&dst->trees, &src->trees, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _decisionforest_clear(void* _p) +{ + decisionforest *p = (decisionforest*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->trees); +} + + +void _decisionforest_destroy(void* _p) +{ + decisionforest *p = (decisionforest*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->trees); +} + + +ae_bool _dfreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + dfreport *p = (dfreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _dfreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + dfreport *dst = (dfreport*)_dst; + dfreport *src = (dfreport*)_src; + dst->relclserror = src->relclserror; + dst->avgce = src->avgce; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + dst->oobrelclserror = src->oobrelclserror; + dst->oobavgce = src->oobavgce; + dst->oobrmserror = src->oobrmserror; + dst->oobavgerror = src->oobavgerror; + dst->oobavgrelerror = src->oobavgrelerror; + return ae_true; +} + + +void _dfreport_clear(void* _p) +{ + dfreport *p = (dfreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _dfreport_destroy(void* _p) +{ + dfreport *p = (dfreport*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _dfinternalbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + dfinternalbuffers *p = (dfinternalbuffers*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->treebuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->idxbuf, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpbufr, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpbufr2, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpbufi, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->classibuf, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->sortrbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->sortrbuf2, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->sortibuf, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->varpool, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->evsbin, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->evssplits, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _dfinternalbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + dfinternalbuffers *dst = (dfinternalbuffers*)_dst; + dfinternalbuffers *src = (dfinternalbuffers*)_src; + if( !ae_vector_init_copy(&dst->treebuf, &src->treebuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->idxbuf, &src->idxbuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpbufr, &src->tmpbufr, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpbufr2, &src->tmpbufr2, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpbufi, &src->tmpbufi, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->classibuf, &src->classibuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->sortrbuf, &src->sortrbuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->sortrbuf2, &src->sortrbuf2, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->sortibuf, &src->sortibuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->varpool, &src->varpool, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->evsbin, &src->evsbin, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->evssplits, &src->evssplits, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _dfinternalbuffers_clear(void* _p) +{ + dfinternalbuffers *p = (dfinternalbuffers*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->treebuf); + ae_vector_clear(&p->idxbuf); + ae_vector_clear(&p->tmpbufr); + ae_vector_clear(&p->tmpbufr2); + ae_vector_clear(&p->tmpbufi); + ae_vector_clear(&p->classibuf); + ae_vector_clear(&p->sortrbuf); + ae_vector_clear(&p->sortrbuf2); + ae_vector_clear(&p->sortibuf); + ae_vector_clear(&p->varpool); + ae_vector_clear(&p->evsbin); + ae_vector_clear(&p->evssplits); +} + + +void _dfinternalbuffers_destroy(void* _p) +{ + dfinternalbuffers *p = (dfinternalbuffers*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->treebuf); + ae_vector_destroy(&p->idxbuf); + ae_vector_destroy(&p->tmpbufr); + ae_vector_destroy(&p->tmpbufr2); + ae_vector_destroy(&p->tmpbufi); + ae_vector_destroy(&p->classibuf); + ae_vector_destroy(&p->sortrbuf); + ae_vector_destroy(&p->sortrbuf2); + ae_vector_destroy(&p->sortibuf); + ae_vector_destroy(&p->varpool); + ae_vector_destroy(&p->evsbin); + ae_vector_destroy(&p->evssplits); +} + + + + +/************************************************************************* +Linear regression + +Subroutine builds model: + + Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + A(N) + +and model found in ALGLIB format, covariation matrix, training set errors +(rms, average, average relative) and leave-one-out cross-validation +estimate of the generalization error. CV estimate calculated using fast +algorithm with O(NPoints*NVars) complexity. + +When covariation matrix is calculated standard deviations of function +values are assumed to be equal to RMS error on the training set. + +INPUT PARAMETERS: + XY - training set, array [0..NPoints-1,0..NVars]: + * NVars columns - independent variables + * last column - dependent variable + NPoints - training set size, NPoints>NVars+1 + NVars - number of independent variables + +OUTPUT PARAMETERS: + Info - return code: + * -255, in case of unknown internal error + * -4, if internal SVD subroutine haven't converged + * -1, if incorrect parameters was passed (NPointsrmserror, _state)*npoints/(npoints-nvars-1); + for(i=0; i<=nvars; i++) + { + ae_v_muld(&ar->c.ptr.pp_double[i][0], 1, ae_v_len(0,nvars), sigma2); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Linear regression + +Variant of LRBuild which uses vector of standatd deviations (errors in +function values). + +INPUT PARAMETERS: + XY - training set, array [0..NPoints-1,0..NVars]: + * NVars columns - independent variables + * last column - dependent variable + S - standard deviations (errors in function values) + array[0..NPoints-1], S[i]>0. + NPoints - training set size, NPoints>NVars+1 + NVars - number of independent variables + +OUTPUT PARAMETERS: + Info - return code: + * -255, in case of unknown internal error + * -4, if internal SVD subroutine haven't converged + * -1, if incorrect parameters was passed (NPointsptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + xyi.ptr.pp_double[i][nvars] = 1; + xyi.ptr.pp_double[i][nvars+1] = xy->ptr.pp_double[i][nvars]; + } + + /* + * Standartization + */ + ae_vector_set_length(&x, npoints-1+1, _state); + ae_vector_set_length(&means, nvars-1+1, _state); + ae_vector_set_length(&sigmas, nvars-1+1, _state); + for(j=0; j<=nvars-1; j++) + { + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[0][j], xy->stride, ae_v_len(0,npoints-1)); + samplemoments(&x, npoints, &mean, &variance, &skewness, &kurtosis, _state); + means.ptr.p_double[j] = mean; + sigmas.ptr.p_double[j] = ae_sqrt(variance, _state); + if( ae_fp_eq(sigmas.ptr.p_double[j],0) ) + { + sigmas.ptr.p_double[j] = 1; + } + for(i=0; i<=npoints-1; i++) + { + xyi.ptr.pp_double[i][j] = (xyi.ptr.pp_double[i][j]-means.ptr.p_double[j])/sigmas.ptr.p_double[j]; + } + } + + /* + * Internal processing + */ + linreg_lrinternal(&xyi, s, npoints, nvars+1, info, lm, ar, _state); + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Un-standartization + */ + offs = ae_round(lm->w.ptr.p_double[3], _state); + for(j=0; j<=nvars-1; j++) + { + + /* + * Constant term is updated (and its covariance too, + * since it gets some variance from J-th component) + */ + lm->w.ptr.p_double[offs+nvars] = lm->w.ptr.p_double[offs+nvars]-lm->w.ptr.p_double[offs+j]*means.ptr.p_double[j]/sigmas.ptr.p_double[j]; + v = means.ptr.p_double[j]/sigmas.ptr.p_double[j]; + ae_v_subd(&ar->c.ptr.pp_double[nvars][0], 1, &ar->c.ptr.pp_double[j][0], 1, ae_v_len(0,nvars), v); + ae_v_subd(&ar->c.ptr.pp_double[0][nvars], ar->c.stride, &ar->c.ptr.pp_double[0][j], ar->c.stride, ae_v_len(0,nvars), v); + + /* + * J-th term is updated + */ + lm->w.ptr.p_double[offs+j] = lm->w.ptr.p_double[offs+j]/sigmas.ptr.p_double[j]; + v = 1/sigmas.ptr.p_double[j]; + ae_v_muld(&ar->c.ptr.pp_double[j][0], 1, ae_v_len(0,nvars), v); + ae_v_muld(&ar->c.ptr.pp_double[0][j], ar->c.stride, ae_v_len(0,nvars), v); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Like LRBuildS, but builds model + + Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + +i.e. with zero constant term. + + -- ALGLIB -- + Copyright 30.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lrbuildzs(/* Real */ ae_matrix* xy, + /* Real */ ae_vector* s, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + linearmodel* lm, + lrreport* ar, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix xyi; + ae_vector x; + ae_vector c; + ae_int_t i; + ae_int_t j; + double v; + ae_int_t offs; + double mean; + double variance; + double skewness; + double kurtosis; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _linearmodel_clear(lm); + _lrreport_clear(ar); + ae_matrix_init(&xyi, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&c, 0, DT_REAL, _state, ae_true); + + + /* + * Test parameters + */ + if( npoints<=nvars+1||nvars<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + + /* + * Copy data, add one more column (constant term) + */ + ae_matrix_set_length(&xyi, npoints-1+1, nvars+1+1, _state); + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&xyi.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + xyi.ptr.pp_double[i][nvars] = 0; + xyi.ptr.pp_double[i][nvars+1] = xy->ptr.pp_double[i][nvars]; + } + + /* + * Standartization: unusual scaling + */ + ae_vector_set_length(&x, npoints-1+1, _state); + ae_vector_set_length(&c, nvars-1+1, _state); + for(j=0; j<=nvars-1; j++) + { + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[0][j], xy->stride, ae_v_len(0,npoints-1)); + samplemoments(&x, npoints, &mean, &variance, &skewness, &kurtosis, _state); + if( ae_fp_greater(ae_fabs(mean, _state),ae_sqrt(variance, _state)) ) + { + + /* + * variation is relatively small, it is better to + * bring mean value to 1 + */ + c.ptr.p_double[j] = mean; + } + else + { + + /* + * variation is large, it is better to bring variance to 1 + */ + if( ae_fp_eq(variance,0) ) + { + variance = 1; + } + c.ptr.p_double[j] = ae_sqrt(variance, _state); + } + for(i=0; i<=npoints-1; i++) + { + xyi.ptr.pp_double[i][j] = xyi.ptr.pp_double[i][j]/c.ptr.p_double[j]; + } + } + + /* + * Internal processing + */ + linreg_lrinternal(&xyi, s, npoints, nvars+1, info, lm, ar, _state); + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Un-standartization + */ + offs = ae_round(lm->w.ptr.p_double[3], _state); + for(j=0; j<=nvars-1; j++) + { + + /* + * J-th term is updated + */ + lm->w.ptr.p_double[offs+j] = lm->w.ptr.p_double[offs+j]/c.ptr.p_double[j]; + v = 1/c.ptr.p_double[j]; + ae_v_muld(&ar->c.ptr.pp_double[j][0], 1, ae_v_len(0,nvars), v); + ae_v_muld(&ar->c.ptr.pp_double[0][j], ar->c.stride, ae_v_len(0,nvars), v); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Like LRBuild but builds model + + Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + +i.e. with zero constant term. + + -- ALGLIB -- + Copyright 30.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lrbuildz(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + linearmodel* lm, + lrreport* ar, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector s; + ae_int_t i; + double sigma2; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _linearmodel_clear(lm); + _lrreport_clear(ar); + ae_vector_init(&s, 0, DT_REAL, _state, ae_true); + + if( npoints<=nvars+1||nvars<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&s, npoints-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + s.ptr.p_double[i] = 1; + } + lrbuildzs(xy, &s, npoints, nvars, info, lm, ar, _state); + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + sigma2 = ae_sqr(ar->rmserror, _state)*npoints/(npoints-nvars-1); + for(i=0; i<=nvars; i++) + { + ae_v_muld(&ar->c.ptr.pp_double[i][0], 1, ae_v_len(0,nvars), sigma2); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Unpacks coefficients of linear model. + +INPUT PARAMETERS: + LM - linear model in ALGLIB format + +OUTPUT PARAMETERS: + V - coefficients, array[0..NVars] + constant term (intercept) is stored in the V[NVars]. + NVars - number of independent variables (one less than number + of coefficients) + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +void lrunpack(linearmodel* lm, + /* Real */ ae_vector* v, + ae_int_t* nvars, + ae_state *_state) +{ + ae_int_t offs; + + ae_vector_clear(v); + *nvars = 0; + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); + *nvars = ae_round(lm->w.ptr.p_double[2], _state); + offs = ae_round(lm->w.ptr.p_double[3], _state); + ae_vector_set_length(v, *nvars+1, _state); + ae_v_move(&v->ptr.p_double[0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,*nvars)); +} + + +/************************************************************************* +"Packs" coefficients and creates linear model in ALGLIB format (LRUnpack +reversed). + +INPUT PARAMETERS: + V - coefficients, array[0..NVars] + NVars - number of independent variables + +OUTPUT PAREMETERS: + LM - linear model. + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +void lrpack(/* Real */ ae_vector* v, + ae_int_t nvars, + linearmodel* lm, + ae_state *_state) +{ + ae_int_t offs; + + _linearmodel_clear(lm); + + ae_vector_set_length(&lm->w, 4+nvars+1, _state); + offs = 4; + lm->w.ptr.p_double[0] = 4+nvars+1; + lm->w.ptr.p_double[1] = linreg_lrvnum; + lm->w.ptr.p_double[2] = nvars; + lm->w.ptr.p_double[3] = offs; + ae_v_move(&lm->w.ptr.p_double[offs], 1, &v->ptr.p_double[0], 1, ae_v_len(offs,offs+nvars)); +} + + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + LM - linear model + X - input vector, array[0..NVars-1]. + +Result: + value of linear model regression estimate + + -- ALGLIB -- + Copyright 03.09.2008 by Bochkanov Sergey +*************************************************************************/ +double lrprocess(linearmodel* lm, + /* Real */ ae_vector* x, + ae_state *_state) +{ + double v; + ae_int_t offs; + ae_int_t nvars; + double result; + + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); + nvars = ae_round(lm->w.ptr.p_double[2], _state); + offs = ae_round(lm->w.ptr.p_double[3], _state); + v = ae_v_dotproduct(&x->ptr.p_double[0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); + result = v+lm->w.ptr.p_double[offs+nvars]; + return result; +} + + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + LM - linear model + XY - test set + NPoints - test set size + +RESULT: + root mean square error. + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double lrrmserror(linearmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_int_t i; + double v; + ae_int_t offs; + ae_int_t nvars; + double result; + + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); + nvars = ae_round(lm->w.ptr.p_double[2], _state); + offs = ae_round(lm->w.ptr.p_double[3], _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + v = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); + v = v+lm->w.ptr.p_double[offs+nvars]; + result = result+ae_sqr(v-xy->ptr.pp_double[i][nvars], _state); + } + result = ae_sqrt(result/npoints, _state); + return result; +} + + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + LM - linear model + XY - test set + NPoints - test set size + +RESULT: + average error. + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double lravgerror(linearmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_int_t i; + double v; + ae_int_t offs; + ae_int_t nvars; + double result; + + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); + nvars = ae_round(lm->w.ptr.p_double[2], _state); + offs = ae_round(lm->w.ptr.p_double[3], _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + v = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); + v = v+lm->w.ptr.p_double[offs+nvars]; + result = result+ae_fabs(v-xy->ptr.pp_double[i][nvars], _state); + } + result = result/npoints; + return result; +} + + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + LM - linear model + XY - test set + NPoints - test set size + +RESULT: + average relative error. + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double lravgrelerror(linearmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + double v; + ae_int_t offs; + ae_int_t nvars; + double result; + + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==linreg_lrvnum, "LINREG: Incorrect LINREG version!", _state); + nvars = ae_round(lm->w.ptr.p_double[2], _state); + offs = ae_round(lm->w.ptr.p_double[3], _state); + result = 0; + k = 0; + for(i=0; i<=npoints-1; i++) + { + if( ae_fp_neq(xy->ptr.pp_double[i][nvars],0) ) + { + v = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); + v = v+lm->w.ptr.p_double[offs+nvars]; + result = result+ae_fabs((v-xy->ptr.pp_double[i][nvars])/xy->ptr.pp_double[i][nvars], _state); + k = k+1; + } + } + if( k!=0 ) + { + result = result/k; + } + return result; +} + + +/************************************************************************* +Copying of LinearModel strucure + +INPUT PARAMETERS: + LM1 - original + +OUTPUT PARAMETERS: + LM2 - copy + + -- ALGLIB -- + Copyright 15.03.2009 by Bochkanov Sergey +*************************************************************************/ +void lrcopy(linearmodel* lm1, linearmodel* lm2, ae_state *_state) +{ + ae_int_t k; + + _linearmodel_clear(lm2); + + k = ae_round(lm1->w.ptr.p_double[0], _state); + ae_vector_set_length(&lm2->w, k-1+1, _state); + ae_v_move(&lm2->w.ptr.p_double[0], 1, &lm1->w.ptr.p_double[0], 1, ae_v_len(0,k-1)); +} + + +void lrlines(/* Real */ ae_matrix* xy, + /* Real */ ae_vector* s, + ae_int_t n, + ae_int_t* info, + double* a, + double* b, + double* vara, + double* varb, + double* covab, + double* corrab, + double* p, + ae_state *_state) +{ + ae_int_t i; + double ss; + double sx; + double sxx; + double sy; + double stt; + double e1; + double e2; + double t; + double chi2; + + *info = 0; + *a = 0; + *b = 0; + *vara = 0; + *varb = 0; + *covab = 0; + *corrab = 0; + *p = 0; + + if( n<2 ) + { + *info = -1; + return; + } + for(i=0; i<=n-1; i++) + { + if( ae_fp_less_eq(s->ptr.p_double[i],0) ) + { + *info = -2; + return; + } + } + *info = 1; + + /* + * Calculate S, SX, SY, SXX + */ + ss = 0; + sx = 0; + sy = 0; + sxx = 0; + for(i=0; i<=n-1; i++) + { + t = ae_sqr(s->ptr.p_double[i], _state); + ss = ss+1/t; + sx = sx+xy->ptr.pp_double[i][0]/t; + sy = sy+xy->ptr.pp_double[i][1]/t; + sxx = sxx+ae_sqr(xy->ptr.pp_double[i][0], _state)/t; + } + + /* + * Test for condition number + */ + t = ae_sqrt(4*ae_sqr(sx, _state)+ae_sqr(ss-sxx, _state), _state); + e1 = 0.5*(ss+sxx+t); + e2 = 0.5*(ss+sxx-t); + if( ae_fp_less_eq(ae_minreal(e1, e2, _state),1000*ae_machineepsilon*ae_maxreal(e1, e2, _state)) ) + { + *info = -3; + return; + } + + /* + * Calculate A, B + */ + *a = 0; + *b = 0; + stt = 0; + for(i=0; i<=n-1; i++) + { + t = (xy->ptr.pp_double[i][0]-sx/ss)/s->ptr.p_double[i]; + *b = *b+t*xy->ptr.pp_double[i][1]/s->ptr.p_double[i]; + stt = stt+ae_sqr(t, _state); + } + *b = *b/stt; + *a = (sy-sx*(*b))/ss; + + /* + * Calculate goodness-of-fit + */ + if( n>2 ) + { + chi2 = 0; + for(i=0; i<=n-1; i++) + { + chi2 = chi2+ae_sqr((xy->ptr.pp_double[i][1]-(*a)-*b*xy->ptr.pp_double[i][0])/s->ptr.p_double[i], _state); + } + *p = incompletegammac((double)(n-2)/(double)2, chi2/2, _state); + } + else + { + *p = 1; + } + + /* + * Calculate other parameters + */ + *vara = (1+ae_sqr(sx, _state)/(ss*stt))/ss; + *varb = 1/stt; + *covab = -sx/(ss*stt); + *corrab = *covab/ae_sqrt(*vara*(*varb), _state); +} + + +void lrline(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t* info, + double* a, + double* b, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector s; + ae_int_t i; + double vara; + double varb; + double covab; + double corrab; + double p; + + ae_frame_make(_state, &_frame_block); + *info = 0; + *a = 0; + *b = 0; + ae_vector_init(&s, 0, DT_REAL, _state, ae_true); + + if( n<2 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&s, n-1+1, _state); + for(i=0; i<=n-1; i++) + { + s.ptr.p_double[i] = 1; + } + lrlines(xy, &s, n, info, a, b, &vara, &varb, &covab, &corrab, &p, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal linear regression subroutine +*************************************************************************/ +static void linreg_lrinternal(/* Real */ ae_matrix* xy, + /* Real */ ae_vector* s, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + linearmodel* lm, + lrreport* ar, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix a; + ae_matrix u; + ae_matrix vt; + ae_matrix vm; + ae_matrix xym; + ae_vector b; + ae_vector sv; + ae_vector t; + ae_vector svi; + ae_vector work; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t ncv; + ae_int_t na; + ae_int_t nacv; + double r; + double p; + double epstol; + lrreport ar2; + ae_int_t offs; + linearmodel tlm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _linearmodel_clear(lm); + _lrreport_clear(ar); + ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&vm, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xym, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sv, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&svi, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + _lrreport_init(&ar2, _state, ae_true); + _linearmodel_init(&tlm, _state, ae_true); + + epstol = 1000; + + /* + * Check for errors in data + */ + if( npointsptr.p_double[i],0) ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + *info = 1; + + /* + * Create design matrix + */ + ae_matrix_set_length(&a, npoints-1+1, nvars-1+1, _state); + ae_vector_set_length(&b, npoints-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + r = 1/s->ptr.p_double[i]; + ae_v_moved(&a.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1), r); + b.ptr.p_double[i] = xy->ptr.pp_double[i][nvars]/s->ptr.p_double[i]; + } + + /* + * Allocate W: + * W[0] array size + * W[1] version number, 0 + * W[2] NVars (minus 1, to be compatible with external representation) + * W[3] coefficients offset + */ + ae_vector_set_length(&lm->w, 4+nvars-1+1, _state); + offs = 4; + lm->w.ptr.p_double[0] = 4+nvars; + lm->w.ptr.p_double[1] = linreg_lrvnum; + lm->w.ptr.p_double[2] = nvars-1; + lm->w.ptr.p_double[3] = offs; + + /* + * Solve problem using SVD: + * + * 0. check for degeneracy (different types) + * 1. A = U*diag(sv)*V' + * 2. T = b'*U + * 3. w = SUM((T[i]/sv[i])*V[..,i]) + * 4. cov(wi,wj) = SUM(Vji*Vjk/sv[i]^2,K=1..M) + * + * see $15.4 of "Numerical Recipes in C" for more information + */ + ae_vector_set_length(&t, nvars-1+1, _state); + ae_vector_set_length(&svi, nvars-1+1, _state); + ae_matrix_set_length(&ar->c, nvars-1+1, nvars-1+1, _state); + ae_matrix_set_length(&vm, nvars-1+1, nvars-1+1, _state); + if( !rmatrixsvd(&a, npoints, nvars, 1, 1, 2, &sv, &u, &vt, _state) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + if( ae_fp_less_eq(sv.ptr.p_double[0],0) ) + { + + /* + * Degenerate case: zero design matrix. + */ + for(i=offs; i<=offs+nvars-1; i++) + { + lm->w.ptr.p_double[i] = 0; + } + ar->rmserror = lrrmserror(lm, xy, npoints, _state); + ar->avgerror = lravgerror(lm, xy, npoints, _state); + ar->avgrelerror = lravgrelerror(lm, xy, npoints, _state); + ar->cvrmserror = ar->rmserror; + ar->cvavgerror = ar->avgerror; + ar->cvavgrelerror = ar->avgrelerror; + ar->ncvdefects = 0; + ae_vector_set_length(&ar->cvdefects, nvars-1+1, _state); + ae_matrix_set_length(&ar->c, nvars-1+1, nvars-1+1, _state); + for(i=0; i<=nvars-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + ar->c.ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return; + } + if( ae_fp_less_eq(sv.ptr.p_double[nvars-1],epstol*ae_machineepsilon*sv.ptr.p_double[0]) ) + { + + /* + * Degenerate case, non-zero design matrix. + * + * We can leave it and solve task in SVD least squares fashion. + * Solution and covariance matrix will be obtained correctly, + * but CV error estimates - will not. It is better to reduce + * it to non-degenerate task and to obtain correct CV estimates. + */ + for(k=nvars; k>=1; k--) + { + if( ae_fp_greater(sv.ptr.p_double[k-1],epstol*ae_machineepsilon*sv.ptr.p_double[0]) ) + { + + /* + * Reduce + */ + ae_matrix_set_length(&xym, npoints-1+1, k+1, _state); + for(i=0; i<=npoints-1; i++) + { + for(j=0; j<=k-1; j++) + { + r = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &vt.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); + xym.ptr.pp_double[i][j] = r; + } + xym.ptr.pp_double[i][k] = xy->ptr.pp_double[i][nvars]; + } + + /* + * Solve + */ + linreg_lrinternal(&xym, s, npoints, k, info, &tlm, &ar2, _state); + if( *info!=1 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Convert back to un-reduced format + */ + for(j=0; j<=nvars-1; j++) + { + lm->w.ptr.p_double[offs+j] = 0; + } + for(j=0; j<=k-1; j++) + { + r = tlm.w.ptr.p_double[offs+j]; + ae_v_addd(&lm->w.ptr.p_double[offs], 1, &vt.ptr.pp_double[j][0], 1, ae_v_len(offs,offs+nvars-1), r); + } + ar->rmserror = ar2.rmserror; + ar->avgerror = ar2.avgerror; + ar->avgrelerror = ar2.avgrelerror; + ar->cvrmserror = ar2.cvrmserror; + ar->cvavgerror = ar2.cvavgerror; + ar->cvavgrelerror = ar2.cvavgrelerror; + ar->ncvdefects = ar2.ncvdefects; + ae_vector_set_length(&ar->cvdefects, nvars-1+1, _state); + for(j=0; j<=ar->ncvdefects-1; j++) + { + ar->cvdefects.ptr.p_int[j] = ar2.cvdefects.ptr.p_int[j]; + } + ae_matrix_set_length(&ar->c, nvars-1+1, nvars-1+1, _state); + ae_vector_set_length(&work, nvars+1, _state); + matrixmatrixmultiply(&ar2.c, 0, k-1, 0, k-1, ae_false, &vt, 0, k-1, 0, nvars-1, ae_false, 1.0, &vm, 0, k-1, 0, nvars-1, 0.0, &work, _state); + matrixmatrixmultiply(&vt, 0, k-1, 0, nvars-1, ae_true, &vm, 0, k-1, 0, nvars-1, ae_false, 1.0, &ar->c, 0, nvars-1, 0, nvars-1, 0.0, &work, _state); + ae_frame_leave(_state); + return; + } + } + *info = -255; + ae_frame_leave(_state); + return; + } + for(i=0; i<=nvars-1; i++) + { + if( ae_fp_greater(sv.ptr.p_double[i],epstol*ae_machineepsilon*sv.ptr.p_double[0]) ) + { + svi.ptr.p_double[i] = 1/sv.ptr.p_double[i]; + } + else + { + svi.ptr.p_double[i] = 0; + } + } + for(i=0; i<=nvars-1; i++) + { + t.ptr.p_double[i] = 0; + } + for(i=0; i<=npoints-1; i++) + { + r = b.ptr.p_double[i]; + ae_v_addd(&t.ptr.p_double[0], 1, &u.ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1), r); + } + for(i=0; i<=nvars-1; i++) + { + lm->w.ptr.p_double[offs+i] = 0; + } + for(i=0; i<=nvars-1; i++) + { + r = t.ptr.p_double[i]*svi.ptr.p_double[i]; + ae_v_addd(&lm->w.ptr.p_double[offs], 1, &vt.ptr.pp_double[i][0], 1, ae_v_len(offs,offs+nvars-1), r); + } + for(j=0; j<=nvars-1; j++) + { + r = svi.ptr.p_double[j]; + ae_v_moved(&vm.ptr.pp_double[0][j], vm.stride, &vt.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1), r); + } + for(i=0; i<=nvars-1; i++) + { + for(j=i; j<=nvars-1; j++) + { + r = ae_v_dotproduct(&vm.ptr.pp_double[i][0], 1, &vm.ptr.pp_double[j][0], 1, ae_v_len(0,nvars-1)); + ar->c.ptr.pp_double[i][j] = r; + ar->c.ptr.pp_double[j][i] = r; + } + } + + /* + * Leave-1-out cross-validation error. + * + * NOTATIONS: + * A design matrix + * A*x = b original linear least squares task + * U*S*V' SVD of A + * ai i-th row of the A + * bi i-th element of the b + * xf solution of the original LLS task + * + * Cross-validation error of i-th element from a sample is + * calculated using following formula: + * + * ERRi = ai*xf - (ai*xf-bi*(ui*ui'))/(1-ui*ui') (1) + * + * This formula can be derived from normal equations of the + * original task + * + * (A'*A)x = A'*b (2) + * + * by applying modification (zeroing out i-th row of A) to (2): + * + * (A-ai)'*(A-ai) = (A-ai)'*b + * + * and using Sherman-Morrison formula for updating matrix inverse + * + * NOTE 1: b is not zeroed out since it is much simpler and + * does not influence final result. + * + * NOTE 2: some design matrices A have such ui that 1-ui*ui'=0. + * Formula (1) can't be applied for such cases and they are skipped + * from CV calculation (which distorts resulting CV estimate). + * But from the properties of U we can conclude that there can + * be no more than NVars such vectors. Usually + * NVars << NPoints, so in a normal case it only slightly + * influences result. + */ + ncv = 0; + na = 0; + nacv = 0; + ar->rmserror = 0; + ar->avgerror = 0; + ar->avgrelerror = 0; + ar->cvrmserror = 0; + ar->cvavgerror = 0; + ar->cvavgrelerror = 0; + ar->ncvdefects = 0; + ae_vector_set_length(&ar->cvdefects, nvars-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + + /* + * Error on a training set + */ + r = ae_v_dotproduct(&xy->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs], 1, ae_v_len(0,nvars-1)); + ar->rmserror = ar->rmserror+ae_sqr(r-xy->ptr.pp_double[i][nvars], _state); + ar->avgerror = ar->avgerror+ae_fabs(r-xy->ptr.pp_double[i][nvars], _state); + if( ae_fp_neq(xy->ptr.pp_double[i][nvars],0) ) + { + ar->avgrelerror = ar->avgrelerror+ae_fabs((r-xy->ptr.pp_double[i][nvars])/xy->ptr.pp_double[i][nvars], _state); + na = na+1; + } + + /* + * Error using fast leave-one-out cross-validation + */ + p = ae_v_dotproduct(&u.ptr.pp_double[i][0], 1, &u.ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + if( ae_fp_greater(p,1-epstol*ae_machineepsilon) ) + { + ar->cvdefects.ptr.p_int[ar->ncvdefects] = i; + ar->ncvdefects = ar->ncvdefects+1; + continue; + } + r = s->ptr.p_double[i]*(r/s->ptr.p_double[i]-b.ptr.p_double[i]*p)/(1-p); + ar->cvrmserror = ar->cvrmserror+ae_sqr(r-xy->ptr.pp_double[i][nvars], _state); + ar->cvavgerror = ar->cvavgerror+ae_fabs(r-xy->ptr.pp_double[i][nvars], _state); + if( ae_fp_neq(xy->ptr.pp_double[i][nvars],0) ) + { + ar->cvavgrelerror = ar->cvavgrelerror+ae_fabs((r-xy->ptr.pp_double[i][nvars])/xy->ptr.pp_double[i][nvars], _state); + nacv = nacv+1; + } + ncv = ncv+1; + } + if( ncv==0 ) + { + + /* + * Something strange: ALL ui are degenerate. + * Unexpected... + */ + *info = -255; + ae_frame_leave(_state); + return; + } + ar->rmserror = ae_sqrt(ar->rmserror/npoints, _state); + ar->avgerror = ar->avgerror/npoints; + if( na!=0 ) + { + ar->avgrelerror = ar->avgrelerror/na; + } + ar->cvrmserror = ae_sqrt(ar->cvrmserror/ncv, _state); + ar->cvavgerror = ar->cvavgerror/ncv; + if( nacv!=0 ) + { + ar->cvavgrelerror = ar->cvavgrelerror/nacv; + } + ae_frame_leave(_state); +} + + +ae_bool _linearmodel_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + linearmodel *p = (linearmodel*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->w, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _linearmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + linearmodel *dst = (linearmodel*)_dst; + linearmodel *src = (linearmodel*)_src; + if( !ae_vector_init_copy(&dst->w, &src->w, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _linearmodel_clear(void* _p) +{ + linearmodel *p = (linearmodel*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->w); +} + + +void _linearmodel_destroy(void* _p) +{ + linearmodel *p = (linearmodel*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->w); +} + + +ae_bool _lrreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + lrreport *p = (lrreport*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->c, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cvdefects, 0, DT_INT, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _lrreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + lrreport *dst = (lrreport*)_dst; + lrreport *src = (lrreport*)_src; + if( !ae_matrix_init_copy(&dst->c, &src->c, _state, make_automatic) ) + return ae_false; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + dst->cvrmserror = src->cvrmserror; + dst->cvavgerror = src->cvavgerror; + dst->cvavgrelerror = src->cvavgrelerror; + dst->ncvdefects = src->ncvdefects; + if( !ae_vector_init_copy(&dst->cvdefects, &src->cvdefects, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _lrreport_clear(void* _p) +{ + lrreport *p = (lrreport*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->c); + ae_vector_clear(&p->cvdefects); +} + + +void _lrreport_destroy(void* _p) +{ + lrreport *p = (lrreport*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->c); + ae_vector_destroy(&p->cvdefects); +} + + + + +/************************************************************************* +Filters: simple moving averages (unsymmetric). + +This filter replaces array by results of SMA(K) filter. SMA(K) is defined +as filter which averages at most K previous points (previous - not points +AROUND central point) - or less, in case of the first K-1 points. + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + K - K>=1 (K can be larger than N , such cases will be + correctly handled). Window width. K=1 corresponds to + identity transformation (nothing changes). + +OUTPUT PARAMETERS: + X - array, whose first N elements were processed with SMA(K) + +NOTE 1: this function uses efficient in-place algorithm which does not + allocate temporary arrays. + +NOTE 2: this algorithm makes only one pass through array and uses running + sum to speed-up calculation of the averages. Additional measures + are taken to ensure that running sum on a long sequence of zero + elements will be correctly reset to zero even in the presence of + round-off error. + +NOTE 3: this is unsymmetric version of the algorithm, which does NOT + averages points after the current one. Only X[i], X[i-1], ... are + used when calculating new value of X[i]. We should also note that + this algorithm uses BOTH previous points and current one, i.e. + new value of X[i] depends on BOTH previous point and X[i] itself. + + -- ALGLIB -- + Copyright 25.10.2011 by Bochkanov Sergey +*************************************************************************/ +void filtersma(/* Real */ ae_vector* x, + ae_int_t n, + ae_int_t k, + ae_state *_state) +{ + ae_int_t i; + double runningsum; + double termsinsum; + ae_int_t zeroprefix; + double v; + + + ae_assert(n>=0, "FilterSMA: N<0", _state); + ae_assert(x->cnt>=n, "FilterSMA: Length(X)=1, "FilterSMA: K<1", _state); + + /* + * Quick exit, if necessary + */ + if( n<=1||k==1 ) + { + return; + } + + /* + * Prepare variables (see below for explanation) + */ + runningsum = 0.0; + termsinsum = 0; + for(i=ae_maxint(n-k, 0, _state); i<=n-1; i++) + { + runningsum = runningsum+x->ptr.p_double[i]; + termsinsum = termsinsum+1; + } + i = ae_maxint(n-k, 0, _state); + zeroprefix = 0; + while(i<=n-1&&ae_fp_eq(x->ptr.p_double[i],0)) + { + zeroprefix = zeroprefix+1; + i = i+1; + } + + /* + * General case: we assume that N>1 and K>1 + * + * Make one pass through all elements. At the beginning of + * the iteration we have: + * * I element being processed + * * RunningSum current value of the running sum + * (including I-th element) + * * TermsInSum number of terms in sum, 0<=TermsInSum<=K + * * ZeroPrefix length of the sequence of zero elements + * which starts at X[I-K+1] and continues towards X[I]. + * Equal to zero in case X[I-K+1] is non-zero. + * This value is used to make RunningSum exactly zero + * when it follows from the problem properties. + */ + for(i=n-1; i>=0; i--) + { + + /* + * Store new value of X[i], save old value in V + */ + v = x->ptr.p_double[i]; + x->ptr.p_double[i] = runningsum/termsinsum; + + /* + * Update RunningSum and TermsInSum + */ + if( i-k>=0 ) + { + runningsum = runningsum-v+x->ptr.p_double[i-k]; + } + else + { + runningsum = runningsum-v; + termsinsum = termsinsum-1; + } + + /* + * Update ZeroPrefix. + * In case we have ZeroPrefix=TermsInSum, + * RunningSum is reset to zero. + */ + if( i-k>=0 ) + { + if( ae_fp_neq(x->ptr.p_double[i-k],0) ) + { + zeroprefix = 0; + } + else + { + zeroprefix = ae_minint(zeroprefix+1, k, _state); + } + } + else + { + zeroprefix = ae_minint(zeroprefix, i+1, _state); + } + if( ae_fp_eq(zeroprefix,termsinsum) ) + { + runningsum = 0; + } + } +} + + +/************************************************************************* +Filters: exponential moving averages. + +This filter replaces array by results of EMA(alpha) filter. EMA(alpha) is +defined as filter which replaces X[] by S[]: + S[0] = X[0] + S[t] = alpha*X[t] + (1-alpha)*S[t-1] + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + alpha - 0=0, "FilterEMA: N<0", _state); + ae_assert(x->cnt>=n, "FilterEMA: Length(X)1", _state); + + /* + * Quick exit, if necessary + */ + if( n<=1||ae_fp_eq(alpha,1) ) + { + return; + } + + /* + * Process + */ + for(i=1; i<=n-1; i++) + { + x->ptr.p_double[i] = alpha*x->ptr.p_double[i]+(1-alpha)*x->ptr.p_double[i-1]; + } +} + + +/************************************************************************* +Filters: linear regression moving averages. + +This filter replaces array by results of LRMA(K) filter. + +LRMA(K) is defined as filter which, for each data point, builds linear +regression model using K prevous points (point itself is included in +these K points) and calculates value of this linear model at the point in +question. + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + K - K>=1 (K can be larger than N , such cases will be + correctly handled). Window width. K=1 corresponds to + identity transformation (nothing changes). + +OUTPUT PARAMETERS: + X - array, whose first N elements were processed with SMA(K) + +NOTE 1: this function uses efficient in-place algorithm which does not + allocate temporary arrays. + +NOTE 2: this algorithm makes only one pass through array and uses running + sum to speed-up calculation of the averages. Additional measures + are taken to ensure that running sum on a long sequence of zero + elements will be correctly reset to zero even in the presence of + round-off error. + +NOTE 3: this is unsymmetric version of the algorithm, which does NOT + averages points after the current one. Only X[i], X[i-1], ... are + used when calculating new value of X[i]. We should also note that + this algorithm uses BOTH previous points and current one, i.e. + new value of X[i] depends on BOTH previous point and X[i] itself. + + -- ALGLIB -- + Copyright 25.10.2011 by Bochkanov Sergey +*************************************************************************/ +void filterlrma(/* Real */ ae_vector* x, + ae_int_t n, + ae_int_t k, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t m; + ae_matrix xy; + ae_vector s; + ae_int_t info; + double a; + double b; + double vara; + double varb; + double covab; + double corrab; + double p; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init(&xy, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&s, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=0, "FilterLRMA: N<0", _state); + ae_assert(x->cnt>=n, "FilterLRMA: Length(X)=1, "FilterLRMA: K<1", _state); + + /* + * Quick exit, if necessary: + * * either N is equal to 1 (nothing to average) + * * or K is 1 (only point itself is used) or 2 (model is too simple, + * we will always get identity transformation) + */ + if( n<=1||k<=2 ) + { + ae_frame_leave(_state); + return; + } + + /* + * General case: K>2, N>1. + * We do not process points with I<2 because first two points (I=0 and I=1) will be + * left unmodified by LRMA filter in any case. + */ + ae_matrix_set_length(&xy, k, 2, _state); + ae_vector_set_length(&s, k, _state); + for(i=0; i<=k-1; i++) + { + xy.ptr.pp_double[i][0] = i; + s.ptr.p_double[i] = 1.0; + } + for(i=n-1; i>=2; i--) + { + m = ae_minint(i+1, k, _state); + ae_v_move(&xy.ptr.pp_double[0][1], xy.stride, &x->ptr.p_double[i-m+1], 1, ae_v_len(0,m-1)); + lrlines(&xy, &s, m, &info, &a, &b, &vara, &varb, &covab, &corrab, &p, _state); + ae_assert(info==1, "FilterLRMA: internal error", _state); + x->ptr.p_double[i] = a+b*(m-1); + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +Multiclass Fisher LDA + +Subroutine finds coefficients of linear combination which optimally separates +training set on classes. + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars]. + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + + +OUTPUT PARAMETERS: + Info - return code: + * -4, if internal EVD subroutine hasn't converged + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed (NPoints<0, + NVars<1, NClasses<2) + * 1, if task has been solved + * 2, if there was a multicollinearity in training set, + but task has been solved. + W - linear combination coefficients, array[0..NVars-1] + + -- ALGLIB -- + Copyright 31.05.2008 by Bochkanov Sergey +*************************************************************************/ +void fisherlda(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t* info, + /* Real */ ae_vector* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix w2; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(w); + ae_matrix_init(&w2, 0, 0, DT_REAL, _state, ae_true); + + fisherldan(xy, npoints, nvars, nclasses, info, &w2, _state); + if( *info>0 ) + { + ae_vector_set_length(w, nvars-1+1, _state); + ae_v_move(&w->ptr.p_double[0], 1, &w2.ptr.pp_double[0][0], w2.stride, ae_v_len(0,nvars-1)); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +N-dimensional multiclass Fisher LDA + +Subroutine finds coefficients of linear combinations which optimally separates +training set on classes. It returns N-dimensional basis whose vector are sorted +by quality of training set separation (in descending order). + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars]. + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + + +OUTPUT PARAMETERS: + Info - return code: + * -4, if internal EVD subroutine hasn't converged + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed (NPoints<0, + NVars<1, NClasses<2) + * 1, if task has been solved + * 2, if there was a multicollinearity in training set, + but task has been solved. + W - basis, array[0..NVars-1,0..NVars-1] + columns of matrix stores basis vectors, sorted by + quality of training set separation (in descending order) + + -- ALGLIB -- + Copyright 31.05.2008 by Bochkanov Sergey +*************************************************************************/ +void fisherldan(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t* info, + /* Real */ ae_matrix* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t m; + double v; + ae_vector c; + ae_vector mu; + ae_matrix muc; + ae_vector nc; + ae_matrix sw; + ae_matrix st; + ae_matrix z; + ae_matrix z2; + ae_matrix tm; + ae_matrix sbroot; + ae_matrix a; + ae_matrix xyproj; + ae_matrix wproj; + ae_vector tf; + ae_vector d; + ae_vector d2; + ae_vector work; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_matrix_clear(w); + ae_vector_init(&c, 0, DT_INT, _state, ae_true); + ae_vector_init(&mu, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&muc, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&nc, 0, DT_INT, _state, ae_true); + ae_matrix_init(&sw, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&st, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z2, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tm, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&sbroot, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xyproj, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&wproj, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + + /* + * Test data + */ + if( (npoints<0||nvars<1)||nclasses<2 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=npoints-1; i++) + { + if( ae_round(xy->ptr.pp_double[i][nvars], _state)<0||ae_round(xy->ptr.pp_double[i][nvars], _state)>=nclasses ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + *info = 1; + + /* + * Special case: NPoints<=1 + * Degenerate task. + */ + if( npoints<=1 ) + { + *info = 2; + ae_matrix_set_length(w, nvars-1+1, nvars-1+1, _state); + for(i=0; i<=nvars-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + if( i==j ) + { + w->ptr.pp_double[i][j] = 1; + } + else + { + w->ptr.pp_double[i][j] = 0; + } + } + } + ae_frame_leave(_state); + return; + } + + /* + * Prepare temporaries + */ + ae_vector_set_length(&tf, nvars-1+1, _state); + ae_vector_set_length(&work, ae_maxint(nvars, npoints, _state)+1, _state); + + /* + * Convert class labels from reals to integers (just for convenience) + */ + ae_vector_set_length(&c, npoints-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + c.ptr.p_int[i] = ae_round(xy->ptr.pp_double[i][nvars], _state); + } + + /* + * Calculate class sizes and means + */ + ae_vector_set_length(&mu, nvars-1+1, _state); + ae_matrix_set_length(&muc, nclasses-1+1, nvars-1+1, _state); + ae_vector_set_length(&nc, nclasses-1+1, _state); + for(j=0; j<=nvars-1; j++) + { + mu.ptr.p_double[j] = 0; + } + for(i=0; i<=nclasses-1; i++) + { + nc.ptr.p_int[i] = 0; + for(j=0; j<=nvars-1; j++) + { + muc.ptr.pp_double[i][j] = 0; + } + } + for(i=0; i<=npoints-1; i++) + { + ae_v_add(&mu.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + ae_v_add(&muc.ptr.pp_double[c.ptr.p_int[i]][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + nc.ptr.p_int[c.ptr.p_int[i]] = nc.ptr.p_int[c.ptr.p_int[i]]+1; + } + for(i=0; i<=nclasses-1; i++) + { + v = (double)1/(double)nc.ptr.p_int[i]; + ae_v_muld(&muc.ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1), v); + } + v = (double)1/(double)npoints; + ae_v_muld(&mu.ptr.p_double[0], 1, ae_v_len(0,nvars-1), v); + + /* + * Create ST matrix + */ + ae_matrix_set_length(&st, nvars-1+1, nvars-1+1, _state); + for(i=0; i<=nvars-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + st.ptr.pp_double[i][j] = 0; + } + } + for(k=0; k<=npoints-1; k++) + { + ae_v_move(&tf.ptr.p_double[0], 1, &xy->ptr.pp_double[k][0], 1, ae_v_len(0,nvars-1)); + ae_v_sub(&tf.ptr.p_double[0], 1, &mu.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); + for(i=0; i<=nvars-1; i++) + { + v = tf.ptr.p_double[i]; + ae_v_addd(&st.ptr.pp_double[i][0], 1, &tf.ptr.p_double[0], 1, ae_v_len(0,nvars-1), v); + } + } + + /* + * Create SW matrix + */ + ae_matrix_set_length(&sw, nvars-1+1, nvars-1+1, _state); + for(i=0; i<=nvars-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + sw.ptr.pp_double[i][j] = 0; + } + } + for(k=0; k<=npoints-1; k++) + { + ae_v_move(&tf.ptr.p_double[0], 1, &xy->ptr.pp_double[k][0], 1, ae_v_len(0,nvars-1)); + ae_v_sub(&tf.ptr.p_double[0], 1, &muc.ptr.pp_double[c.ptr.p_int[k]][0], 1, ae_v_len(0,nvars-1)); + for(i=0; i<=nvars-1; i++) + { + v = tf.ptr.p_double[i]; + ae_v_addd(&sw.ptr.pp_double[i][0], 1, &tf.ptr.p_double[0], 1, ae_v_len(0,nvars-1), v); + } + } + + /* + * Maximize ratio J=(w'*ST*w)/(w'*SW*w). + * + * First, make transition from w to v such that w'*ST*w becomes v'*v: + * v = root(ST)*w = R*w + * R = root(D)*Z' + * w = (root(ST)^-1)*v = RI*v + * RI = Z*inv(root(D)) + * J = (v'*v)/(v'*(RI'*SW*RI)*v) + * ST = Z*D*Z' + * + * so we have + * + * J = (v'*v) / (v'*(inv(root(D))*Z'*SW*Z*inv(root(D)))*v) = + * = (v'*v) / (v'*A*v) + */ + if( !smatrixevd(&st, nvars, 1, ae_true, &d, &z, _state) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(w, nvars-1+1, nvars-1+1, _state); + if( ae_fp_less_eq(d.ptr.p_double[nvars-1],0)||ae_fp_less_eq(d.ptr.p_double[0],1000*ae_machineepsilon*d.ptr.p_double[nvars-1]) ) + { + + /* + * Special case: D[NVars-1]<=0 + * Degenerate task (all variables takes the same value). + */ + if( ae_fp_less_eq(d.ptr.p_double[nvars-1],0) ) + { + *info = 2; + for(i=0; i<=nvars-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + if( i==j ) + { + w->ptr.pp_double[i][j] = 1; + } + else + { + w->ptr.pp_double[i][j] = 0; + } + } + } + ae_frame_leave(_state); + return; + } + + /* + * Special case: degenerate ST matrix, multicollinearity found. + * Since we know ST eigenvalues/vectors we can translate task to + * non-degenerate form. + * + * Let WG is orthogonal basis of the non zero variance subspace + * of the ST and let WZ is orthogonal basis of the zero variance + * subspace. + * + * Projection on WG allows us to use LDA on reduced M-dimensional + * subspace, N-M vectors of WZ allows us to update reduced LDA + * factors to full N-dimensional subspace. + */ + m = 0; + for(k=0; k<=nvars-1; k++) + { + if( ae_fp_less_eq(d.ptr.p_double[k],1000*ae_machineepsilon*d.ptr.p_double[nvars-1]) ) + { + m = k+1; + } + } + ae_assert(m!=0, "FisherLDAN: internal error #1", _state); + ae_matrix_set_length(&xyproj, npoints-1+1, nvars-m+1, _state); + matrixmatrixmultiply(xy, 0, npoints-1, 0, nvars-1, ae_false, &z, 0, nvars-1, m, nvars-1, ae_false, 1.0, &xyproj, 0, npoints-1, 0, nvars-m-1, 0.0, &work, _state); + for(i=0; i<=npoints-1; i++) + { + xyproj.ptr.pp_double[i][nvars-m] = xy->ptr.pp_double[i][nvars]; + } + fisherldan(&xyproj, npoints, nvars-m, nclasses, info, &wproj, _state); + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + matrixmatrixmultiply(&z, 0, nvars-1, m, nvars-1, ae_false, &wproj, 0, nvars-m-1, 0, nvars-m-1, ae_false, 1.0, w, 0, nvars-1, 0, nvars-m-1, 0.0, &work, _state); + for(k=nvars-m; k<=nvars-1; k++) + { + ae_v_move(&w->ptr.pp_double[0][k], w->stride, &z.ptr.pp_double[0][k-(nvars-m)], z.stride, ae_v_len(0,nvars-1)); + } + *info = 2; + } + else + { + + /* + * General case: no multicollinearity + */ + ae_matrix_set_length(&tm, nvars-1+1, nvars-1+1, _state); + ae_matrix_set_length(&a, nvars-1+1, nvars-1+1, _state); + matrixmatrixmultiply(&sw, 0, nvars-1, 0, nvars-1, ae_false, &z, 0, nvars-1, 0, nvars-1, ae_false, 1.0, &tm, 0, nvars-1, 0, nvars-1, 0.0, &work, _state); + matrixmatrixmultiply(&z, 0, nvars-1, 0, nvars-1, ae_true, &tm, 0, nvars-1, 0, nvars-1, ae_false, 1.0, &a, 0, nvars-1, 0, nvars-1, 0.0, &work, _state); + for(i=0; i<=nvars-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + a.ptr.pp_double[i][j] = a.ptr.pp_double[i][j]/ae_sqrt(d.ptr.p_double[i]*d.ptr.p_double[j], _state); + } + } + if( !smatrixevd(&a, nvars, 1, ae_true, &d2, &z2, _state) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + for(k=0; k<=nvars-1; k++) + { + for(i=0; i<=nvars-1; i++) + { + tf.ptr.p_double[i] = z2.ptr.pp_double[i][k]/ae_sqrt(d.ptr.p_double[i], _state); + } + for(i=0; i<=nvars-1; i++) + { + v = ae_v_dotproduct(&z.ptr.pp_double[i][0], 1, &tf.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); + w->ptr.pp_double[i][k] = v; + } + } + } + + /* + * Post-processing: + * * normalization + * * converting to non-negative form, if possible + */ + for(k=0; k<=nvars-1; k++) + { + v = ae_v_dotproduct(&w->ptr.pp_double[0][k], w->stride, &w->ptr.pp_double[0][k], w->stride, ae_v_len(0,nvars-1)); + v = 1/ae_sqrt(v, _state); + ae_v_muld(&w->ptr.pp_double[0][k], w->stride, ae_v_len(0,nvars-1), v); + v = 0; + for(i=0; i<=nvars-1; i++) + { + v = v+w->ptr.pp_double[i][k]; + } + if( ae_fp_less(v,0) ) + { + ae_v_muld(&w->ptr.pp_double[0][k], w->stride, ae_v_len(0,nvars-1), -1); + } + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +This function returns number of weights updates which is required for +gradient calculation problem to be splitted. +*************************************************************************/ +ae_int_t mlpgradsplitcost(ae_state *_state) +{ + ae_int_t result; + + + result = mlpbase_gradbasecasecost; + return result; +} + + +/************************************************************************* +This function returns number of elements in subset of dataset which is +required for gradient calculation problem to be splitted. +*************************************************************************/ +ae_int_t mlpgradsplitsize(ae_state *_state) +{ + ae_int_t result; + + + result = mlpbase_microbatchsize; + return result; +} + + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers, with linear output layer. Network weights are filled with small +random values. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate0(ae_int_t nin, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(-5, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, 0, 0, nout, ae_false, ae_true, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Same as MLPCreate0, but with one hidden layer (NHid neurons) with +non-linear activation function. Output layer is linear. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3+3; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(-5, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, nhid, 0, nout, ae_false, ae_true, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Same as MLPCreate0, but with two hidden layers (NHid1 and NHid2 neurons) +with non-linear activation function. Output layer is linear. + $ALL + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3+3+3; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid2, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(-5, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, nhid1, nhid2, nout, ae_false, ae_true, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers with non-linear output layer. Network weights are filled with small +random values. + +Activation function of the output layer takes values: + + (B, +INF), if D>=0 + +or + + (-INF, B), if D<0. + + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb0(ae_int_t nin, + ae_int_t nout, + double b, + double d, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3; + if( ae_fp_greater_eq(d,0) ) + { + d = 1; + } + else + { + d = -1; + } + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(3, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, 0, 0, nout, ae_false, ae_false, _state); + + /* + * Turn on ouputs shift/scaling. + */ + for(i=nin; i<=nin+nout-1; i++) + { + network->columnmeans.ptr.p_double[i] = b; + network->columnsigmas.ptr.p_double[i] = d; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Same as MLPCreateB0 but with non-linear hidden layer. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + double b, + double d, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3+3; + if( ae_fp_greater_eq(d,0) ) + { + d = 1; + } + else + { + d = -1; + } + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(3, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, nhid, 0, nout, ae_false, ae_false, _state); + + /* + * Turn on ouputs shift/scaling. + */ + for(i=nin; i<=nin+nout-1; i++) + { + network->columnmeans.ptr.p_double[i] = b; + network->columnsigmas.ptr.p_double[i] = d; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Same as MLPCreateB0 but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + double b, + double d, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3+3+3; + if( ae_fp_greater_eq(d,0) ) + { + d = 1; + } + else + { + d = -1; + } + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid2, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(3, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, nhid1, nhid2, nout, ae_false, ae_false, _state); + + /* + * Turn on ouputs shift/scaling. + */ + for(i=nin; i<=nin+nout-1; i++) + { + network->columnmeans.ptr.p_double[i] = b; + network->columnsigmas.ptr.p_double[i] = d; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers with non-linear output layer. Network weights are filled with small +random values. Activation function of the output layer takes values [A,B]. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater0(ae_int_t nin, + ae_int_t nout, + double a, + double b, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, 0, 0, nout, ae_false, ae_false, _state); + + /* + * Turn on outputs shift/scaling. + */ + for(i=nin; i<=nin+nout-1; i++) + { + network->columnmeans.ptr.p_double[i] = 0.5*(a+b); + network->columnsigmas.ptr.p_double[i] = 0.5*(a-b); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Same as MLPCreateR0, but with non-linear hidden layer. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + double a, + double b, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3+3; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, nhid, 0, nout, ae_false, ae_false, _state); + + /* + * Turn on outputs shift/scaling. + */ + for(i=nin; i<=nin+nout-1; i++) + { + network->columnmeans.ptr.p_double[i] = 0.5*(a+b); + network->columnsigmas.ptr.p_double[i] = 0.5*(a-b); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Same as MLPCreateR0, but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + double a, + double b, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + layerscount = 1+3+3+3; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid2, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_false, network, _state); + mlpbase_fillhighlevelinformation(network, nin, nhid1, nhid2, nout, ae_false, ae_false, _state); + + /* + * Turn on outputs shift/scaling. + */ + for(i=nin; i<=nin+nout-1; i++) + { + network->columnmeans.ptr.p_double[i] = 0.5*(a+b); + network->columnsigmas.ptr.p_double[i] = 0.5*(a-b); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Creates classifier network with NIn inputs and NOut possible classes. +Network contains no hidden layers and linear output layer with SOFTMAX- +normalization (so outputs sums up to 1.0 and converge to posterior +probabilities). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec0(ae_int_t nin, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + ae_assert(nout>=2, "MLPCreateC0: NOut<2!", _state); + layerscount = 1+2+1; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout-1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addzerolayer(&lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_true, network, _state); + mlpbase_fillhighlevelinformation(network, nin, 0, 0, nout, ae_true, ae_true, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Same as MLPCreateC0, but with one non-linear hidden layer. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + ae_assert(nout>=2, "MLPCreateC1: NOut<2!", _state); + layerscount = 1+3+2+1; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout-1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addzerolayer(&lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_true, network, _state); + mlpbase_fillhighlevelinformation(network, nin, nhid, 0, nout, ae_true, ae_true, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Same as MLPCreateC0, but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector lsizes; + ae_vector ltypes; + ae_vector lconnfirst; + ae_vector lconnlast; + ae_int_t layerscount; + ae_int_t lastproc; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&lsizes, 0, DT_INT, _state, ae_true); + ae_vector_init(<ypes, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lconnlast, 0, DT_INT, _state, ae_true); + + ae_assert(nout>=2, "MLPCreateC2: NOut<2!", _state); + layerscount = 1+3+3+2+1; + + /* + * Allocate arrays + */ + ae_vector_set_length(&lsizes, layerscount-1+1, _state); + ae_vector_set_length(<ypes, layerscount-1+1, _state); + ae_vector_set_length(&lconnfirst, layerscount-1+1, _state); + ae_vector_set_length(&lconnlast, layerscount-1+1, _state); + + /* + * Layers + */ + mlpbase_addinputlayer(nin, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nhid2, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addactivationlayer(1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addbiasedsummatorlayer(nout-1, &lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + mlpbase_addzerolayer(&lsizes, <ypes, &lconnfirst, &lconnlast, &lastproc, _state); + + /* + * Create + */ + mlpbase_mlpcreate(nin, nout, &lsizes, <ypes, &lconnfirst, &lconnlast, layerscount, ae_true, network, _state); + mlpbase_fillhighlevelinformation(network, nin, nhid1, nhid2, nout, ae_true, ae_true, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Copying of neural network + +INPUT PARAMETERS: + Network1 - original + +OUTPUT PARAMETERS: + Network2 - copy + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcopy(multilayerperceptron* network1, + multilayerperceptron* network2, + ae_state *_state) +{ + + _multilayerperceptron_clear(network2); + + mlpcopyshared(network1, network2, _state); +} + + +/************************************************************************* +Copying of neural network (second parameter is passed as shared object). + +INPUT PARAMETERS: + Network1 - original + +OUTPUT PARAMETERS: + Network2 - copy + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcopyshared(multilayerperceptron* network1, + multilayerperceptron* network2, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t wcount; + ae_int_t i; + mlpbuffers buf; + smlpgrad sgrad; + + ae_frame_make(_state, &_frame_block); + _mlpbuffers_init(&buf, _state, ae_true); + _smlpgrad_init(&sgrad, _state, ae_true); + + + /* + * Copy scalar and array fields + */ + network2->hlnetworktype = network1->hlnetworktype; + network2->hlnormtype = network1->hlnormtype; + copyintegerarray(&network1->hllayersizes, &network2->hllayersizes, _state); + copyintegerarray(&network1->hlconnections, &network2->hlconnections, _state); + copyintegerarray(&network1->hlneurons, &network2->hlneurons, _state); + copyintegerarray(&network1->structinfo, &network2->structinfo, _state); + copyrealarray(&network1->weights, &network2->weights, _state); + copyrealarray(&network1->columnmeans, &network2->columnmeans, _state); + copyrealarray(&network1->columnsigmas, &network2->columnsigmas, _state); + copyrealarray(&network1->neurons, &network2->neurons, _state); + copyrealarray(&network1->dfdnet, &network2->dfdnet, _state); + copyrealarray(&network1->derror, &network2->derror, _state); + copyrealarray(&network1->x, &network2->x, _state); + copyrealarray(&network1->y, &network2->y, _state); + copyrealarray(&network1->nwbuf, &network2->nwbuf, _state); + copyintegerarray(&network1->integerbuf, &network2->integerbuf, _state); + + /* + * copy buffers + */ + wcount = mlpgetweightscount(network1, _state); + ae_shared_pool_set_seed(&network2->buf, &buf, sizeof(buf), _mlpbuffers_init, _mlpbuffers_init_copy, _mlpbuffers_destroy, _state); + ae_vector_set_length(&sgrad.g, wcount, _state); + sgrad.f = 0.0; + for(i=0; i<=wcount-1; i++) + { + sgrad.g.ptr.p_double[i] = 0.0; + } + ae_shared_pool_set_seed(&network2->gradbuf, &sgrad, sizeof(sgrad), _smlpgrad_init, _smlpgrad_init_copy, _smlpgrad_destroy, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function compares architectures of neural networks. Only geometries +are compared, weights and other parameters are not tested. + + -- ALGLIB -- + Copyright 20.06.2013 by Bochkanov Sergey +*************************************************************************/ +ae_bool mlpsamearchitecture(multilayerperceptron* network1, + multilayerperceptron* network2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t ninfo; + ae_bool result; + + + ae_assert(network1->structinfo.cnt>0&&network1->structinfo.cnt>=network1->structinfo.ptr.p_int[0], "MLPSameArchitecture: Network1 is uninitialized", _state); + ae_assert(network2->structinfo.cnt>0&&network2->structinfo.cnt>=network2->structinfo.ptr.p_int[0], "MLPSameArchitecture: Network2 is uninitialized", _state); + result = ae_false; + if( network1->structinfo.ptr.p_int[0]!=network2->structinfo.ptr.p_int[0] ) + { + return result; + } + ninfo = network1->structinfo.ptr.p_int[0]; + for(i=0; i<=ninfo-1; i++) + { + if( network1->structinfo.ptr.p_int[i]!=network2->structinfo.ptr.p_int[i] ) + { + return result; + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function copies tunable parameters (weights/means/sigmas) from one +network to another with same architecture. It performs some rudimentary +checks that architectures are same, and throws exception if check fails. + +It is intended for fast copying of states between two network which are +known to have same geometry. + +INPUT PARAMETERS: + Network1 - source, must be correctly initialized + Network2 - target, must have same architecture + +OUTPUT PARAMETERS: + Network2 - network state is copied from source to target + + -- ALGLIB -- + Copyright 20.06.2013 by Bochkanov Sergey +*************************************************************************/ +void mlpcopytunableparameters(multilayerperceptron* network1, + multilayerperceptron* network2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t ninfo; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + + + ae_assert(network1->structinfo.cnt>0&&network1->structinfo.cnt>=network1->structinfo.ptr.p_int[0], "MLPCopyTunableParameters: Network1 is uninitialized", _state); + ae_assert(network2->structinfo.cnt>0&&network2->structinfo.cnt>=network2->structinfo.ptr.p_int[0], "MLPCopyTunableParameters: Network2 is uninitialized", _state); + ae_assert(network1->structinfo.ptr.p_int[0]==network2->structinfo.ptr.p_int[0], "MLPCopyTunableParameters: Network1 geometry differs from that of Network2", _state); + ninfo = network1->structinfo.ptr.p_int[0]; + for(i=0; i<=ninfo-1; i++) + { + ae_assert(network1->structinfo.ptr.p_int[i]==network2->structinfo.ptr.p_int[i], "MLPCopyTunableParameters: Network1 geometry differs from that of Network2", _state); + } + mlpproperties(network1, &nin, &nout, &wcount, _state); + for(i=0; i<=wcount-1; i++) + { + network2->weights.ptr.p_double[i] = network1->weights.ptr.p_double[i]; + } + if( mlpissoftmax(network1, _state) ) + { + for(i=0; i<=nin-1; i++) + { + network2->columnmeans.ptr.p_double[i] = network1->columnmeans.ptr.p_double[i]; + network2->columnsigmas.ptr.p_double[i] = network1->columnsigmas.ptr.p_double[i]; + } + } + else + { + for(i=0; i<=nin+nout-1; i++) + { + network2->columnmeans.ptr.p_double[i] = network1->columnmeans.ptr.p_double[i]; + network2->columnsigmas.ptr.p_double[i] = network1->columnsigmas.ptr.p_double[i]; + } + } +} + + +/************************************************************************* +This function exports tunable parameters (weights/means/sigmas) from +network to contiguous array. Nothing is guaranteed about array format, the +only thing you can count for is that MLPImportTunableParameters() will be +able to parse it. + +It is intended for fast copying of states between network and backup array + +INPUT PARAMETERS: + Network - source, must be correctly initialized + P - array to use. If its size is enough to store data, it + is reused. + +OUTPUT PARAMETERS: + P - array which stores network parameters, resized if needed + PCount - number of parameters stored in array. + + -- ALGLIB -- + Copyright 20.06.2013 by Bochkanov Sergey +*************************************************************************/ +void mlpexporttunableparameters(multilayerperceptron* network, + /* Real */ ae_vector* p, + ae_int_t* pcount, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + + *pcount = 0; + + ae_assert(network->structinfo.cnt>0&&network->structinfo.cnt>=network->structinfo.ptr.p_int[0], "MLPExportTunableParameters: Network is uninitialized", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + if( mlpissoftmax(network, _state) ) + { + *pcount = wcount+2*nin; + rvectorsetlengthatleast(p, *pcount, _state); + k = 0; + for(i=0; i<=wcount-1; i++) + { + p->ptr.p_double[k] = network->weights.ptr.p_double[i]; + k = k+1; + } + for(i=0; i<=nin-1; i++) + { + p->ptr.p_double[k] = network->columnmeans.ptr.p_double[i]; + k = k+1; + p->ptr.p_double[k] = network->columnsigmas.ptr.p_double[i]; + k = k+1; + } + } + else + { + *pcount = wcount+2*(nin+nout); + rvectorsetlengthatleast(p, *pcount, _state); + k = 0; + for(i=0; i<=wcount-1; i++) + { + p->ptr.p_double[k] = network->weights.ptr.p_double[i]; + k = k+1; + } + for(i=0; i<=nin+nout-1; i++) + { + p->ptr.p_double[k] = network->columnmeans.ptr.p_double[i]; + k = k+1; + p->ptr.p_double[k] = network->columnsigmas.ptr.p_double[i]; + k = k+1; + } + } +} + + +/************************************************************************* +This function imports tunable parameters (weights/means/sigmas) which +were exported by MLPExportTunableParameters(). + +It is intended for fast copying of states between network and backup array + +INPUT PARAMETERS: + Network - target: + * must be correctly initialized + * must have same geometry as network used to export params + P - array with parameters + + -- ALGLIB -- + Copyright 20.06.2013 by Bochkanov Sergey +*************************************************************************/ +void mlpimporttunableparameters(multilayerperceptron* network, + /* Real */ ae_vector* p, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + + + ae_assert(network->structinfo.cnt>0&&network->structinfo.cnt>=network->structinfo.ptr.p_int[0], "MLPImportTunableParameters: Network is uninitialized", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + if( mlpissoftmax(network, _state) ) + { + k = 0; + for(i=0; i<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = p->ptr.p_double[k]; + k = k+1; + } + for(i=0; i<=nin-1; i++) + { + network->columnmeans.ptr.p_double[i] = p->ptr.p_double[k]; + k = k+1; + network->columnsigmas.ptr.p_double[i] = p->ptr.p_double[k]; + k = k+1; + } + } + else + { + k = 0; + for(i=0; i<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = p->ptr.p_double[k]; + k = k+1; + } + for(i=0; i<=nin+nout-1; i++) + { + network->columnmeans.ptr.p_double[i] = p->ptr.p_double[k]; + k = k+1; + network->columnsigmas.ptr.p_double[i] = p->ptr.p_double[k]; + k = k+1; + } + } +} + + +/************************************************************************* +Serialization of MultiLayerPerceptron strucure + +INPUT PARAMETERS: + Network - original + +OUTPUT PARAMETERS: + RA - array of real numbers which stores network, + array[0..RLen-1] + RLen - RA lenght + + -- ALGLIB -- + Copyright 29.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpserializeold(multilayerperceptron* network, + /* Real */ ae_vector* ra, + ae_int_t* rlen, + ae_state *_state) +{ + ae_int_t i; + ae_int_t ssize; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t sigmalen; + ae_int_t offs; + + ae_vector_clear(ra); + *rlen = 0; + + + /* + * Unload info + */ + ssize = network->structinfo.ptr.p_int[0]; + nin = network->structinfo.ptr.p_int[1]; + nout = network->structinfo.ptr.p_int[2]; + wcount = network->structinfo.ptr.p_int[4]; + if( mlpissoftmax(network, _state) ) + { + sigmalen = nin; + } + else + { + sigmalen = nin+nout; + } + + /* + * RA format: + * LEN DESRC. + * 1 RLen + * 1 version (MLPVNum) + * 1 StructInfo size + * SSize StructInfo + * WCount Weights + * SigmaLen ColumnMeans + * SigmaLen ColumnSigmas + */ + *rlen = 3+ssize+wcount+2*sigmalen; + ae_vector_set_length(ra, *rlen-1+1, _state); + ra->ptr.p_double[0] = *rlen; + ra->ptr.p_double[1] = mlpbase_mlpvnum; + ra->ptr.p_double[2] = ssize; + offs = 3; + for(i=0; i<=ssize-1; i++) + { + ra->ptr.p_double[offs+i] = network->structinfo.ptr.p_int[i]; + } + offs = offs+ssize; + ae_v_move(&ra->ptr.p_double[offs], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(offs,offs+wcount-1)); + offs = offs+wcount; + ae_v_move(&ra->ptr.p_double[offs], 1, &network->columnmeans.ptr.p_double[0], 1, ae_v_len(offs,offs+sigmalen-1)); + offs = offs+sigmalen; + ae_v_move(&ra->ptr.p_double[offs], 1, &network->columnsigmas.ptr.p_double[0], 1, ae_v_len(offs,offs+sigmalen-1)); + offs = offs+sigmalen; +} + + +/************************************************************************* +Unserialization of MultiLayerPerceptron strucure + +INPUT PARAMETERS: + RA - real array which stores network + +OUTPUT PARAMETERS: + Network - restored network + + -- ALGLIB -- + Copyright 29.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpunserializeold(/* Real */ ae_vector* ra, + multilayerperceptron* network, + ae_state *_state) +{ + ae_int_t i; + ae_int_t ssize; + ae_int_t ntotal; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t sigmalen; + ae_int_t offs; + + _multilayerperceptron_clear(network); + + ae_assert(ae_round(ra->ptr.p_double[1], _state)==mlpbase_mlpvnum, "MLPUnserialize: incorrect array!", _state); + + /* + * Unload StructInfo from IA + */ + offs = 3; + ssize = ae_round(ra->ptr.p_double[2], _state); + ae_vector_set_length(&network->structinfo, ssize-1+1, _state); + for(i=0; i<=ssize-1; i++) + { + network->structinfo.ptr.p_int[i] = ae_round(ra->ptr.p_double[offs+i], _state); + } + offs = offs+ssize; + + /* + * Unload info from StructInfo + */ + ssize = network->structinfo.ptr.p_int[0]; + nin = network->structinfo.ptr.p_int[1]; + nout = network->structinfo.ptr.p_int[2]; + ntotal = network->structinfo.ptr.p_int[3]; + wcount = network->structinfo.ptr.p_int[4]; + if( network->structinfo.ptr.p_int[6]==0 ) + { + sigmalen = nin+nout; + } + else + { + sigmalen = nin; + } + + /* + * Allocate space for other fields + */ + ae_vector_set_length(&network->weights, wcount-1+1, _state); + ae_vector_set_length(&network->columnmeans, sigmalen-1+1, _state); + ae_vector_set_length(&network->columnsigmas, sigmalen-1+1, _state); + ae_vector_set_length(&network->neurons, ntotal-1+1, _state); + ae_vector_set_length(&network->nwbuf, ae_maxint(wcount, 2*nout, _state)-1+1, _state); + ae_vector_set_length(&network->dfdnet, ntotal-1+1, _state); + ae_vector_set_length(&network->x, nin-1+1, _state); + ae_vector_set_length(&network->y, nout-1+1, _state); + ae_vector_set_length(&network->derror, ntotal-1+1, _state); + + /* + * Copy parameters from RA + */ + ae_v_move(&network->weights.ptr.p_double[0], 1, &ra->ptr.p_double[offs], 1, ae_v_len(0,wcount-1)); + offs = offs+wcount; + ae_v_move(&network->columnmeans.ptr.p_double[0], 1, &ra->ptr.p_double[offs], 1, ae_v_len(0,sigmalen-1)); + offs = offs+sigmalen; + ae_v_move(&network->columnsigmas.ptr.p_double[0], 1, &ra->ptr.p_double[offs], 1, ae_v_len(0,sigmalen-1)); + offs = offs+sigmalen; +} + + +/************************************************************************* +Randomization of neural network weights + + -- ALGLIB -- + Copyright 06.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlprandomize(multilayerperceptron* network, ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntotal; + ae_int_t istart; + hqrndstate r; + ae_int_t entrysize; + ae_int_t entryoffs; + ae_int_t neuronidx; + ae_int_t neurontype; + double vmean; + double vvar; + ae_int_t i; + ae_int_t n1; + ae_int_t n2; + double desiredsigma; + ae_int_t montecarlocnt; + double ef; + double ef2; + double v; + double wscale; + + ae_frame_make(_state, &_frame_block); + _hqrndstate_init(&r, _state, ae_true); + + hqrndrandomize(&r, _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + desiredsigma = 0.5; + montecarlocnt = 20; + + /* + * Stage 1: + * * Network.Weights is filled by standard deviation of weights + * * default values: sigma=1 + */ + for(i=0; i<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = 1.0; + } + + /* + * Stage 2: + * * assume that input neurons have zero mean and unit standard deviation + * * assume that constant neurons have zero standard deviation + * * perform forward pass along neurons + * * for each non-input non-constant neuron: + * * calculate mean and standard deviation of neuron's output + * assuming that we know means/deviations of neurons which feed it + * and assuming that weights has unit variance and zero mean. + * * for each nonlinear neuron additionally we perform backward pass: + * * scale variances of weights which feed it in such way that neuron's + * input has unit standard deviation + * + * NOTE: this algorithm assumes that each connection feeds at most one + * non-linear neuron. This assumption can be incorrect in upcoming + * architectures with strong neurons. However, algorithm should + * work smoothly even in this case. + * + * During this stage we use Network.RndBuf, which is grouped into NTotal + * entries, each of them having following format: + * + * Buf[Offset+0] mean value of neuron's output + * Buf[Offset+1] standard deviation of neuron's output + * + * + */ + entrysize = 2; + rvectorsetlengthatleast(&network->rndbuf, entrysize*ntotal, _state); + for(neuronidx=0; neuronidx<=ntotal-1; neuronidx++) + { + neurontype = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+0]; + entryoffs = entrysize*neuronidx; + if( neurontype==-2 ) + { + + /* + * Input neuron: zero mean, unit variance. + */ + network->rndbuf.ptr.p_double[entryoffs+0] = 0.0; + network->rndbuf.ptr.p_double[entryoffs+1] = 1.0; + continue; + } + if( neurontype==-3 ) + { + + /* + * "-1" neuron: mean=-1, zero variance. + */ + network->rndbuf.ptr.p_double[entryoffs+0] = -1.0; + network->rndbuf.ptr.p_double[entryoffs+1] = 0.0; + continue; + } + if( neurontype==-4 ) + { + + /* + * "0" neuron: mean=0, zero variance. + */ + network->rndbuf.ptr.p_double[entryoffs+0] = 0.0; + network->rndbuf.ptr.p_double[entryoffs+1] = 0.0; + continue; + } + if( neurontype==0 ) + { + + /* + * Adaptive summator neuron: + * * calculate its mean and variance. + * * we assume that weights of this neuron have unit variance and zero mean. + * * thus, neuron's output is always have zero mean + * * as for variance, it is a bit more interesting: + * * let n[i] is i-th input neuron + * * let w[i] is i-th weight + * * we assume that n[i] and w[i] are independently distributed + * * Var(n0*w0+n1*w1+...) = Var(n0*w0)+Var(n1*w1)+... + * * Var(X*Y) = mean(X)^2*Var(Y) + mean(Y)^2*Var(X) + Var(X)*Var(Y) + * * mean(w[i])=0, var(w[i])=1 + * * Var(n[i]*w[i]) = mean(n[i])^2 + Var(n[i]) + */ + n1 = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+2]; + n2 = n1+network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+1]-1; + vmean = 0.0; + vvar = 0.0; + for(i=n1; i<=n2; i++) + { + vvar = vvar+ae_sqr(network->rndbuf.ptr.p_double[entrysize*i+0], _state)+ae_sqr(network->rndbuf.ptr.p_double[entrysize*i+1], _state); + } + network->rndbuf.ptr.p_double[entryoffs+0] = vmean; + network->rndbuf.ptr.p_double[entryoffs+1] = ae_sqrt(vvar, _state); + continue; + } + if( neurontype==-5 ) + { + + /* + * Linear activation function + */ + i = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+2]; + vmean = network->rndbuf.ptr.p_double[entrysize*i+0]; + vvar = ae_sqr(network->rndbuf.ptr.p_double[entrysize*i+1], _state); + if( ae_fp_greater(vvar,0) ) + { + wscale = desiredsigma/ae_sqrt(vvar, _state); + } + else + { + wscale = 1.0; + } + mlpbase_randomizebackwardpass(network, i, wscale, _state); + network->rndbuf.ptr.p_double[entryoffs+0] = vmean*wscale; + network->rndbuf.ptr.p_double[entryoffs+1] = desiredsigma; + continue; + } + if( neurontype>0 ) + { + + /* + * Nonlinear activation function: + * * scale its inputs + * * estimate mean/sigma of its output using Monte-Carlo method + * (we simulate different inputs with unit deviation and + * sample activation function output on such inputs) + */ + i = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+2]; + vmean = network->rndbuf.ptr.p_double[entrysize*i+0]; + vvar = ae_sqr(network->rndbuf.ptr.p_double[entrysize*i+1], _state); + if( ae_fp_greater(vvar,0) ) + { + wscale = desiredsigma/ae_sqrt(vvar, _state); + } + else + { + wscale = 1.0; + } + mlpbase_randomizebackwardpass(network, i, wscale, _state); + ef = 0.0; + ef2 = 0.0; + vmean = vmean*wscale; + for(i=0; i<=montecarlocnt-1; i++) + { + v = vmean+desiredsigma*hqrndnormal(&r, _state); + ef = ef+v; + ef2 = ef2+v*v; + } + ef = ef/montecarlocnt; + ef2 = ef2/montecarlocnt; + network->rndbuf.ptr.p_double[entryoffs+0] = ef; + network->rndbuf.ptr.p_double[entryoffs+1] = ae_maxreal(ef2-ef*ef, 0.0, _state); + continue; + } + ae_assert(ae_false, "MLPRandomize: unexpected neuron type", _state); + } + + /* + * Stage 3: generate weights. + */ + for(i=0; i<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = network->weights.ptr.p_double[i]*hqrndnormal(&r, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Randomization of neural network weights and standartisator + + -- ALGLIB -- + Copyright 10.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlprandomizefull(multilayerperceptron* network, ae_state *_state) +{ + ae_int_t i; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntotal; + ae_int_t istart; + ae_int_t offs; + ae_int_t ntype; + + + mlpproperties(network, &nin, &nout, &wcount, _state); + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + + /* + * Process network + */ + mlprandomize(network, _state); + for(i=0; i<=nin-1; i++) + { + network->columnmeans.ptr.p_double[i] = ae_randomreal(_state)-0.5; + network->columnsigmas.ptr.p_double[i] = ae_randomreal(_state)+0.5; + } + if( !mlpissoftmax(network, _state) ) + { + for(i=0; i<=nout-1; i++) + { + offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; + ntype = network->structinfo.ptr.p_int[offs+0]; + if( ntype==0 ) + { + + /* + * Shifts are changed only for linear outputs neurons + */ + network->columnmeans.ptr.p_double[nin+i] = 2*ae_randomreal(_state)-1; + } + if( ntype==0||ntype==3 ) + { + + /* + * Scales are changed only for linear or bounded outputs neurons. + * Note that scale randomization preserves sign. + */ + network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*(1.5*ae_randomreal(_state)+0.5); + } + } + } +} + + +/************************************************************************* +Internal subroutine. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpinitpreprocessor(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t jmax; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntotal; + ae_int_t istart; + ae_int_t offs; + ae_int_t ntype; + ae_vector means; + ae_vector sigmas; + double s; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&means, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sigmas, 0, DT_REAL, _state, ae_true); + + mlpproperties(network, &nin, &nout, &wcount, _state); + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + + /* + * Means/Sigmas + */ + if( mlpissoftmax(network, _state) ) + { + jmax = nin-1; + } + else + { + jmax = nin+nout-1; + } + ae_vector_set_length(&means, jmax+1, _state); + ae_vector_set_length(&sigmas, jmax+1, _state); + for(i=0; i<=jmax; i++) + { + means.ptr.p_double[i] = 0; + sigmas.ptr.p_double[i] = 0; + } + for(i=0; i<=ssize-1; i++) + { + for(j=0; j<=jmax; j++) + { + means.ptr.p_double[j] = means.ptr.p_double[j]+xy->ptr.pp_double[i][j]; + } + } + for(i=0; i<=jmax; i++) + { + means.ptr.p_double[i] = means.ptr.p_double[i]/ssize; + } + for(i=0; i<=ssize-1; i++) + { + for(j=0; j<=jmax; j++) + { + sigmas.ptr.p_double[j] = sigmas.ptr.p_double[j]+ae_sqr(xy->ptr.pp_double[i][j]-means.ptr.p_double[j], _state); + } + } + for(i=0; i<=jmax; i++) + { + sigmas.ptr.p_double[i] = ae_sqrt(sigmas.ptr.p_double[i]/ssize, _state); + } + + /* + * Inputs + */ + for(i=0; i<=nin-1; i++) + { + network->columnmeans.ptr.p_double[i] = means.ptr.p_double[i]; + network->columnsigmas.ptr.p_double[i] = sigmas.ptr.p_double[i]; + if( ae_fp_eq(network->columnsigmas.ptr.p_double[i],0) ) + { + network->columnsigmas.ptr.p_double[i] = 1; + } + } + + /* + * Outputs + */ + if( !mlpissoftmax(network, _state) ) + { + for(i=0; i<=nout-1; i++) + { + offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; + ntype = network->structinfo.ptr.p_int[offs+0]; + + /* + * Linear outputs + */ + if( ntype==0 ) + { + network->columnmeans.ptr.p_double[nin+i] = means.ptr.p_double[nin+i]; + network->columnsigmas.ptr.p_double[nin+i] = sigmas.ptr.p_double[nin+i]; + if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) + { + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + + /* + * Bounded outputs (half-interval) + */ + if( ntype==3 ) + { + s = means.ptr.p_double[nin+i]-network->columnmeans.ptr.p_double[nin+i]; + if( ae_fp_eq(s,0) ) + { + s = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state); + } + if( ae_fp_eq(s,0) ) + { + s = 1.0; + } + network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*ae_fabs(s, _state); + if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) + { + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. +Initialization for preprocessor based on a sample. + +INPUT + Network - initialized neural network; + XY - sample, given by sparse matrix; + SSize - sample size. + +OUTPUT + Network - neural network with initialised preprocessor. + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpinitpreprocessorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t ssize, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t jmax; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntotal; + ae_int_t istart; + ae_int_t offs; + ae_int_t ntype; + ae_vector means; + ae_vector sigmas; + double s; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&means, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sigmas, 0, DT_REAL, _state, ae_true); + + mlpproperties(network, &nin, &nout, &wcount, _state); + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + + /* + * Means/Sigmas + */ + if( mlpissoftmax(network, _state) ) + { + jmax = nin-1; + } + else + { + jmax = nin+nout-1; + } + ae_vector_set_length(&means, jmax+1, _state); + ae_vector_set_length(&sigmas, jmax+1, _state); + for(i=0; i<=jmax; i++) + { + means.ptr.p_double[i] = 0; + sigmas.ptr.p_double[i] = 0; + } + for(i=0; i<=ssize-1; i++) + { + sparsegetrow(xy, i, &network->xyrow, _state); + for(j=0; j<=jmax; j++) + { + means.ptr.p_double[j] = means.ptr.p_double[j]+network->xyrow.ptr.p_double[j]; + } + } + for(i=0; i<=jmax; i++) + { + means.ptr.p_double[i] = means.ptr.p_double[i]/ssize; + } + for(i=0; i<=ssize-1; i++) + { + sparsegetrow(xy, i, &network->xyrow, _state); + for(j=0; j<=jmax; j++) + { + sigmas.ptr.p_double[j] = sigmas.ptr.p_double[j]+ae_sqr(network->xyrow.ptr.p_double[j]-means.ptr.p_double[j], _state); + } + } + for(i=0; i<=jmax; i++) + { + sigmas.ptr.p_double[i] = ae_sqrt(sigmas.ptr.p_double[i]/ssize, _state); + } + + /* + * Inputs + */ + for(i=0; i<=nin-1; i++) + { + network->columnmeans.ptr.p_double[i] = means.ptr.p_double[i]; + network->columnsigmas.ptr.p_double[i] = sigmas.ptr.p_double[i]; + if( ae_fp_eq(network->columnsigmas.ptr.p_double[i],0) ) + { + network->columnsigmas.ptr.p_double[i] = 1; + } + } + + /* + * Outputs + */ + if( !mlpissoftmax(network, _state) ) + { + for(i=0; i<=nout-1; i++) + { + offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; + ntype = network->structinfo.ptr.p_int[offs+0]; + + /* + * Linear outputs + */ + if( ntype==0 ) + { + network->columnmeans.ptr.p_double[nin+i] = means.ptr.p_double[nin+i]; + network->columnsigmas.ptr.p_double[nin+i] = sigmas.ptr.p_double[nin+i]; + if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) + { + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + + /* + * Bounded outputs (half-interval) + */ + if( ntype==3 ) + { + s = means.ptr.p_double[nin+i]-network->columnmeans.ptr.p_double[nin+i]; + if( ae_fp_eq(s,0) ) + { + s = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state); + } + if( ae_fp_eq(s,0) ) + { + s = 1.0; + } + network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*ae_fabs(s, _state); + if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) + { + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. +Initialization for preprocessor based on a subsample. + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset; one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SetSize - real size of XY, SetSize>=0; + Idx - subset of SubsetSize elements, array[SubsetSize]: + * Idx[I] stores row index in the original dataset which is + given by XY. Gradient is calculated with respect to rows + whose indexes are stored in Idx[]. + * Idx[] must store correct indexes; this function throws + an exception in case incorrect index (less than 0 or + larger than rows(XY)) is given + * Idx[] may store indexes in any order and even with + repetitions. + SubsetSize- number of elements in Idx[] array. + +OUTPUT: + Network - neural network with initialised preprocessor. + +NOTE: when SubsetSize<0 is used full dataset by call MLPInitPreprocessor + function. + + -- ALGLIB -- + Copyright 23.08.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpinitpreprocessorsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t jmax; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntotal; + ae_int_t istart; + ae_int_t offs; + ae_int_t ntype; + ae_vector means; + ae_vector sigmas; + double s; + ae_int_t npoints; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&means, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sigmas, 0, DT_REAL, _state, ae_true); + + ae_assert(setsize>=0, "MLPInitPreprocessorSubset: SetSize<0", _state); + if( subsetsize<0 ) + { + mlpinitpreprocessor(network, xy, setsize, _state); + ae_frame_leave(_state); + return; + } + ae_assert(subsetsize<=idx->cnt, "MLPInitPreprocessorSubset: SubsetSize>Length(Idx)", _state); + npoints = setsize; + for(i=0; i<=subsetsize-1; i++) + { + ae_assert(idx->ptr.p_int[i]>=0, "MLPInitPreprocessorSubset: incorrect index of XY row(Idx[I]<0)", _state); + ae_assert(idx->ptr.p_int[i]<=npoints-1, "MLPInitPreprocessorSubset: incorrect index of XY row(Idx[I]>Rows(XY)-1)", _state); + } + mlpproperties(network, &nin, &nout, &wcount, _state); + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + + /* + * Means/Sigmas + */ + if( mlpissoftmax(network, _state) ) + { + jmax = nin-1; + } + else + { + jmax = nin+nout-1; + } + ae_vector_set_length(&means, jmax+1, _state); + ae_vector_set_length(&sigmas, jmax+1, _state); + for(i=0; i<=jmax; i++) + { + means.ptr.p_double[i] = 0; + sigmas.ptr.p_double[i] = 0; + } + for(i=0; i<=subsetsize-1; i++) + { + for(j=0; j<=jmax; j++) + { + means.ptr.p_double[j] = means.ptr.p_double[j]+xy->ptr.pp_double[idx->ptr.p_int[i]][j]; + } + } + for(i=0; i<=jmax; i++) + { + means.ptr.p_double[i] = means.ptr.p_double[i]/subsetsize; + } + for(i=0; i<=subsetsize-1; i++) + { + for(j=0; j<=jmax; j++) + { + sigmas.ptr.p_double[j] = sigmas.ptr.p_double[j]+ae_sqr(xy->ptr.pp_double[idx->ptr.p_int[i]][j]-means.ptr.p_double[j], _state); + } + } + for(i=0; i<=jmax; i++) + { + sigmas.ptr.p_double[i] = ae_sqrt(sigmas.ptr.p_double[i]/subsetsize, _state); + } + + /* + * Inputs + */ + for(i=0; i<=nin-1; i++) + { + network->columnmeans.ptr.p_double[i] = means.ptr.p_double[i]; + network->columnsigmas.ptr.p_double[i] = sigmas.ptr.p_double[i]; + if( ae_fp_eq(network->columnsigmas.ptr.p_double[i],0) ) + { + network->columnsigmas.ptr.p_double[i] = 1; + } + } + + /* + * Outputs + */ + if( !mlpissoftmax(network, _state) ) + { + for(i=0; i<=nout-1; i++) + { + offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; + ntype = network->structinfo.ptr.p_int[offs+0]; + + /* + * Linear outputs + */ + if( ntype==0 ) + { + network->columnmeans.ptr.p_double[nin+i] = means.ptr.p_double[nin+i]; + network->columnsigmas.ptr.p_double[nin+i] = sigmas.ptr.p_double[nin+i]; + if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) + { + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + + /* + * Bounded outputs (half-interval) + */ + if( ntype==3 ) + { + s = means.ptr.p_double[nin+i]-network->columnmeans.ptr.p_double[nin+i]; + if( ae_fp_eq(s,0) ) + { + s = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state); + } + if( ae_fp_eq(s,0) ) + { + s = 1.0; + } + network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*ae_fabs(s, _state); + if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) + { + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. +Initialization for preprocessor based on a subsample. + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset, given by sparse matrix; + one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SetSize - real size of XY, SetSize>=0; + Idx - subset of SubsetSize elements, array[SubsetSize]: + * Idx[I] stores row index in the original dataset which is + given by XY. Gradient is calculated with respect to rows + whose indexes are stored in Idx[]. + * Idx[] must store correct indexes; this function throws + an exception in case incorrect index (less than 0 or + larger than rows(XY)) is given + * Idx[] may store indexes in any order and even with + repetitions. + SubsetSize- number of elements in Idx[] array. + +OUTPUT: + Network - neural network with initialised preprocessor. + +NOTE: when SubsetSize<0 is used full dataset by call + MLPInitPreprocessorSparse function. + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpinitpreprocessorsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t jmax; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntotal; + ae_int_t istart; + ae_int_t offs; + ae_int_t ntype; + ae_vector means; + ae_vector sigmas; + double s; + ae_int_t npoints; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&means, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sigmas, 0, DT_REAL, _state, ae_true); + + ae_assert(setsize>=0, "MLPInitPreprocessorSparseSubset: SetSize<0", _state); + if( subsetsize<0 ) + { + mlpinitpreprocessorsparse(network, xy, setsize, _state); + ae_frame_leave(_state); + return; + } + ae_assert(subsetsize<=idx->cnt, "MLPInitPreprocessorSparseSubset: SubsetSize>Length(Idx)", _state); + npoints = setsize; + for(i=0; i<=subsetsize-1; i++) + { + ae_assert(idx->ptr.p_int[i]>=0, "MLPInitPreprocessorSparseSubset: incorrect index of XY row(Idx[I]<0)", _state); + ae_assert(idx->ptr.p_int[i]<=npoints-1, "MLPInitPreprocessorSparseSubset: incorrect index of XY row(Idx[I]>Rows(XY)-1)", _state); + } + mlpproperties(network, &nin, &nout, &wcount, _state); + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + + /* + * Means/Sigmas + */ + if( mlpissoftmax(network, _state) ) + { + jmax = nin-1; + } + else + { + jmax = nin+nout-1; + } + ae_vector_set_length(&means, jmax+1, _state); + ae_vector_set_length(&sigmas, jmax+1, _state); + for(i=0; i<=jmax; i++) + { + means.ptr.p_double[i] = 0; + sigmas.ptr.p_double[i] = 0; + } + for(i=0; i<=subsetsize-1; i++) + { + sparsegetrow(xy, idx->ptr.p_int[i], &network->xyrow, _state); + for(j=0; j<=jmax; j++) + { + means.ptr.p_double[j] = means.ptr.p_double[j]+network->xyrow.ptr.p_double[j]; + } + } + for(i=0; i<=jmax; i++) + { + means.ptr.p_double[i] = means.ptr.p_double[i]/subsetsize; + } + for(i=0; i<=subsetsize-1; i++) + { + sparsegetrow(xy, idx->ptr.p_int[i], &network->xyrow, _state); + for(j=0; j<=jmax; j++) + { + sigmas.ptr.p_double[j] = sigmas.ptr.p_double[j]+ae_sqr(network->xyrow.ptr.p_double[j]-means.ptr.p_double[j], _state); + } + } + for(i=0; i<=jmax; i++) + { + sigmas.ptr.p_double[i] = ae_sqrt(sigmas.ptr.p_double[i]/subsetsize, _state); + } + + /* + * Inputs + */ + for(i=0; i<=nin-1; i++) + { + network->columnmeans.ptr.p_double[i] = means.ptr.p_double[i]; + network->columnsigmas.ptr.p_double[i] = sigmas.ptr.p_double[i]; + if( ae_fp_eq(network->columnsigmas.ptr.p_double[i],0) ) + { + network->columnsigmas.ptr.p_double[i] = 1; + } + } + + /* + * Outputs + */ + if( !mlpissoftmax(network, _state) ) + { + for(i=0; i<=nout-1; i++) + { + offs = istart+(ntotal-nout+i)*mlpbase_nfieldwidth; + ntype = network->structinfo.ptr.p_int[offs+0]; + + /* + * Linear outputs + */ + if( ntype==0 ) + { + network->columnmeans.ptr.p_double[nin+i] = means.ptr.p_double[nin+i]; + network->columnsigmas.ptr.p_double[nin+i] = sigmas.ptr.p_double[nin+i]; + if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) + { + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + + /* + * Bounded outputs (half-interval) + */ + if( ntype==3 ) + { + s = means.ptr.p_double[nin+i]-network->columnmeans.ptr.p_double[nin+i]; + if( ae_fp_eq(s,0) ) + { + s = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state); + } + if( ae_fp_eq(s,0) ) + { + s = 1.0; + } + network->columnsigmas.ptr.p_double[nin+i] = ae_sign(network->columnsigmas.ptr.p_double[nin+i], _state)*ae_fabs(s, _state); + if( ae_fp_eq(network->columnsigmas.ptr.p_double[nin+i],0) ) + { + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Returns information about initialized network: number of inputs, outputs, +weights. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpproperties(multilayerperceptron* network, + ae_int_t* nin, + ae_int_t* nout, + ae_int_t* wcount, + ae_state *_state) +{ + + *nin = 0; + *nout = 0; + *wcount = 0; + + *nin = network->structinfo.ptr.p_int[1]; + *nout = network->structinfo.ptr.p_int[2]; + *wcount = network->structinfo.ptr.p_int[4]; +} + + +/************************************************************************* +Returns number of "internal", low-level neurons in the network (one which +is stored in StructInfo). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpntotal(multilayerperceptron* network, ae_state *_state) +{ + ae_int_t result; + + + result = network->structinfo.ptr.p_int[3]; + return result; +} + + +/************************************************************************* +Returns number of inputs. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetinputscount(multilayerperceptron* network, + ae_state *_state) +{ + ae_int_t result; + + + result = network->structinfo.ptr.p_int[1]; + return result; +} + + +/************************************************************************* +Returns number of outputs. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetoutputscount(multilayerperceptron* network, + ae_state *_state) +{ + ae_int_t result; + + + result = network->structinfo.ptr.p_int[2]; + return result; +} + + +/************************************************************************* +Returns number of weights. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetweightscount(multilayerperceptron* network, + ae_state *_state) +{ + ae_int_t result; + + + result = network->structinfo.ptr.p_int[4]; + return result; +} + + +/************************************************************************* +Tells whether network is SOFTMAX-normalized (i.e. classifier) or not. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +ae_bool mlpissoftmax(multilayerperceptron* network, ae_state *_state) +{ + ae_bool result; + + + result = network->structinfo.ptr.p_int[6]==1; + return result; +} + + +/************************************************************************* +This function returns total number of layers (including input, hidden and +output layers). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetlayerscount(multilayerperceptron* network, + ae_state *_state) +{ + ae_int_t result; + + + result = network->hllayersizes.cnt; + return result; +} + + +/************************************************************************* +This function returns size of K-th layer. + +K=0 corresponds to input layer, K=CNT-1 corresponds to output layer. + +Size of the output layer is always equal to the number of outputs, although +when we have softmax-normalized network, last neuron doesn't have any +connections - it is just zero. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetlayersize(multilayerperceptron* network, + ae_int_t k, + ae_state *_state) +{ + ae_int_t result; + + + ae_assert(k>=0&&khllayersizes.cnt, "MLPGetLayerSize: incorrect layer index", _state); + result = network->hllayersizes.ptr.p_int[k]; + return result; +} + + +/************************************************************************* +This function returns offset/scaling coefficients for I-th input of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + +OUTPUT PARAMETERS: + Mean - mean term + Sigma - sigma term, guaranteed to be nonzero. + +I-th input is passed through linear transformation + IN[i] = (IN[i]-Mean)/Sigma +before feeding to the network + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetinputscaling(multilayerperceptron* network, + ae_int_t i, + double* mean, + double* sigma, + ae_state *_state) +{ + + *mean = 0; + *sigma = 0; + + ae_assert(i>=0&&ihllayersizes.ptr.p_int[0], "MLPGetInputScaling: incorrect (nonexistent) I", _state); + *mean = network->columnmeans.ptr.p_double[i]; + *sigma = network->columnsigmas.ptr.p_double[i]; + if( ae_fp_eq(*sigma,0) ) + { + *sigma = 1; + } +} + + +/************************************************************************* +This function returns offset/scaling coefficients for I-th output of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + +OUTPUT PARAMETERS: + Mean - mean term + Sigma - sigma term, guaranteed to be nonzero. + +I-th output is passed through linear transformation + OUT[i] = OUT[i]*Sigma+Mean +before returning it to user. In case we have SOFTMAX-normalized network, +we return (Mean,Sigma)=(0.0,1.0). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetoutputscaling(multilayerperceptron* network, + ae_int_t i, + double* mean, + double* sigma, + ae_state *_state) +{ + + *mean = 0; + *sigma = 0; + + ae_assert(i>=0&&ihllayersizes.ptr.p_int[network->hllayersizes.cnt-1], "MLPGetOutputScaling: incorrect (nonexistent) I", _state); + if( network->structinfo.ptr.p_int[6]==1 ) + { + *mean = 0; + *sigma = 1; + } + else + { + *mean = network->columnmeans.ptr.p_double[network->hllayersizes.ptr.p_int[0]+i]; + *sigma = network->columnsigmas.ptr.p_double[network->hllayersizes.ptr.p_int[0]+i]; + } +} + + +/************************************************************************* +This function returns information about Ith neuron of Kth layer + +INPUT PARAMETERS: + Network - network + K - layer index + I - neuron index (within layer) + +OUTPUT PARAMETERS: + FKind - activation function type (used by MLPActivationFunction()) + this value is zero for input or linear neurons + Threshold - also called offset, bias + zero for input neurons + +NOTE: this function throws exception if layer or neuron with given index +do not exists. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetneuroninfo(multilayerperceptron* network, + ae_int_t k, + ae_int_t i, + ae_int_t* fkind, + double* threshold, + ae_state *_state) +{ + ae_int_t ncnt; + ae_int_t istart; + ae_int_t highlevelidx; + ae_int_t activationoffset; + + *fkind = 0; + *threshold = 0; + + ncnt = network->hlneurons.cnt/mlpbase_hlnfieldwidth; + istart = network->structinfo.ptr.p_int[5]; + + /* + * search + */ + network->integerbuf.ptr.p_int[0] = k; + network->integerbuf.ptr.p_int[1] = i; + highlevelidx = recsearch(&network->hlneurons, mlpbase_hlnfieldwidth, 2, 0, ncnt, &network->integerbuf, _state); + ae_assert(highlevelidx>=0, "MLPGetNeuronInfo: incorrect (nonexistent) layer or neuron index", _state); + + /* + * 1. find offset of the activation function record in the + */ + if( network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+2]>=0 ) + { + activationoffset = istart+network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+2]*mlpbase_nfieldwidth; + *fkind = network->structinfo.ptr.p_int[activationoffset+0]; + } + else + { + *fkind = 0; + } + if( network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+3]>=0 ) + { + *threshold = network->weights.ptr.p_double[network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+3]]; + } + else + { + *threshold = 0; + } +} + + +/************************************************************************* +This function returns information about connection from I0-th neuron of +K0-th layer to I1-th neuron of K1-th layer. + +INPUT PARAMETERS: + Network - network + K0 - layer index + I0 - neuron index (within layer) + K1 - layer index + I1 - neuron index (within layer) + +RESULT: + connection weight (zero for non-existent connections) + +This function: +1. throws exception if layer or neuron with given index do not exists. +2. returns zero if neurons exist, but there is no connection between them + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +double mlpgetweight(multilayerperceptron* network, + ae_int_t k0, + ae_int_t i0, + ae_int_t k1, + ae_int_t i1, + ae_state *_state) +{ + ae_int_t ccnt; + ae_int_t highlevelidx; + double result; + + + ccnt = network->hlconnections.cnt/mlpbase_hlconnfieldwidth; + + /* + * check params + */ + ae_assert(k0>=0&&k0hllayersizes.cnt, "MLPGetWeight: incorrect (nonexistent) K0", _state); + ae_assert(i0>=0&&i0hllayersizes.ptr.p_int[k0], "MLPGetWeight: incorrect (nonexistent) I0", _state); + ae_assert(k1>=0&&k1hllayersizes.cnt, "MLPGetWeight: incorrect (nonexistent) K1", _state); + ae_assert(i1>=0&&i1hllayersizes.ptr.p_int[k1], "MLPGetWeight: incorrect (nonexistent) I1", _state); + + /* + * search + */ + network->integerbuf.ptr.p_int[0] = k0; + network->integerbuf.ptr.p_int[1] = i0; + network->integerbuf.ptr.p_int[2] = k1; + network->integerbuf.ptr.p_int[3] = i1; + highlevelidx = recsearch(&network->hlconnections, mlpbase_hlconnfieldwidth, 4, 0, ccnt, &network->integerbuf, _state); + if( highlevelidx>=0 ) + { + result = network->weights.ptr.p_double[network->hlconnections.ptr.p_int[highlevelidx*mlpbase_hlconnfieldwidth+4]]; + } + else + { + result = 0; + } + return result; +} + + +/************************************************************************* +This function sets offset/scaling coefficients for I-th input of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + Mean - mean term + Sigma - sigma term (if zero, will be replaced by 1.0) + +NTE: I-th input is passed through linear transformation + IN[i] = (IN[i]-Mean)/Sigma +before feeding to the network. This function sets Mean and Sigma. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetinputscaling(multilayerperceptron* network, + ae_int_t i, + double mean, + double sigma, + ae_state *_state) +{ + + + ae_assert(i>=0&&ihllayersizes.ptr.p_int[0], "MLPSetInputScaling: incorrect (nonexistent) I", _state); + ae_assert(ae_isfinite(mean, _state), "MLPSetInputScaling: infinite or NAN Mean", _state); + ae_assert(ae_isfinite(sigma, _state), "MLPSetInputScaling: infinite or NAN Sigma", _state); + if( ae_fp_eq(sigma,0) ) + { + sigma = 1; + } + network->columnmeans.ptr.p_double[i] = mean; + network->columnsigmas.ptr.p_double[i] = sigma; +} + + +/************************************************************************* +This function sets offset/scaling coefficients for I-th output of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + Mean - mean term + Sigma - sigma term (if zero, will be replaced by 1.0) + +OUTPUT PARAMETERS: + +NOTE: I-th output is passed through linear transformation + OUT[i] = OUT[i]*Sigma+Mean +before returning it to user. This function sets Sigma/Mean. In case we +have SOFTMAX-normalized network, you can not set (Sigma,Mean) to anything +other than(0.0,1.0) - this function will throw exception. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetoutputscaling(multilayerperceptron* network, + ae_int_t i, + double mean, + double sigma, + ae_state *_state) +{ + + + ae_assert(i>=0&&ihllayersizes.ptr.p_int[network->hllayersizes.cnt-1], "MLPSetOutputScaling: incorrect (nonexistent) I", _state); + ae_assert(ae_isfinite(mean, _state), "MLPSetOutputScaling: infinite or NAN Mean", _state); + ae_assert(ae_isfinite(sigma, _state), "MLPSetOutputScaling: infinite or NAN Sigma", _state); + if( network->structinfo.ptr.p_int[6]==1 ) + { + ae_assert(ae_fp_eq(mean,0), "MLPSetOutputScaling: you can not set non-zero Mean term for classifier network", _state); + ae_assert(ae_fp_eq(sigma,1), "MLPSetOutputScaling: you can not set non-unit Sigma term for classifier network", _state); + } + else + { + if( ae_fp_eq(sigma,0) ) + { + sigma = 1; + } + network->columnmeans.ptr.p_double[network->hllayersizes.ptr.p_int[0]+i] = mean; + network->columnsigmas.ptr.p_double[network->hllayersizes.ptr.p_int[0]+i] = sigma; + } +} + + +/************************************************************************* +This function modifies information about Ith neuron of Kth layer + +INPUT PARAMETERS: + Network - network + K - layer index + I - neuron index (within layer) + FKind - activation function type (used by MLPActivationFunction()) + this value must be zero for input neurons + (you can not set activation function for input neurons) + Threshold - also called offset, bias + this value must be zero for input neurons + (you can not set threshold for input neurons) + +NOTES: +1. this function throws exception if layer or neuron with given index do + not exists. +2. this function also throws exception when you try to set non-linear + activation function for input neurons (any kind of network) or for output + neurons of classifier network. +3. this function throws exception when you try to set non-zero threshold for + input neurons (any kind of network). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetneuroninfo(multilayerperceptron* network, + ae_int_t k, + ae_int_t i, + ae_int_t fkind, + double threshold, + ae_state *_state) +{ + ae_int_t ncnt; + ae_int_t istart; + ae_int_t highlevelidx; + ae_int_t activationoffset; + + + ae_assert(ae_isfinite(threshold, _state), "MLPSetNeuronInfo: infinite or NAN Threshold", _state); + + /* + * convenience vars + */ + ncnt = network->hlneurons.cnt/mlpbase_hlnfieldwidth; + istart = network->structinfo.ptr.p_int[5]; + + /* + * search + */ + network->integerbuf.ptr.p_int[0] = k; + network->integerbuf.ptr.p_int[1] = i; + highlevelidx = recsearch(&network->hlneurons, mlpbase_hlnfieldwidth, 2, 0, ncnt, &network->integerbuf, _state); + ae_assert(highlevelidx>=0, "MLPSetNeuronInfo: incorrect (nonexistent) layer or neuron index", _state); + + /* + * activation function + */ + if( network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+2]>=0 ) + { + activationoffset = istart+network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+2]*mlpbase_nfieldwidth; + network->structinfo.ptr.p_int[activationoffset+0] = fkind; + } + else + { + ae_assert(fkind==0, "MLPSetNeuronInfo: you try to set activation function for neuron which can not have one", _state); + } + + /* + * Threshold + */ + if( network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+3]>=0 ) + { + network->weights.ptr.p_double[network->hlneurons.ptr.p_int[highlevelidx*mlpbase_hlnfieldwidth+3]] = threshold; + } + else + { + ae_assert(ae_fp_eq(threshold,0), "MLPSetNeuronInfo: you try to set non-zero threshold for neuron which can not have one", _state); + } +} + + +/************************************************************************* +This function modifies information about connection from I0-th neuron of +K0-th layer to I1-th neuron of K1-th layer. + +INPUT PARAMETERS: + Network - network + K0 - layer index + I0 - neuron index (within layer) + K1 - layer index + I1 - neuron index (within layer) + W - connection weight (must be zero for non-existent + connections) + +This function: +1. throws exception if layer or neuron with given index do not exists. +2. throws exception if you try to set non-zero weight for non-existent + connection + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetweight(multilayerperceptron* network, + ae_int_t k0, + ae_int_t i0, + ae_int_t k1, + ae_int_t i1, + double w, + ae_state *_state) +{ + ae_int_t ccnt; + ae_int_t highlevelidx; + + + ccnt = network->hlconnections.cnt/mlpbase_hlconnfieldwidth; + + /* + * check params + */ + ae_assert(k0>=0&&k0hllayersizes.cnt, "MLPSetWeight: incorrect (nonexistent) K0", _state); + ae_assert(i0>=0&&i0hllayersizes.ptr.p_int[k0], "MLPSetWeight: incorrect (nonexistent) I0", _state); + ae_assert(k1>=0&&k1hllayersizes.cnt, "MLPSetWeight: incorrect (nonexistent) K1", _state); + ae_assert(i1>=0&&i1hllayersizes.ptr.p_int[k1], "MLPSetWeight: incorrect (nonexistent) I1", _state); + ae_assert(ae_isfinite(w, _state), "MLPSetWeight: infinite or NAN weight", _state); + + /* + * search + */ + network->integerbuf.ptr.p_int[0] = k0; + network->integerbuf.ptr.p_int[1] = i0; + network->integerbuf.ptr.p_int[2] = k1; + network->integerbuf.ptr.p_int[3] = i1; + highlevelidx = recsearch(&network->hlconnections, mlpbase_hlconnfieldwidth, 4, 0, ccnt, &network->integerbuf, _state); + if( highlevelidx>=0 ) + { + network->weights.ptr.p_double[network->hlconnections.ptr.p_int[highlevelidx*mlpbase_hlconnfieldwidth+4]] = w; + } + else + { + ae_assert(ae_fp_eq(w,0), "MLPSetWeight: you try to set non-zero weight for non-existent connection", _state); + } +} + + +/************************************************************************* +Neural network activation function + +INPUT PARAMETERS: + NET - neuron input + K - function index (zero for linear function) + +OUTPUT PARAMETERS: + F - function + DF - its derivative + D2F - its second derivative + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpactivationfunction(double net, + ae_int_t k, + double* f, + double* df, + double* d2f, + ae_state *_state) +{ + double net2; + double arg; + double root; + double r; + + *f = 0; + *df = 0; + *d2f = 0; + + if( k==0||k==-5 ) + { + *f = net; + *df = 1; + *d2f = 0; + return; + } + if( k==1 ) + { + + /* + * TanH activation function + */ + if( ae_fp_less(ae_fabs(net, _state),100) ) + { + *f = ae_tanh(net, _state); + } + else + { + *f = ae_sign(net, _state); + } + *df = 1-*f*(*f); + *d2f = -2*(*f)*(*df); + return; + } + if( k==3 ) + { + + /* + * EX activation function + */ + if( ae_fp_greater_eq(net,0) ) + { + net2 = net*net; + arg = net2+1; + root = ae_sqrt(arg, _state); + *f = net+root; + r = net/root; + *df = 1+r; + *d2f = (root-net*r)/arg; + } + else + { + *f = ae_exp(net, _state); + *df = *f; + *d2f = *f; + } + return; + } + if( k==2 ) + { + *f = ae_exp(-ae_sqr(net, _state), _state); + *df = -2*net*(*f); + *d2f = -2*(*f+*df*net); + return; + } + *f = 0; + *df = 0; + *d2f = 0; +} + + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + Network - neural network + X - input vector, array[0..NIn-1]. + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + +See also MLPProcessI + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpprocess(multilayerperceptron* network, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + + + if( y->cntstructinfo.ptr.p_int[2] ) + { + ae_vector_set_length(y, network->structinfo.ptr.p_int[2], _state); + } + mlpinternalprocessvector(&network->structinfo, &network->weights, &network->columnmeans, &network->columnsigmas, &network->neurons, &network->dfdnet, x, y, _state); +} + + +/************************************************************************* +'interactive' variant of MLPProcess for languages like Python which +support constructs like "Y = MLPProcess(NN,X)" and interactive mode of the +interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 21.09.2010 by Bochkanov Sergey +*************************************************************************/ +void mlpprocessi(multilayerperceptron* network, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + + ae_vector_clear(y); + + mlpprocess(network, x, y, _state); +} + + +/************************************************************************* +Error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x, depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlperror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(xy->rows>=npoints, "MLPError: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPError: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPError: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = ae_sqr(network->err.rmserror, _state)*npoints*mlpgetoutputscount(network, _state)/2; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlperror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlperror(network,xy,npoints, _state); +} + + +/************************************************************************* +Error of the neural network on dataset given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x, depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0 + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(sparseiscrs(xy, _state), "MLPErrorSparse: XY is not in CRS format.", _state); + ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPErrorSparse: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPErrorSparse: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPErrorSparse: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = ae_sqr(network->err.rmserror, _state)*npoints*mlpgetoutputscount(network, _state)/2; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlperrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlperrorsparse(network,xy,npoints, _state); +} + + +/************************************************************************* +Natural error function for neural network, internal subroutine. + +NOTE: this function is single-threaded. Unlike other error function, it +receives no speed-up from being executed in SMP mode. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlperrorn(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double e; + double result; + + + mlpproperties(network, &nin, &nout, &wcount, _state); + result = 0; + for(i=0; i<=ssize-1; i++) + { + + /* + * Process vector + */ + ae_v_move(&network->x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nin-1)); + mlpprocess(network, &network->x, &network->y, _state); + + /* + * Update error function + */ + if( network->structinfo.ptr.p_int[6]==0 ) + { + + /* + * Least squares error function + */ + ae_v_sub(&network->y.ptr.p_double[0], 1, &xy->ptr.pp_double[i][nin], 1, ae_v_len(0,nout-1)); + e = ae_v_dotproduct(&network->y.ptr.p_double[0], 1, &network->y.ptr.p_double[0], 1, ae_v_len(0,nout-1)); + result = result+e/2; + } + else + { + + /* + * Cross-entropy error function + */ + k = ae_round(xy->ptr.pp_double[i][nin], _state); + if( k>=0&&ky.ptr.p_double[k], _state); + } + } + } + return result; +} + + +/************************************************************************* +Classification error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: + classification error (number of misclassified cases) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpclserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_int_t result; + + + ae_assert(xy->rows>=npoints, "MLPClsError: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPClsError: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPClsError: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = ae_round(npoints*network->err.relclserror, _state); + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +ae_int_t _pexec_mlpclserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlpclserror(network,xy,npoints, _state); +} + + +/************************************************************************* +Relative classification error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Percent of incorrectly classified cases. Works both for classifier +networks and general purpose networks used as classifiers. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 25.12.2008 by Bochkanov Sergey +*************************************************************************/ +double mlprelclserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(xy->rows>=npoints, "MLPRelClsError: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPRelClsError: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPRelClsError: XY has less than NIn+NOut columns", _state); + } + } + if( npoints>0 ) + { + result = (double)mlpclserror(network, xy, npoints, _state)/(double)npoints; + } + else + { + result = 0.0; + } + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlprelclserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlprelclserror(network,xy,npoints, _state); +} + + +/************************************************************************* +Relative classification error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. Sparse matrix must use CRS format + for storage. + NPoints - points count, >=0. + +RESULT: +Percent of incorrectly classified cases. Works both for classifier +networks and general purpose networks used as classifiers. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlprelclserrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(sparseiscrs(xy, _state), "MLPRelClsErrorSparse: sparse matrix XY is not in CRS format.", _state); + ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPRelClsErrorSparse: sparse matrix XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPRelClsErrorSparse: sparse matrix XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPRelClsErrorSparse: sparse matrix XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.relclserror; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlprelclserrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlprelclserrorsparse(network,xy,npoints, _state); +} + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +CrossEntropy/(NPoints*LN(2)). +Zero if network solves regression task. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 08.01.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpavgce(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(xy->rows>=npoints, "MLPAvgCE: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPAvgCE: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgCE: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.avgce; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlpavgce(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlpavgce(network,xy,npoints, _state); +} + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set given by +sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +CrossEntropy/(NPoints*LN(2)). +Zero if network solves regression task. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 9.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgcesparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(sparseiscrs(xy, _state), "MLPAvgCESparse: sparse matrix XY is not in CRS format.", _state); + ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPAvgCESparse: sparse matrix XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPAvgCESparse: sparse matrix XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgCESparse: sparse matrix XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.avgce; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlpavgcesparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlpavgcesparse(network,xy,npoints, _state); +} + + +/************************************************************************* +RMS error on the test set given. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Root mean square error. Its meaning for regression task is obvious. As for +classification task, RMS error means error when estimating posterior +probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlprmserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(xy->rows>=npoints, "MLPRMSError: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPRMSError: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPRMSError: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.rmserror; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlprmserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlprmserror(network,xy,npoints, _state); +} + + +/************************************************************************* +RMS error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Root mean square error. Its meaning for regression task is obvious. As for +classification task, RMS error means error when estimating posterior +probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlprmserrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(sparseiscrs(xy, _state), "MLPRMSErrorSparse: sparse matrix XY is not in CRS format.", _state); + ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPRMSErrorSparse: sparse matrix XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPRMSErrorSparse: sparse matrix XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPRMSErrorSparse: sparse matrix XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.rmserror; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlprmserrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlprmserrorsparse(network,xy,npoints, _state); +} + + +/************************************************************************* +Average absolute error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average error when estimating posterior probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 11.03.2008 by Bochkanov Sergey +*************************************************************************/ +double mlpavgerror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(xy->rows>=npoints, "MLPAvgError: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPAvgError: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgError: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.avgerror; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlpavgerror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlpavgerror(network,xy,npoints, _state); +} + + +/************************************************************************* +Average absolute error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average error when estimating posterior probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgerrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(sparseiscrs(xy, _state), "MLPAvgErrorSparse: XY is not in CRS format.", _state); + ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPAvgErrorSparse: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPAvgErrorSparse: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgErrorSparse: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.avgerror; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlpavgerrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlpavgerrorsparse(network,xy,npoints, _state); +} + + +/************************************************************************* +Average relative error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average relative error when estimating posterior probability of +belonging to the correct class. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 11.03.2008 by Bochkanov Sergey +*************************************************************************/ +double mlpavgrelerror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(xy->rows>=npoints, "MLPAvgRelError: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPAvgRelError: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgRelError: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, xy, &network->dummysxy, npoints, 0, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.avgrelerror; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlpavgrelerror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlpavgrelerror(network,xy,npoints, _state); +} + + +/************************************************************************* +Average relative error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average relative error when estimating posterior probability of +belonging to the correct class. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgrelerrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + ae_assert(sparseiscrs(xy, _state), "MLPAvgRelErrorSparse: XY is not in CRS format.", _state); + ae_assert(sparsegetnrows(xy, _state)>=npoints, "MLPAvgRelErrorSparse: XY has less than NPoints rows", _state); + if( npoints>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPAvgRelErrorSparse: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAvgRelErrorSparse: XY has less than NIn+NOut columns", _state); + } + } + mlpallerrorsx(network, &network->dummydxy, xy, npoints, 1, &network->dummyidx, 0, npoints, 0, &network->buf, &network->err, _state); + result = network->err.avgrelerror; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlpavgrelerrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state) +{ + return mlpavgrelerrorsparse(network,xy,npoints, _state); +} + + +/************************************************************************* +Gradient calculation + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + X - input vector, length of array must be at least NIn + DesiredY- desired outputs, length of array must be at least NOut + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgrad(multilayerperceptron* network, + /* Real */ ae_vector* x, + /* Real */ ae_vector* desiredy, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state) +{ + ae_int_t i; + ae_int_t nout; + ae_int_t ntotal; + + *e = 0; + + + /* + * Alloc + */ + rvectorsetlengthatleast(grad, network->structinfo.ptr.p_int[4], _state); + + /* + * Prepare dError/dOut, internal structures + */ + mlpprocess(network, x, &network->y, _state); + nout = network->structinfo.ptr.p_int[2]; + ntotal = network->structinfo.ptr.p_int[3]; + *e = 0; + for(i=0; i<=ntotal-1; i++) + { + network->derror.ptr.p_double[i] = 0; + } + for(i=0; i<=nout-1; i++) + { + network->derror.ptr.p_double[ntotal-nout+i] = network->y.ptr.p_double[i]-desiredy->ptr.p_double[i]; + *e = *e+ae_sqr(network->y.ptr.p_double[i]-desiredy->ptr.p_double[i], _state)/2; + } + + /* + * gradient + */ + mlpbase_mlpinternalcalculategradient(network, &network->neurons, &network->weights, &network->derror, grad, ae_false, _state); +} + + +/************************************************************************* +Gradient calculation (natural error function is used) + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + X - input vector, length of array must be at least NIn + DesiredY- desired outputs, length of array must be at least NOut + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, sum-of-squares for regression networks, + cross-entropy for classification networks. + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradn(multilayerperceptron* network, + /* Real */ ae_vector* x, + /* Real */ ae_vector* desiredy, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state) +{ + double s; + ae_int_t i; + ae_int_t nout; + ae_int_t ntotal; + + *e = 0; + + + /* + * Alloc + */ + rvectorsetlengthatleast(grad, network->structinfo.ptr.p_int[4], _state); + + /* + * Prepare dError/dOut, internal structures + */ + mlpprocess(network, x, &network->y, _state); + nout = network->structinfo.ptr.p_int[2]; + ntotal = network->structinfo.ptr.p_int[3]; + for(i=0; i<=ntotal-1; i++) + { + network->derror.ptr.p_double[i] = 0; + } + *e = 0; + if( network->structinfo.ptr.p_int[6]==0 ) + { + + /* + * Regression network, least squares + */ + for(i=0; i<=nout-1; i++) + { + network->derror.ptr.p_double[ntotal-nout+i] = network->y.ptr.p_double[i]-desiredy->ptr.p_double[i]; + *e = *e+ae_sqr(network->y.ptr.p_double[i]-desiredy->ptr.p_double[i], _state)/2; + } + } + else + { + + /* + * Classification network, cross-entropy + */ + s = 0; + for(i=0; i<=nout-1; i++) + { + s = s+desiredy->ptr.p_double[i]; + } + for(i=0; i<=nout-1; i++) + { + network->derror.ptr.p_double[ntotal-nout+i] = s*network->y.ptr.p_double[i]-desiredy->ptr.p_double[i]; + *e = *e+mlpbase_safecrossentropy(desiredy->ptr.p_double[i], network->y.ptr.p_double[i], _state); + } + } + + /* + * gradient + */ + mlpbase_mlpinternalcalculategradient(network, &network->neurons, &network->weights, &network->derror, grad, ae_true, _state); +} + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in dense format; one sample = one row: + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t subset0; + ae_int_t subset1; + ae_int_t subsettype; + smlpgrad *sgrad; + ae_smart_ptr _sgrad; + + ae_frame_make(_state, &_frame_block); + *e = 0; + ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); + + ae_assert(ssize>=0, "MLPGradBatchSparse: SSize<0", _state); + subset0 = 0; + subset1 = ssize; + subsettype = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + rvectorsetlengthatleast(grad, wcount, _state); + ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); + while(sgrad!=NULL) + { + sgrad->f = 0.0; + for(i=0; i<=wcount-1; i++) + { + sgrad->g.ptr.p_double[i] = 0.0; + } + ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); + } + mlpgradbatchx(network, xy, &network->dummysxy, ssize, 0, &network->dummyidx, subset0, subset1, subsettype, &network->buf, &network->gradbuf, _state); + *e = 0.0; + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = 0.0; + } + ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); + while(sgrad!=NULL) + { + *e = *e+sgrad->f; + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = grad->ptr.p_double[i]+sgrad->g.ptr.p_double[i]; + } + ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlpgradbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, ae_state *_state) +{ + mlpgradbatch(network,xy,ssize,e,grad, _state); +} + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs given by sparse +matrices + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in sparse format; one sample = one row: + * MATRIX MUST BE STORED IN CRS FORMAT + * first NIn columns contain inputs. + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t subset0; + ae_int_t subset1; + ae_int_t subsettype; + smlpgrad *sgrad; + ae_smart_ptr _sgrad; + + ae_frame_make(_state, &_frame_block); + *e = 0; + ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); + + ae_assert(ssize>=0, "MLPGradBatchSparse: SSize<0", _state); + ae_assert(sparseiscrs(xy, _state), "MLPGradBatchSparse: sparse matrix XY must be in CRS format.", _state); + subset0 = 0; + subset1 = ssize; + subsettype = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + rvectorsetlengthatleast(grad, wcount, _state); + ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); + while(sgrad!=NULL) + { + sgrad->f = 0.0; + for(i=0; i<=wcount-1; i++) + { + sgrad->g.ptr.p_double[i] = 0.0; + } + ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); + } + mlpgradbatchx(network, &network->dummydxy, xy, ssize, 1, &network->dummyidx, subset0, subset1, subsettype, &network->buf, &network->gradbuf, _state); + *e = 0.0; + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = 0.0; + } + ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); + while(sgrad!=NULL) + { + *e = *e+sgrad->f; + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = grad->ptr.p_double[i]+sgrad->g.ptr.p_double[i]; + } + ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlpgradbatchsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, ae_state *_state) +{ + mlpgradbatchsparse(network,xy,ssize,e,grad, _state); +} + + +/************************************************************************* +Batch gradient calculation for a subset of dataset + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in dense format; one sample = one row: + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SetSize - real size of XY, SetSize>=0; + Idx - subset of SubsetSize elements, array[SubsetSize]: + * Idx[I] stores row index in the original dataset which is + given by XY. Gradient is calculated with respect to rows + whose indexes are stored in Idx[]. + * Idx[] must store correct indexes; this function throws + an exception in case incorrect index (less than 0 or + larger than rows(XY)) is given + * Idx[] may store indexes in any order and even with + repetitions. + SubsetSize- number of elements in Idx[] array: + * positive value means that subset given by Idx[] is processed + * zero value results in zero gradient + * negative value means that full dataset is processed + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, + array[WCount] + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t npoints; + ae_int_t subset0; + ae_int_t subset1; + ae_int_t subsettype; + smlpgrad *sgrad; + ae_smart_ptr _sgrad; + + ae_frame_make(_state, &_frame_block); + *e = 0; + ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); + + ae_assert(setsize>=0, "MLPGradBatchSubset: SetSize<0", _state); + ae_assert(subsetsize<=idx->cnt, "MLPGradBatchSubset: SubsetSize>Length(Idx)", _state); + npoints = setsize; + if( subsetsize<0 ) + { + subset0 = 0; + subset1 = setsize; + subsettype = 0; + } + else + { + subset0 = 0; + subset1 = subsetsize; + subsettype = 1; + for(i=0; i<=subsetsize-1; i++) + { + ae_assert(idx->ptr.p_int[i]>=0, "MLPGradBatchSubset: incorrect index of XY row(Idx[I]<0)", _state); + ae_assert(idx->ptr.p_int[i]<=npoints-1, "MLPGradBatchSubset: incorrect index of XY row(Idx[I]>Rows(XY)-1)", _state); + } + } + mlpproperties(network, &nin, &nout, &wcount, _state); + rvectorsetlengthatleast(grad, wcount, _state); + ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); + while(sgrad!=NULL) + { + sgrad->f = 0.0; + for(i=0; i<=wcount-1; i++) + { + sgrad->g.ptr.p_double[i] = 0.0; + } + ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); + } + mlpgradbatchx(network, xy, &network->dummysxy, setsize, 0, idx, subset0, subset1, subsettype, &network->buf, &network->gradbuf, _state); + *e = 0.0; + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = 0.0; + } + ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); + while(sgrad!=NULL) + { + *e = *e+sgrad->f; + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = grad->ptr.p_double[i]+sgrad->g.ptr.p_double[i]; + } + ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlpgradbatchsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + double* e, + /* Real */ ae_vector* grad, ae_state *_state) +{ + mlpgradbatchsubset(network,xy,setsize,idx,subsetsize,e,grad, _state); +} + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs for a subset of +dataset given by set of indexes. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in sparse format; one sample = one row: + * MATRIX MUST BE STORED IN CRS FORMAT + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SetSize - real size of XY, SetSize>=0; + Idx - subset of SubsetSize elements, array[SubsetSize]: + * Idx[I] stores row index in the original dataset which is + given by XY. Gradient is calculated with respect to rows + whose indexes are stored in Idx[]. + * Idx[] must store correct indexes; this function throws + an exception in case incorrect index (less than 0 or + larger than rows(XY)) is given + * Idx[] may store indexes in any order and even with + repetitions. + SubsetSize- number of elements in Idx[] array: + * positive value means that subset given by Idx[] is processed + * zero value results in zero gradient + * negative value means that full dataset is processed + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, + array[WCount] + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatchSparse + function. + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t npoints; + ae_int_t subset0; + ae_int_t subset1; + ae_int_t subsettype; + smlpgrad *sgrad; + ae_smart_ptr _sgrad; + + ae_frame_make(_state, &_frame_block); + *e = 0; + ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); + + ae_assert(setsize>=0, "MLPGradBatchSparseSubset: SetSize<0", _state); + ae_assert(subsetsize<=idx->cnt, "MLPGradBatchSparseSubset: SubsetSize>Length(Idx)", _state); + ae_assert(sparseiscrs(xy, _state), "MLPGradBatchSparseSubset: sparse matrix XY must be in CRS format.", _state); + npoints = setsize; + if( subsetsize<0 ) + { + subset0 = 0; + subset1 = setsize; + subsettype = 0; + } + else + { + subset0 = 0; + subset1 = subsetsize; + subsettype = 1; + for(i=0; i<=subsetsize-1; i++) + { + ae_assert(idx->ptr.p_int[i]>=0, "MLPGradBatchSparseSubset: incorrect index of XY row(Idx[I]<0)", _state); + ae_assert(idx->ptr.p_int[i]<=npoints-1, "MLPGradBatchSparseSubset: incorrect index of XY row(Idx[I]>Rows(XY)-1)", _state); + } + } + mlpproperties(network, &nin, &nout, &wcount, _state); + rvectorsetlengthatleast(grad, wcount, _state); + ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); + while(sgrad!=NULL) + { + sgrad->f = 0.0; + for(i=0; i<=wcount-1; i++) + { + sgrad->g.ptr.p_double[i] = 0.0; + } + ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); + } + mlpgradbatchx(network, &network->dummydxy, xy, setsize, 1, idx, subset0, subset1, subsettype, &network->buf, &network->gradbuf, _state); + *e = 0.0; + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = 0.0; + } + ae_shared_pool_first_recycled(&network->gradbuf, &_sgrad, _state); + while(sgrad!=NULL) + { + *e = *e+sgrad->f; + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = grad->ptr.p_double[i]+sgrad->g.ptr.p_double[i]; + } + ae_shared_pool_next_recycled(&network->gradbuf, &_sgrad, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlpgradbatchsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + double* e, + /* Real */ ae_vector* grad, ae_state *_state) +{ + mlpgradbatchsparsesubset(network,xy,setsize,idx,subsetsize,e,grad, _state); +} + + +void mlpgradbatchx(multilayerperceptron* network, + /* Real */ ae_matrix* densexy, + sparsematrix* sparsexy, + ae_int_t datasetsize, + ae_int_t datasettype, + /* Integer */ ae_vector* idx, + ae_int_t subset0, + ae_int_t subset1, + ae_int_t subsettype, + ae_shared_pool* buf, + ae_shared_pool* gradbuf, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t rowsize; + ae_int_t srcidx; + ae_int_t cstart; + ae_int_t csize; + ae_int_t j; + double problemcost; + mlpbuffers *buf2; + ae_smart_ptr _buf2; + ae_int_t len0; + ae_int_t len1; + mlpbuffers *pbuf; + ae_smart_ptr _pbuf; + smlpgrad *sgrad; + ae_smart_ptr _sgrad; + + ae_frame_make(_state, &_frame_block); + ae_smart_ptr_init(&_buf2, (void**)&buf2, _state, ae_true); + ae_smart_ptr_init(&_pbuf, (void**)&pbuf, _state, ae_true); + ae_smart_ptr_init(&_sgrad, (void**)&sgrad, _state, ae_true); + + ae_assert(datasetsize>=0, "MLPGradBatchX: SetSize<0", _state); + ae_assert(datasettype==0||datasettype==1, "MLPGradBatchX: DatasetType is incorrect", _state); + ae_assert(subsettype==0||subsettype==1, "MLPGradBatchX: SubsetType is incorrect", _state); + + /* + * Determine network and dataset properties + */ + mlpproperties(network, &nin, &nout, &wcount, _state); + if( mlpissoftmax(network, _state) ) + { + rowsize = nin+1; + } + else + { + rowsize = nin+nout; + } + + /* + * Split problem. + * + * Splitting problem allows us to reduce effect of single-precision + * arithmetics (SSE-optimized version of MLPChunkedGradient uses single + * precision internally, but converts them to double precision after + * results are exported from HPC buffer to network). Small batches are + * calculated in single precision, results are aggregated in double + * precision, and it allows us to avoid accumulation of errors when + * we process very large batches (tens of thousands of items). + * + * NOTE: it is important to use real arithmetics for ProblemCost + * because ProblemCost may be larger than MAXINT. + */ + problemcost = subset1-subset0; + problemcost = problemcost*wcount; + if( subset1-subset0>=2*mlpbase_microbatchsize&&ae_fp_greater(problemcost,mlpbase_gradbasecasecost) ) + { + splitlength(subset1-subset0, mlpbase_microbatchsize, &len0, &len1, _state); + mlpgradbatchx(network, densexy, sparsexy, datasetsize, datasettype, idx, subset0, subset0+len0, subsettype, buf, gradbuf, _state); + mlpgradbatchx(network, densexy, sparsexy, datasetsize, datasettype, idx, subset0+len0, subset1, subsettype, buf, gradbuf, _state); + ae_frame_leave(_state); + return; + } + + /* + * Chunked processing + */ + ae_shared_pool_retrieve(gradbuf, &_sgrad, _state); + ae_shared_pool_retrieve(buf, &_pbuf, _state); + hpcpreparechunkedgradient(&network->weights, wcount, mlpntotal(network, _state), nin, nout, pbuf, _state); + cstart = subset0; + while(cstartchunksize, _state)-cstart; + for(j=0; j<=csize-1; j++) + { + srcidx = -1; + if( subsettype==0 ) + { + srcidx = cstart+j; + } + if( subsettype==1 ) + { + srcidx = idx->ptr.p_int[cstart+j]; + } + ae_assert(srcidx>=0, "MLPGradBatchX: internal error", _state); + if( datasettype==0 ) + { + ae_v_move(&pbuf->xy.ptr.pp_double[j][0], 1, &densexy->ptr.pp_double[srcidx][0], 1, ae_v_len(0,rowsize-1)); + } + if( datasettype==1 ) + { + sparsegetrow(sparsexy, srcidx, &pbuf->xyrow, _state); + ae_v_move(&pbuf->xy.ptr.pp_double[j][0], 1, &pbuf->xyrow.ptr.p_double[0], 1, ae_v_len(0,rowsize-1)); + } + } + + /* + * Process chunk and advance line pointer + */ + mlpbase_mlpchunkedgradient(network, &pbuf->xy, 0, csize, &pbuf->batch4buf, &pbuf->hpcbuf, &sgrad->f, ae_false, _state); + cstart = cstart+pbuf->chunksize; + } + hpcfinalizechunkedgradient(pbuf, &sgrad->g, _state); + ae_shared_pool_recycle(buf, &_pbuf, _state); + ae_shared_pool_recycle(gradbuf, &_sgrad, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs +(natural error function is used) + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - set of inputs/outputs; one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, sum-of-squares for regression networks, + cross-entropy for classification networks. + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradnbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + mlpbuffers *pbuf; + ae_smart_ptr _pbuf; + + ae_frame_make(_state, &_frame_block); + *e = 0; + ae_smart_ptr_init(&_pbuf, (void**)&pbuf, _state, ae_true); + + + /* + * Alloc + */ + mlpproperties(network, &nin, &nout, &wcount, _state); + ae_shared_pool_retrieve(&network->buf, &_pbuf, _state); + hpcpreparechunkedgradient(&network->weights, wcount, mlpntotal(network, _state), nin, nout, pbuf, _state); + rvectorsetlengthatleast(grad, wcount, _state); + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = 0; + } + *e = 0; + i = 0; + while(i<=ssize-1) + { + mlpbase_mlpchunkedgradient(network, xy, i, ae_minint(ssize, i+pbuf->chunksize, _state)-i, &pbuf->batch4buf, &pbuf->hpcbuf, e, ae_true, _state); + i = i+pbuf->chunksize; + } + hpcfinalizechunkedgradient(pbuf, grad, _state); + ae_shared_pool_recycle(&network->buf, &_pbuf, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Batch Hessian calculation (natural error function) using R-algorithm. +Internal subroutine. + + -- ALGLIB -- + Copyright 26.01.2008 by Bochkanov Sergey. + + Hessian calculation based on R-algorithm described in + "Fast Exact Multiplication by the Hessian", + B. A. Pearlmutter, + Neural Computation, 1994. +*************************************************************************/ +void mlphessiannbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + /* Real */ ae_matrix* h, + ae_state *_state) +{ + + *e = 0; + + mlpbase_mlphessianbatchinternal(network, xy, ssize, ae_true, e, grad, h, _state); +} + + +/************************************************************************* +Batch Hessian calculation using R-algorithm. +Internal subroutine. + + -- ALGLIB -- + Copyright 26.01.2008 by Bochkanov Sergey. + + Hessian calculation based on R-algorithm described in + "Fast Exact Multiplication by the Hessian", + B. A. Pearlmutter, + Neural Computation, 1994. +*************************************************************************/ +void mlphessianbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + /* Real */ ae_matrix* h, + ae_state *_state) +{ + + *e = 0; + + mlpbase_mlphessianbatchinternal(network, xy, ssize, ae_false, e, grad, h, _state); +} + + +/************************************************************************* +Internal subroutine, shouldn't be called by user. +*************************************************************************/ +void mlpinternalprocessvector(/* Integer */ ae_vector* structinfo, + /* Real */ ae_vector* weights, + /* Real */ ae_vector* columnmeans, + /* Real */ ae_vector* columnsigmas, + /* Real */ ae_vector* neurons, + /* Real */ ae_vector* dfdnet, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n1; + ae_int_t n2; + ae_int_t w1; + ae_int_t w2; + ae_int_t ntotal; + ae_int_t nin; + ae_int_t nout; + ae_int_t istart; + ae_int_t offs; + double net; + double f; + double df; + double d2f; + double mx; + ae_bool perr; + + + + /* + * Read network geometry + */ + nin = structinfo->ptr.p_int[1]; + nout = structinfo->ptr.p_int[2]; + ntotal = structinfo->ptr.p_int[3]; + istart = structinfo->ptr.p_int[5]; + + /* + * Inputs standartisation and putting in the network + */ + for(i=0; i<=nin-1; i++) + { + if( ae_fp_neq(columnsigmas->ptr.p_double[i],0) ) + { + neurons->ptr.p_double[i] = (x->ptr.p_double[i]-columnmeans->ptr.p_double[i])/columnsigmas->ptr.p_double[i]; + } + else + { + neurons->ptr.p_double[i] = x->ptr.p_double[i]-columnmeans->ptr.p_double[i]; + } + } + + /* + * Process network + */ + for(i=0; i<=ntotal-1; i++) + { + offs = istart+i*mlpbase_nfieldwidth; + if( structinfo->ptr.p_int[offs+0]>0||structinfo->ptr.p_int[offs+0]==-5 ) + { + + /* + * Activation function + */ + mlpactivationfunction(neurons->ptr.p_double[structinfo->ptr.p_int[offs+2]], structinfo->ptr.p_int[offs+0], &f, &df, &d2f, _state); + neurons->ptr.p_double[i] = f; + dfdnet->ptr.p_double[i] = df; + continue; + } + if( structinfo->ptr.p_int[offs+0]==0 ) + { + + /* + * Adaptive summator + */ + n1 = structinfo->ptr.p_int[offs+2]; + n2 = n1+structinfo->ptr.p_int[offs+1]-1; + w1 = structinfo->ptr.p_int[offs+3]; + w2 = w1+structinfo->ptr.p_int[offs+1]-1; + net = ae_v_dotproduct(&weights->ptr.p_double[w1], 1, &neurons->ptr.p_double[n1], 1, ae_v_len(w1,w2)); + neurons->ptr.p_double[i] = net; + dfdnet->ptr.p_double[i] = 1.0; + touchint(&n2, _state); + continue; + } + if( structinfo->ptr.p_int[offs+0]<0 ) + { + perr = ae_true; + if( structinfo->ptr.p_int[offs+0]==-2 ) + { + + /* + * input neuron, left unchanged + */ + perr = ae_false; + } + if( structinfo->ptr.p_int[offs+0]==-3 ) + { + + /* + * "-1" neuron + */ + neurons->ptr.p_double[i] = -1; + perr = ae_false; + } + if( structinfo->ptr.p_int[offs+0]==-4 ) + { + + /* + * "0" neuron + */ + neurons->ptr.p_double[i] = 0; + perr = ae_false; + } + ae_assert(!perr, "MLPInternalProcessVector: internal error - unknown neuron type!", _state); + continue; + } + } + + /* + * Extract result + */ + ae_v_move(&y->ptr.p_double[0], 1, &neurons->ptr.p_double[ntotal-nout], 1, ae_v_len(0,nout-1)); + + /* + * Softmax post-processing or standardisation if needed + */ + ae_assert(structinfo->ptr.p_int[6]==0||structinfo->ptr.p_int[6]==1, "MLPInternalProcessVector: unknown normalization type!", _state); + if( structinfo->ptr.p_int[6]==1 ) + { + + /* + * Softmax + */ + mx = y->ptr.p_double[0]; + for(i=1; i<=nout-1; i++) + { + mx = ae_maxreal(mx, y->ptr.p_double[i], _state); + } + net = 0; + for(i=0; i<=nout-1; i++) + { + y->ptr.p_double[i] = ae_exp(y->ptr.p_double[i]-mx, _state); + net = net+y->ptr.p_double[i]; + } + for(i=0; i<=nout-1; i++) + { + y->ptr.p_double[i] = y->ptr.p_double[i]/net; + } + } + else + { + + /* + * Standardisation + */ + for(i=0; i<=nout-1; i++) + { + y->ptr.p_double[i] = y->ptr.p_double[i]*columnsigmas->ptr.p_double[nin+i]+columnmeans->ptr.p_double[nin+i]; + } + } +} + + +/************************************************************************* +Serializer: allocation + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpalloc(ae_serializer* s, + multilayerperceptron* network, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t fkind; + double threshold; + double v0; + double v1; + ae_int_t nin; + ae_int_t nout; + + + nin = network->hllayersizes.ptr.p_int[0]; + nout = network->hllayersizes.ptr.p_int[network->hllayersizes.cnt-1]; + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + allocintegerarray(s, &network->hllayersizes, -1, _state); + for(i=1; i<=network->hllayersizes.cnt-1; i++) + { + for(j=0; j<=network->hllayersizes.ptr.p_int[i]-1; j++) + { + mlpgetneuroninfo(network, i, j, &fkind, &threshold, _state); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + for(k=0; k<=network->hllayersizes.ptr.p_int[i-1]-1; k++) + { + ae_serializer_alloc_entry(s); + } + } + } + for(j=0; j<=nin-1; j++) + { + mlpgetinputscaling(network, j, &v0, &v1, _state); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + } + for(j=0; j<=nout-1; j++) + { + mlpgetoutputscaling(network, j, &v0, &v1, _state); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + } +} + + +/************************************************************************* +Serializer: serialization + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpserialize(ae_serializer* s, + multilayerperceptron* network, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t fkind; + double threshold; + double v0; + double v1; + ae_int_t nin; + ae_int_t nout; + + + nin = network->hllayersizes.ptr.p_int[0]; + nout = network->hllayersizes.ptr.p_int[network->hllayersizes.cnt-1]; + ae_serializer_serialize_int(s, getmlpserializationcode(_state), _state); + ae_serializer_serialize_int(s, mlpbase_mlpfirstversion, _state); + ae_serializer_serialize_bool(s, mlpissoftmax(network, _state), _state); + serializeintegerarray(s, &network->hllayersizes, -1, _state); + for(i=1; i<=network->hllayersizes.cnt-1; i++) + { + for(j=0; j<=network->hllayersizes.ptr.p_int[i]-1; j++) + { + mlpgetneuroninfo(network, i, j, &fkind, &threshold, _state); + ae_serializer_serialize_int(s, fkind, _state); + ae_serializer_serialize_double(s, threshold, _state); + for(k=0; k<=network->hllayersizes.ptr.p_int[i-1]-1; k++) + { + ae_serializer_serialize_double(s, mlpgetweight(network, i-1, k, i, j, _state), _state); + } + } + } + for(j=0; j<=nin-1; j++) + { + mlpgetinputscaling(network, j, &v0, &v1, _state); + ae_serializer_serialize_double(s, v0, _state); + ae_serializer_serialize_double(s, v1, _state); + } + for(j=0; j<=nout-1; j++) + { + mlpgetoutputscaling(network, j, &v0, &v1, _state); + ae_serializer_serialize_double(s, v0, _state); + ae_serializer_serialize_double(s, v1, _state); + } +} + + +/************************************************************************* +Serializer: unserialization + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpunserialize(ae_serializer* s, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i0; + ae_int_t i1; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t fkind; + double threshold; + double v0; + double v1; + ae_int_t nin; + ae_int_t nout; + ae_bool issoftmax; + ae_vector layersizes; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&layersizes, 0, DT_INT, _state, ae_true); + + + /* + * check correctness of header + */ + ae_serializer_unserialize_int(s, &i0, _state); + ae_assert(i0==getmlpserializationcode(_state), "MLPUnserialize: stream header corrupted", _state); + ae_serializer_unserialize_int(s, &i1, _state); + ae_assert(i1==mlpbase_mlpfirstversion, "MLPUnserialize: stream header corrupted", _state); + + /* + * Create network + */ + ae_serializer_unserialize_bool(s, &issoftmax, _state); + unserializeintegerarray(s, &layersizes, _state); + ae_assert((layersizes.cnt==2||layersizes.cnt==3)||layersizes.cnt==4, "MLPUnserialize: too many hidden layers!", _state); + nin = layersizes.ptr.p_int[0]; + nout = layersizes.ptr.p_int[layersizes.cnt-1]; + if( layersizes.cnt==2 ) + { + if( issoftmax ) + { + mlpcreatec0(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], network, _state); + } + else + { + mlpcreate0(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], network, _state); + } + } + if( layersizes.cnt==3 ) + { + if( issoftmax ) + { + mlpcreatec1(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], layersizes.ptr.p_int[2], network, _state); + } + else + { + mlpcreate1(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], layersizes.ptr.p_int[2], network, _state); + } + } + if( layersizes.cnt==4 ) + { + if( issoftmax ) + { + mlpcreatec2(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], layersizes.ptr.p_int[2], layersizes.ptr.p_int[3], network, _state); + } + else + { + mlpcreate2(layersizes.ptr.p_int[0], layersizes.ptr.p_int[1], layersizes.ptr.p_int[2], layersizes.ptr.p_int[3], network, _state); + } + } + + /* + * Load neurons and weights + */ + for(i=1; i<=layersizes.cnt-1; i++) + { + for(j=0; j<=layersizes.ptr.p_int[i]-1; j++) + { + ae_serializer_unserialize_int(s, &fkind, _state); + ae_serializer_unserialize_double(s, &threshold, _state); + mlpsetneuroninfo(network, i, j, fkind, threshold, _state); + for(k=0; k<=layersizes.ptr.p_int[i-1]-1; k++) + { + ae_serializer_unserialize_double(s, &v0, _state); + mlpsetweight(network, i-1, k, i, j, v0, _state); + } + } + } + + /* + * Load standartizator + */ + for(j=0; j<=nin-1; j++) + { + ae_serializer_unserialize_double(s, &v0, _state); + ae_serializer_unserialize_double(s, &v1, _state); + mlpsetinputscaling(network, j, v0, v1, _state); + } + for(j=0; j<=nout-1; j++) + { + ae_serializer_unserialize_double(s, &v0, _state); + ae_serializer_unserialize_double(s, &v1, _state); + mlpsetoutputscaling(network, j, v0, v1, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Calculation of all types of errors. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset; one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +OUTPUT PARAMETERS: + Rep - it contains all type of errors. + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpallerrorssubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + modelerrors* rep, + ae_state *_state) +{ + ae_int_t idx0; + ae_int_t idx1; + ae_int_t idxtype; + + _modelerrors_clear(rep); + + ae_assert(xy->rows>=setsize, "MLPAllErrorsSubset: XY has less than SetSize rows", _state); + if( setsize>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPAllErrorsSubset: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAllErrorsSubset: XY has less than NIn+NOut columns", _state); + } + } + if( subsetsize>=0 ) + { + idx0 = 0; + idx1 = subsetsize; + idxtype = 1; + } + else + { + idx0 = 0; + idx1 = setsize; + idxtype = 0; + } + mlpallerrorsx(network, xy, &network->dummysxy, setsize, 0, subset, idx0, idx1, idxtype, &network->buf, rep, _state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlpallerrorssubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + modelerrors* rep, ae_state *_state) +{ + mlpallerrorssubset(network,xy,setsize,subset,subsetsize,rep, _state); +} + + +/************************************************************************* +Calculation of all types of errors on sparse dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset given by sparse matrix; + one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +OUTPUT PARAMETERS: + Rep - it contains all type of errors. + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpallerrorssparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + modelerrors* rep, + ae_state *_state) +{ + ae_int_t idx0; + ae_int_t idx1; + ae_int_t idxtype; + + _modelerrors_clear(rep); + + ae_assert(sparseiscrs(xy, _state), "MLPAllErrorsSparseSubset: XY is not in CRS format.", _state); + ae_assert(sparsegetnrows(xy, _state)>=setsize, "MLPAllErrorsSparseSubset: XY has less than SetSize rows", _state); + if( setsize>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPAllErrorsSparseSubset: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPAllErrorsSparseSubset: XY has less than NIn+NOut columns", _state); + } + } + if( subsetsize>=0 ) + { + idx0 = 0; + idx1 = subsetsize; + idxtype = 1; + } + else + { + idx0 = 0; + idx1 = setsize; + idxtype = 0; + } + mlpallerrorsx(network, &network->dummydxy, xy, setsize, 1, subset, idx0, idx1, idxtype, &network->buf, rep, _state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlpallerrorssparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + modelerrors* rep, ae_state *_state) +{ + mlpallerrorssparsesubset(network,xy,setsize,subset,subsetsize,rep, _state); +} + + +/************************************************************************* +Error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_state *_state) +{ + ae_int_t idx0; + ae_int_t idx1; + ae_int_t idxtype; + double result; + + + ae_assert(xy->rows>=setsize, "MLPErrorSubset: XY has less than SetSize rows", _state); + if( setsize>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+1, "MLPErrorSubset: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(xy->cols>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPErrorSubset: XY has less than NIn+NOut columns", _state); + } + } + if( subsetsize>=0 ) + { + idx0 = 0; + idx1 = subsetsize; + idxtype = 1; + } + else + { + idx0 = 0; + idx1 = setsize; + idxtype = 0; + } + mlpallerrorsx(network, xy, &network->dummysxy, setsize, 0, subset, idx0, idx1, idxtype, &network->buf, &network->err, _state); + result = ae_sqr(network->err.rmserror, _state)*(idx1-idx0)*mlpgetoutputscount(network, _state)/2; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlperrorsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, ae_state *_state) +{ + return mlperrorsubset(network,xy,setsize,subset,subsetsize, _state); +} + + +/************************************************************************* +Error of the neural network on sparse dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + SetSize - real size of XY, SetSize>=0; + it is used when SubsetSize<0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_state *_state) +{ + ae_int_t idx0; + ae_int_t idx1; + ae_int_t idxtype; + double result; + + + ae_assert(sparseiscrs(xy, _state), "MLPErrorSparseSubset: XY is not in CRS format.", _state); + ae_assert(sparsegetnrows(xy, _state)>=setsize, "MLPErrorSparseSubset: XY has less than SetSize rows", _state); + if( setsize>0 ) + { + if( mlpissoftmax(network, _state) ) + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+1, "MLPErrorSparseSubset: XY has less than NIn+1 columns", _state); + } + else + { + ae_assert(sparsegetncols(xy, _state)>=mlpgetinputscount(network, _state)+mlpgetoutputscount(network, _state), "MLPErrorSparseSubset: XY has less than NIn+NOut columns", _state); + } + } + if( subsetsize>=0 ) + { + idx0 = 0; + idx1 = subsetsize; + idxtype = 1; + } + else + { + idx0 = 0; + idx1 = setsize; + idxtype = 0; + } + mlpallerrorsx(network, &network->dummydxy, xy, setsize, 1, subset, idx0, idx1, idxtype, &network->buf, &network->err, _state); + result = ae_sqr(network->err.rmserror, _state)*(idx1-idx0)*mlpgetoutputscount(network, _state)/2; + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +double _pexec_mlperrorsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, ae_state *_state) +{ + return mlperrorsparsesubset(network,xy,setsize,subset,subsetsize, _state); +} + + +void mlpallerrorsx(multilayerperceptron* network, + /* Real */ ae_matrix* densexy, + sparsematrix* sparsexy, + ae_int_t datasetsize, + ae_int_t datasettype, + /* Integer */ ae_vector* idx, + ae_int_t subset0, + ae_int_t subset1, + ae_int_t subsettype, + ae_shared_pool* buf, + modelerrors* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t rowsize; + ae_bool iscls; + ae_int_t srcidx; + ae_int_t cstart; + ae_int_t csize; + ae_int_t j; + mlpbuffers *pbuf; + ae_smart_ptr _pbuf; + ae_int_t len0; + ae_int_t len1; + modelerrors rep0; + modelerrors rep1; + + ae_frame_make(_state, &_frame_block); + ae_smart_ptr_init(&_pbuf, (void**)&pbuf, _state, ae_true); + _modelerrors_init(&rep0, _state, ae_true); + _modelerrors_init(&rep1, _state, ae_true); + + ae_assert(datasetsize>=0, "MLPAllErrorsX: SetSize<0", _state); + ae_assert(datasettype==0||datasettype==1, "MLPAllErrorsX: DatasetType is incorrect", _state); + ae_assert(subsettype==0||subsettype==1, "MLPAllErrorsX: SubsetType is incorrect", _state); + + /* + * Determine network properties + */ + mlpproperties(network, &nin, &nout, &wcount, _state); + iscls = mlpissoftmax(network, _state); + + /* + * Split problem. + * + * Splitting problem allows us to reduce effect of single-precision + * arithmetics (SSE-optimized version of MLPChunkedProcess uses single + * precision internally, but converts them to double precision after + * results are exported from HPC buffer to network). Small batches are + * calculated in single precision, results are aggregated in double + * precision, and it allows us to avoid accumulation of errors when + * we process very large batches (tens of thousands of items). + * + * NOTE: it is important to use real arithmetics for ProblemCost + * because ProblemCost may be larger than MAXINT. + */ + if( subset1-subset0>=2*mlpbase_microbatchsize&&ae_fp_greater(inttoreal(subset1-subset0, _state)*inttoreal(wcount, _state),mlpbase_gradbasecasecost) ) + { + splitlength(subset1-subset0, mlpbase_microbatchsize, &len0, &len1, _state); + mlpallerrorsx(network, densexy, sparsexy, datasetsize, datasettype, idx, subset0, subset0+len0, subsettype, buf, &rep0, _state); + mlpallerrorsx(network, densexy, sparsexy, datasetsize, datasettype, idx, subset0+len0, subset1, subsettype, buf, &rep1, _state); + rep->relclserror = (len0*rep0.relclserror+len1*rep1.relclserror)/(len0+len1); + rep->avgce = (len0*rep0.avgce+len1*rep1.avgce)/(len0+len1); + rep->rmserror = ae_sqrt((len0*ae_sqr(rep0.rmserror, _state)+len1*ae_sqr(rep1.rmserror, _state))/(len0+len1), _state); + rep->avgerror = (len0*rep0.avgerror+len1*rep1.avgerror)/(len0+len1); + rep->avgrelerror = (len0*rep0.avgrelerror+len1*rep1.avgrelerror)/(len0+len1); + ae_frame_leave(_state); + return; + } + + /* + * Retrieve and prepare + */ + ae_shared_pool_retrieve(buf, &_pbuf, _state); + if( iscls ) + { + rowsize = nin+1; + dserrallocate(nout, &pbuf->tmp0, _state); + } + else + { + rowsize = nin+nout; + dserrallocate(-nout, &pbuf->tmp0, _state); + } + + /* + * Processing + */ + hpcpreparechunkedgradient(&network->weights, wcount, mlpntotal(network, _state), nin, nout, pbuf, _state); + cstart = subset0; + while(cstartchunksize, _state)-cstart; + for(j=0; j<=csize-1; j++) + { + srcidx = -1; + if( subsettype==0 ) + { + srcidx = cstart+j; + } + if( subsettype==1 ) + { + srcidx = idx->ptr.p_int[cstart+j]; + } + ae_assert(srcidx>=0, "MLPAllErrorsX: internal error", _state); + if( datasettype==0 ) + { + ae_v_move(&pbuf->xy.ptr.pp_double[j][0], 1, &densexy->ptr.pp_double[srcidx][0], 1, ae_v_len(0,rowsize-1)); + } + if( datasettype==1 ) + { + sparsegetrow(sparsexy, srcidx, &pbuf->xyrow, _state); + ae_v_move(&pbuf->xy.ptr.pp_double[j][0], 1, &pbuf->xyrow.ptr.p_double[0], 1, ae_v_len(0,rowsize-1)); + } + } + + /* + * Unpack XY and process (temporary code, to be replaced by chunked processing) + */ + for(j=0; j<=csize-1; j++) + { + ae_v_move(&pbuf->xy2.ptr.pp_double[j][0], 1, &pbuf->xy.ptr.pp_double[j][0], 1, ae_v_len(0,rowsize-1)); + } + mlpbase_mlpchunkedprocess(network, &pbuf->xy2, 0, csize, &pbuf->batch4buf, &pbuf->hpcbuf, _state); + for(j=0; j<=csize-1; j++) + { + ae_v_move(&pbuf->x.ptr.p_double[0], 1, &pbuf->xy2.ptr.pp_double[j][0], 1, ae_v_len(0,nin-1)); + ae_v_move(&pbuf->y.ptr.p_double[0], 1, &pbuf->xy2.ptr.pp_double[j][nin], 1, ae_v_len(0,nout-1)); + if( iscls ) + { + pbuf->desiredy.ptr.p_double[0] = pbuf->xy.ptr.pp_double[j][nin]; + } + else + { + ae_v_move(&pbuf->desiredy.ptr.p_double[0], 1, &pbuf->xy.ptr.pp_double[j][nin], 1, ae_v_len(0,nout-1)); + } + dserraccumulate(&pbuf->tmp0, &pbuf->y, &pbuf->desiredy, _state); + } + + /* + * Process chunk and advance line pointer + */ + cstart = cstart+pbuf->chunksize; + } + dserrfinish(&pbuf->tmp0, _state); + rep->relclserror = pbuf->tmp0.ptr.p_double[0]; + rep->avgce = pbuf->tmp0.ptr.p_double[1]/ae_log(2, _state); + rep->rmserror = pbuf->tmp0.ptr.p_double[2]; + rep->avgerror = pbuf->tmp0.ptr.p_double[3]; + rep->avgrelerror = pbuf->tmp0.ptr.p_double[4]; + + /* + * Recycle + */ + ae_shared_pool_recycle(buf, &_pbuf, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine: adding new input layer to network +*************************************************************************/ +static void mlpbase_addinputlayer(ae_int_t ncount, + /* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t* lastproc, + ae_state *_state) +{ + + + lsizes->ptr.p_int[0] = ncount; + ltypes->ptr.p_int[0] = -2; + lconnfirst->ptr.p_int[0] = 0; + lconnlast->ptr.p_int[0] = 0; + *lastproc = 0; +} + + +/************************************************************************* +Internal subroutine: adding new summator layer to network +*************************************************************************/ +static void mlpbase_addbiasedsummatorlayer(ae_int_t ncount, + /* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t* lastproc, + ae_state *_state) +{ + + + lsizes->ptr.p_int[*lastproc+1] = 1; + ltypes->ptr.p_int[*lastproc+1] = -3; + lconnfirst->ptr.p_int[*lastproc+1] = 0; + lconnlast->ptr.p_int[*lastproc+1] = 0; + lsizes->ptr.p_int[*lastproc+2] = ncount; + ltypes->ptr.p_int[*lastproc+2] = 0; + lconnfirst->ptr.p_int[*lastproc+2] = *lastproc; + lconnlast->ptr.p_int[*lastproc+2] = *lastproc+1; + *lastproc = *lastproc+2; +} + + +/************************************************************************* +Internal subroutine: adding new summator layer to network +*************************************************************************/ +static void mlpbase_addactivationlayer(ae_int_t functype, + /* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t* lastproc, + ae_state *_state) +{ + + + ae_assert(functype>0||functype==-5, "AddActivationLayer: incorrect function type", _state); + lsizes->ptr.p_int[*lastproc+1] = lsizes->ptr.p_int[*lastproc]; + ltypes->ptr.p_int[*lastproc+1] = functype; + lconnfirst->ptr.p_int[*lastproc+1] = *lastproc; + lconnlast->ptr.p_int[*lastproc+1] = *lastproc; + *lastproc = *lastproc+1; +} + + +/************************************************************************* +Internal subroutine: adding new zero layer to network +*************************************************************************/ +static void mlpbase_addzerolayer(/* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t* lastproc, + ae_state *_state) +{ + + + lsizes->ptr.p_int[*lastproc+1] = 1; + ltypes->ptr.p_int[*lastproc+1] = -4; + lconnfirst->ptr.p_int[*lastproc+1] = 0; + lconnlast->ptr.p_int[*lastproc+1] = 0; + *lastproc = *lastproc+1; +} + + +/************************************************************************* +This routine adds input layer to the high-level description of the network. + +It modifies Network.HLConnections and Network.HLNeurons and assumes that +these arrays have enough place to store data. It accepts following +parameters: + Network - network + ConnIdx - index of the first free entry in the HLConnections + NeuroIdx - index of the first free entry in the HLNeurons + StructInfoIdx- index of the first entry in the low level description + of the current layer (in the StructInfo array) + NIn - number of inputs + +It modified Network and indices. +*************************************************************************/ +static void mlpbase_hladdinputlayer(multilayerperceptron* network, + ae_int_t* connidx, + ae_int_t* neuroidx, + ae_int_t* structinfoidx, + ae_int_t nin, + ae_state *_state) +{ + ae_int_t i; + ae_int_t offs; + + + offs = mlpbase_hlnfieldwidth*(*neuroidx); + for(i=0; i<=nin-1; i++) + { + network->hlneurons.ptr.p_int[offs+0] = 0; + network->hlneurons.ptr.p_int[offs+1] = i; + network->hlneurons.ptr.p_int[offs+2] = -1; + network->hlneurons.ptr.p_int[offs+3] = -1; + offs = offs+mlpbase_hlnfieldwidth; + } + *neuroidx = *neuroidx+nin; + *structinfoidx = *structinfoidx+nin; +} + + +/************************************************************************* +This routine adds output layer to the high-level description of +the network. + +It modifies Network.HLConnections and Network.HLNeurons and assumes that +these arrays have enough place to store data. It accepts following +parameters: + Network - network + ConnIdx - index of the first free entry in the HLConnections + NeuroIdx - index of the first free entry in the HLNeurons + StructInfoIdx- index of the first entry in the low level description + of the current layer (in the StructInfo array) + WeightsIdx - index of the first entry in the Weights array which + corresponds to the current layer + K - current layer index + NPrev - number of neurons in the previous layer + NOut - number of outputs + IsCls - is it classifier network? + IsLinear - is it network with linear output? + +It modified Network and ConnIdx/NeuroIdx/StructInfoIdx/WeightsIdx. +*************************************************************************/ +static void mlpbase_hladdoutputlayer(multilayerperceptron* network, + ae_int_t* connidx, + ae_int_t* neuroidx, + ae_int_t* structinfoidx, + ae_int_t* weightsidx, + ae_int_t k, + ae_int_t nprev, + ae_int_t nout, + ae_bool iscls, + ae_bool islinearout, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t neurooffs; + ae_int_t connoffs; + + + ae_assert((iscls&&islinearout)||!iscls, "HLAddOutputLayer: internal error", _state); + neurooffs = mlpbase_hlnfieldwidth*(*neuroidx); + connoffs = mlpbase_hlconnfieldwidth*(*connidx); + if( !iscls ) + { + + /* + * Regression network + */ + for(i=0; i<=nout-1; i++) + { + network->hlneurons.ptr.p_int[neurooffs+0] = k; + network->hlneurons.ptr.p_int[neurooffs+1] = i; + network->hlneurons.ptr.p_int[neurooffs+2] = *structinfoidx+1+nout+i; + network->hlneurons.ptr.p_int[neurooffs+3] = *weightsidx+nprev+(nprev+1)*i; + neurooffs = neurooffs+mlpbase_hlnfieldwidth; + } + for(i=0; i<=nprev-1; i++) + { + for(j=0; j<=nout-1; j++) + { + network->hlconnections.ptr.p_int[connoffs+0] = k-1; + network->hlconnections.ptr.p_int[connoffs+1] = i; + network->hlconnections.ptr.p_int[connoffs+2] = k; + network->hlconnections.ptr.p_int[connoffs+3] = j; + network->hlconnections.ptr.p_int[connoffs+4] = *weightsidx+i+j*(nprev+1); + connoffs = connoffs+mlpbase_hlconnfieldwidth; + } + } + *connidx = *connidx+nprev*nout; + *neuroidx = *neuroidx+nout; + *structinfoidx = *structinfoidx+2*nout+1; + *weightsidx = *weightsidx+nout*(nprev+1); + } + else + { + + /* + * Classification network + */ + for(i=0; i<=nout-2; i++) + { + network->hlneurons.ptr.p_int[neurooffs+0] = k; + network->hlneurons.ptr.p_int[neurooffs+1] = i; + network->hlneurons.ptr.p_int[neurooffs+2] = -1; + network->hlneurons.ptr.p_int[neurooffs+3] = *weightsidx+nprev+(nprev+1)*i; + neurooffs = neurooffs+mlpbase_hlnfieldwidth; + } + network->hlneurons.ptr.p_int[neurooffs+0] = k; + network->hlneurons.ptr.p_int[neurooffs+1] = i; + network->hlneurons.ptr.p_int[neurooffs+2] = -1; + network->hlneurons.ptr.p_int[neurooffs+3] = -1; + for(i=0; i<=nprev-1; i++) + { + for(j=0; j<=nout-2; j++) + { + network->hlconnections.ptr.p_int[connoffs+0] = k-1; + network->hlconnections.ptr.p_int[connoffs+1] = i; + network->hlconnections.ptr.p_int[connoffs+2] = k; + network->hlconnections.ptr.p_int[connoffs+3] = j; + network->hlconnections.ptr.p_int[connoffs+4] = *weightsidx+i+j*(nprev+1); + connoffs = connoffs+mlpbase_hlconnfieldwidth; + } + } + *connidx = *connidx+nprev*(nout-1); + *neuroidx = *neuroidx+nout; + *structinfoidx = *structinfoidx+nout+2; + *weightsidx = *weightsidx+(nout-1)*(nprev+1); + } +} + + +/************************************************************************* +This routine adds hidden layer to the high-level description of +the network. + +It modifies Network.HLConnections and Network.HLNeurons and assumes that +these arrays have enough place to store data. It accepts following +parameters: + Network - network + ConnIdx - index of the first free entry in the HLConnections + NeuroIdx - index of the first free entry in the HLNeurons + StructInfoIdx- index of the first entry in the low level description + of the current layer (in the StructInfo array) + WeightsIdx - index of the first entry in the Weights array which + corresponds to the current layer + K - current layer index + NPrev - number of neurons in the previous layer + NCur - number of neurons in the current layer + +It modified Network and ConnIdx/NeuroIdx/StructInfoIdx/WeightsIdx. +*************************************************************************/ +static void mlpbase_hladdhiddenlayer(multilayerperceptron* network, + ae_int_t* connidx, + ae_int_t* neuroidx, + ae_int_t* structinfoidx, + ae_int_t* weightsidx, + ae_int_t k, + ae_int_t nprev, + ae_int_t ncur, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t neurooffs; + ae_int_t connoffs; + + + neurooffs = mlpbase_hlnfieldwidth*(*neuroidx); + connoffs = mlpbase_hlconnfieldwidth*(*connidx); + for(i=0; i<=ncur-1; i++) + { + network->hlneurons.ptr.p_int[neurooffs+0] = k; + network->hlneurons.ptr.p_int[neurooffs+1] = i; + network->hlneurons.ptr.p_int[neurooffs+2] = *structinfoidx+1+ncur+i; + network->hlneurons.ptr.p_int[neurooffs+3] = *weightsidx+nprev+(nprev+1)*i; + neurooffs = neurooffs+mlpbase_hlnfieldwidth; + } + for(i=0; i<=nprev-1; i++) + { + for(j=0; j<=ncur-1; j++) + { + network->hlconnections.ptr.p_int[connoffs+0] = k-1; + network->hlconnections.ptr.p_int[connoffs+1] = i; + network->hlconnections.ptr.p_int[connoffs+2] = k; + network->hlconnections.ptr.p_int[connoffs+3] = j; + network->hlconnections.ptr.p_int[connoffs+4] = *weightsidx+i+j*(nprev+1); + connoffs = connoffs+mlpbase_hlconnfieldwidth; + } + } + *connidx = *connidx+nprev*ncur; + *neuroidx = *neuroidx+ncur; + *structinfoidx = *structinfoidx+2*ncur+1; + *weightsidx = *weightsidx+ncur*(nprev+1); +} + + +/************************************************************************* +This function fills high level information about network created using +internal MLPCreate() function. + +This function does NOT examine StructInfo for low level information, it +just expects that network has following structure: + + input neuron \ + ... | input layer + input neuron / + + "-1" neuron \ + biased summator | + ... | + biased summator | hidden layer(s), if there are exists any + activation function | + ... | + activation function / + + "-1" neuron \ + biased summator | output layer: + ... | + biased summator | * we have NOut summators/activators for regression networks + activation function | * we have only NOut-1 summators and no activators for classifiers + ... | * we have "0" neuron only when we have classifier + activation function | + "0" neuron / + + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +static void mlpbase_fillhighlevelinformation(multilayerperceptron* network, + ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + ae_bool iscls, + ae_bool islinearout, + ae_state *_state) +{ + ae_int_t idxweights; + ae_int_t idxstruct; + ae_int_t idxneuro; + ae_int_t idxconn; + + + ae_assert((iscls&&islinearout)||!iscls, "FillHighLevelInformation: internal error", _state); + + /* + * Preparations common to all types of networks + */ + idxweights = 0; + idxneuro = 0; + idxstruct = 0; + idxconn = 0; + network->hlnetworktype = 0; + + /* + * network without hidden layers + */ + if( nhid1==0 ) + { + ae_vector_set_length(&network->hllayersizes, 2, _state); + network->hllayersizes.ptr.p_int[0] = nin; + network->hllayersizes.ptr.p_int[1] = nout; + if( !iscls ) + { + ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*nin*nout, _state); + ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nout), _state); + network->hlnormtype = 0; + } + else + { + ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*nin*(nout-1), _state); + ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nout), _state); + network->hlnormtype = 1; + } + mlpbase_hladdinputlayer(network, &idxconn, &idxneuro, &idxstruct, nin, _state); + mlpbase_hladdoutputlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 1, nin, nout, iscls, islinearout, _state); + return; + } + + /* + * network with one hidden layers + */ + if( nhid2==0 ) + { + ae_vector_set_length(&network->hllayersizes, 3, _state); + network->hllayersizes.ptr.p_int[0] = nin; + network->hllayersizes.ptr.p_int[1] = nhid1; + network->hllayersizes.ptr.p_int[2] = nout; + if( !iscls ) + { + ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*(nin*nhid1+nhid1*nout), _state); + ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nhid1+nout), _state); + network->hlnormtype = 0; + } + else + { + ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*(nin*nhid1+nhid1*(nout-1)), _state); + ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nhid1+nout), _state); + network->hlnormtype = 1; + } + mlpbase_hladdinputlayer(network, &idxconn, &idxneuro, &idxstruct, nin, _state); + mlpbase_hladdhiddenlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 1, nin, nhid1, _state); + mlpbase_hladdoutputlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 2, nhid1, nout, iscls, islinearout, _state); + return; + } + + /* + * Two hidden layers + */ + ae_vector_set_length(&network->hllayersizes, 4, _state); + network->hllayersizes.ptr.p_int[0] = nin; + network->hllayersizes.ptr.p_int[1] = nhid1; + network->hllayersizes.ptr.p_int[2] = nhid2; + network->hllayersizes.ptr.p_int[3] = nout; + if( !iscls ) + { + ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*(nin*nhid1+nhid1*nhid2+nhid2*nout), _state); + ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nhid1+nhid2+nout), _state); + network->hlnormtype = 0; + } + else + { + ae_vector_set_length(&network->hlconnections, mlpbase_hlconnfieldwidth*(nin*nhid1+nhid1*nhid2+nhid2*(nout-1)), _state); + ae_vector_set_length(&network->hlneurons, mlpbase_hlnfieldwidth*(nin+nhid1+nhid2+nout), _state); + network->hlnormtype = 1; + } + mlpbase_hladdinputlayer(network, &idxconn, &idxneuro, &idxstruct, nin, _state); + mlpbase_hladdhiddenlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 1, nin, nhid1, _state); + mlpbase_hladdhiddenlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 2, nhid1, nhid2, _state); + mlpbase_hladdoutputlayer(network, &idxconn, &idxneuro, &idxstruct, &idxweights, 3, nhid2, nout, iscls, islinearout, _state); +} + + +/************************************************************************* +Internal subroutine. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +static void mlpbase_mlpcreate(ae_int_t nin, + ae_int_t nout, + /* Integer */ ae_vector* lsizes, + /* Integer */ ae_vector* ltypes, + /* Integer */ ae_vector* lconnfirst, + /* Integer */ ae_vector* lconnlast, + ae_int_t layerscount, + ae_bool isclsnet, + multilayerperceptron* network, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t ssize; + ae_int_t ntotal; + ae_int_t wcount; + ae_int_t offs; + ae_int_t nprocessed; + ae_int_t wallocated; + ae_vector localtemp; + ae_vector lnfirst; + ae_vector lnsyn; + mlpbuffers buf; + smlpgrad sgrad; + + ae_frame_make(_state, &_frame_block); + _multilayerperceptron_clear(network); + ae_vector_init(&localtemp, 0, DT_INT, _state, ae_true); + ae_vector_init(&lnfirst, 0, DT_INT, _state, ae_true); + ae_vector_init(&lnsyn, 0, DT_INT, _state, ae_true); + _mlpbuffers_init(&buf, _state, ae_true); + _smlpgrad_init(&sgrad, _state, ae_true); + + + /* + * Check + */ + ae_assert(layerscount>0, "MLPCreate: wrong parameters!", _state); + ae_assert(ltypes->ptr.p_int[0]==-2, "MLPCreate: wrong LTypes[0] (must be -2)!", _state); + for(i=0; i<=layerscount-1; i++) + { + ae_assert(lsizes->ptr.p_int[i]>0, "MLPCreate: wrong LSizes!", _state); + ae_assert(lconnfirst->ptr.p_int[i]>=0&&(lconnfirst->ptr.p_int[i]ptr.p_int[i]>=lconnfirst->ptr.p_int[i]&&(lconnlast->ptr.p_int[i]ptr.p_int[i]>=0||ltypes->ptr.p_int[i]==-5 ) + { + lnsyn.ptr.p_int[i] = 0; + for(j=lconnfirst->ptr.p_int[i]; j<=lconnlast->ptr.p_int[i]; j++) + { + lnsyn.ptr.p_int[i] = lnsyn.ptr.p_int[i]+lsizes->ptr.p_int[j]; + } + } + else + { + if( (ltypes->ptr.p_int[i]==-2||ltypes->ptr.p_int[i]==-3)||ltypes->ptr.p_int[i]==-4 ) + { + lnsyn.ptr.p_int[i] = 0; + } + } + ae_assert(lnsyn.ptr.p_int[i]>=0, "MLPCreate: internal error #0!", _state); + + /* + * Other info + */ + lnfirst.ptr.p_int[i] = ntotal; + ntotal = ntotal+lsizes->ptr.p_int[i]; + if( ltypes->ptr.p_int[i]==0 ) + { + wcount = wcount+lnsyn.ptr.p_int[i]*lsizes->ptr.p_int[i]; + } + } + ssize = 7+ntotal*mlpbase_nfieldwidth; + + /* + * Allocate + */ + ae_vector_set_length(&network->structinfo, ssize-1+1, _state); + ae_vector_set_length(&network->weights, wcount-1+1, _state); + if( isclsnet ) + { + ae_vector_set_length(&network->columnmeans, nin-1+1, _state); + ae_vector_set_length(&network->columnsigmas, nin-1+1, _state); + } + else + { + ae_vector_set_length(&network->columnmeans, nin+nout-1+1, _state); + ae_vector_set_length(&network->columnsigmas, nin+nout-1+1, _state); + } + ae_vector_set_length(&network->neurons, ntotal-1+1, _state); + ae_vector_set_length(&network->nwbuf, ae_maxint(wcount, 2*nout, _state)-1+1, _state); + ae_vector_set_length(&network->integerbuf, 3+1, _state); + ae_vector_set_length(&network->dfdnet, ntotal-1+1, _state); + ae_vector_set_length(&network->x, nin-1+1, _state); + ae_vector_set_length(&network->y, nout-1+1, _state); + ae_vector_set_length(&network->derror, ntotal-1+1, _state); + + /* + * Fill structure: global info + */ + network->structinfo.ptr.p_int[0] = ssize; + network->structinfo.ptr.p_int[1] = nin; + network->structinfo.ptr.p_int[2] = nout; + network->structinfo.ptr.p_int[3] = ntotal; + network->structinfo.ptr.p_int[4] = wcount; + network->structinfo.ptr.p_int[5] = 7; + if( isclsnet ) + { + network->structinfo.ptr.p_int[6] = 1; + } + else + { + network->structinfo.ptr.p_int[6] = 0; + } + + /* + * Fill structure: neuron connections + */ + nprocessed = 0; + wallocated = 0; + for(i=0; i<=layerscount-1; i++) + { + for(j=0; j<=lsizes->ptr.p_int[i]-1; j++) + { + offs = network->structinfo.ptr.p_int[5]+nprocessed*mlpbase_nfieldwidth; + network->structinfo.ptr.p_int[offs+0] = ltypes->ptr.p_int[i]; + if( ltypes->ptr.p_int[i]==0 ) + { + + /* + * Adaptive summator: + * * connections with weights to previous neurons + */ + network->structinfo.ptr.p_int[offs+1] = lnsyn.ptr.p_int[i]; + network->structinfo.ptr.p_int[offs+2] = lnfirst.ptr.p_int[lconnfirst->ptr.p_int[i]]; + network->structinfo.ptr.p_int[offs+3] = wallocated; + wallocated = wallocated+lnsyn.ptr.p_int[i]; + nprocessed = nprocessed+1; + } + if( ltypes->ptr.p_int[i]>0||ltypes->ptr.p_int[i]==-5 ) + { + + /* + * Activation layer: + * * each neuron connected to one (only one) of previous neurons. + * * no weights + */ + network->structinfo.ptr.p_int[offs+1] = 1; + network->structinfo.ptr.p_int[offs+2] = lnfirst.ptr.p_int[lconnfirst->ptr.p_int[i]]+j; + network->structinfo.ptr.p_int[offs+3] = -1; + nprocessed = nprocessed+1; + } + if( (ltypes->ptr.p_int[i]==-2||ltypes->ptr.p_int[i]==-3)||ltypes->ptr.p_int[i]==-4 ) + { + nprocessed = nprocessed+1; + } + } + } + ae_assert(wallocated==wcount, "MLPCreate: internal error #1!", _state); + ae_assert(nprocessed==ntotal, "MLPCreate: internal error #2!", _state); + + /* + * Fill weights by small random values + * Initialize means and sigmas + */ + for(i=0; i<=nin-1; i++) + { + network->columnmeans.ptr.p_double[i] = 0; + network->columnsigmas.ptr.p_double[i] = 1; + } + if( !isclsnet ) + { + for(i=0; i<=nout-1; i++) + { + network->columnmeans.ptr.p_double[nin+i] = 0; + network->columnsigmas.ptr.p_double[nin+i] = 1; + } + } + mlprandomize(network, _state); + + /* + * Seed buffers + */ + ae_shared_pool_set_seed(&network->buf, &buf, sizeof(buf), _mlpbuffers_init, _mlpbuffers_init_copy, _mlpbuffers_destroy, _state); + ae_vector_set_length(&sgrad.g, wcount, _state); + sgrad.f = 0.0; + for(i=0; i<=wcount-1; i++) + { + sgrad.g.ptr.p_double[i] = 0.0; + } + ae_shared_pool_set_seed(&network->gradbuf, &sgrad, sizeof(sgrad), _smlpgrad_init, _smlpgrad_init_copy, _smlpgrad_destroy, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine for Hessian calculation. + +WARNING! Unspeakable math far beyong human capabilities :) +*************************************************************************/ +static void mlpbase_mlphessianbatchinternal(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + ae_bool naturalerr, + double* e, + /* Real */ ae_vector* grad, + /* Real */ ae_matrix* h, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntotal; + ae_int_t istart; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t kl; + ae_int_t offs; + ae_int_t n1; + ae_int_t n2; + ae_int_t w1; + ae_int_t w2; + double s; + double t; + double v; + double et; + ae_bool bflag; + double f; + double df; + double d2f; + double deidyj; + double mx; + double q; + double z; + double s2; + double expi; + double expj; + ae_vector x; + ae_vector desiredy; + ae_vector gt; + ae_vector zeros; + ae_matrix rx; + ae_matrix ry; + ae_matrix rdx; + ae_matrix rdy; + + ae_frame_make(_state, &_frame_block); + *e = 0; + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&desiredy, 0, DT_REAL, _state, ae_true); + ae_vector_init(>, 0, DT_REAL, _state, ae_true); + ae_vector_init(&zeros, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&rx, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&ry, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&rdx, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&rdy, 0, 0, DT_REAL, _state, ae_true); + + mlpproperties(network, &nin, &nout, &wcount, _state); + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + + /* + * Prepare + */ + ae_vector_set_length(&x, nin-1+1, _state); + ae_vector_set_length(&desiredy, nout-1+1, _state); + ae_vector_set_length(&zeros, wcount-1+1, _state); + ae_vector_set_length(>, wcount-1+1, _state); + ae_matrix_set_length(&rx, ntotal+nout-1+1, wcount-1+1, _state); + ae_matrix_set_length(&ry, ntotal+nout-1+1, wcount-1+1, _state); + ae_matrix_set_length(&rdx, ntotal+nout-1+1, wcount-1+1, _state); + ae_matrix_set_length(&rdy, ntotal+nout-1+1, wcount-1+1, _state); + *e = 0; + for(i=0; i<=wcount-1; i++) + { + zeros.ptr.p_double[i] = 0; + } + ae_v_move(&grad->ptr.p_double[0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + for(i=0; i<=wcount-1; i++) + { + ae_v_move(&h->ptr.pp_double[i][0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + } + + /* + * Process + */ + for(k=0; k<=ssize-1; k++) + { + + /* + * Process vector with MLPGradN. + * Now Neurons, DFDNET and DError contains results of the last run. + */ + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[k][0], 1, ae_v_len(0,nin-1)); + if( mlpissoftmax(network, _state) ) + { + + /* + * class labels outputs + */ + kl = ae_round(xy->ptr.pp_double[k][nin], _state); + for(i=0; i<=nout-1; i++) + { + if( i==kl ) + { + desiredy.ptr.p_double[i] = 1; + } + else + { + desiredy.ptr.p_double[i] = 0; + } + } + } + else + { + + /* + * real outputs + */ + ae_v_move(&desiredy.ptr.p_double[0], 1, &xy->ptr.pp_double[k][nin], 1, ae_v_len(0,nout-1)); + } + if( naturalerr ) + { + mlpgradn(network, &x, &desiredy, &et, >, _state); + } + else + { + mlpgrad(network, &x, &desiredy, &et, >, _state); + } + + /* + * grad, error + */ + *e = *e+et; + ae_v_add(&grad->ptr.p_double[0], 1, >.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + + /* + * Hessian. + * Forward pass of the R-algorithm + */ + for(i=0; i<=ntotal-1; i++) + { + offs = istart+i*mlpbase_nfieldwidth; + ae_v_move(&rx.ptr.pp_double[i][0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + ae_v_move(&ry.ptr.pp_double[i][0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + if( network->structinfo.ptr.p_int[offs+0]>0||network->structinfo.ptr.p_int[offs+0]==-5 ) + { + + /* + * Activation function + */ + n1 = network->structinfo.ptr.p_int[offs+2]; + ae_v_move(&rx.ptr.pp_double[i][0], 1, &ry.ptr.pp_double[n1][0], 1, ae_v_len(0,wcount-1)); + v = network->dfdnet.ptr.p_double[i]; + ae_v_moved(&ry.ptr.pp_double[i][0], 1, &rx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), v); + continue; + } + if( network->structinfo.ptr.p_int[offs+0]==0 ) + { + + /* + * Adaptive summator + */ + n1 = network->structinfo.ptr.p_int[offs+2]; + n2 = n1+network->structinfo.ptr.p_int[offs+1]-1; + w1 = network->structinfo.ptr.p_int[offs+3]; + w2 = w1+network->structinfo.ptr.p_int[offs+1]-1; + for(j=n1; j<=n2; j++) + { + v = network->weights.ptr.p_double[w1+j-n1]; + ae_v_addd(&rx.ptr.pp_double[i][0], 1, &ry.ptr.pp_double[j][0], 1, ae_v_len(0,wcount-1), v); + rx.ptr.pp_double[i][w1+j-n1] = rx.ptr.pp_double[i][w1+j-n1]+network->neurons.ptr.p_double[j]; + } + ae_v_move(&ry.ptr.pp_double[i][0], 1, &rx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1)); + continue; + } + if( network->structinfo.ptr.p_int[offs+0]<0 ) + { + bflag = ae_true; + if( network->structinfo.ptr.p_int[offs+0]==-2 ) + { + + /* + * input neuron, left unchanged + */ + bflag = ae_false; + } + if( network->structinfo.ptr.p_int[offs+0]==-3 ) + { + + /* + * "-1" neuron, left unchanged + */ + bflag = ae_false; + } + if( network->structinfo.ptr.p_int[offs+0]==-4 ) + { + + /* + * "0" neuron, left unchanged + */ + bflag = ae_false; + } + ae_assert(!bflag, "MLPHessianNBatch: internal error - unknown neuron type!", _state); + continue; + } + } + + /* + * Hessian. Backward pass of the R-algorithm. + * + * Stage 1. Initialize RDY + */ + for(i=0; i<=ntotal+nout-1; i++) + { + ae_v_move(&rdy.ptr.pp_double[i][0], 1, &zeros.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + } + if( network->structinfo.ptr.p_int[6]==0 ) + { + + /* + * Standardisation. + * + * In context of the Hessian calculation standardisation + * is considered as additional layer with weightless + * activation function: + * + * F(NET) := Sigma*NET + * + * So we add one more layer to forward pass, and + * make forward/backward pass through this layer. + */ + for(i=0; i<=nout-1; i++) + { + n1 = ntotal-nout+i; + n2 = ntotal+i; + + /* + * Forward pass from N1 to N2 + */ + ae_v_move(&rx.ptr.pp_double[n2][0], 1, &ry.ptr.pp_double[n1][0], 1, ae_v_len(0,wcount-1)); + v = network->columnsigmas.ptr.p_double[nin+i]; + ae_v_moved(&ry.ptr.pp_double[n2][0], 1, &rx.ptr.pp_double[n2][0], 1, ae_v_len(0,wcount-1), v); + + /* + * Initialization of RDY + */ + ae_v_move(&rdy.ptr.pp_double[n2][0], 1, &ry.ptr.pp_double[n2][0], 1, ae_v_len(0,wcount-1)); + + /* + * Backward pass from N2 to N1: + * 1. Calculate R(dE/dX). + * 2. No R(dE/dWij) is needed since weight of activation neuron + * is fixed to 1. So we can update R(dE/dY) for + * the connected neuron (note that Vij=0, Wij=1) + */ + df = network->columnsigmas.ptr.p_double[nin+i]; + ae_v_moved(&rdx.ptr.pp_double[n2][0], 1, &rdy.ptr.pp_double[n2][0], 1, ae_v_len(0,wcount-1), df); + ae_v_add(&rdy.ptr.pp_double[n1][0], 1, &rdx.ptr.pp_double[n2][0], 1, ae_v_len(0,wcount-1)); + } + } + else + { + + /* + * Softmax. + * + * Initialize RDY using generalized expression for ei'(yi) + * (see expression (9) from p. 5 of "Fast Exact Multiplication by the Hessian"). + * + * When we are working with softmax network, generalized + * expression for ei'(yi) is used because softmax + * normalization leads to ei, which depends on all y's + */ + if( naturalerr ) + { + + /* + * softmax + cross-entropy. + * We have: + * + * S = sum(exp(yk)), + * ei = sum(trn)*exp(yi)/S-trn_i + * + * j=i: d(ei)/d(yj) = T*exp(yi)*(S-exp(yi))/S^2 + * j<>i: d(ei)/d(yj) = -T*exp(yi)*exp(yj)/S^2 + */ + t = 0; + for(i=0; i<=nout-1; i++) + { + t = t+desiredy.ptr.p_double[i]; + } + mx = network->neurons.ptr.p_double[ntotal-nout]; + for(i=0; i<=nout-1; i++) + { + mx = ae_maxreal(mx, network->neurons.ptr.p_double[ntotal-nout+i], _state); + } + s = 0; + for(i=0; i<=nout-1; i++) + { + network->nwbuf.ptr.p_double[i] = ae_exp(network->neurons.ptr.p_double[ntotal-nout+i]-mx, _state); + s = s+network->nwbuf.ptr.p_double[i]; + } + for(i=0; i<=nout-1; i++) + { + for(j=0; j<=nout-1; j++) + { + if( j==i ) + { + deidyj = t*network->nwbuf.ptr.p_double[i]*(s-network->nwbuf.ptr.p_double[i])/ae_sqr(s, _state); + ae_v_addd(&rdy.ptr.pp_double[ntotal-nout+i][0], 1, &ry.ptr.pp_double[ntotal-nout+i][0], 1, ae_v_len(0,wcount-1), deidyj); + } + else + { + deidyj = -t*network->nwbuf.ptr.p_double[i]*network->nwbuf.ptr.p_double[j]/ae_sqr(s, _state); + ae_v_addd(&rdy.ptr.pp_double[ntotal-nout+i][0], 1, &ry.ptr.pp_double[ntotal-nout+j][0], 1, ae_v_len(0,wcount-1), deidyj); + } + } + } + } + else + { + + /* + * For a softmax + squared error we have expression + * far beyond human imagination so we dont even try + * to comment on it. Just enjoy the code... + * + * P.S. That's why "natural error" is called "natural" - + * compact beatiful expressions, fast code.... + */ + mx = network->neurons.ptr.p_double[ntotal-nout]; + for(i=0; i<=nout-1; i++) + { + mx = ae_maxreal(mx, network->neurons.ptr.p_double[ntotal-nout+i], _state); + } + s = 0; + s2 = 0; + for(i=0; i<=nout-1; i++) + { + network->nwbuf.ptr.p_double[i] = ae_exp(network->neurons.ptr.p_double[ntotal-nout+i]-mx, _state); + s = s+network->nwbuf.ptr.p_double[i]; + s2 = s2+ae_sqr(network->nwbuf.ptr.p_double[i], _state); + } + q = 0; + for(i=0; i<=nout-1; i++) + { + q = q+(network->y.ptr.p_double[i]-desiredy.ptr.p_double[i])*network->nwbuf.ptr.p_double[i]; + } + for(i=0; i<=nout-1; i++) + { + z = -q+(network->y.ptr.p_double[i]-desiredy.ptr.p_double[i])*s; + expi = network->nwbuf.ptr.p_double[i]; + for(j=0; j<=nout-1; j++) + { + expj = network->nwbuf.ptr.p_double[j]; + if( j==i ) + { + deidyj = expi/ae_sqr(s, _state)*((z+expi)*(s-2*expi)/s+expi*s2/ae_sqr(s, _state)); + } + else + { + deidyj = expi*expj/ae_sqr(s, _state)*(s2/ae_sqr(s, _state)-2*z/s-(expi+expj)/s+(network->y.ptr.p_double[i]-desiredy.ptr.p_double[i])-(network->y.ptr.p_double[j]-desiredy.ptr.p_double[j])); + } + ae_v_addd(&rdy.ptr.pp_double[ntotal-nout+i][0], 1, &ry.ptr.pp_double[ntotal-nout+j][0], 1, ae_v_len(0,wcount-1), deidyj); + } + } + } + } + + /* + * Hessian. Backward pass of the R-algorithm + * + * Stage 2. Process. + */ + for(i=ntotal-1; i>=0; i--) + { + + /* + * Possible variants: + * 1. Activation function + * 2. Adaptive summator + * 3. Special neuron + */ + offs = istart+i*mlpbase_nfieldwidth; + if( network->structinfo.ptr.p_int[offs+0]>0||network->structinfo.ptr.p_int[offs+0]==-5 ) + { + n1 = network->structinfo.ptr.p_int[offs+2]; + + /* + * First, calculate R(dE/dX). + */ + mlpactivationfunction(network->neurons.ptr.p_double[n1], network->structinfo.ptr.p_int[offs+0], &f, &df, &d2f, _state); + v = d2f*network->derror.ptr.p_double[i]; + ae_v_moved(&rdx.ptr.pp_double[i][0], 1, &rdy.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), df); + ae_v_addd(&rdx.ptr.pp_double[i][0], 1, &rx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), v); + + /* + * No R(dE/dWij) is needed since weight of activation neuron + * is fixed to 1. + * + * So we can update R(dE/dY) for the connected neuron. + * (note that Vij=0, Wij=1) + */ + ae_v_add(&rdy.ptr.pp_double[n1][0], 1, &rdx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1)); + continue; + } + if( network->structinfo.ptr.p_int[offs+0]==0 ) + { + + /* + * Adaptive summator + */ + n1 = network->structinfo.ptr.p_int[offs+2]; + n2 = n1+network->structinfo.ptr.p_int[offs+1]-1; + w1 = network->structinfo.ptr.p_int[offs+3]; + w2 = w1+network->structinfo.ptr.p_int[offs+1]-1; + + /* + * First, calculate R(dE/dX). + */ + ae_v_move(&rdx.ptr.pp_double[i][0], 1, &rdy.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1)); + + /* + * Then, calculate R(dE/dWij) + */ + for(j=w1; j<=w2; j++) + { + v = network->neurons.ptr.p_double[n1+j-w1]; + ae_v_addd(&h->ptr.pp_double[j][0], 1, &rdx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), v); + v = network->derror.ptr.p_double[i]; + ae_v_addd(&h->ptr.pp_double[j][0], 1, &ry.ptr.pp_double[n1+j-w1][0], 1, ae_v_len(0,wcount-1), v); + } + + /* + * And finally, update R(dE/dY) for connected neurons. + */ + for(j=w1; j<=w2; j++) + { + v = network->weights.ptr.p_double[j]; + ae_v_addd(&rdy.ptr.pp_double[n1+j-w1][0], 1, &rdx.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1), v); + rdy.ptr.pp_double[n1+j-w1][j] = rdy.ptr.pp_double[n1+j-w1][j]+network->derror.ptr.p_double[i]; + } + continue; + } + if( network->structinfo.ptr.p_int[offs+0]<0 ) + { + bflag = ae_false; + if( (network->structinfo.ptr.p_int[offs+0]==-2||network->structinfo.ptr.p_int[offs+0]==-3)||network->structinfo.ptr.p_int[offs+0]==-4 ) + { + + /* + * Special neuron type, no back-propagation required + */ + bflag = ae_true; + } + ae_assert(bflag, "MLPHessianNBatch: unknown neuron type!", _state); + continue; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine + +Network must be processed by MLPProcess on X +*************************************************************************/ +static void mlpbase_mlpinternalcalculategradient(multilayerperceptron* network, + /* Real */ ae_vector* neurons, + /* Real */ ae_vector* weights, + /* Real */ ae_vector* derror, + /* Real */ ae_vector* grad, + ae_bool naturalerrorfunc, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n1; + ae_int_t n2; + ae_int_t w1; + ae_int_t w2; + ae_int_t ntotal; + ae_int_t istart; + ae_int_t nin; + ae_int_t nout; + ae_int_t offs; + double dedf; + double dfdnet; + double v; + double fown; + double deown; + double net; + double mx; + ae_bool bflag; + + + + /* + * Read network geometry + */ + nin = network->structinfo.ptr.p_int[1]; + nout = network->structinfo.ptr.p_int[2]; + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + + /* + * Pre-processing of dError/dOut: + * from dError/dOut(normalized) to dError/dOut(non-normalized) + */ + ae_assert(network->structinfo.ptr.p_int[6]==0||network->structinfo.ptr.p_int[6]==1, "MLPInternalCalculateGradient: unknown normalization type!", _state); + if( network->structinfo.ptr.p_int[6]==1 ) + { + + /* + * Softmax + */ + if( !naturalerrorfunc ) + { + mx = network->neurons.ptr.p_double[ntotal-nout]; + for(i=0; i<=nout-1; i++) + { + mx = ae_maxreal(mx, network->neurons.ptr.p_double[ntotal-nout+i], _state); + } + net = 0; + for(i=0; i<=nout-1; i++) + { + network->nwbuf.ptr.p_double[i] = ae_exp(network->neurons.ptr.p_double[ntotal-nout+i]-mx, _state); + net = net+network->nwbuf.ptr.p_double[i]; + } + v = ae_v_dotproduct(&network->derror.ptr.p_double[ntotal-nout], 1, &network->nwbuf.ptr.p_double[0], 1, ae_v_len(ntotal-nout,ntotal-1)); + for(i=0; i<=nout-1; i++) + { + fown = network->nwbuf.ptr.p_double[i]; + deown = network->derror.ptr.p_double[ntotal-nout+i]; + network->nwbuf.ptr.p_double[nout+i] = (-v+deown*fown+deown*(net-fown))*fown/ae_sqr(net, _state); + } + for(i=0; i<=nout-1; i++) + { + network->derror.ptr.p_double[ntotal-nout+i] = network->nwbuf.ptr.p_double[nout+i]; + } + } + } + else + { + + /* + * Un-standardisation + */ + for(i=0; i<=nout-1; i++) + { + network->derror.ptr.p_double[ntotal-nout+i] = network->derror.ptr.p_double[ntotal-nout+i]*network->columnsigmas.ptr.p_double[nin+i]; + } + } + + /* + * Backpropagation + */ + for(i=ntotal-1; i>=0; i--) + { + + /* + * Extract info + */ + offs = istart+i*mlpbase_nfieldwidth; + if( network->structinfo.ptr.p_int[offs+0]>0||network->structinfo.ptr.p_int[offs+0]==-5 ) + { + + /* + * Activation function + */ + dedf = network->derror.ptr.p_double[i]; + dfdnet = network->dfdnet.ptr.p_double[i]; + derror->ptr.p_double[network->structinfo.ptr.p_int[offs+2]] = derror->ptr.p_double[network->structinfo.ptr.p_int[offs+2]]+dedf*dfdnet; + continue; + } + if( network->structinfo.ptr.p_int[offs+0]==0 ) + { + + /* + * Adaptive summator + */ + n1 = network->structinfo.ptr.p_int[offs+2]; + n2 = n1+network->structinfo.ptr.p_int[offs+1]-1; + w1 = network->structinfo.ptr.p_int[offs+3]; + w2 = w1+network->structinfo.ptr.p_int[offs+1]-1; + dedf = network->derror.ptr.p_double[i]; + dfdnet = 1.0; + v = dedf*dfdnet; + ae_v_moved(&grad->ptr.p_double[w1], 1, &neurons->ptr.p_double[n1], 1, ae_v_len(w1,w2), v); + ae_v_addd(&derror->ptr.p_double[n1], 1, &weights->ptr.p_double[w1], 1, ae_v_len(n1,n2), v); + continue; + } + if( network->structinfo.ptr.p_int[offs+0]<0 ) + { + bflag = ae_false; + if( (network->structinfo.ptr.p_int[offs+0]==-2||network->structinfo.ptr.p_int[offs+0]==-3)||network->structinfo.ptr.p_int[offs+0]==-4 ) + { + + /* + * Special neuron type, no back-propagation required + */ + bflag = ae_true; + } + ae_assert(bflag, "MLPInternalCalculateGradient: unknown neuron type!", _state); + continue; + } + } +} + + +static void mlpbase_mlpchunkedgradient(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + /* Real */ ae_vector* batch4buf, + /* Real */ ae_vector* hpcbuf, + double* e, + ae_bool naturalerrorfunc, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t kl; + ae_int_t ntotal; + ae_int_t nin; + ae_int_t nout; + ae_int_t offs; + double f; + double df; + double d2f; + double v; + double vv; + double s; + double fown; + double deown; + ae_bool bflag; + ae_int_t istart; + ae_int_t entrysize; + ae_int_t dfoffs; + ae_int_t derroroffs; + ae_int_t entryoffs; + ae_int_t neuronidx; + ae_int_t srcentryoffs; + ae_int_t srcneuronidx; + ae_int_t srcweightidx; + ae_int_t neurontype; + ae_int_t nweights; + ae_int_t offs0; + ae_int_t offs1; + ae_int_t offs2; + double v0; + double v1; + double v2; + double v3; + double s0; + double s1; + double s2; + double s3; + ae_int_t chunksize; + + + chunksize = 4; + ae_assert(csize<=chunksize, "MLPChunkedGradient: internal error (CSize>ChunkSize)", _state); + + /* + * Try to use HPC core, if possible + */ + if( hpcchunkedgradient(&network->weights, &network->structinfo, &network->columnmeans, &network->columnsigmas, xy, cstart, csize, batch4buf, hpcbuf, e, naturalerrorfunc, _state) ) + { + return; + } + + /* + * Read network geometry, prepare data + */ + nin = network->structinfo.ptr.p_int[1]; + nout = network->structinfo.ptr.p_int[2]; + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + entrysize = 12; + dfoffs = 4; + derroroffs = 8; + + /* + * Fill Batch4Buf by zeros. + * + * THIS STAGE IS VERY IMPORTANT! + * + * We fill all components of entry - neuron values, dF/dNET, dError/dF. + * It allows us to easily handle situations when CSizeptr.p_double[i] = 0; + } + + /* + * Forward pass: + * 1. Load data into Batch4Buf. If CSizecolumnsigmas.ptr.p_double[i],0) ) + { + batch4buf->ptr.p_double[entryoffs+j] = (xy->ptr.pp_double[cstart+j][i]-network->columnmeans.ptr.p_double[i])/network->columnsigmas.ptr.p_double[i]; + } + else + { + batch4buf->ptr.p_double[entryoffs+j] = xy->ptr.pp_double[cstart+j][i]-network->columnmeans.ptr.p_double[i]; + } + } + } + for(neuronidx=0; neuronidx<=ntotal-1; neuronidx++) + { + entryoffs = entrysize*neuronidx; + offs = istart+neuronidx*mlpbase_nfieldwidth; + neurontype = network->structinfo.ptr.p_int[offs+0]; + if( neurontype>0||neurontype==-5 ) + { + + /* + * "activation function" neuron, which takes value of neuron SrcNeuronIdx + * and applies activation function to it. + * + * This neuron has no weights and no tunable parameters. + */ + srcneuronidx = network->structinfo.ptr.p_int[offs+2]; + srcentryoffs = entrysize*srcneuronidx; + mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+0], neurontype, &f, &df, &d2f, _state); + batch4buf->ptr.p_double[entryoffs+0] = f; + batch4buf->ptr.p_double[entryoffs+0+dfoffs] = df; + mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+1], neurontype, &f, &df, &d2f, _state); + batch4buf->ptr.p_double[entryoffs+1] = f; + batch4buf->ptr.p_double[entryoffs+1+dfoffs] = df; + mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+2], neurontype, &f, &df, &d2f, _state); + batch4buf->ptr.p_double[entryoffs+2] = f; + batch4buf->ptr.p_double[entryoffs+2+dfoffs] = df; + mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+3], neurontype, &f, &df, &d2f, _state); + batch4buf->ptr.p_double[entryoffs+3] = f; + batch4buf->ptr.p_double[entryoffs+3+dfoffs] = df; + continue; + } + if( neurontype==0 ) + { + + /* + * "adaptive summator" neuron, whose output is a weighted sum of inputs. + * It has weights, but has no activation function. + */ + nweights = network->structinfo.ptr.p_int[offs+1]; + srcneuronidx = network->structinfo.ptr.p_int[offs+2]; + srcentryoffs = entrysize*srcneuronidx; + srcweightidx = network->structinfo.ptr.p_int[offs+3]; + v0 = 0; + v1 = 0; + v2 = 0; + v3 = 0; + for(j=0; j<=nweights-1; j++) + { + v = network->weights.ptr.p_double[srcweightidx]; + srcweightidx = srcweightidx+1; + v0 = v0+v*batch4buf->ptr.p_double[srcentryoffs+0]; + v1 = v1+v*batch4buf->ptr.p_double[srcentryoffs+1]; + v2 = v2+v*batch4buf->ptr.p_double[srcentryoffs+2]; + v3 = v3+v*batch4buf->ptr.p_double[srcentryoffs+3]; + srcentryoffs = srcentryoffs+entrysize; + } + batch4buf->ptr.p_double[entryoffs+0] = v0; + batch4buf->ptr.p_double[entryoffs+1] = v1; + batch4buf->ptr.p_double[entryoffs+2] = v2; + batch4buf->ptr.p_double[entryoffs+3] = v3; + batch4buf->ptr.p_double[entryoffs+0+dfoffs] = 1; + batch4buf->ptr.p_double[entryoffs+1+dfoffs] = 1; + batch4buf->ptr.p_double[entryoffs+2+dfoffs] = 1; + batch4buf->ptr.p_double[entryoffs+3+dfoffs] = 1; + continue; + } + if( neurontype<0 ) + { + bflag = ae_false; + if( neurontype==-2 ) + { + + /* + * Input neuron, left unchanged + */ + bflag = ae_true; + } + if( neurontype==-3 ) + { + + /* + * "-1" neuron + */ + batch4buf->ptr.p_double[entryoffs+0] = -1; + batch4buf->ptr.p_double[entryoffs+1] = -1; + batch4buf->ptr.p_double[entryoffs+2] = -1; + batch4buf->ptr.p_double[entryoffs+3] = -1; + batch4buf->ptr.p_double[entryoffs+0+dfoffs] = 0; + batch4buf->ptr.p_double[entryoffs+1+dfoffs] = 0; + batch4buf->ptr.p_double[entryoffs+2+dfoffs] = 0; + batch4buf->ptr.p_double[entryoffs+3+dfoffs] = 0; + bflag = ae_true; + } + if( neurontype==-4 ) + { + + /* + * "0" neuron + */ + batch4buf->ptr.p_double[entryoffs+0] = 0; + batch4buf->ptr.p_double[entryoffs+1] = 0; + batch4buf->ptr.p_double[entryoffs+2] = 0; + batch4buf->ptr.p_double[entryoffs+3] = 0; + batch4buf->ptr.p_double[entryoffs+0+dfoffs] = 0; + batch4buf->ptr.p_double[entryoffs+1+dfoffs] = 0; + batch4buf->ptr.p_double[entryoffs+2+dfoffs] = 0; + batch4buf->ptr.p_double[entryoffs+3+dfoffs] = 0; + bflag = ae_true; + } + ae_assert(bflag, "MLPChunkedGradient: internal error - unknown neuron type!", _state); + continue; + } + } + + /* + * Intermediate phase between forward and backward passes. + * + * For regression networks: + * * forward pass is completely done (no additional post-processing is + * needed). + * * before starting backward pass, we have to calculate dError/dOut + * for output neurons. We also update error at this phase. + * + * For classification networks: + * * in addition to forward pass we apply SOFTMAX normalization to + * output neurons. + * * after applying normalization, we have to calculate dError/dOut, + * which is calculated in two steps: + * * first, we calculate derivative of error with respect to SOFTMAX + * normalized outputs (normalized dError) + * * then, we calculate derivative of error with respect to values + * of outputs BEFORE normalization was applied to them + */ + ae_assert(network->structinfo.ptr.p_int[6]==0||network->structinfo.ptr.p_int[6]==1, "MLPChunkedGradient: unknown normalization type!", _state); + if( network->structinfo.ptr.p_int[6]==1 ) + { + + /* + * SOFTMAX-normalized network. + * + * First, calculate (V0,V1,V2,V3) - component-wise maximum + * of output neurons. This vector of maximum values will be + * used for normalization of outputs prior to calculating + * exponentials. + * + * NOTE: the only purpose of this stage is to prevent overflow + * during calculation of exponentials. With this stage + * we make sure that all exponentials are calculated + * with non-positive argument. If you load (0,0,0,0) to + * (V0,V1,V2,V3), your program will continue working - + * although with less robustness. + */ + entryoffs = entrysize*(ntotal-nout); + v0 = batch4buf->ptr.p_double[entryoffs+0]; + v1 = batch4buf->ptr.p_double[entryoffs+1]; + v2 = batch4buf->ptr.p_double[entryoffs+2]; + v3 = batch4buf->ptr.p_double[entryoffs+3]; + entryoffs = entryoffs+entrysize; + for(i=1; i<=nout-1; i++) + { + v = batch4buf->ptr.p_double[entryoffs+0]; + if( v>v0 ) + { + v0 = v; + } + v = batch4buf->ptr.p_double[entryoffs+1]; + if( v>v1 ) + { + v1 = v; + } + v = batch4buf->ptr.p_double[entryoffs+2]; + if( v>v2 ) + { + v2 = v; + } + v = batch4buf->ptr.p_double[entryoffs+3]; + if( v>v3 ) + { + v3 = v; + } + entryoffs = entryoffs+entrysize; + } + + /* + * Then, calculate exponentials and place them to part of the + * array which is located past the last entry. We also + * calculate sum of exponentials which will be stored past the + * exponentials. + */ + entryoffs = entrysize*(ntotal-nout); + offs0 = entrysize*ntotal; + s0 = 0; + s1 = 0; + s2 = 0; + s3 = 0; + for(i=0; i<=nout-1; i++) + { + v = ae_exp(batch4buf->ptr.p_double[entryoffs+0]-v0, _state); + s0 = s0+v; + batch4buf->ptr.p_double[offs0+0] = v; + v = ae_exp(batch4buf->ptr.p_double[entryoffs+1]-v1, _state); + s1 = s1+v; + batch4buf->ptr.p_double[offs0+1] = v; + v = ae_exp(batch4buf->ptr.p_double[entryoffs+2]-v2, _state); + s2 = s2+v; + batch4buf->ptr.p_double[offs0+2] = v; + v = ae_exp(batch4buf->ptr.p_double[entryoffs+3]-v3, _state); + s3 = s3+v; + batch4buf->ptr.p_double[offs0+3] = v; + entryoffs = entryoffs+entrysize; + offs0 = offs0+chunksize; + } + offs0 = entrysize*ntotal+2*nout*chunksize; + batch4buf->ptr.p_double[offs0+0] = s0; + batch4buf->ptr.p_double[offs0+1] = s1; + batch4buf->ptr.p_double[offs0+2] = s2; + batch4buf->ptr.p_double[offs0+3] = s3; + + /* + * Now we have: + * * Batch4Buf[0...EntrySize*NTotal-1] stores: + * * NTotal*ChunkSize neuron output values (SOFTMAX normalization + * was not applied to these values), + * * NTotal*ChunkSize values of dF/dNET (derivative of neuron + * output with respect to its input) + * * NTotal*ChunkSize zeros in the elements which correspond to + * dError/dOut (derivative of error with respect to neuron output). + * * Batch4Buf[EntrySize*NTotal...EntrySize*NTotal+ChunkSize*NOut-1] - + * stores exponentials of last NOut neurons. + * * Batch4Buf[EntrySize*NTotal+ChunkSize*NOut-1...EntrySize*NTotal+ChunkSize*2*NOut-1] + * - can be used for temporary calculations + * * Batch4Buf[EntrySize*NTotal+ChunkSize*2*NOut...EntrySize*NTotal+ChunkSize*2*NOut+ChunkSize-1] + * - stores sum-of-exponentials + * + * Block below calculates derivatives of error function with respect + * to non-SOFTMAX-normalized output values of last NOut neurons. + * + * It is quite complicated; we do not describe algebra behind it, + * but if you want you may check it yourself :) + */ + if( naturalerrorfunc ) + { + + /* + * Calculate derivative of error with respect to values of + * output neurons PRIOR TO SOFTMAX NORMALIZATION. Because we + * use natural error function (cross-entropy), we can do so + * very easy. + */ + offs0 = entrysize*ntotal+2*nout*chunksize; + for(k=0; k<=csize-1; k++) + { + s = batch4buf->ptr.p_double[offs0+k]; + kl = ae_round(xy->ptr.pp_double[cstart+k][nin], _state); + offs1 = (ntotal-nout)*entrysize+derroroffs+k; + offs2 = entrysize*ntotal+k; + for(i=0; i<=nout-1; i++) + { + if( i==kl ) + { + v = 1; + } + else + { + v = 0; + } + vv = batch4buf->ptr.p_double[offs2]; + batch4buf->ptr.p_double[offs1] = vv/s-v; + *e = *e+mlpbase_safecrossentropy(v, vv/s, _state); + offs1 = offs1+entrysize; + offs2 = offs2+chunksize; + } + } + } + else + { + + /* + * SOFTMAX normalization makes things very difficult. + * Sorry, we do not dare to describe this esoteric math + * in details. + */ + offs0 = entrysize*ntotal+chunksize*2*nout; + for(k=0; k<=csize-1; k++) + { + s = batch4buf->ptr.p_double[offs0+k]; + kl = ae_round(xy->ptr.pp_double[cstart+k][nin], _state); + vv = 0; + offs1 = entrysize*ntotal+k; + offs2 = entrysize*ntotal+nout*chunksize+k; + for(i=0; i<=nout-1; i++) + { + fown = batch4buf->ptr.p_double[offs1]; + if( i==kl ) + { + deown = fown/s-1; + } + else + { + deown = fown/s; + } + batch4buf->ptr.p_double[offs2] = deown; + vv = vv+deown*fown; + *e = *e+deown*deown/2; + offs1 = offs1+chunksize; + offs2 = offs2+chunksize; + } + offs1 = entrysize*ntotal+k; + offs2 = entrysize*ntotal+nout*chunksize+k; + for(i=0; i<=nout-1; i++) + { + fown = batch4buf->ptr.p_double[offs1]; + deown = batch4buf->ptr.p_double[offs2]; + batch4buf->ptr.p_double[(ntotal-nout+i)*entrysize+derroroffs+k] = (-vv+deown*fown+deown*(s-fown))*fown/ae_sqr(s, _state); + offs1 = offs1+chunksize; + offs2 = offs2+chunksize; + } + } + } + } + else + { + + /* + * Regression network with sum-of-squares function. + * + * For each NOut of last neurons: + * * calculate difference between actual and desired output + * * calculate dError/dOut for this neuron (proportional to difference) + * * store in in last 4 components of entry (these values are used + * to start backpropagation) + * * update error + */ + for(i=0; i<=nout-1; i++) + { + v0 = network->columnsigmas.ptr.p_double[nin+i]; + v1 = network->columnmeans.ptr.p_double[nin+i]; + entryoffs = entrysize*(ntotal-nout+i); + offs0 = entryoffs; + offs1 = entryoffs+derroroffs; + for(j=0; j<=csize-1; j++) + { + v = batch4buf->ptr.p_double[offs0+j]*v0+v1-xy->ptr.pp_double[cstart+j][nin+i]; + batch4buf->ptr.p_double[offs1+j] = v*v0; + *e = *e+v*v/2; + } + } + } + + /* + * Backpropagation + */ + for(neuronidx=ntotal-1; neuronidx>=0; neuronidx--) + { + entryoffs = entrysize*neuronidx; + offs = istart+neuronidx*mlpbase_nfieldwidth; + neurontype = network->structinfo.ptr.p_int[offs+0]; + if( neurontype>0||neurontype==-5 ) + { + + /* + * Activation function + */ + srcneuronidx = network->structinfo.ptr.p_int[offs+2]; + srcentryoffs = entrysize*srcneuronidx; + offs0 = srcentryoffs+derroroffs; + offs1 = entryoffs+derroroffs; + offs2 = entryoffs+dfoffs; + batch4buf->ptr.p_double[offs0+0] = batch4buf->ptr.p_double[offs0+0]+batch4buf->ptr.p_double[offs1+0]*batch4buf->ptr.p_double[offs2+0]; + batch4buf->ptr.p_double[offs0+1] = batch4buf->ptr.p_double[offs0+1]+batch4buf->ptr.p_double[offs1+1]*batch4buf->ptr.p_double[offs2+1]; + batch4buf->ptr.p_double[offs0+2] = batch4buf->ptr.p_double[offs0+2]+batch4buf->ptr.p_double[offs1+2]*batch4buf->ptr.p_double[offs2+2]; + batch4buf->ptr.p_double[offs0+3] = batch4buf->ptr.p_double[offs0+3]+batch4buf->ptr.p_double[offs1+3]*batch4buf->ptr.p_double[offs2+3]; + continue; + } + if( neurontype==0 ) + { + + /* + * Adaptive summator + */ + nweights = network->structinfo.ptr.p_int[offs+1]; + srcneuronidx = network->structinfo.ptr.p_int[offs+2]; + srcentryoffs = entrysize*srcneuronidx; + srcweightidx = network->structinfo.ptr.p_int[offs+3]; + v0 = batch4buf->ptr.p_double[entryoffs+derroroffs+0]; + v1 = batch4buf->ptr.p_double[entryoffs+derroroffs+1]; + v2 = batch4buf->ptr.p_double[entryoffs+derroroffs+2]; + v3 = batch4buf->ptr.p_double[entryoffs+derroroffs+3]; + for(j=0; j<=nweights-1; j++) + { + offs0 = srcentryoffs; + offs1 = srcentryoffs+derroroffs; + v = network->weights.ptr.p_double[srcweightidx]; + hpcbuf->ptr.p_double[srcweightidx] = hpcbuf->ptr.p_double[srcweightidx]+batch4buf->ptr.p_double[offs0+0]*v0+batch4buf->ptr.p_double[offs0+1]*v1+batch4buf->ptr.p_double[offs0+2]*v2+batch4buf->ptr.p_double[offs0+3]*v3; + batch4buf->ptr.p_double[offs1+0] = batch4buf->ptr.p_double[offs1+0]+v*v0; + batch4buf->ptr.p_double[offs1+1] = batch4buf->ptr.p_double[offs1+1]+v*v1; + batch4buf->ptr.p_double[offs1+2] = batch4buf->ptr.p_double[offs1+2]+v*v2; + batch4buf->ptr.p_double[offs1+3] = batch4buf->ptr.p_double[offs1+3]+v*v3; + srcentryoffs = srcentryoffs+entrysize; + srcweightidx = srcweightidx+1; + } + continue; + } + if( neurontype<0 ) + { + bflag = ae_false; + if( (neurontype==-2||neurontype==-3)||neurontype==-4 ) + { + + /* + * Special neuron type, no back-propagation required + */ + bflag = ae_true; + } + ae_assert(bflag, "MLPInternalCalculateGradient: unknown neuron type!", _state); + continue; + } + } +} + + +static void mlpbase_mlpchunkedprocess(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + /* Real */ ae_vector* batch4buf, + /* Real */ ae_vector* hpcbuf, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t ntotal; + ae_int_t nin; + ae_int_t nout; + ae_int_t offs; + double f; + double df; + double d2f; + double v; + ae_bool bflag; + ae_int_t istart; + ae_int_t entrysize; + ae_int_t entryoffs; + ae_int_t neuronidx; + ae_int_t srcentryoffs; + ae_int_t srcneuronidx; + ae_int_t srcweightidx; + ae_int_t neurontype; + ae_int_t nweights; + ae_int_t offs0; + double v0; + double v1; + double v2; + double v3; + double s0; + double s1; + double s2; + double s3; + ae_int_t chunksize; + + + chunksize = 4; + ae_assert(csize<=chunksize, "MLPChunkedProcess: internal error (CSize>ChunkSize)", _state); + + /* + * Try to use HPC core, if possible + */ + if( hpcchunkedprocess(&network->weights, &network->structinfo, &network->columnmeans, &network->columnsigmas, xy, cstart, csize, batch4buf, hpcbuf, _state) ) + { + return; + } + + /* + * Read network geometry, prepare data + */ + nin = network->structinfo.ptr.p_int[1]; + nout = network->structinfo.ptr.p_int[2]; + ntotal = network->structinfo.ptr.p_int[3]; + istart = network->structinfo.ptr.p_int[5]; + entrysize = 4; + + /* + * Fill Batch4Buf by zeros. + * + * THIS STAGE IS VERY IMPORTANT! + * + * We fill all components of entry - neuron values, dF/dNET, dError/dF. + * It allows us to easily handle situations when CSizeptr.p_double[i] = 0; + } + + /* + * Forward pass: + * 1. Load data into Batch4Buf. If CSizecolumnsigmas.ptr.p_double[i],0) ) + { + batch4buf->ptr.p_double[entryoffs+j] = (xy->ptr.pp_double[cstart+j][i]-network->columnmeans.ptr.p_double[i])/network->columnsigmas.ptr.p_double[i]; + } + else + { + batch4buf->ptr.p_double[entryoffs+j] = xy->ptr.pp_double[cstart+j][i]-network->columnmeans.ptr.p_double[i]; + } + } + } + for(neuronidx=0; neuronidx<=ntotal-1; neuronidx++) + { + entryoffs = entrysize*neuronidx; + offs = istart+neuronidx*mlpbase_nfieldwidth; + neurontype = network->structinfo.ptr.p_int[offs+0]; + if( neurontype>0||neurontype==-5 ) + { + + /* + * "activation function" neuron, which takes value of neuron SrcNeuronIdx + * and applies activation function to it. + * + * This neuron has no weights and no tunable parameters. + */ + srcneuronidx = network->structinfo.ptr.p_int[offs+2]; + srcentryoffs = entrysize*srcneuronidx; + mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+0], neurontype, &f, &df, &d2f, _state); + batch4buf->ptr.p_double[entryoffs+0] = f; + mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+1], neurontype, &f, &df, &d2f, _state); + batch4buf->ptr.p_double[entryoffs+1] = f; + mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+2], neurontype, &f, &df, &d2f, _state); + batch4buf->ptr.p_double[entryoffs+2] = f; + mlpactivationfunction(batch4buf->ptr.p_double[srcentryoffs+3], neurontype, &f, &df, &d2f, _state); + batch4buf->ptr.p_double[entryoffs+3] = f; + continue; + } + if( neurontype==0 ) + { + + /* + * "adaptive summator" neuron, whose output is a weighted sum of inputs. + * It has weights, but has no activation function. + */ + nweights = network->structinfo.ptr.p_int[offs+1]; + srcneuronidx = network->structinfo.ptr.p_int[offs+2]; + srcentryoffs = entrysize*srcneuronidx; + srcweightidx = network->structinfo.ptr.p_int[offs+3]; + v0 = 0; + v1 = 0; + v2 = 0; + v3 = 0; + for(j=0; j<=nweights-1; j++) + { + v = network->weights.ptr.p_double[srcweightidx]; + srcweightidx = srcweightidx+1; + v0 = v0+v*batch4buf->ptr.p_double[srcentryoffs+0]; + v1 = v1+v*batch4buf->ptr.p_double[srcentryoffs+1]; + v2 = v2+v*batch4buf->ptr.p_double[srcentryoffs+2]; + v3 = v3+v*batch4buf->ptr.p_double[srcentryoffs+3]; + srcentryoffs = srcentryoffs+entrysize; + } + batch4buf->ptr.p_double[entryoffs+0] = v0; + batch4buf->ptr.p_double[entryoffs+1] = v1; + batch4buf->ptr.p_double[entryoffs+2] = v2; + batch4buf->ptr.p_double[entryoffs+3] = v3; + continue; + } + if( neurontype<0 ) + { + bflag = ae_false; + if( neurontype==-2 ) + { + + /* + * Input neuron, left unchanged + */ + bflag = ae_true; + } + if( neurontype==-3 ) + { + + /* + * "-1" neuron + */ + batch4buf->ptr.p_double[entryoffs+0] = -1; + batch4buf->ptr.p_double[entryoffs+1] = -1; + batch4buf->ptr.p_double[entryoffs+2] = -1; + batch4buf->ptr.p_double[entryoffs+3] = -1; + bflag = ae_true; + } + if( neurontype==-4 ) + { + + /* + * "0" neuron + */ + batch4buf->ptr.p_double[entryoffs+0] = 0; + batch4buf->ptr.p_double[entryoffs+1] = 0; + batch4buf->ptr.p_double[entryoffs+2] = 0; + batch4buf->ptr.p_double[entryoffs+3] = 0; + bflag = ae_true; + } + ae_assert(bflag, "MLPChunkedProcess: internal error - unknown neuron type!", _state); + continue; + } + } + + /* + * SOFTMAX normalization or scaling. + */ + ae_assert(network->structinfo.ptr.p_int[6]==0||network->structinfo.ptr.p_int[6]==1, "MLPChunkedProcess: unknown normalization type!", _state); + if( network->structinfo.ptr.p_int[6]==1 ) + { + + /* + * SOFTMAX-normalized network. + * + * First, calculate (V0,V1,V2,V3) - component-wise maximum + * of output neurons. This vector of maximum values will be + * used for normalization of outputs prior to calculating + * exponentials. + * + * NOTE: the only purpose of this stage is to prevent overflow + * during calculation of exponentials. With this stage + * we make sure that all exponentials are calculated + * with non-positive argument. If you load (0,0,0,0) to + * (V0,V1,V2,V3), your program will continue working - + * although with less robustness. + */ + entryoffs = entrysize*(ntotal-nout); + v0 = batch4buf->ptr.p_double[entryoffs+0]; + v1 = batch4buf->ptr.p_double[entryoffs+1]; + v2 = batch4buf->ptr.p_double[entryoffs+2]; + v3 = batch4buf->ptr.p_double[entryoffs+3]; + entryoffs = entryoffs+entrysize; + for(i=1; i<=nout-1; i++) + { + v = batch4buf->ptr.p_double[entryoffs+0]; + if( v>v0 ) + { + v0 = v; + } + v = batch4buf->ptr.p_double[entryoffs+1]; + if( v>v1 ) + { + v1 = v; + } + v = batch4buf->ptr.p_double[entryoffs+2]; + if( v>v2 ) + { + v2 = v; + } + v = batch4buf->ptr.p_double[entryoffs+3]; + if( v>v3 ) + { + v3 = v; + } + entryoffs = entryoffs+entrysize; + } + + /* + * Then, calculate exponentials and place them to part of the + * array which is located past the last entry. We also + * calculate sum of exponentials. + */ + entryoffs = entrysize*(ntotal-nout); + offs0 = entrysize*ntotal; + s0 = 0; + s1 = 0; + s2 = 0; + s3 = 0; + for(i=0; i<=nout-1; i++) + { + v = ae_exp(batch4buf->ptr.p_double[entryoffs+0]-v0, _state); + s0 = s0+v; + batch4buf->ptr.p_double[offs0+0] = v; + v = ae_exp(batch4buf->ptr.p_double[entryoffs+1]-v1, _state); + s1 = s1+v; + batch4buf->ptr.p_double[offs0+1] = v; + v = ae_exp(batch4buf->ptr.p_double[entryoffs+2]-v2, _state); + s2 = s2+v; + batch4buf->ptr.p_double[offs0+2] = v; + v = ae_exp(batch4buf->ptr.p_double[entryoffs+3]-v3, _state); + s3 = s3+v; + batch4buf->ptr.p_double[offs0+3] = v; + entryoffs = entryoffs+entrysize; + offs0 = offs0+chunksize; + } + + /* + * Write SOFTMAX-normalized values to the output array. + */ + offs0 = entrysize*ntotal; + for(i=0; i<=nout-1; i++) + { + if( csize>0 ) + { + xy->ptr.pp_double[cstart+0][nin+i] = batch4buf->ptr.p_double[offs0+0]/s0; + } + if( csize>1 ) + { + xy->ptr.pp_double[cstart+1][nin+i] = batch4buf->ptr.p_double[offs0+1]/s1; + } + if( csize>2 ) + { + xy->ptr.pp_double[cstart+2][nin+i] = batch4buf->ptr.p_double[offs0+2]/s2; + } + if( csize>3 ) + { + xy->ptr.pp_double[cstart+3][nin+i] = batch4buf->ptr.p_double[offs0+3]/s3; + } + offs0 = offs0+chunksize; + } + } + else + { + + /* + * Regression network with sum-of-squares function. + * + * For each NOut of last neurons: + * * calculate difference between actual and desired output + * * calculate dError/dOut for this neuron (proportional to difference) + * * store in in last 4 components of entry (these values are used + * to start backpropagation) + * * update error + */ + for(i=0; i<=nout-1; i++) + { + v0 = network->columnsigmas.ptr.p_double[nin+i]; + v1 = network->columnmeans.ptr.p_double[nin+i]; + entryoffs = entrysize*(ntotal-nout+i); + for(j=0; j<=csize-1; j++) + { + xy->ptr.pp_double[cstart+j][nin+i] = batch4buf->ptr.p_double[entryoffs+j]*v0+v1; + } + } + } +} + + +/************************************************************************* +Returns T*Ln(T/Z), guarded against overflow/underflow. +Internal subroutine. +*************************************************************************/ +static double mlpbase_safecrossentropy(double t, + double z, + ae_state *_state) +{ + double r; + double result; + + + if( ae_fp_eq(t,0) ) + { + result = 0; + } + else + { + if( ae_fp_greater(ae_fabs(z, _state),1) ) + { + + /* + * Shouldn't be the case with softmax, + * but we just want to be sure. + */ + if( ae_fp_eq(t/z,0) ) + { + r = ae_minrealnumber; + } + else + { + r = t/z; + } + } + else + { + + /* + * Normal case + */ + if( ae_fp_eq(z,0)||ae_fp_greater_eq(ae_fabs(t, _state),ae_maxrealnumber*ae_fabs(z, _state)) ) + { + r = ae_maxrealnumber; + } + else + { + r = t/z; + } + } + result = t*ae_log(r, _state); + } + return result; +} + + +/************************************************************************* +This function performs backward pass of neural network randimization: +* it assumes that Network.Weights stores standard deviation of weights + (weights are not generated yet, only their deviations are present) +* it sets deviations of weights which feed NeuronIdx-th neuron to specified value +* it recursively passes to deeper neuron and modifies their weights +* it stops after encountering nonlinear neurons, linear activation function, + input neurons, "0" and "-1" neurons + + -- ALGLIB -- + Copyright 27.06.2013 by Bochkanov Sergey +*************************************************************************/ +static void mlpbase_randomizebackwardpass(multilayerperceptron* network, + ae_int_t neuronidx, + double v, + ae_state *_state) +{ + ae_int_t istart; + ae_int_t neurontype; + ae_int_t n1; + ae_int_t n2; + ae_int_t w1; + ae_int_t w2; + ae_int_t offs; + ae_int_t i; + + + istart = network->structinfo.ptr.p_int[5]; + neurontype = network->structinfo.ptr.p_int[istart+neuronidx*mlpbase_nfieldwidth+0]; + if( neurontype==-2 ) + { + + /* + * Input neuron - stop + */ + return; + } + if( neurontype==-3 ) + { + + /* + * "-1" neuron: stop + */ + return; + } + if( neurontype==-4 ) + { + + /* + * "0" neuron: stop + */ + return; + } + if( neurontype==0 ) + { + + /* + * Adaptive summator neuron: + * * modify deviations of its weights + * * recursively call this function for its inputs + */ + offs = istart+neuronidx*mlpbase_nfieldwidth; + n1 = network->structinfo.ptr.p_int[offs+2]; + n2 = n1+network->structinfo.ptr.p_int[offs+1]-1; + w1 = network->structinfo.ptr.p_int[offs+3]; + w2 = w1+network->structinfo.ptr.p_int[offs+1]-1; + for(i=w1; i<=w2; i++) + { + network->weights.ptr.p_double[i] = v; + } + for(i=n1; i<=n2; i++) + { + mlpbase_randomizebackwardpass(network, i, v, _state); + } + return; + } + if( neurontype==-5 ) + { + + /* + * Linear activation function: stop + */ + return; + } + if( neurontype>0 ) + { + + /* + * Nonlinear activation function: stop + */ + return; + } + ae_assert(ae_false, "RandomizeBackwardPass: unexpected neuron type", _state); +} + + +ae_bool _modelerrors_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + modelerrors *p = (modelerrors*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _modelerrors_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + modelerrors *dst = (modelerrors*)_dst; + modelerrors *src = (modelerrors*)_src; + dst->relclserror = src->relclserror; + dst->avgce = src->avgce; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + return ae_true; +} + + +void _modelerrors_clear(void* _p) +{ + modelerrors *p = (modelerrors*)_p; + ae_touch_ptr((void*)p); +} + + +void _modelerrors_destroy(void* _p) +{ + modelerrors *p = (modelerrors*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _smlpgrad_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + smlpgrad *p = (smlpgrad*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _smlpgrad_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + smlpgrad *dst = (smlpgrad*)_dst; + smlpgrad *src = (smlpgrad*)_src; + dst->f = src->f; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _smlpgrad_clear(void* _p) +{ + smlpgrad *p = (smlpgrad*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->g); +} + + +void _smlpgrad_destroy(void* _p) +{ + smlpgrad *p = (smlpgrad*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->g); +} + + +ae_bool _multilayerperceptron_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + multilayerperceptron *p = (multilayerperceptron*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->hllayersizes, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->hlconnections, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->hlneurons, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->structinfo, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->weights, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->columnmeans, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->columnsigmas, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->neurons, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->dfdnet, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->derror, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->xy, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xyrow, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->nwbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->integerbuf, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !_modelerrors_init(&p->err, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rndbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init(&p->buf, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init(&p->gradbuf, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->dummydxy, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_sparsematrix_init(&p->dummysxy, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->dummyidx, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init(&p->dummypool, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _multilayerperceptron_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + multilayerperceptron *dst = (multilayerperceptron*)_dst; + multilayerperceptron *src = (multilayerperceptron*)_src; + dst->hlnetworktype = src->hlnetworktype; + dst->hlnormtype = src->hlnormtype; + if( !ae_vector_init_copy(&dst->hllayersizes, &src->hllayersizes, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->hlconnections, &src->hlconnections, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->hlneurons, &src->hlneurons, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->structinfo, &src->structinfo, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->weights, &src->weights, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->columnmeans, &src->columnmeans, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->columnsigmas, &src->columnsigmas, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->neurons, &src->neurons, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->dfdnet, &src->dfdnet, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->derror, &src->derror, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->xy, &src->xy, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xyrow, &src->xyrow, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->nwbuf, &src->nwbuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->integerbuf, &src->integerbuf, _state, make_automatic) ) + return ae_false; + if( !_modelerrors_init_copy(&dst->err, &src->err, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rndbuf, &src->rndbuf, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init_copy(&dst->buf, &src->buf, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init_copy(&dst->gradbuf, &src->gradbuf, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->dummydxy, &src->dummydxy, _state, make_automatic) ) + return ae_false; + if( !_sparsematrix_init_copy(&dst->dummysxy, &src->dummysxy, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->dummyidx, &src->dummyidx, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init_copy(&dst->dummypool, &src->dummypool, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _multilayerperceptron_clear(void* _p) +{ + multilayerperceptron *p = (multilayerperceptron*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->hllayersizes); + ae_vector_clear(&p->hlconnections); + ae_vector_clear(&p->hlneurons); + ae_vector_clear(&p->structinfo); + ae_vector_clear(&p->weights); + ae_vector_clear(&p->columnmeans); + ae_vector_clear(&p->columnsigmas); + ae_vector_clear(&p->neurons); + ae_vector_clear(&p->dfdnet); + ae_vector_clear(&p->derror); + ae_vector_clear(&p->x); + ae_vector_clear(&p->y); + ae_matrix_clear(&p->xy); + ae_vector_clear(&p->xyrow); + ae_vector_clear(&p->nwbuf); + ae_vector_clear(&p->integerbuf); + _modelerrors_clear(&p->err); + ae_vector_clear(&p->rndbuf); + ae_shared_pool_clear(&p->buf); + ae_shared_pool_clear(&p->gradbuf); + ae_matrix_clear(&p->dummydxy); + _sparsematrix_clear(&p->dummysxy); + ae_vector_clear(&p->dummyidx); + ae_shared_pool_clear(&p->dummypool); +} + + +void _multilayerperceptron_destroy(void* _p) +{ + multilayerperceptron *p = (multilayerperceptron*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->hllayersizes); + ae_vector_destroy(&p->hlconnections); + ae_vector_destroy(&p->hlneurons); + ae_vector_destroy(&p->structinfo); + ae_vector_destroy(&p->weights); + ae_vector_destroy(&p->columnmeans); + ae_vector_destroy(&p->columnsigmas); + ae_vector_destroy(&p->neurons); + ae_vector_destroy(&p->dfdnet); + ae_vector_destroy(&p->derror); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->y); + ae_matrix_destroy(&p->xy); + ae_vector_destroy(&p->xyrow); + ae_vector_destroy(&p->nwbuf); + ae_vector_destroy(&p->integerbuf); + _modelerrors_destroy(&p->err); + ae_vector_destroy(&p->rndbuf); + ae_shared_pool_destroy(&p->buf); + ae_shared_pool_destroy(&p->gradbuf); + ae_matrix_destroy(&p->dummydxy); + _sparsematrix_destroy(&p->dummysxy); + ae_vector_destroy(&p->dummyidx); + ae_shared_pool_destroy(&p->dummypool); +} + + + + +/************************************************************************* +This subroutine trains logit model. + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars] + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=1 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + +OUTPUT PARAMETERS: + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPointsptr.pp_double[i][nvars], _state)<0||ae_round(xy->ptr.pp_double[i][nvars], _state)>=nclasses ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + *info = 1; + + /* + * Initialize data + */ + rep->ngrad = 0; + rep->nhess = 0; + + /* + * Allocate array + */ + offs = 5; + ssize = 5+(nvars+1)*(nclasses-1)+nclasses; + ae_vector_set_length(&lm->w, ssize-1+1, _state); + lm->w.ptr.p_double[0] = ssize; + lm->w.ptr.p_double[1] = logit_logitvnum; + lm->w.ptr.p_double[2] = nvars; + lm->w.ptr.p_double[3] = nclasses; + lm->w.ptr.p_double[4] = offs; + + /* + * Degenerate case: all outputs are equal + */ + allsame = ae_true; + for(i=1; i<=npoints-1; i++) + { + if( ae_round(xy->ptr.pp_double[i][nvars], _state)!=ae_round(xy->ptr.pp_double[i-1][nvars], _state) ) + { + allsame = ae_false; + } + } + if( allsame ) + { + for(i=0; i<=(nvars+1)*(nclasses-1)-1; i++) + { + lm->w.ptr.p_double[offs+i] = 0; + } + v = -2*ae_log(ae_minrealnumber, _state); + k = ae_round(xy->ptr.pp_double[0][nvars], _state); + if( k==nclasses-1 ) + { + for(i=0; i<=nclasses-2; i++) + { + lm->w.ptr.p_double[offs+i*(nvars+1)+nvars] = -v; + } + } + else + { + for(i=0; i<=nclasses-2; i++) + { + if( i==k ) + { + lm->w.ptr.p_double[offs+i*(nvars+1)+nvars] = v; + } + else + { + lm->w.ptr.p_double[offs+i*(nvars+1)+nvars] = 0; + } + } + } + ae_frame_leave(_state); + return; + } + + /* + * General case. + * Prepare task and network. Allocate space. + */ + mlpcreatec0(nvars, nclasses, &network, _state); + mlpinitpreprocessor(&network, xy, npoints, _state); + mlpproperties(&network, &nin, &nout, &wcount, _state); + for(i=0; i<=wcount-1; i++) + { + network.weights.ptr.p_double[i] = (2*ae_randomreal(_state)-1)/nvars; + } + ae_vector_set_length(&g, wcount-1+1, _state); + ae_matrix_set_length(&h, wcount-1+1, wcount-1+1, _state); + ae_vector_set_length(&wbase, wcount-1+1, _state); + ae_vector_set_length(&wdir, wcount-1+1, _state); + ae_vector_set_length(&work, wcount-1+1, _state); + + /* + * First stage: optimize in gradient direction. + */ + for(k=0; k<=wcount/3+10; k++) + { + + /* + * Calculate gradient in starting point + */ + mlpgradnbatch(&network, xy, npoints, &e, &g, _state); + v = ae_v_dotproduct(&network.weights.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = e+0.5*decay*v; + ae_v_addd(&g.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + rep->ngrad = rep->ngrad+1; + + /* + * Setup optimization scheme + */ + ae_v_moveneg(&wdir.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + v = ae_v_dotproduct(&wdir.ptr.p_double[0], 1, &wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + wstep = ae_sqrt(v, _state); + v = 1/ae_sqrt(v, _state); + ae_v_muld(&wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1), v); + mcstage = 0; + logit_mnlmcsrch(wcount, &network.weights, &e, &g, &wdir, &wstep, &mcinfo, &mcnfev, &work, &mcstate, &mcstage, _state); + while(mcstage!=0) + { + mlpgradnbatch(&network, xy, npoints, &e, &g, _state); + v = ae_v_dotproduct(&network.weights.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = e+0.5*decay*v; + ae_v_addd(&g.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + rep->ngrad = rep->ngrad+1; + logit_mnlmcsrch(wcount, &network.weights, &e, &g, &wdir, &wstep, &mcinfo, &mcnfev, &work, &mcstate, &mcstage, _state); + } + } + + /* + * Second stage: use Hessian when we are close to the minimum + */ + for(;;) + { + + /* + * Calculate and update E/G/H + */ + mlphessiannbatch(&network, xy, npoints, &e, &g, &h, _state); + v = ae_v_dotproduct(&network.weights.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = e+0.5*decay*v; + ae_v_addd(&g.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + for(k=0; k<=wcount-1; k++) + { + h.ptr.pp_double[k][k] = h.ptr.pp_double[k][k]+decay; + } + rep->nhess = rep->nhess+1; + + /* + * Select step direction + * NOTE: it is important to use lower-triangle Cholesky + * factorization since it is much faster than higher-triangle version. + */ + spd = spdmatrixcholesky(&h, wcount, ae_false, _state); + spdmatrixcholeskysolve(&h, wcount, ae_false, &g, &solverinfo, &solverrep, &wdir, _state); + spd = solverinfo>0; + if( spd ) + { + + /* + * H is positive definite. + * Step in Newton direction. + */ + ae_v_muld(&wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1), -1); + spd = ae_true; + } + else + { + + /* + * H is indefinite. + * Step in gradient direction. + */ + ae_v_moveneg(&wdir.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + spd = ae_false; + } + + /* + * Optimize in WDir direction + */ + v = ae_v_dotproduct(&wdir.ptr.p_double[0], 1, &wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + wstep = ae_sqrt(v, _state); + v = 1/ae_sqrt(v, _state); + ae_v_muld(&wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1), v); + mcstage = 0; + logit_mnlmcsrch(wcount, &network.weights, &e, &g, &wdir, &wstep, &mcinfo, &mcnfev, &work, &mcstate, &mcstage, _state); + while(mcstage!=0) + { + mlpgradnbatch(&network, xy, npoints, &e, &g, _state); + v = ae_v_dotproduct(&network.weights.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = e+0.5*decay*v; + ae_v_addd(&g.ptr.p_double[0], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + rep->ngrad = rep->ngrad+1; + logit_mnlmcsrch(wcount, &network.weights, &e, &g, &wdir, &wstep, &mcinfo, &mcnfev, &work, &mcstate, &mcstage, _state); + } + if( spd&&((mcinfo==2||mcinfo==4)||mcinfo==6) ) + { + break; + } + } + + /* + * Convert from NN format to MNL format + */ + ae_v_move(&lm->w.ptr.p_double[offs], 1, &network.weights.ptr.p_double[0], 1, ae_v_len(offs,offs+wcount-1)); + for(k=0; k<=nvars-1; k++) + { + for(i=0; i<=nclasses-2; i++) + { + s = network.columnsigmas.ptr.p_double[k]; + if( ae_fp_eq(s,0) ) + { + s = 1; + } + j = offs+(nvars+1)*i; + v = lm->w.ptr.p_double[j+k]; + lm->w.ptr.p_double[j+k] = v/s; + lm->w.ptr.p_double[j+nvars] = lm->w.ptr.p_double[j+nvars]+v*network.columnmeans.ptr.p_double[k]/s; + } + } + for(k=0; k<=nclasses-2; k++) + { + lm->w.ptr.p_double[offs+(nvars+1)*k+nvars] = -lm->w.ptr.p_double[offs+(nvars+1)*k+nvars]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + LM - logit model, passed by non-constant reference + (some fields of structure are used as temporaries + when calculating model output). + X - input vector, array[0..NVars-1]. + Y - (possibly) preallocated buffer; if size of Y is less than + NClasses, it will be reallocated.If it is large enough, it + is NOT reallocated, so we can save some time on reallocation. + +OUTPUT PARAMETERS: + Y - result, array[0..NClasses-1] + Vector of posterior probabilities for classification task. + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +void mnlprocess(logitmodel* lm, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t nvars; + ae_int_t nclasses; + ae_int_t offs; + ae_int_t i; + ae_int_t i1; + double s; + + + ae_assert(ae_fp_eq(lm->w.ptr.p_double[1],logit_logitvnum), "MNLProcess: unexpected model version", _state); + nvars = ae_round(lm->w.ptr.p_double[2], _state); + nclasses = ae_round(lm->w.ptr.p_double[3], _state); + offs = ae_round(lm->w.ptr.p_double[4], _state); + logit_mnliexp(&lm->w, x, _state); + s = 0; + i1 = offs+(nvars+1)*(nclasses-1); + for(i=i1; i<=i1+nclasses-1; i++) + { + s = s+lm->w.ptr.p_double[i]; + } + if( y->cntptr.p_double[i] = lm->w.ptr.p_double[i1+i]/s; + } +} + + +/************************************************************************* +'interactive' variant of MNLProcess for languages like Python which +support constructs like "Y = MNLProcess(LM,X)" and interactive mode of the +interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +void mnlprocessi(logitmodel* lm, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + + ae_vector_clear(y); + + mnlprocess(lm, x, y, _state); +} + + +/************************************************************************* +Unpacks coefficients of logit model. Logit model have form: + + P(class=i) = S(i) / (S(0) + S(1) + ... +S(M-1)) + S(i) = Exp(A[i,0]*X[0] + ... + A[i,N-1]*X[N-1] + A[i,N]), when iw.ptr.p_double[1],logit_logitvnum), "MNLUnpack: unexpected model version", _state); + *nvars = ae_round(lm->w.ptr.p_double[2], _state); + *nclasses = ae_round(lm->w.ptr.p_double[3], _state); + offs = ae_round(lm->w.ptr.p_double[4], _state); + ae_matrix_set_length(a, *nclasses-2+1, *nvars+1, _state); + for(i=0; i<=*nclasses-2; i++) + { + ae_v_move(&a->ptr.pp_double[i][0], 1, &lm->w.ptr.p_double[offs+i*(*nvars+1)], 1, ae_v_len(0,*nvars)); + } +} + + +/************************************************************************* +"Packs" coefficients and creates logit model in ALGLIB format (MNLUnpack +reversed). + +INPUT PARAMETERS: + A - model (see MNLUnpack) + NVars - number of independent variables + NClasses - number of classes + +OUTPUT PARAMETERS: + LM - logit model. + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +void mnlpack(/* Real */ ae_matrix* a, + ae_int_t nvars, + ae_int_t nclasses, + logitmodel* lm, + ae_state *_state) +{ + ae_int_t offs; + ae_int_t i; + ae_int_t ssize; + + _logitmodel_clear(lm); + + offs = 5; + ssize = 5+(nvars+1)*(nclasses-1)+nclasses; + ae_vector_set_length(&lm->w, ssize-1+1, _state); + lm->w.ptr.p_double[0] = ssize; + lm->w.ptr.p_double[1] = logit_logitvnum; + lm->w.ptr.p_double[2] = nvars; + lm->w.ptr.p_double[3] = nclasses; + lm->w.ptr.p_double[4] = offs; + for(i=0; i<=nclasses-2; i++) + { + ae_v_move(&lm->w.ptr.p_double[offs+i*(nvars+1)], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(offs+i*(nvars+1),offs+i*(nvars+1)+nvars)); + } +} + + +/************************************************************************* +Copying of LogitModel strucure + +INPUT PARAMETERS: + LM1 - original + +OUTPUT PARAMETERS: + LM2 - copy + + -- ALGLIB -- + Copyright 15.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mnlcopy(logitmodel* lm1, logitmodel* lm2, ae_state *_state) +{ + ae_int_t k; + + _logitmodel_clear(lm2); + + k = ae_round(lm1->w.ptr.p_double[0], _state); + ae_vector_set_length(&lm2->w, k-1+1, _state); + ae_v_move(&lm2->w.ptr.p_double[0], 1, &lm1->w.ptr.p_double[0], 1, ae_v_len(0,k-1)); +} + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + CrossEntropy/(NPoints*ln(2)). + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlavgce(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nvars; + ae_int_t nclasses; + ae_int_t i; + ae_vector workx; + ae_vector worky; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&workx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&worky, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_fp_eq(lm->w.ptr.p_double[1],logit_logitvnum), "MNLClsError: unexpected model version", _state); + nvars = ae_round(lm->w.ptr.p_double[2], _state); + nclasses = ae_round(lm->w.ptr.p_double[3], _state); + ae_vector_set_length(&workx, nvars-1+1, _state); + ae_vector_set_length(&worky, nclasses-1+1, _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + ae_assert(ae_round(xy->ptr.pp_double[i][nvars], _state)>=0&&ae_round(xy->ptr.pp_double[i][nvars], _state)ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + mnlprocess(lm, &workx, &worky, _state); + if( ae_fp_greater(worky.ptr.p_double[ae_round(xy->ptr.pp_double[i][nvars], _state)],0) ) + { + result = result-ae_log(worky.ptr.p_double[ae_round(xy->ptr.pp_double[i][nvars], _state)], _state); + } + else + { + result = result-ae_log(ae_minrealnumber, _state); + } + } + result = result/(npoints*ae_log(2, _state)); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Relative classification error on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + percent of incorrectly classified cases. + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlrelclserror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double result; + + + result = (double)mnlclserror(lm, xy, npoints, _state)/(double)npoints; + return result; +} + + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + root mean square error (error when estimating posterior probabilities). + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlrmserror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double relcls; + double avgce; + double rms; + double avg; + double avgrel; + double result; + + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==logit_logitvnum, "MNLRMSError: Incorrect MNL version!", _state); + logit_mnlallerrors(lm, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); + result = rms; + return result; +} + + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + average error (error when estimating posterior probabilities). + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlavgerror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double relcls; + double avgce; + double rms; + double avg; + double avgrel; + double result; + + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==logit_logitvnum, "MNLRMSError: Incorrect MNL version!", _state); + logit_mnlallerrors(lm, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); + result = avg; + return result; +} + + +/************************************************************************* +Average relative error on the test set + +INPUT PARAMETERS: + LM - logit model + XY - test set + NPoints - test set size + +RESULT: + average relative error (error when estimating posterior probabilities). + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +double mnlavgrelerror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + ae_state *_state) +{ + double relcls; + double avgce; + double rms; + double avg; + double avgrel; + double result; + + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==logit_logitvnum, "MNLRMSError: Incorrect MNL version!", _state); + logit_mnlallerrors(lm, xy, ssize, &relcls, &avgce, &rms, &avg, &avgrel, _state); + result = avgrel; + return result; +} + + +/************************************************************************* +Classification error on test set = MNLRelClsError*NPoints + + -- ALGLIB -- + Copyright 10.09.2008 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mnlclserror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nvars; + ae_int_t nclasses; + ae_int_t i; + ae_int_t j; + ae_vector workx; + ae_vector worky; + ae_int_t nmax; + ae_int_t result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&workx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&worky, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_fp_eq(lm->w.ptr.p_double[1],logit_logitvnum), "MNLClsError: unexpected model version", _state); + nvars = ae_round(lm->w.ptr.p_double[2], _state); + nclasses = ae_round(lm->w.ptr.p_double[3], _state); + ae_vector_set_length(&workx, nvars-1+1, _state); + ae_vector_set_length(&worky, nclasses-1+1, _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + + /* + * Process + */ + ae_v_move(&workx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + mnlprocess(lm, &workx, &worky, _state); + + /* + * Logit version of the answer + */ + nmax = 0; + for(j=0; j<=nclasses-1; j++) + { + if( ae_fp_greater(worky.ptr.p_double[j],worky.ptr.p_double[nmax]) ) + { + nmax = j; + } + } + + /* + * compare + */ + if( nmax!=ae_round(xy->ptr.pp_double[i][nvars], _state) ) + { + result = result+1; + } + } + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Internal subroutine. Places exponents of the anti-overflow shifted +internal linear outputs into the service part of the W array. +*************************************************************************/ +static void logit_mnliexp(/* Real */ ae_vector* w, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t nvars; + ae_int_t nclasses; + ae_int_t offs; + ae_int_t i; + ae_int_t i1; + double v; + double mx; + + + ae_assert(ae_fp_eq(w->ptr.p_double[1],logit_logitvnum), "LOGIT: unexpected model version", _state); + nvars = ae_round(w->ptr.p_double[2], _state); + nclasses = ae_round(w->ptr.p_double[3], _state); + offs = ae_round(w->ptr.p_double[4], _state); + i1 = offs+(nvars+1)*(nclasses-1); + for(i=0; i<=nclasses-2; i++) + { + v = ae_v_dotproduct(&w->ptr.p_double[offs+i*(nvars+1)], 1, &x->ptr.p_double[0], 1, ae_v_len(offs+i*(nvars+1),offs+i*(nvars+1)+nvars-1)); + w->ptr.p_double[i1+i] = v+w->ptr.p_double[offs+i*(nvars+1)+nvars]; + } + w->ptr.p_double[i1+nclasses-1] = 0; + mx = 0; + for(i=i1; i<=i1+nclasses-1; i++) + { + mx = ae_maxreal(mx, w->ptr.p_double[i], _state); + } + for(i=i1; i<=i1+nclasses-1; i++) + { + w->ptr.p_double[i] = ae_exp(w->ptr.p_double[i]-mx, _state); + } +} + + +/************************************************************************* +Calculation of all types of errors + + -- ALGLIB -- + Copyright 30.08.2008 by Bochkanov Sergey +*************************************************************************/ +static void logit_mnlallerrors(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double* relcls, + double* avgce, + double* rms, + double* avg, + double* avgrel, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nvars; + ae_int_t nclasses; + ae_int_t i; + ae_vector buf; + ae_vector workx; + ae_vector y; + ae_vector dy; + + ae_frame_make(_state, &_frame_block); + *relcls = 0; + *avgce = 0; + *rms = 0; + *avg = 0; + *avgrel = 0; + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&workx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_round(lm->w.ptr.p_double[1], _state)==logit_logitvnum, "MNL unit: Incorrect MNL version!", _state); + nvars = ae_round(lm->w.ptr.p_double[2], _state); + nclasses = ae_round(lm->w.ptr.p_double[3], _state); + ae_vector_set_length(&workx, nvars-1+1, _state); + ae_vector_set_length(&y, nclasses-1+1, _state); + ae_vector_set_length(&dy, 0+1, _state); + dserrallocate(nclasses, &buf, _state); + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&workx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + mnlprocess(lm, &workx, &y, _state); + dy.ptr.p_double[0] = xy->ptr.pp_double[i][nvars]; + dserraccumulate(&buf, &y, &dy, _state); + } + dserrfinish(&buf, _state); + *relcls = buf.ptr.p_double[0]; + *avgce = buf.ptr.p_double[1]; + *rms = buf.ptr.p_double[2]; + *avg = buf.ptr.p_double[3]; + *avgrel = buf.ptr.p_double[4]; + ae_frame_leave(_state); +} + + +/************************************************************************* +THE PURPOSE OF MCSRCH IS TO FIND A STEP WHICH SATISFIES A SUFFICIENT +DECREASE CONDITION AND A CURVATURE CONDITION. + +AT EACH STAGE THE SUBROUTINE UPDATES AN INTERVAL OF UNCERTAINTY WITH +ENDPOINTS STX AND STY. THE INTERVAL OF UNCERTAINTY IS INITIALLY CHOSEN +SO THAT IT CONTAINS A MINIMIZER OF THE MODIFIED FUNCTION + + F(X+STP*S) - F(X) - FTOL*STP*(GRADF(X)'S). + +IF A STEP IS OBTAINED FOR WHICH THE MODIFIED FUNCTION HAS A NONPOSITIVE +FUNCTION VALUE AND NONNEGATIVE DERIVATIVE, THEN THE INTERVAL OF +UNCERTAINTY IS CHOSEN SO THAT IT CONTAINS A MINIMIZER OF F(X+STP*S). + +THE ALGORITHM IS DESIGNED TO FIND A STEP WHICH SATISFIES THE SUFFICIENT +DECREASE CONDITION + + F(X+STP*S) .LE. F(X) + FTOL*STP*(GRADF(X)'S), + +AND THE CURVATURE CONDITION + + ABS(GRADF(X+STP*S)'S)) .LE. GTOL*ABS(GRADF(X)'S). + +IF FTOL IS LESS THAN GTOL AND IF, FOR EXAMPLE, THE FUNCTION IS BOUNDED +BELOW, THEN THERE IS ALWAYS A STEP WHICH SATISFIES BOTH CONDITIONS. +IF NO STEP CAN BE FOUND WHICH SATISFIES BOTH CONDITIONS, THEN THE +ALGORITHM USUALLY STOPS WHEN ROUNDING ERRORS PREVENT FURTHER PROGRESS. +IN THIS CASE STP ONLY SATISFIES THE SUFFICIENT DECREASE CONDITION. + +PARAMETERS DESCRIPRION + +N IS A POSITIVE INTEGER INPUT VARIABLE SET TO THE NUMBER OF VARIABLES. + +X IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE BASE POINT FOR +THE LINE SEARCH. ON OUTPUT IT CONTAINS X+STP*S. + +F IS A VARIABLE. ON INPUT IT MUST CONTAIN THE VALUE OF F AT X. ON OUTPUT +IT CONTAINS THE VALUE OF F AT X + STP*S. + +G IS AN ARRAY OF LENGTH N. ON INPUT IT MUST CONTAIN THE GRADIENT OF F AT X. +ON OUTPUT IT CONTAINS THE GRADIENT OF F AT X + STP*S. + +S IS AN INPUT ARRAY OF LENGTH N WHICH SPECIFIES THE SEARCH DIRECTION. + +STP IS A NONNEGATIVE VARIABLE. ON INPUT STP CONTAINS AN INITIAL ESTIMATE +OF A SATISFACTORY STEP. ON OUTPUT STP CONTAINS THE FINAL ESTIMATE. + +FTOL AND GTOL ARE NONNEGATIVE INPUT VARIABLES. TERMINATION OCCURS WHEN THE +SUFFICIENT DECREASE CONDITION AND THE DIRECTIONAL DERIVATIVE CONDITION ARE +SATISFIED. + +XTOL IS A NONNEGATIVE INPUT VARIABLE. TERMINATION OCCURS WHEN THE RELATIVE +WIDTH OF THE INTERVAL OF UNCERTAINTY IS AT MOST XTOL. + +STPMIN AND STPMAX ARE NONNEGATIVE INPUT VARIABLES WHICH SPECIFY LOWER AND +UPPER BOUNDS FOR THE STEP. + +MAXFEV IS A POSITIVE INTEGER INPUT VARIABLE. TERMINATION OCCURS WHEN THE +NUMBER OF CALLS TO FCN IS AT LEAST MAXFEV BY THE END OF AN ITERATION. + +INFO IS AN INTEGER OUTPUT VARIABLE SET AS FOLLOWS: + INFO = 0 IMPROPER INPUT PARAMETERS. + + INFO = 1 THE SUFFICIENT DECREASE CONDITION AND THE + DIRECTIONAL DERIVATIVE CONDITION HOLD. + + INFO = 2 RELATIVE WIDTH OF THE INTERVAL OF UNCERTAINTY + IS AT MOST XTOL. + + INFO = 3 NUMBER OF CALLS TO FCN HAS REACHED MAXFEV. + + INFO = 4 THE STEP IS AT THE LOWER BOUND STPMIN. + + INFO = 5 THE STEP IS AT THE UPPER BOUND STPMAX. + + INFO = 6 ROUNDING ERRORS PREVENT FURTHER PROGRESS. + THERE MAY NOT BE A STEP WHICH SATISFIES THE + SUFFICIENT DECREASE AND CURVATURE CONDITIONS. + TOLERANCES MAY BE TOO SMALL. + +NFEV IS AN INTEGER OUTPUT VARIABLE SET TO THE NUMBER OF CALLS TO FCN. + +WA IS A WORK ARRAY OF LENGTH N. + +ARGONNE NATIONAL LABORATORY. MINPACK PROJECT. JUNE 1983 +JORGE J. MORE', DAVID J. THUENTE +*************************************************************************/ +static void logit_mnlmcsrch(ae_int_t n, + /* Real */ ae_vector* x, + double* f, + /* Real */ ae_vector* g, + /* Real */ ae_vector* s, + double* stp, + ae_int_t* info, + ae_int_t* nfev, + /* Real */ ae_vector* wa, + logitmcstate* state, + ae_int_t* stage, + ae_state *_state) +{ + double v; + double p5; + double p66; + double zero; + + + + /* + * init + */ + p5 = 0.5; + p66 = 0.66; + state->xtrapf = 4.0; + zero = 0; + + /* + * Main cycle + */ + for(;;) + { + if( *stage==0 ) + { + + /* + * NEXT + */ + *stage = 2; + continue; + } + if( *stage==2 ) + { + state->infoc = 1; + *info = 0; + + /* + * CHECK THE INPUT PARAMETERS FOR ERRORS. + */ + if( ((((((n<=0||ae_fp_less_eq(*stp,0))||ae_fp_less(logit_ftol,0))||ae_fp_less(logit_gtol,zero))||ae_fp_less(logit_xtol,zero))||ae_fp_less(logit_stpmin,zero))||ae_fp_less(logit_stpmax,logit_stpmin))||logit_maxfev<=0 ) + { + *stage = 0; + return; + } + + /* + * COMPUTE THE INITIAL GRADIENT IN THE SEARCH DIRECTION + * AND CHECK THAT S IS A DESCENT DIRECTION. + */ + v = ae_v_dotproduct(&g->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->dginit = v; + if( ae_fp_greater_eq(state->dginit,0) ) + { + *stage = 0; + return; + } + + /* + * INITIALIZE LOCAL VARIABLES. + */ + state->brackt = ae_false; + state->stage1 = ae_true; + *nfev = 0; + state->finit = *f; + state->dgtest = logit_ftol*state->dginit; + state->width = logit_stpmax-logit_stpmin; + state->width1 = state->width/p5; + ae_v_move(&wa->ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * THE VARIABLES STX, FX, DGX CONTAIN THE VALUES OF THE STEP, + * FUNCTION, AND DIRECTIONAL DERIVATIVE AT THE BEST STEP. + * THE VARIABLES STY, FY, DGY CONTAIN THE VALUE OF THE STEP, + * FUNCTION, AND DERIVATIVE AT THE OTHER ENDPOINT OF + * THE INTERVAL OF UNCERTAINTY. + * THE VARIABLES STP, F, DG CONTAIN THE VALUES OF THE STEP, + * FUNCTION, AND DERIVATIVE AT THE CURRENT STEP. + */ + state->stx = 0; + state->fx = state->finit; + state->dgx = state->dginit; + state->sty = 0; + state->fy = state->finit; + state->dgy = state->dginit; + + /* + * NEXT + */ + *stage = 3; + continue; + } + if( *stage==3 ) + { + + /* + * START OF ITERATION. + * + * SET THE MINIMUM AND MAXIMUM STEPS TO CORRESPOND + * TO THE PRESENT INTERVAL OF UNCERTAINTY. + */ + if( state->brackt ) + { + if( ae_fp_less(state->stx,state->sty) ) + { + state->stmin = state->stx; + state->stmax = state->sty; + } + else + { + state->stmin = state->sty; + state->stmax = state->stx; + } + } + else + { + state->stmin = state->stx; + state->stmax = *stp+state->xtrapf*(*stp-state->stx); + } + + /* + * FORCE THE STEP TO BE WITHIN THE BOUNDS STPMAX AND STPMIN. + */ + if( ae_fp_greater(*stp,logit_stpmax) ) + { + *stp = logit_stpmax; + } + if( ae_fp_less(*stp,logit_stpmin) ) + { + *stp = logit_stpmin; + } + + /* + * IF AN UNUSUAL TERMINATION IS TO OCCUR THEN LET + * STP BE THE LOWEST POINT OBTAINED SO FAR. + */ + if( (((state->brackt&&(ae_fp_less_eq(*stp,state->stmin)||ae_fp_greater_eq(*stp,state->stmax)))||*nfev>=logit_maxfev-1)||state->infoc==0)||(state->brackt&&ae_fp_less_eq(state->stmax-state->stmin,logit_xtol*state->stmax)) ) + { + *stp = state->stx; + } + + /* + * EVALUATE THE FUNCTION AND GRADIENT AT STP + * AND COMPUTE THE DIRECTIONAL DERIVATIVE. + */ + ae_v_move(&x->ptr.p_double[0], 1, &wa->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&x->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1), *stp); + + /* + * NEXT + */ + *stage = 4; + return; + } + if( *stage==4 ) + { + *info = 0; + *nfev = *nfev+1; + v = ae_v_dotproduct(&g->ptr.p_double[0], 1, &s->ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->dg = v; + state->ftest1 = state->finit+*stp*state->dgtest; + + /* + * TEST FOR CONVERGENCE. + */ + if( (state->brackt&&(ae_fp_less_eq(*stp,state->stmin)||ae_fp_greater_eq(*stp,state->stmax)))||state->infoc==0 ) + { + *info = 6; + } + if( (ae_fp_eq(*stp,logit_stpmax)&&ae_fp_less_eq(*f,state->ftest1))&&ae_fp_less_eq(state->dg,state->dgtest) ) + { + *info = 5; + } + if( ae_fp_eq(*stp,logit_stpmin)&&(ae_fp_greater(*f,state->ftest1)||ae_fp_greater_eq(state->dg,state->dgtest)) ) + { + *info = 4; + } + if( *nfev>=logit_maxfev ) + { + *info = 3; + } + if( state->brackt&&ae_fp_less_eq(state->stmax-state->stmin,logit_xtol*state->stmax) ) + { + *info = 2; + } + if( ae_fp_less_eq(*f,state->ftest1)&&ae_fp_less_eq(ae_fabs(state->dg, _state),-logit_gtol*state->dginit) ) + { + *info = 1; + } + + /* + * CHECK FOR TERMINATION. + */ + if( *info!=0 ) + { + *stage = 0; + return; + } + + /* + * IN THE FIRST STAGE WE SEEK A STEP FOR WHICH THE MODIFIED + * FUNCTION HAS A NONPOSITIVE VALUE AND NONNEGATIVE DERIVATIVE. + */ + if( (state->stage1&&ae_fp_less_eq(*f,state->ftest1))&&ae_fp_greater_eq(state->dg,ae_minreal(logit_ftol, logit_gtol, _state)*state->dginit) ) + { + state->stage1 = ae_false; + } + + /* + * A MODIFIED FUNCTION IS USED TO PREDICT THE STEP ONLY IF + * WE HAVE NOT OBTAINED A STEP FOR WHICH THE MODIFIED + * FUNCTION HAS A NONPOSITIVE FUNCTION VALUE AND NONNEGATIVE + * DERIVATIVE, AND IF A LOWER FUNCTION VALUE HAS BEEN + * OBTAINED BUT THE DECREASE IS NOT SUFFICIENT. + */ + if( (state->stage1&&ae_fp_less_eq(*f,state->fx))&&ae_fp_greater(*f,state->ftest1) ) + { + + /* + * DEFINE THE MODIFIED FUNCTION AND DERIVATIVE VALUES. + */ + state->fm = *f-*stp*state->dgtest; + state->fxm = state->fx-state->stx*state->dgtest; + state->fym = state->fy-state->sty*state->dgtest; + state->dgm = state->dg-state->dgtest; + state->dgxm = state->dgx-state->dgtest; + state->dgym = state->dgy-state->dgtest; + + /* + * CALL CSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY + * AND TO COMPUTE THE NEW STEP. + */ + logit_mnlmcstep(&state->stx, &state->fxm, &state->dgxm, &state->sty, &state->fym, &state->dgym, stp, state->fm, state->dgm, &state->brackt, state->stmin, state->stmax, &state->infoc, _state); + + /* + * RESET THE FUNCTION AND GRADIENT VALUES FOR F. + */ + state->fx = state->fxm+state->stx*state->dgtest; + state->fy = state->fym+state->sty*state->dgtest; + state->dgx = state->dgxm+state->dgtest; + state->dgy = state->dgym+state->dgtest; + } + else + { + + /* + * CALL MCSTEP TO UPDATE THE INTERVAL OF UNCERTAINTY + * AND TO COMPUTE THE NEW STEP. + */ + logit_mnlmcstep(&state->stx, &state->fx, &state->dgx, &state->sty, &state->fy, &state->dgy, stp, *f, state->dg, &state->brackt, state->stmin, state->stmax, &state->infoc, _state); + } + + /* + * FORCE A SUFFICIENT DECREASE IN THE SIZE OF THE + * INTERVAL OF UNCERTAINTY. + */ + if( state->brackt ) + { + if( ae_fp_greater_eq(ae_fabs(state->sty-state->stx, _state),p66*state->width1) ) + { + *stp = state->stx+p5*(state->sty-state->stx); + } + state->width1 = state->width; + state->width = ae_fabs(state->sty-state->stx, _state); + } + + /* + * NEXT. + */ + *stage = 3; + continue; + } + } +} + + +static void logit_mnlmcstep(double* stx, + double* fx, + double* dx, + double* sty, + double* fy, + double* dy, + double* stp, + double fp, + double dp, + ae_bool* brackt, + double stmin, + double stmax, + ae_int_t* info, + ae_state *_state) +{ + ae_bool bound; + double gamma; + double p; + double q; + double r; + double s; + double sgnd; + double stpc; + double stpf; + double stpq; + double theta; + + + *info = 0; + + /* + * CHECK THE INPUT PARAMETERS FOR ERRORS. + */ + if( ((*brackt&&(ae_fp_less_eq(*stp,ae_minreal(*stx, *sty, _state))||ae_fp_greater_eq(*stp,ae_maxreal(*stx, *sty, _state))))||ae_fp_greater_eq(*dx*(*stp-(*stx)),0))||ae_fp_less(stmax,stmin) ) + { + return; + } + + /* + * DETERMINE IF THE DERIVATIVES HAVE OPPOSITE SIGN. + */ + sgnd = dp*(*dx/ae_fabs(*dx, _state)); + + /* + * FIRST CASE. A HIGHER FUNCTION VALUE. + * THE MINIMUM IS BRACKETED. IF THE CUBIC STEP IS CLOSER + * TO STX THAN THE QUADRATIC STEP, THE CUBIC STEP IS TAKEN, + * ELSE THE AVERAGE OF THE CUBIC AND QUADRATIC STEPS IS TAKEN. + */ + if( ae_fp_greater(fp,*fx) ) + { + *info = 1; + bound = ae_true; + theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; + s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); + gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state); + if( ae_fp_less(*stp,*stx) ) + { + gamma = -gamma; + } + p = gamma-(*dx)+theta; + q = gamma-(*dx)+gamma+dp; + r = p/q; + stpc = *stx+r*(*stp-(*stx)); + stpq = *stx+*dx/((*fx-fp)/(*stp-(*stx))+(*dx))/2*(*stp-(*stx)); + if( ae_fp_less(ae_fabs(stpc-(*stx), _state),ae_fabs(stpq-(*stx), _state)) ) + { + stpf = stpc; + } + else + { + stpf = stpc+(stpq-stpc)/2; + } + *brackt = ae_true; + } + else + { + if( ae_fp_less(sgnd,0) ) + { + + /* + * SECOND CASE. A LOWER FUNCTION VALUE AND DERIVATIVES OF + * OPPOSITE SIGN. THE MINIMUM IS BRACKETED. IF THE CUBIC + * STEP IS CLOSER TO STX THAN THE QUADRATIC (SECANT) STEP, + * THE CUBIC STEP IS TAKEN, ELSE THE QUADRATIC STEP IS TAKEN. + */ + *info = 2; + bound = ae_false; + theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; + s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); + gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state); + if( ae_fp_greater(*stp,*stx) ) + { + gamma = -gamma; + } + p = gamma-dp+theta; + q = gamma-dp+gamma+(*dx); + r = p/q; + stpc = *stp+r*(*stx-(*stp)); + stpq = *stp+dp/(dp-(*dx))*(*stx-(*stp)); + if( ae_fp_greater(ae_fabs(stpc-(*stp), _state),ae_fabs(stpq-(*stp), _state)) ) + { + stpf = stpc; + } + else + { + stpf = stpq; + } + *brackt = ae_true; + } + else + { + if( ae_fp_less(ae_fabs(dp, _state),ae_fabs(*dx, _state)) ) + { + + /* + * THIRD CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE + * SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DECREASES. + * THE CUBIC STEP IS ONLY USED IF THE CUBIC TENDS TO INFINITY + * IN THE DIRECTION OF THE STEP OR IF THE MINIMUM OF THE CUBIC + * IS BEYOND STP. OTHERWISE THE CUBIC STEP IS DEFINED TO BE + * EITHER STPMIN OR STPMAX. THE QUADRATIC (SECANT) STEP IS ALSO + * COMPUTED AND IF THE MINIMUM IS BRACKETED THEN THE THE STEP + * CLOSEST TO STX IS TAKEN, ELSE THE STEP FARTHEST AWAY IS TAKEN. + */ + *info = 3; + bound = ae_true; + theta = 3*(*fx-fp)/(*stp-(*stx))+(*dx)+dp; + s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dx, _state), ae_fabs(dp, _state), _state), _state); + + /* + * THE CASE GAMMA = 0 ONLY ARISES IF THE CUBIC DOES NOT TEND + * TO INFINITY IN THE DIRECTION OF THE STEP. + */ + gamma = s*ae_sqrt(ae_maxreal(0, ae_sqr(theta/s, _state)-*dx/s*(dp/s), _state), _state); + if( ae_fp_greater(*stp,*stx) ) + { + gamma = -gamma; + } + p = gamma-dp+theta; + q = gamma+(*dx-dp)+gamma; + r = p/q; + if( ae_fp_less(r,0)&&ae_fp_neq(gamma,0) ) + { + stpc = *stp+r*(*stx-(*stp)); + } + else + { + if( ae_fp_greater(*stp,*stx) ) + { + stpc = stmax; + } + else + { + stpc = stmin; + } + } + stpq = *stp+dp/(dp-(*dx))*(*stx-(*stp)); + if( *brackt ) + { + if( ae_fp_less(ae_fabs(*stp-stpc, _state),ae_fabs(*stp-stpq, _state)) ) + { + stpf = stpc; + } + else + { + stpf = stpq; + } + } + else + { + if( ae_fp_greater(ae_fabs(*stp-stpc, _state),ae_fabs(*stp-stpq, _state)) ) + { + stpf = stpc; + } + else + { + stpf = stpq; + } + } + } + else + { + + /* + * FOURTH CASE. A LOWER FUNCTION VALUE, DERIVATIVES OF THE + * SAME SIGN, AND THE MAGNITUDE OF THE DERIVATIVE DOES + * NOT DECREASE. IF THE MINIMUM IS NOT BRACKETED, THE STEP + * IS EITHER STPMIN OR STPMAX, ELSE THE CUBIC STEP IS TAKEN. + */ + *info = 4; + bound = ae_false; + if( *brackt ) + { + theta = 3*(fp-(*fy))/(*sty-(*stp))+(*dy)+dp; + s = ae_maxreal(ae_fabs(theta, _state), ae_maxreal(ae_fabs(*dy, _state), ae_fabs(dp, _state), _state), _state); + gamma = s*ae_sqrt(ae_sqr(theta/s, _state)-*dy/s*(dp/s), _state); + if( ae_fp_greater(*stp,*sty) ) + { + gamma = -gamma; + } + p = gamma-dp+theta; + q = gamma-dp+gamma+(*dy); + r = p/q; + stpc = *stp+r*(*sty-(*stp)); + stpf = stpc; + } + else + { + if( ae_fp_greater(*stp,*stx) ) + { + stpf = stmax; + } + else + { + stpf = stmin; + } + } + } + } + } + + /* + * UPDATE THE INTERVAL OF UNCERTAINTY. THIS UPDATE DOES NOT + * DEPEND ON THE NEW STEP OR THE CASE ANALYSIS ABOVE. + */ + if( ae_fp_greater(fp,*fx) ) + { + *sty = *stp; + *fy = fp; + *dy = dp; + } + else + { + if( ae_fp_less(sgnd,0.0) ) + { + *sty = *stx; + *fy = *fx; + *dy = *dx; + } + *stx = *stp; + *fx = fp; + *dx = dp; + } + + /* + * COMPUTE THE NEW STEP AND SAFEGUARD IT. + */ + stpf = ae_minreal(stmax, stpf, _state); + stpf = ae_maxreal(stmin, stpf, _state); + *stp = stpf; + if( *brackt&&bound ) + { + if( ae_fp_greater(*sty,*stx) ) + { + *stp = ae_minreal(*stx+0.66*(*sty-(*stx)), *stp, _state); + } + else + { + *stp = ae_maxreal(*stx+0.66*(*sty-(*stx)), *stp, _state); + } + } +} + + +ae_bool _logitmodel_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + logitmodel *p = (logitmodel*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->w, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _logitmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + logitmodel *dst = (logitmodel*)_dst; + logitmodel *src = (logitmodel*)_src; + if( !ae_vector_init_copy(&dst->w, &src->w, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _logitmodel_clear(void* _p) +{ + logitmodel *p = (logitmodel*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->w); +} + + +void _logitmodel_destroy(void* _p) +{ + logitmodel *p = (logitmodel*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->w); +} + + +ae_bool _logitmcstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + logitmcstate *p = (logitmcstate*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _logitmcstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + logitmcstate *dst = (logitmcstate*)_dst; + logitmcstate *src = (logitmcstate*)_src; + dst->brackt = src->brackt; + dst->stage1 = src->stage1; + dst->infoc = src->infoc; + dst->dg = src->dg; + dst->dgm = src->dgm; + dst->dginit = src->dginit; + dst->dgtest = src->dgtest; + dst->dgx = src->dgx; + dst->dgxm = src->dgxm; + dst->dgy = src->dgy; + dst->dgym = src->dgym; + dst->finit = src->finit; + dst->ftest1 = src->ftest1; + dst->fm = src->fm; + dst->fx = src->fx; + dst->fxm = src->fxm; + dst->fy = src->fy; + dst->fym = src->fym; + dst->stx = src->stx; + dst->sty = src->sty; + dst->stmin = src->stmin; + dst->stmax = src->stmax; + dst->width = src->width; + dst->width1 = src->width1; + dst->xtrapf = src->xtrapf; + return ae_true; +} + + +void _logitmcstate_clear(void* _p) +{ + logitmcstate *p = (logitmcstate*)_p; + ae_touch_ptr((void*)p); +} + + +void _logitmcstate_destroy(void* _p) +{ + logitmcstate *p = (logitmcstate*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _mnlreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mnlreport *p = (mnlreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _mnlreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mnlreport *dst = (mnlreport*)_dst; + mnlreport *src = (mnlreport*)_src; + dst->ngrad = src->ngrad; + dst->nhess = src->nhess; + return ae_true; +} + + +void _mnlreport_clear(void* _p) +{ + mnlreport *p = (mnlreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _mnlreport_destroy(void* _p) +{ + mnlreport *p = (mnlreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* +DESCRIPTION: + +This function creates MCPD (Markov Chains for Population Data) solver. + +This solver can be used to find transition matrix P for N-dimensional +prediction problem where transition from X[i] to X[i+1] is modelled as + X[i+1] = P*X[i] +where X[i] and X[i+1] are N-dimensional population vectors (components of +each X are non-negative), and P is a N*N transition matrix (elements of P +are non-negative, each column sums to 1.0). + +Such models arise when when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is constant, i.e. there is no new individuals and no one + leaves population +* you want to model transitions of individuals from one state into another + +USAGE: + +Here we give very brief outline of the MCPD. We strongly recommend you to +read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide +on data analysis which is available at http://www.alglib.net/dataanalysis/ + +1. User initializes algorithm state with MCPDCreate() call + +2. User adds one or more tracks - sequences of states which describe + evolution of a system being modelled from different starting conditions + +3. User may add optional boundary, equality and/or linear constraints on + the coefficients of P by calling one of the following functions: + * MCPDSetEC() to set equality constraints + * MCPDSetBC() to set bound constraints + * MCPDSetLC() to set linear constraints + +4. Optionally, user may set custom weights for prediction errors (by + default, algorithm assigns non-equal, automatically chosen weights for + errors in the prediction of different components of X). It can be done + with a call of MCPDSetPredictionWeights() function. + +5. User calls MCPDSolve() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. + +6. User calls MCPDResults() to get solution + +INPUT PARAMETERS: + N - problem dimension, N>=1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreate(ae_int_t n, mcpdstate* s, ae_state *_state) +{ + + _mcpdstate_clear(s); + + ae_assert(n>=1, "MCPDCreate: N<1", _state); + mcpd_mcpdinit(n, -1, -1, s, _state); +} + + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Entry-state" model, i.e. model where transition from X[i] to X[i+1] +is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +and one selected component of X[] is called "entry" state and is treated +in a special way: + system state always transits from "entry" state to some another state + system state can not transit from any state into "entry" state +Such conditions basically mean that row of P which corresponds to "entry" +state is zero. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant - at every moment of time there is some + (unpredictable) amount of "new" individuals, which can transit into one + of the states at the next turn, but still no one leaves population +* you want to model transitions of individuals from one state into another +* but you do NOT want to predict amount of "new" individuals because it + does not depends on individuals already present (hence system can not + transit INTO entry state - it can only transit FROM it). + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + EntryState- index of entry state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateentry(ae_int_t n, + ae_int_t entrystate, + mcpdstate* s, + ae_state *_state) +{ + + _mcpdstate_clear(s); + + ae_assert(n>=2, "MCPDCreateEntry: N<2", _state); + ae_assert(entrystate>=0, "MCPDCreateEntry: EntryState<0", _state); + ae_assert(entrystate=N", _state); + mcpd_mcpdinit(n, entrystate, -1, s, _state); +} + + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Exit-state" model, i.e. model where transition from X[i] to X[i+1] +is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +and one selected component of X[] is called "exit" state and is treated +in a special way: + system state can transit from any state into "exit" state + system state can not transit from "exit" state into any other state + transition operator discards "exit" state (makes it zero at each turn) +Such conditions basically mean that column of P which corresponds to +"exit" state is zero. Multiplication by such P may decrease sum of vector +components. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant - individuals can move into "exit" state + and leave population at the next turn, but there are no new individuals +* amount of individuals which leave population can be predicted +* you want to model transitions of individuals from one state into another + (including transitions into the "exit" state) + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + ExitState- index of exit state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateexit(ae_int_t n, + ae_int_t exitstate, + mcpdstate* s, + ae_state *_state) +{ + + _mcpdstate_clear(s); + + ae_assert(n>=2, "MCPDCreateExit: N<2", _state); + ae_assert(exitstate>=0, "MCPDCreateExit: ExitState<0", _state); + ae_assert(exitstate=N", _state); + mcpd_mcpdinit(n, -1, exitstate, s, _state); +} + + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Entry-Exit-states" model, i.e. model where transition from X[i] to +X[i+1] is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +one selected component of X[] is called "entry" state and is treated in a +special way: + system state always transits from "entry" state to some another state + system state can not transit from any state into "entry" state +and another one component of X[] is called "exit" state and is treated in +a special way too: + system state can transit from any state into "exit" state + system state can not transit from "exit" state into any other state + transition operator discards "exit" state (makes it zero at each turn) +Such conditions basically mean that: + row of P which corresponds to "entry" state is zero + column of P which corresponds to "exit" state is zero +Multiplication by such P may decrease sum of vector components. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant +* at every moment of time there is some (unpredictable) amount of "new" + individuals, which can transit into one of the states at the next turn +* some individuals can move (predictably) into "exit" state and leave + population at the next turn +* you want to model transitions of individuals from one state into another, + including transitions from the "entry" state and into the "exit" state. +* but you do NOT want to predict amount of "new" individuals because it + does not depends on individuals already present (hence system can not + transit INTO entry state - it can only transit FROM it). + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + EntryState- index of entry state, in 0..N-1 + ExitState- index of exit state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateentryexit(ae_int_t n, + ae_int_t entrystate, + ae_int_t exitstate, + mcpdstate* s, + ae_state *_state) +{ + + _mcpdstate_clear(s); + + ae_assert(n>=2, "MCPDCreateEntryExit: N<2", _state); + ae_assert(entrystate>=0, "MCPDCreateEntryExit: EntryState<0", _state); + ae_assert(entrystate=N", _state); + ae_assert(exitstate>=0, "MCPDCreateEntryExit: ExitState<0", _state); + ae_assert(exitstate=N", _state); + ae_assert(entrystate!=exitstate, "MCPDCreateEntryExit: EntryState=ExitState", _state); + mcpd_mcpdinit(n, entrystate, exitstate, s, _state); +} + + +/************************************************************************* +This function is used to add a track - sequence of system states at the +different moments of its evolution. + +You may add one or several tracks to the MCPD solver. In case you have +several tracks, they won't overwrite each other. For example, if you pass +two tracks, A1-A2-A3 (system at t=A+1, t=A+2 and t=A+3) and B1-B2-B3, then +solver will try to model transitions from t=A+1 to t=A+2, t=A+2 to t=A+3, +t=B+1 to t=B+2, t=B+2 to t=B+3. But it WONT mix these two tracks - i.e. it +wont try to model transition from t=A+3 to t=B+1. + +INPUT PARAMETERS: + S - solver + XY - track, array[K,N]: + * I-th row is a state at t=I + * elements of XY must be non-negative (exception will be + thrown on negative elements) + K - number of points in a track + * if given, only leading K rows of XY are used + * if not given, automatically determined from size of XY + +NOTES: + +1. Track may contain either proportional or population data: + * with proportional data all rows of XY must sum to 1.0, i.e. we have + proportions instead of absolute population values + * with population data rows of XY contain population counts and generally + do not sum to 1.0 (although they still must be non-negative) + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdaddtrack(mcpdstate* s, + /* Real */ ae_matrix* xy, + ae_int_t k, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n; + double s0; + double s1; + + + n = s->n; + ae_assert(k>=0, "MCPDAddTrack: K<0", _state); + ae_assert(xy->cols>=n, "MCPDAddTrack: Cols(XY)rows>=k, "MCPDAddTrack: Rows(XY)ptr.pp_double[i][j],0), "MCPDAddTrack: XY contains negative elements", _state); + } + } + if( k<2 ) + { + return; + } + if( s->data.rowsnpairs+k-1 ) + { + rmatrixresize(&s->data, ae_maxint(2*s->data.rows, s->npairs+k-1, _state), 2*n, _state); + } + for(i=0; i<=k-2; i++) + { + s0 = 0; + s1 = 0; + for(j=0; j<=n-1; j++) + { + if( s->states.ptr.p_int[j]>=0 ) + { + s0 = s0+xy->ptr.pp_double[i][j]; + } + if( s->states.ptr.p_int[j]<=0 ) + { + s1 = s1+xy->ptr.pp_double[i+1][j]; + } + } + if( ae_fp_greater(s0,0)&&ae_fp_greater(s1,0) ) + { + for(j=0; j<=n-1; j++) + { + if( s->states.ptr.p_int[j]>=0 ) + { + s->data.ptr.pp_double[s->npairs][j] = xy->ptr.pp_double[i][j]/s0; + } + else + { + s->data.ptr.pp_double[s->npairs][j] = 0.0; + } + if( s->states.ptr.p_int[j]<=0 ) + { + s->data.ptr.pp_double[s->npairs][n+j] = xy->ptr.pp_double[i+1][j]/s1; + } + else + { + s->data.ptr.pp_double[s->npairs][n+j] = 0.0; + } + } + s->npairs = s->npairs+1; + } + } +} + + +/************************************************************************* +This function is used to add equality constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to place equality constraints on arbitrary +subset of elements of P. Set of constraints is specified by EC, which may +contain either NAN's or finite numbers from [0,1]. NAN denotes absence of +constraint, finite number denotes equality constraint on specific element +of P. + +You can also use MCPDAddEC() function which allows to ADD equality +constraint for one element of P without changing constraints for other +elements. + +These functions (MCPDSetEC and MCPDAddEC) interact as follows: +* there is internal matrix of equality constraints which is stored in the + MCPD solver +* MCPDSetEC() replaces this matrix by another one (SET) +* MCPDAddEC() modifies one element of this matrix and leaves other ones + unchanged (ADD) +* thus MCPDAddEC() call preserves all modifications done by previous + calls, while MCPDSetEC() completely discards all changes done to the + equality constraints. + +INPUT PARAMETERS: + S - solver + EC - equality constraints, array[N,N]. Elements of EC can be + either NAN's or finite numbers from [0,1]. NAN denotes + absence of constraints, while finite value denotes + equality constraint on the corresponding element of P. + +NOTES: + +1. infinite values of EC will lead to exception being thrown. Values less +than 0.0 or greater than 1.0 will lead to error code being returned after +call to MCPDSolve(). + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetec(mcpdstate* s, + /* Real */ ae_matrix* ec, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n; + + + n = s->n; + ae_assert(ec->cols>=n, "MCPDSetEC: Cols(EC)rows>=n, "MCPDSetEC: Rows(EC)ptr.pp_double[i][j], _state)||ae_isnan(ec->ptr.pp_double[i][j], _state), "MCPDSetEC: EC containts infinite elements", _state); + s->ec.ptr.pp_double[i][j] = ec->ptr.pp_double[i][j]; + } + } +} + + +/************************************************************************* +This function is used to add equality constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to ADD equality constraint for one element of P +without changing constraints for other elements. + +You can also use MCPDSetEC() function which allows you to specify +arbitrary set of equality constraints in one call. + +These functions (MCPDSetEC and MCPDAddEC) interact as follows: +* there is internal matrix of equality constraints which is stored in the + MCPD solver +* MCPDSetEC() replaces this matrix by another one (SET) +* MCPDAddEC() modifies one element of this matrix and leaves other ones + unchanged (ADD) +* thus MCPDAddEC() call preserves all modifications done by previous + calls, while MCPDSetEC() completely discards all changes done to the + equality constraints. + +INPUT PARAMETERS: + S - solver + I - row index of element being constrained + J - column index of element being constrained + C - value (constraint for P[I,J]). Can be either NAN (no + constraint) or finite value from [0,1]. + +NOTES: + +1. infinite values of C will lead to exception being thrown. Values less +than 0.0 or greater than 1.0 will lead to error code being returned after +call to MCPDSolve(). + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdaddec(mcpdstate* s, + ae_int_t i, + ae_int_t j, + double c, + ae_state *_state) +{ + + + ae_assert(i>=0, "MCPDAddEC: I<0", _state); + ae_assert(in, "MCPDAddEC: I>=N", _state); + ae_assert(j>=0, "MCPDAddEC: J<0", _state); + ae_assert(jn, "MCPDAddEC: J>=N", _state); + ae_assert(ae_isnan(c, _state)||ae_isfinite(c, _state), "MCPDAddEC: C is not finite number or NAN", _state); + s->ec.ptr.pp_double[i][j] = c; +} + + +/************************************************************************* +This function is used to add bound constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to place bound constraints on arbitrary +subset of elements of P. Set of constraints is specified by BndL/BndU +matrices, which may contain arbitrary combination of finite numbers or +infinities (like -INFn; + ae_assert(bndl->cols>=n, "MCPDSetBC: Cols(BndL)rows>=n, "MCPDSetBC: Rows(BndL)cols>=n, "MCPDSetBC: Cols(BndU)rows>=n, "MCPDSetBC: Rows(BndU)ptr.pp_double[i][j], _state)||ae_isneginf(bndl->ptr.pp_double[i][j], _state), "MCPDSetBC: BndL containts NAN or +INF", _state); + ae_assert(ae_isfinite(bndu->ptr.pp_double[i][j], _state)||ae_isposinf(bndu->ptr.pp_double[i][j], _state), "MCPDSetBC: BndU containts NAN or -INF", _state); + s->bndl.ptr.pp_double[i][j] = bndl->ptr.pp_double[i][j]; + s->bndu.ptr.pp_double[i][j] = bndu->ptr.pp_double[i][j]; + } + } +} + + +/************************************************************************* +This function is used to add bound constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to ADD bound constraint for one element of P +without changing constraints for other elements. + +You can also use MCPDSetBC() function which allows to place bound +constraints on arbitrary subset of elements of P. Set of constraints is +specified by BndL/BndU matrices, which may contain arbitrary combination +of finite numbers or infinities (like -INF=0, "MCPDAddBC: I<0", _state); + ae_assert(in, "MCPDAddBC: I>=N", _state); + ae_assert(j>=0, "MCPDAddBC: J<0", _state); + ae_assert(jn, "MCPDAddBC: J>=N", _state); + ae_assert(ae_isfinite(bndl, _state)||ae_isneginf(bndl, _state), "MCPDAddBC: BndL is NAN or +INF", _state); + ae_assert(ae_isfinite(bndu, _state)||ae_isposinf(bndu, _state), "MCPDAddBC: BndU is NAN or -INF", _state); + s->bndl.ptr.pp_double[i][j] = bndl; + s->bndu.ptr.pp_double[i][j] = bndu; +} + + +/************************************************************************* +This function is used to set linear equality/inequality constraints on the +elements of the transition matrix P. + +This function can be used to set one or several general linear constraints +on the elements of P. Two types of constraints are supported: +* equality constraints +* inequality constraints (both less-or-equal and greater-or-equal) + +Coefficients of constraints are specified by matrix C (one of the +parameters). One row of C corresponds to one constraint. Because +transition matrix P has N*N elements, we need N*N columns to store all +coefficients (they are stored row by row), and one more column to store +right part - hence C has N*N+1 columns. Constraint kind is stored in the +CT array. + +Thus, I-th linear constraint is + P[0,0]*C[I,0] + P[0,1]*C[I,1] + .. + P[0,N-1]*C[I,N-1] + + + P[1,0]*C[I,N] + P[1,1]*C[I,N+1] + ... + + + P[N-1,N-1]*C[I,N*N-1] ?=? C[I,N*N] +where ?=? can be either "=" (CT[i]=0), "<=" (CT[i]<0) or ">=" (CT[i]>0). + +Your constraint may involve only some subset of P (less than N*N elements). +For example it can be something like + P[0,0] + P[0,1] = 0.5 +In this case you still should pass matrix with N*N+1 columns, but all its +elements (except for C[0,0], C[0,1] and C[0,N*N-1]) will be zero. + +INPUT PARAMETERS: + S - solver + C - array[K,N*N+1] - coefficients of constraints + (see above for complete description) + CT - array[K] - constraint types + (see above for complete description) + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetlc(mcpdstate* s, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* ct, + ae_int_t k, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n; + + + n = s->n; + ae_assert(c->cols>=n*n+1, "MCPDSetLC: Cols(C)rows>=k, "MCPDSetLC: Rows(C)cnt>=k, "MCPDSetLC: Len(CT)c, k, n*n+1, _state); + ivectorsetlengthatleast(&s->ct, k, _state); + for(i=0; i<=k-1; i++) + { + for(j=0; j<=n*n; j++) + { + s->c.ptr.pp_double[i][j] = c->ptr.pp_double[i][j]; + } + s->ct.ptr.p_int[i] = ct->ptr.p_int[i]; + } + s->ccnt = k; +} + + +/************************************************************************* +This function allows to tune amount of Tikhonov regularization being +applied to your problem. + +By default, regularizing term is equal to r*||P-prior_P||^2, where r is a +small non-zero value, P is transition matrix, prior_P is identity matrix, +||X||^2 is a sum of squared elements of X. + +This function allows you to change coefficient r. You can also change +prior values with MCPDSetPrior() function. + +INPUT PARAMETERS: + S - solver + V - regularization coefficient, finite non-negative value. It + is not recommended to specify zero value unless you are + pretty sure that you want it. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsettikhonovregularizer(mcpdstate* s, double v, ae_state *_state) +{ + + + ae_assert(ae_isfinite(v, _state), "MCPDSetTikhonovRegularizer: V is infinite or NAN", _state); + ae_assert(ae_fp_greater_eq(v,0.0), "MCPDSetTikhonovRegularizer: V is less than zero", _state); + s->regterm = v; +} + + +/************************************************************************* +This function allows to set prior values used for regularization of your +problem. + +By default, regularizing term is equal to r*||P-prior_P||^2, where r is a +small non-zero value, P is transition matrix, prior_P is identity matrix, +||X||^2 is a sum of squared elements of X. + +This function allows you to change prior values prior_P. You can also +change r with MCPDSetTikhonovRegularizer() function. + +INPUT PARAMETERS: + S - solver + PP - array[N,N], matrix of prior values: + 1. elements must be real numbers from [0,1] + 2. columns must sum to 1.0. + First property is checked (exception is thrown otherwise), + while second one is not checked/enforced. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetprior(mcpdstate* s, + /* Real */ ae_matrix* pp, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _pp; + ae_int_t i; + ae_int_t j; + ae_int_t n; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_pp, pp, _state, ae_true); + pp = &_pp; + + n = s->n; + ae_assert(pp->cols>=n, "MCPDSetPrior: Cols(PP)rows>=n, "MCPDSetPrior: Rows(PP)ptr.pp_double[i][j], _state), "MCPDSetPrior: PP containts infinite elements", _state); + ae_assert(ae_fp_greater_eq(pp->ptr.pp_double[i][j],0.0)&&ae_fp_less_eq(pp->ptr.pp_double[i][j],1.0), "MCPDSetPrior: PP[i,j] is less than 0.0 or greater than 1.0", _state); + s->priorp.ptr.pp_double[i][j] = pp->ptr.pp_double[i][j]; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function is used to change prediction weights + +MCPD solver scales prediction errors as follows + Error(P) = ||W*(y-P*x)||^2 +where + x is a system state at time t + y is a system state at time t+1 + P is a transition matrix + W is a diagonal scaling matrix + +By default, weights are chosen in order to minimize relative prediction +error instead of absolute one. For example, if one component of state is +about 0.5 in magnitude and another one is about 0.05, then algorithm will +make corresponding weights equal to 2.0 and 20.0. + +INPUT PARAMETERS: + S - solver + PW - array[N], weights: + * must be non-negative values (exception will be thrown otherwise) + * zero values will be replaced by automatically chosen values + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetpredictionweights(mcpdstate* s, + /* Real */ ae_vector* pw, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n; + + + n = s->n; + ae_assert(pw->cnt>=n, "MCPDSetPredictionWeights: Length(PW)ptr.p_double[i], _state), "MCPDSetPredictionWeights: PW containts infinite or NAN elements", _state); + ae_assert(ae_fp_greater_eq(pw->ptr.p_double[i],0), "MCPDSetPredictionWeights: PW containts negative elements", _state); + s->pw.ptr.p_double[i] = pw->ptr.p_double[i]; + } +} + + +/************************************************************************* +This function is used to start solution of the MCPD problem. + +After return from this function, you can use MCPDResults() to get solution +and completion code. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsolve(mcpdstate* s, ae_state *_state) +{ + ae_int_t n; + ae_int_t npairs; + ae_int_t ccnt; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t k2; + double v; + double vv; + + + n = s->n; + npairs = s->npairs; + + /* + * init fields of S + */ + s->repterminationtype = 0; + s->repinneriterationscount = 0; + s->repouteriterationscount = 0; + s->repnfev = 0; + for(k=0; k<=n-1; k++) + { + for(k2=0; k2<=n-1; k2++) + { + s->p.ptr.pp_double[k][k2] = _state->v_nan; + } + } + + /* + * Generate "effective" weights for prediction and calculate preconditioner + */ + for(i=0; i<=n-1; i++) + { + if( ae_fp_eq(s->pw.ptr.p_double[i],0) ) + { + v = 0; + k = 0; + for(j=0; j<=npairs-1; j++) + { + if( ae_fp_neq(s->data.ptr.pp_double[j][n+i],0) ) + { + v = v+s->data.ptr.pp_double[j][n+i]; + k = k+1; + } + } + if( k!=0 ) + { + s->effectivew.ptr.p_double[i] = k/v; + } + else + { + s->effectivew.ptr.p_double[i] = 1.0; + } + } + else + { + s->effectivew.ptr.p_double[i] = s->pw.ptr.p_double[i]; + } + } + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + s->h.ptr.p_double[i*n+j] = 2*s->regterm; + } + } + for(k=0; k<=npairs-1; k++) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + s->h.ptr.p_double[i*n+j] = s->h.ptr.p_double[i*n+j]+2*ae_sqr(s->effectivew.ptr.p_double[i], _state)*ae_sqr(s->data.ptr.pp_double[k][j], _state); + } + } + } + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( ae_fp_eq(s->h.ptr.p_double[i*n+j],0) ) + { + s->h.ptr.p_double[i*n+j] = 1; + } + } + } + + /* + * Generate "effective" BndL/BndU + */ + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + + /* + * Set default boundary constraints. + * Lower bound is always zero, upper bound is calculated + * with respect to entry/exit states. + */ + s->effectivebndl.ptr.p_double[i*n+j] = 0.0; + if( s->states.ptr.p_int[i]>0||s->states.ptr.p_int[j]<0 ) + { + s->effectivebndu.ptr.p_double[i*n+j] = 0.0; + } + else + { + s->effectivebndu.ptr.p_double[i*n+j] = 1.0; + } + + /* + * Calculate intersection of the default and user-specified bound constraints. + * This code checks consistency of such combination. + */ + if( ae_isfinite(s->bndl.ptr.pp_double[i][j], _state)&&ae_fp_greater(s->bndl.ptr.pp_double[i][j],s->effectivebndl.ptr.p_double[i*n+j]) ) + { + s->effectivebndl.ptr.p_double[i*n+j] = s->bndl.ptr.pp_double[i][j]; + } + if( ae_isfinite(s->bndu.ptr.pp_double[i][j], _state)&&ae_fp_less(s->bndu.ptr.pp_double[i][j],s->effectivebndu.ptr.p_double[i*n+j]) ) + { + s->effectivebndu.ptr.p_double[i*n+j] = s->bndu.ptr.pp_double[i][j]; + } + if( ae_fp_greater(s->effectivebndl.ptr.p_double[i*n+j],s->effectivebndu.ptr.p_double[i*n+j]) ) + { + s->repterminationtype = -3; + return; + } + + /* + * Calculate intersection of the effective bound constraints + * and user-specified equality constraints. + * This code checks consistency of such combination. + */ + if( ae_isfinite(s->ec.ptr.pp_double[i][j], _state) ) + { + if( ae_fp_less(s->ec.ptr.pp_double[i][j],s->effectivebndl.ptr.p_double[i*n+j])||ae_fp_greater(s->ec.ptr.pp_double[i][j],s->effectivebndu.ptr.p_double[i*n+j]) ) + { + s->repterminationtype = -3; + return; + } + s->effectivebndl.ptr.p_double[i*n+j] = s->ec.ptr.pp_double[i][j]; + s->effectivebndu.ptr.p_double[i*n+j] = s->ec.ptr.pp_double[i][j]; + } + } + } + + /* + * Generate linear constraints: + * * "default" sums-to-one constraints (not generated for "exit" states) + */ + rmatrixsetlengthatleast(&s->effectivec, s->ccnt+n, n*n+1, _state); + ivectorsetlengthatleast(&s->effectivect, s->ccnt+n, _state); + ccnt = s->ccnt; + for(i=0; i<=s->ccnt-1; i++) + { + for(j=0; j<=n*n; j++) + { + s->effectivec.ptr.pp_double[i][j] = s->c.ptr.pp_double[i][j]; + } + s->effectivect.ptr.p_int[i] = s->ct.ptr.p_int[i]; + } + for(i=0; i<=n-1; i++) + { + if( s->states.ptr.p_int[i]>=0 ) + { + for(k=0; k<=n*n-1; k++) + { + s->effectivec.ptr.pp_double[ccnt][k] = 0; + } + for(k=0; k<=n-1; k++) + { + s->effectivec.ptr.pp_double[ccnt][k*n+i] = 1; + } + s->effectivec.ptr.pp_double[ccnt][n*n] = 1.0; + s->effectivect.ptr.p_int[ccnt] = 0; + ccnt = ccnt+1; + } + } + + /* + * create optimizer + */ + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + s->tmpp.ptr.p_double[i*n+j] = (double)1/(double)n; + } + } + minbleicrestartfrom(&s->bs, &s->tmpp, _state); + minbleicsetbc(&s->bs, &s->effectivebndl, &s->effectivebndu, _state); + minbleicsetlc(&s->bs, &s->effectivec, &s->effectivect, ccnt, _state); + minbleicsetcond(&s->bs, 0.0, 0.0, mcpd_xtol, 0, _state); + minbleicsetprecdiag(&s->bs, &s->h, _state); + + /* + * solve problem + */ + while(minbleiciteration(&s->bs, _state)) + { + ae_assert(s->bs.needfg, "MCPDSolve: internal error", _state); + if( s->bs.needfg ) + { + + /* + * Calculate regularization term + */ + s->bs.f = 0.0; + vv = s->regterm; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + s->bs.f = s->bs.f+vv*ae_sqr(s->bs.x.ptr.p_double[i*n+j]-s->priorp.ptr.pp_double[i][j], _state); + s->bs.g.ptr.p_double[i*n+j] = 2*vv*(s->bs.x.ptr.p_double[i*n+j]-s->priorp.ptr.pp_double[i][j]); + } + } + + /* + * calculate prediction error/gradient for K-th pair + */ + for(k=0; k<=npairs-1; k++) + { + for(i=0; i<=n-1; i++) + { + v = ae_v_dotproduct(&s->bs.x.ptr.p_double[i*n], 1, &s->data.ptr.pp_double[k][0], 1, ae_v_len(i*n,i*n+n-1)); + vv = s->effectivew.ptr.p_double[i]; + s->bs.f = s->bs.f+ae_sqr(vv*(v-s->data.ptr.pp_double[k][n+i]), _state); + for(j=0; j<=n-1; j++) + { + s->bs.g.ptr.p_double[i*n+j] = s->bs.g.ptr.p_double[i*n+j]+2*vv*vv*(v-s->data.ptr.pp_double[k][n+i])*s->data.ptr.pp_double[k][j]; + } + } + } + + /* + * continue + */ + continue; + } + } + minbleicresultsbuf(&s->bs, &s->tmpp, &s->br, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + s->p.ptr.pp_double[i][j] = s->tmpp.ptr.p_double[i*n+j]; + } + } + s->repterminationtype = s->br.terminationtype; + s->repinneriterationscount = s->br.inneriterationscount; + s->repouteriterationscount = s->br.outeriterationscount; + s->repnfev = s->br.nfev; +} + + +/************************************************************************* +MCPD results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + P - array[N,N], transition matrix + Rep - optimization report. You should check Rep.TerminationType + in order to distinguish successful termination from + unsuccessful one. Speaking short, positive values denote + success, negative ones are failures. + More information about fields of this structure can be + found in the comments on MCPDReport datatype. + + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdresults(mcpdstate* s, + /* Real */ ae_matrix* p, + mcpdreport* rep, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + ae_matrix_clear(p); + _mcpdreport_clear(rep); + + ae_matrix_set_length(p, s->n, s->n, _state); + for(i=0; i<=s->n-1; i++) + { + for(j=0; j<=s->n-1; j++) + { + p->ptr.pp_double[i][j] = s->p.ptr.pp_double[i][j]; + } + } + rep->terminationtype = s->repterminationtype; + rep->inneriterationscount = s->repinneriterationscount; + rep->outeriterationscount = s->repouteriterationscount; + rep->nfev = s->repnfev; +} + + +/************************************************************************* +Internal initialization function + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +static void mcpd_mcpdinit(ae_int_t n, + ae_int_t entrystate, + ae_int_t exitstate, + mcpdstate* s, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + + ae_assert(n>=1, "MCPDCreate: N<1", _state); + s->n = n; + ae_vector_set_length(&s->states, n, _state); + for(i=0; i<=n-1; i++) + { + s->states.ptr.p_int[i] = 0; + } + if( entrystate>=0 ) + { + s->states.ptr.p_int[entrystate] = 1; + } + if( exitstate>=0 ) + { + s->states.ptr.p_int[exitstate] = -1; + } + s->npairs = 0; + s->regterm = 1.0E-8; + s->ccnt = 0; + ae_matrix_set_length(&s->p, n, n, _state); + ae_matrix_set_length(&s->ec, n, n, _state); + ae_matrix_set_length(&s->bndl, n, n, _state); + ae_matrix_set_length(&s->bndu, n, n, _state); + ae_vector_set_length(&s->pw, n, _state); + ae_matrix_set_length(&s->priorp, n, n, _state); + ae_vector_set_length(&s->tmpp, n*n, _state); + ae_vector_set_length(&s->effectivew, n, _state); + ae_vector_set_length(&s->effectivebndl, n*n, _state); + ae_vector_set_length(&s->effectivebndu, n*n, _state); + ae_vector_set_length(&s->h, n*n, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + s->p.ptr.pp_double[i][j] = 0.0; + s->priorp.ptr.pp_double[i][j] = 0.0; + s->bndl.ptr.pp_double[i][j] = _state->v_neginf; + s->bndu.ptr.pp_double[i][j] = _state->v_posinf; + s->ec.ptr.pp_double[i][j] = _state->v_nan; + } + s->pw.ptr.p_double[i] = 0.0; + s->priorp.ptr.pp_double[i][i] = 1.0; + } + ae_matrix_set_length(&s->data, 1, 2*n, _state); + for(i=0; i<=2*n-1; i++) + { + s->data.ptr.pp_double[0][i] = 0.0; + } + for(i=0; i<=n*n-1; i++) + { + s->tmpp.ptr.p_double[i] = 0.0; + } + minbleiccreate(n*n, &s->tmpp, &s->bs, _state); +} + + +ae_bool _mcpdstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mcpdstate *p = (mcpdstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->states, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->data, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->ec, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->bndl, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->bndu, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->c, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ct, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->pw, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->priorp, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_minbleicstate_init(&p->bs, _state, make_automatic) ) + return ae_false; + if( !_minbleicreport_init(&p->br, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpp, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->effectivew, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->effectivebndl, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->effectivebndu, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->effectivec, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->effectivect, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->h, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->p, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _mcpdstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mcpdstate *dst = (mcpdstate*)_dst; + mcpdstate *src = (mcpdstate*)_src; + dst->n = src->n; + if( !ae_vector_init_copy(&dst->states, &src->states, _state, make_automatic) ) + return ae_false; + dst->npairs = src->npairs; + if( !ae_matrix_init_copy(&dst->data, &src->data, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->ec, &src->ec, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->c, &src->c, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ct, &src->ct, _state, make_automatic) ) + return ae_false; + dst->ccnt = src->ccnt; + if( !ae_vector_init_copy(&dst->pw, &src->pw, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->priorp, &src->priorp, _state, make_automatic) ) + return ae_false; + dst->regterm = src->regterm; + if( !_minbleicstate_init_copy(&dst->bs, &src->bs, _state, make_automatic) ) + return ae_false; + dst->repinneriterationscount = src->repinneriterationscount; + dst->repouteriterationscount = src->repouteriterationscount; + dst->repnfev = src->repnfev; + dst->repterminationtype = src->repterminationtype; + if( !_minbleicreport_init_copy(&dst->br, &src->br, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpp, &src->tmpp, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->effectivew, &src->effectivew, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->effectivebndl, &src->effectivebndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->effectivebndu, &src->effectivebndu, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->effectivec, &src->effectivec, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->effectivect, &src->effectivect, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->h, &src->h, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->p, &src->p, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _mcpdstate_clear(void* _p) +{ + mcpdstate *p = (mcpdstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->states); + ae_matrix_clear(&p->data); + ae_matrix_clear(&p->ec); + ae_matrix_clear(&p->bndl); + ae_matrix_clear(&p->bndu); + ae_matrix_clear(&p->c); + ae_vector_clear(&p->ct); + ae_vector_clear(&p->pw); + ae_matrix_clear(&p->priorp); + _minbleicstate_clear(&p->bs); + _minbleicreport_clear(&p->br); + ae_vector_clear(&p->tmpp); + ae_vector_clear(&p->effectivew); + ae_vector_clear(&p->effectivebndl); + ae_vector_clear(&p->effectivebndu); + ae_matrix_clear(&p->effectivec); + ae_vector_clear(&p->effectivect); + ae_vector_clear(&p->h); + ae_matrix_clear(&p->p); +} + + +void _mcpdstate_destroy(void* _p) +{ + mcpdstate *p = (mcpdstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->states); + ae_matrix_destroy(&p->data); + ae_matrix_destroy(&p->ec); + ae_matrix_destroy(&p->bndl); + ae_matrix_destroy(&p->bndu); + ae_matrix_destroy(&p->c); + ae_vector_destroy(&p->ct); + ae_vector_destroy(&p->pw); + ae_matrix_destroy(&p->priorp); + _minbleicstate_destroy(&p->bs); + _minbleicreport_destroy(&p->br); + ae_vector_destroy(&p->tmpp); + ae_vector_destroy(&p->effectivew); + ae_vector_destroy(&p->effectivebndl); + ae_vector_destroy(&p->effectivebndu); + ae_matrix_destroy(&p->effectivec); + ae_vector_destroy(&p->effectivect); + ae_vector_destroy(&p->h); + ae_matrix_destroy(&p->p); +} + + +ae_bool _mcpdreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mcpdreport *p = (mcpdreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _mcpdreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mcpdreport *dst = (mcpdreport*)_dst; + mcpdreport *src = (mcpdreport*)_src; + dst->inneriterationscount = src->inneriterationscount; + dst->outeriterationscount = src->outeriterationscount; + dst->nfev = src->nfev; + dst->terminationtype = src->terminationtype; + return ae_true; +} + + +void _mcpdreport_clear(void* _p) +{ + mcpdreport *p = (mcpdreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _mcpdreport_destroy(void* _p) +{ + mcpdreport *p = (mcpdreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* +Like MLPCreate0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate0(ae_int_t nin, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreate0(nin, nout, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreate1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreate1(nin, nhid, nout, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreate2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreate2(nin, nhid1, nhid2, nout, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateB0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb0(ae_int_t nin, + ae_int_t nout, + double b, + double d, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreateb0(nin, nout, b, d, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateB1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + double b, + double d, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreateb1(nin, nhid, nout, b, d, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateB2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + double b, + double d, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreateb2(nin, nhid1, nhid2, nout, b, d, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateR0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater0(ae_int_t nin, + ae_int_t nout, + double a, + double b, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreater0(nin, nout, a, b, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateR1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + double a, + double b, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreater1(nin, nhid, nout, a, b, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateR2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + double a, + double b, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreater2(nin, nhid1, nhid2, nout, a, b, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateC0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec0(ae_int_t nin, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreatec0(nin, nout, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateC1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreatec1(nin, nhid, nout, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Like MLPCreateC2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_frame _frame_block; + multilayerperceptron net; + + ae_frame_make(_state, &_frame_block); + _mlpensemble_clear(ensemble); + _multilayerperceptron_init(&net, _state, ae_true); + + mlpcreatec2(nin, nhid1, nhid2, nout, &net, _state); + mlpecreatefromnetwork(&net, ensemblesize, ensemble, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Creates ensemble from network. Only network geometry is copied. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatefromnetwork(multilayerperceptron* network, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_int_t i; + ae_int_t ccount; + ae_int_t wcount; + + _mlpensemble_clear(ensemble); + + ae_assert(ensemblesize>0, "MLPECreate: incorrect ensemble size!", _state); + + /* + * Copy network + */ + mlpcopy(network, &ensemble->network, _state); + + /* + * network properties + */ + if( mlpissoftmax(network, _state) ) + { + ccount = mlpgetinputscount(&ensemble->network, _state); + } + else + { + ccount = mlpgetinputscount(&ensemble->network, _state)+mlpgetoutputscount(&ensemble->network, _state); + } + wcount = mlpgetweightscount(&ensemble->network, _state); + ensemble->ensemblesize = ensemblesize; + + /* + * weights, means, sigmas + */ + ae_vector_set_length(&ensemble->weights, ensemblesize*wcount, _state); + ae_vector_set_length(&ensemble->columnmeans, ensemblesize*ccount, _state); + ae_vector_set_length(&ensemble->columnsigmas, ensemblesize*ccount, _state); + for(i=0; i<=ensemblesize*wcount-1; i++) + { + ensemble->weights.ptr.p_double[i] = ae_randomreal(_state)-0.5; + } + for(i=0; i<=ensemblesize-1; i++) + { + ae_v_move(&ensemble->columnmeans.ptr.p_double[i*ccount], 1, &network->columnmeans.ptr.p_double[0], 1, ae_v_len(i*ccount,(i+1)*ccount-1)); + ae_v_move(&ensemble->columnsigmas.ptr.p_double[i*ccount], 1, &network->columnsigmas.ptr.p_double[0], 1, ae_v_len(i*ccount,(i+1)*ccount-1)); + } + + /* + * temporaries, internal buffers + */ + ae_vector_set_length(&ensemble->y, mlpgetoutputscount(&ensemble->network, _state), _state); +} + + +/************************************************************************* +Copying of MLPEnsemble strucure + +INPUT PARAMETERS: + Ensemble1 - original + +OUTPUT PARAMETERS: + Ensemble2 - copy + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecopy(mlpensemble* ensemble1, + mlpensemble* ensemble2, + ae_state *_state) +{ + ae_int_t ccount; + ae_int_t wcount; + + _mlpensemble_clear(ensemble2); + + + /* + * Unload info + */ + if( mlpissoftmax(&ensemble1->network, _state) ) + { + ccount = mlpgetinputscount(&ensemble1->network, _state); + } + else + { + ccount = mlpgetinputscount(&ensemble1->network, _state)+mlpgetoutputscount(&ensemble1->network, _state); + } + wcount = mlpgetweightscount(&ensemble1->network, _state); + + /* + * Allocate space + */ + ae_vector_set_length(&ensemble2->weights, ensemble1->ensemblesize*wcount, _state); + ae_vector_set_length(&ensemble2->columnmeans, ensemble1->ensemblesize*ccount, _state); + ae_vector_set_length(&ensemble2->columnsigmas, ensemble1->ensemblesize*ccount, _state); + ae_vector_set_length(&ensemble2->y, mlpgetoutputscount(&ensemble1->network, _state), _state); + + /* + * Copy + */ + ensemble2->ensemblesize = ensemble1->ensemblesize; + ae_v_move(&ensemble2->weights.ptr.p_double[0], 1, &ensemble1->weights.ptr.p_double[0], 1, ae_v_len(0,ensemble1->ensemblesize*wcount-1)); + ae_v_move(&ensemble2->columnmeans.ptr.p_double[0], 1, &ensemble1->columnmeans.ptr.p_double[0], 1, ae_v_len(0,ensemble1->ensemblesize*ccount-1)); + ae_v_move(&ensemble2->columnsigmas.ptr.p_double[0], 1, &ensemble1->columnsigmas.ptr.p_double[0], 1, ae_v_len(0,ensemble1->ensemblesize*ccount-1)); + mlpcopy(&ensemble1->network, &ensemble2->network, _state); +} + + +/************************************************************************* +Randomization of MLP ensemble + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlperandomize(mlpensemble* ensemble, ae_state *_state) +{ + ae_int_t i; + ae_int_t wcount; + + + wcount = mlpgetweightscount(&ensemble->network, _state); + for(i=0; i<=ensemble->ensemblesize*wcount-1; i++) + { + ensemble->weights.ptr.p_double[i] = ae_randomreal(_state)-0.5; + } +} + + +/************************************************************************* +Return ensemble properties (number of inputs and outputs). + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeproperties(mlpensemble* ensemble, + ae_int_t* nin, + ae_int_t* nout, + ae_state *_state) +{ + + *nin = 0; + *nout = 0; + + *nin = mlpgetinputscount(&ensemble->network, _state); + *nout = mlpgetoutputscount(&ensemble->network, _state); +} + + +/************************************************************************* +Return normalization type (whether ensemble is SOFTMAX-normalized or not). + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool mlpeissoftmax(mlpensemble* ensemble, ae_state *_state) +{ + ae_bool result; + + + result = mlpissoftmax(&ensemble->network, _state); + return result; +} + + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + Ensemble- neural networks ensemble + X - input vector, array[0..NIn-1]. + Y - (possibly) preallocated buffer; if size of Y is less than + NOut, it will be reallocated. If it is large enough, it + is NOT reallocated, so we can save some time on reallocation. + + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeprocess(mlpensemble* ensemble, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + ae_int_t es; + ae_int_t wc; + ae_int_t cc; + double v; + ae_int_t nout; + + + if( y->cntnetwork, _state) ) + { + ae_vector_set_length(y, mlpgetoutputscount(&ensemble->network, _state), _state); + } + es = ensemble->ensemblesize; + wc = mlpgetweightscount(&ensemble->network, _state); + if( mlpissoftmax(&ensemble->network, _state) ) + { + cc = mlpgetinputscount(&ensemble->network, _state); + } + else + { + cc = mlpgetinputscount(&ensemble->network, _state)+mlpgetoutputscount(&ensemble->network, _state); + } + v = (double)1/(double)es; + nout = mlpgetoutputscount(&ensemble->network, _state); + for(i=0; i<=nout-1; i++) + { + y->ptr.p_double[i] = 0; + } + for(i=0; i<=es-1; i++) + { + ae_v_move(&ensemble->network.weights.ptr.p_double[0], 1, &ensemble->weights.ptr.p_double[i*wc], 1, ae_v_len(0,wc-1)); + ae_v_move(&ensemble->network.columnmeans.ptr.p_double[0], 1, &ensemble->columnmeans.ptr.p_double[i*cc], 1, ae_v_len(0,cc-1)); + ae_v_move(&ensemble->network.columnsigmas.ptr.p_double[0], 1, &ensemble->columnsigmas.ptr.p_double[i*cc], 1, ae_v_len(0,cc-1)); + mlpprocess(&ensemble->network, x, &ensemble->y, _state); + ae_v_addd(&y->ptr.p_double[0], 1, &ensemble->y.ptr.p_double[0], 1, ae_v_len(0,nout-1), v); + } +} + + +/************************************************************************* +'interactive' variant of MLPEProcess for languages like Python which +support constructs like "Y = MLPEProcess(LM,X)" and interactive mode of the +interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeprocessi(mlpensemble* ensemble, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + + ae_vector_clear(y); + + mlpeprocess(ensemble, x, y, _state); +} + + +/************************************************************************* +Calculation of all types of errors + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeallerrorsx(mlpensemble* ensemble, + /* Real */ ae_matrix* densexy, + sparsematrix* sparsexy, + ae_int_t datasetsize, + ae_int_t datasettype, + /* Integer */ ae_vector* idx, + ae_int_t subset0, + ae_int_t subset1, + ae_int_t subsettype, + ae_shared_pool* buf, + modelerrors* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t nin; + ae_int_t nout; + ae_bool iscls; + ae_int_t srcidx; + mlpbuffers *pbuf; + ae_smart_ptr _pbuf; + modelerrors rep0; + modelerrors rep1; + + ae_frame_make(_state, &_frame_block); + ae_smart_ptr_init(&_pbuf, (void**)&pbuf, _state, ae_true); + _modelerrors_init(&rep0, _state, ae_true); + _modelerrors_init(&rep1, _state, ae_true); + + + /* + * Get network information + */ + nin = mlpgetinputscount(&ensemble->network, _state); + nout = mlpgetoutputscount(&ensemble->network, _state); + iscls = mlpissoftmax(&ensemble->network, _state); + + /* + * Retrieve buffer, prepare, process data, recycle buffer + */ + ae_shared_pool_retrieve(buf, &_pbuf, _state); + if( iscls ) + { + dserrallocate(nout, &pbuf->tmp0, _state); + } + else + { + dserrallocate(-nout, &pbuf->tmp0, _state); + } + rvectorsetlengthatleast(&pbuf->x, nin, _state); + rvectorsetlengthatleast(&pbuf->y, nout, _state); + rvectorsetlengthatleast(&pbuf->desiredy, nout, _state); + for(i=subset0; i<=subset1-1; i++) + { + srcidx = -1; + if( subsettype==0 ) + { + srcidx = i; + } + if( subsettype==1 ) + { + srcidx = idx->ptr.p_int[i]; + } + ae_assert(srcidx>=0, "MLPEAllErrorsX: internal error", _state); + if( datasettype==0 ) + { + ae_v_move(&pbuf->x.ptr.p_double[0], 1, &densexy->ptr.pp_double[srcidx][0], 1, ae_v_len(0,nin-1)); + } + if( datasettype==1 ) + { + sparsegetrow(sparsexy, srcidx, &pbuf->x, _state); + } + mlpeprocess(ensemble, &pbuf->x, &pbuf->y, _state); + if( mlpissoftmax(&ensemble->network, _state) ) + { + if( datasettype==0 ) + { + pbuf->desiredy.ptr.p_double[0] = densexy->ptr.pp_double[srcidx][nin]; + } + if( datasettype==1 ) + { + pbuf->desiredy.ptr.p_double[0] = sparseget(sparsexy, srcidx, nin, _state); + } + } + else + { + if( datasettype==0 ) + { + ae_v_move(&pbuf->desiredy.ptr.p_double[0], 1, &densexy->ptr.pp_double[srcidx][nin], 1, ae_v_len(0,nout-1)); + } + if( datasettype==1 ) + { + for(j=0; j<=nout-1; j++) + { + pbuf->desiredy.ptr.p_double[j] = sparseget(sparsexy, srcidx, nin+j, _state); + } + } + } + dserraccumulate(&pbuf->tmp0, &pbuf->y, &pbuf->desiredy, _state); + } + dserrfinish(&pbuf->tmp0, _state); + rep->relclserror = pbuf->tmp0.ptr.p_double[0]; + rep->avgce = pbuf->tmp0.ptr.p_double[1]/ae_log(2, _state); + rep->rmserror = pbuf->tmp0.ptr.p_double[2]; + rep->avgerror = pbuf->tmp0.ptr.p_double[3]; + rep->avgrelerror = pbuf->tmp0.ptr.p_double[4]; + ae_shared_pool_recycle(buf, &_pbuf, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Calculation of all types of errors on dataset given by sparse matrix + + -- ALGLIB -- + Copyright 10.09.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpeallerrorssparse(mlpensemble* ensemble, + sparsematrix* xy, + ae_int_t npoints, + double* relcls, + double* avgce, + double* rms, + double* avg, + double* avgrel, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector buf; + ae_vector workx; + ae_vector y; + ae_vector dy; + ae_int_t nin; + ae_int_t nout; + + ae_frame_make(_state, &_frame_block); + *relcls = 0; + *avgce = 0; + *rms = 0; + *avg = 0; + *avgrel = 0; + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&workx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); + + nin = mlpgetinputscount(&ensemble->network, _state); + nout = mlpgetoutputscount(&ensemble->network, _state); + if( mlpissoftmax(&ensemble->network, _state) ) + { + ae_vector_set_length(&dy, 1, _state); + dserrallocate(nout, &buf, _state); + } + else + { + ae_vector_set_length(&dy, nout, _state); + dserrallocate(-nout, &buf, _state); + } + for(i=0; i<=npoints-1; i++) + { + sparsegetrow(xy, i, &workx, _state); + mlpeprocess(ensemble, &workx, &y, _state); + if( mlpissoftmax(&ensemble->network, _state) ) + { + dy.ptr.p_double[0] = workx.ptr.p_double[nin]; + } + else + { + ae_v_move(&dy.ptr.p_double[0], 1, &workx.ptr.p_double[nin], 1, ae_v_len(0,nout-1)); + } + dserraccumulate(&buf, &y, &dy, _state); + } + dserrfinish(&buf, _state); + *relcls = buf.ptr.p_double[0]; + *avgce = buf.ptr.p_double[1]; + *rms = buf.ptr.p_double[2]; + *avg = buf.ptr.p_double[3]; + *avgrel = buf.ptr.p_double[4]; + ae_frame_leave(_state); +} + + +/************************************************************************* +Relative classification error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + percent of incorrectly classified cases. + Works both for classifier betwork and for regression networks which +are used as classifiers. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlperelclserror(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + modelerrors rep; + double result; + + ae_frame_make(_state, &_frame_block); + _modelerrors_init(&rep, _state, ae_true); + + mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); + result = rep.relclserror; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + CrossEntropy/(NPoints*LN(2)). + Zero if ensemble solves regression task. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgce(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + modelerrors rep; + double result; + + ae_frame_make(_state, &_frame_block); + _modelerrors_init(&rep, _state, ae_true); + + mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); + result = rep.avgce; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + root mean square error. + Its meaning for regression task is obvious. As for classification task +RMS error means error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpermserror(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + modelerrors rep; + double result; + + ae_frame_make(_state, &_frame_block); + _modelerrors_init(&rep, _state, ae_true); + + mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); + result = rep.rmserror; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for classification task +it means average error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgerror(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + modelerrors rep; + double result; + + ae_frame_make(_state, &_frame_block); + _modelerrors_init(&rep, _state, ae_true); + + mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); + result = rep.avgerror; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Average relative error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for classification task +it means average relative error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgrelerror(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_frame _frame_block; + modelerrors rep; + double result; + + ae_frame_make(_state, &_frame_block); + _modelerrors_init(&rep, _state, ae_true); + + mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &rep, _state); + result = rep.avgrelerror; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Serializer: allocation + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpealloc(ae_serializer* s, mlpensemble* ensemble, ae_state *_state) +{ + + + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + allocrealarray(s, &ensemble->weights, -1, _state); + allocrealarray(s, &ensemble->columnmeans, -1, _state); + allocrealarray(s, &ensemble->columnsigmas, -1, _state); + mlpalloc(s, &ensemble->network, _state); +} + + +/************************************************************************* +Serializer: serialization + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpeserialize(ae_serializer* s, + mlpensemble* ensemble, + ae_state *_state) +{ + + + ae_serializer_serialize_int(s, getmlpeserializationcode(_state), _state); + ae_serializer_serialize_int(s, mlpe_mlpefirstversion, _state); + ae_serializer_serialize_int(s, ensemble->ensemblesize, _state); + serializerealarray(s, &ensemble->weights, -1, _state); + serializerealarray(s, &ensemble->columnmeans, -1, _state); + serializerealarray(s, &ensemble->columnsigmas, -1, _state); + mlpserialize(s, &ensemble->network, _state); +} + + +/************************************************************************* +Serializer: unserialization + + -- ALGLIB -- + Copyright 14.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpeunserialize(ae_serializer* s, + mlpensemble* ensemble, + ae_state *_state) +{ + ae_int_t i0; + ae_int_t i1; + + _mlpensemble_clear(ensemble); + + + /* + * check correctness of header + */ + ae_serializer_unserialize_int(s, &i0, _state); + ae_assert(i0==getmlpeserializationcode(_state), "MLPEUnserialize: stream header corrupted", _state); + ae_serializer_unserialize_int(s, &i1, _state); + ae_assert(i1==mlpe_mlpefirstversion, "MLPEUnserialize: stream header corrupted", _state); + + /* + * Create network + */ + ae_serializer_unserialize_int(s, &ensemble->ensemblesize, _state); + unserializerealarray(s, &ensemble->weights, _state); + unserializerealarray(s, &ensemble->columnmeans, _state); + unserializerealarray(s, &ensemble->columnsigmas, _state); + mlpunserialize(s, &ensemble->network, _state); + + /* + * Allocate termoraries + */ + ae_vector_set_length(&ensemble->y, mlpgetoutputscount(&ensemble->network, _state), _state); +} + + +ae_bool _mlpensemble_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mlpensemble *p = (mlpensemble*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->weights, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->columnmeans, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->columnsigmas, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_multilayerperceptron_init(&p->network, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _mlpensemble_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mlpensemble *dst = (mlpensemble*)_dst; + mlpensemble *src = (mlpensemble*)_src; + dst->ensemblesize = src->ensemblesize; + if( !ae_vector_init_copy(&dst->weights, &src->weights, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->columnmeans, &src->columnmeans, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->columnsigmas, &src->columnsigmas, _state, make_automatic) ) + return ae_false; + if( !_multilayerperceptron_init_copy(&dst->network, &src->network, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _mlpensemble_clear(void* _p) +{ + mlpensemble *p = (mlpensemble*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->weights); + ae_vector_clear(&p->columnmeans); + ae_vector_clear(&p->columnsigmas); + _multilayerperceptron_clear(&p->network); + ae_vector_clear(&p->y); +} + + +void _mlpensemble_destroy(void* _p) +{ + mlpensemble *p = (mlpensemble*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->weights); + ae_vector_destroy(&p->columnmeans); + ae_vector_destroy(&p->columnsigmas); + _multilayerperceptron_destroy(&p->network); + ae_vector_destroy(&p->y); +} + + + + +/************************************************************************* +Neural network training using modified Levenberg-Marquardt with exact +Hessian calculation and regularization. Subroutine trains neural network +with restarts from random positions. Algorithm is well suited for small +and medium scale problems (hundreds of weights). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts from random position, >0. + If you don't know what Restarts to choose, use 2. + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -9, if internal matrix inverse subroutine failed + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlptrainlm(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t* info, + mlpreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double lmsteptol; + ae_int_t i; + ae_int_t k; + double v; + double e; + double enew; + double xnorm2; + double stepnorm; + ae_vector g; + ae_vector d; + ae_matrix h; + ae_matrix hmod; + ae_matrix z; + ae_bool spd; + double nu; + double lambdav; + double lambdaup; + double lambdadown; + minlbfgsreport internalrep; + minlbfgsstate state; + ae_vector x; + ae_vector y; + ae_vector wbase; + ae_vector wdir; + ae_vector wt; + ae_vector wx; + ae_int_t pass; + ae_vector wbest; + double ebest; + ae_int_t invinfo; + matinvreport invrep; + ae_int_t solverinfo; + densesolverreport solverrep; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _mlpreport_clear(rep); + ae_vector_init(&g, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&h, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&hmod, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); + _minlbfgsreport_init(&internalrep, _state, ae_true); + _minlbfgsstate_init(&state, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wbase, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wdir, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wt, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wbest, 0, DT_REAL, _state, ae_true); + _matinvreport_init(&invrep, _state, ae_true); + _densesolverreport_init(&solverrep, _state, ae_true); + + mlpproperties(network, &nin, &nout, &wcount, _state); + lambdaup = 10; + lambdadown = 0.3; + lmsteptol = 0.001; + + /* + * Test for inputs + */ + if( npoints<=0||restarts<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( mlpissoftmax(network, _state) ) + { + for(i=0; i<=npoints-1; i++) + { + if( ae_round(xy->ptr.pp_double[i][nin], _state)<0||ae_round(xy->ptr.pp_double[i][nin], _state)>=nout ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + } + decay = ae_maxreal(decay, mlptrain_mindecay, _state); + *info = 2; + + /* + * Initialize data + */ + rep->ngrad = 0; + rep->nhess = 0; + rep->ncholesky = 0; + + /* + * General case. + * Prepare task and network. Allocate space. + */ + mlpinitpreprocessor(network, xy, npoints, _state); + ae_vector_set_length(&g, wcount-1+1, _state); + ae_matrix_set_length(&h, wcount-1+1, wcount-1+1, _state); + ae_matrix_set_length(&hmod, wcount-1+1, wcount-1+1, _state); + ae_vector_set_length(&wbase, wcount-1+1, _state); + ae_vector_set_length(&wdir, wcount-1+1, _state); + ae_vector_set_length(&wbest, wcount-1+1, _state); + ae_vector_set_length(&wt, wcount-1+1, _state); + ae_vector_set_length(&wx, wcount-1+1, _state); + ebest = ae_maxrealnumber; + + /* + * Multiple passes + */ + for(pass=1; pass<=restarts; pass++) + { + + /* + * Initialize weights + */ + mlprandomize(network, _state); + + /* + * First stage of the hybrid algorithm: LBFGS + */ + ae_v_move(&wbase.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + minlbfgscreate(wcount, ae_minint(wcount, 5, _state), &wbase, &state, _state); + minlbfgssetcond(&state, 0, 0, 0, ae_maxint(25, wcount, _state), _state); + while(minlbfgsiteration(&state, _state)) + { + + /* + * gradient + */ + ae_v_move(&network->weights.ptr.p_double[0], 1, &state.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + mlpgradbatch(network, xy, npoints, &state.f, &state.g, _state); + + /* + * weight decay + */ + v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + state.f = state.f+0.5*decay*v; + ae_v_addd(&state.g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + + /* + * next iteration + */ + rep->ngrad = rep->ngrad+1; + } + minlbfgsresults(&state, &wbase, &internalrep, _state); + ae_v_move(&network->weights.ptr.p_double[0], 1, &wbase.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + + /* + * Second stage of the hybrid algorithm: LM + * + * Initialize H with identity matrix, + * G with gradient, + * E with regularized error. + */ + mlphessianbatch(network, xy, npoints, &e, &g, &h, _state); + v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = e+0.5*decay*v; + ae_v_addd(&g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + for(k=0; k<=wcount-1; k++) + { + h.ptr.pp_double[k][k] = h.ptr.pp_double[k][k]+decay; + } + rep->nhess = rep->nhess+1; + lambdav = 0.001; + nu = 2; + for(;;) + { + + /* + * 1. HMod = H+lambda*I + * 2. Try to solve (H+Lambda*I)*dx = -g. + * Increase lambda if left part is not positive definite. + */ + for(i=0; i<=wcount-1; i++) + { + ae_v_move(&hmod.ptr.pp_double[i][0], 1, &h.ptr.pp_double[i][0], 1, ae_v_len(0,wcount-1)); + hmod.ptr.pp_double[i][i] = hmod.ptr.pp_double[i][i]+lambdav; + } + spd = spdmatrixcholesky(&hmod, wcount, ae_true, _state); + rep->ncholesky = rep->ncholesky+1; + if( !spd ) + { + lambdav = lambdav*lambdaup*nu; + nu = nu*2; + continue; + } + spdmatrixcholeskysolve(&hmod, wcount, ae_true, &g, &solverinfo, &solverrep, &wdir, _state); + if( solverinfo<0 ) + { + lambdav = lambdav*lambdaup*nu; + nu = nu*2; + continue; + } + ae_v_muld(&wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1), -1); + + /* + * Lambda found. + * 1. Save old w in WBase + * 1. Test some stopping criterions + * 2. If error(w+wdir)>error(w), increase lambda + */ + ae_v_add(&network->weights.ptr.p_double[0], 1, &wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + xnorm2 = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + stepnorm = ae_v_dotproduct(&wdir.ptr.p_double[0], 1, &wdir.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + stepnorm = ae_sqrt(stepnorm, _state); + enew = mlperror(network, xy, npoints, _state)+0.5*decay*xnorm2; + if( ae_fp_less(stepnorm,lmsteptol*(1+ae_sqrt(xnorm2, _state))) ) + { + break; + } + if( ae_fp_greater(enew,e) ) + { + lambdav = lambdav*lambdaup*nu; + nu = nu*2; + continue; + } + + /* + * Optimize using inv(cholesky(H)) as preconditioner + */ + rmatrixtrinverse(&hmod, wcount, ae_true, ae_false, &invinfo, &invrep, _state); + if( invinfo<=0 ) + { + + /* + * if matrix can't be inverted then exit with errors + * TODO: make WCount steps in direction suggested by HMod + */ + *info = -9; + ae_frame_leave(_state); + return; + } + ae_v_move(&wbase.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + for(i=0; i<=wcount-1; i++) + { + wt.ptr.p_double[i] = 0; + } + minlbfgscreatex(wcount, wcount, &wt, 1, 0.0, &state, _state); + minlbfgssetcond(&state, 0, 0, 0, 5, _state); + while(minlbfgsiteration(&state, _state)) + { + + /* + * gradient + */ + for(i=0; i<=wcount-1; i++) + { + v = ae_v_dotproduct(&state.x.ptr.p_double[i], 1, &hmod.ptr.pp_double[i][i], 1, ae_v_len(i,wcount-1)); + network->weights.ptr.p_double[i] = wbase.ptr.p_double[i]+v; + } + mlpgradbatch(network, xy, npoints, &state.f, &g, _state); + for(i=0; i<=wcount-1; i++) + { + state.g.ptr.p_double[i] = 0; + } + for(i=0; i<=wcount-1; i++) + { + v = g.ptr.p_double[i]; + ae_v_addd(&state.g.ptr.p_double[i], 1, &hmod.ptr.pp_double[i][i], 1, ae_v_len(i,wcount-1), v); + } + + /* + * weight decay + * grad(x'*x) = A'*(x0+A*t) + */ + v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + state.f = state.f+0.5*decay*v; + for(i=0; i<=wcount-1; i++) + { + v = decay*network->weights.ptr.p_double[i]; + ae_v_addd(&state.g.ptr.p_double[i], 1, &hmod.ptr.pp_double[i][i], 1, ae_v_len(i,wcount-1), v); + } + + /* + * next iteration + */ + rep->ngrad = rep->ngrad+1; + } + minlbfgsresults(&state, &wt, &internalrep, _state); + + /* + * Accept new position. + * Calculate Hessian + */ + for(i=0; i<=wcount-1; i++) + { + v = ae_v_dotproduct(&wt.ptr.p_double[i], 1, &hmod.ptr.pp_double[i][i], 1, ae_v_len(i,wcount-1)); + network->weights.ptr.p_double[i] = wbase.ptr.p_double[i]+v; + } + mlphessianbatch(network, xy, npoints, &e, &g, &h, _state); + v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = e+0.5*decay*v; + ae_v_addd(&g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + for(k=0; k<=wcount-1; k++) + { + h.ptr.pp_double[k][k] = h.ptr.pp_double[k][k]+decay; + } + rep->nhess = rep->nhess+1; + + /* + * Update lambda + */ + lambdav = lambdav*lambdadown; + nu = 2; + } + + /* + * update WBest + */ + v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = 0.5*decay*v+mlperror(network, xy, npoints, _state); + if( ae_fp_less(e,ebest) ) + { + ebest = e; + ae_v_move(&wbest.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + } + } + + /* + * copy WBest to output + */ + ae_v_move(&network->weights.ptr.p_double[0], 1, &wbest.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Neural network training using L-BFGS algorithm with regularization. +Subroutine trains neural network with restarts from random positions. +Algorithm is well suited for problems of any dimensionality (memory +requirements and step complexity are linear by weights number). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts from random position, >0. + If you don't know what Restarts to choose, use 2. + WStep - stopping criterion. Algorithm stops if step size is + less than WStep. Recommended value - 0.01. Zero step + size means stopping after MaxIts iterations. + MaxIts - stopping criterion. Algorithm stops after MaxIts + iterations (NOT gradient calculations). Zero MaxIts + means stopping when step is sufficiently small. + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -8, if both WStep=0 and MaxIts=0 + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlptrainlbfgs(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + double wstep, + ae_int_t maxits, + ae_int_t* info, + mlpreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t pass; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_vector w; + ae_vector wbest; + double e; + double v; + double ebest; + minlbfgsreport internalrep; + minlbfgsstate state; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _mlpreport_clear(rep); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wbest, 0, DT_REAL, _state, ae_true); + _minlbfgsreport_init(&internalrep, _state, ae_true); + _minlbfgsstate_init(&state, _state, ae_true); + + + /* + * Test inputs, parse flags, read network geometry + */ + if( ae_fp_eq(wstep,0)&&maxits==0 ) + { + *info = -8; + ae_frame_leave(_state); + return; + } + if( ((npoints<=0||restarts<1)||ae_fp_less(wstep,0))||maxits<0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + mlpproperties(network, &nin, &nout, &wcount, _state); + if( mlpissoftmax(network, _state) ) + { + for(i=0; i<=npoints-1; i++) + { + if( ae_round(xy->ptr.pp_double[i][nin], _state)<0||ae_round(xy->ptr.pp_double[i][nin], _state)>=nout ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + } + decay = ae_maxreal(decay, mlptrain_mindecay, _state); + *info = 2; + + /* + * Prepare + */ + mlpinitpreprocessor(network, xy, npoints, _state); + ae_vector_set_length(&w, wcount-1+1, _state); + ae_vector_set_length(&wbest, wcount-1+1, _state); + ebest = ae_maxrealnumber; + + /* + * Multiple starts + */ + rep->ncholesky = 0; + rep->nhess = 0; + rep->ngrad = 0; + for(pass=1; pass<=restarts; pass++) + { + + /* + * Process + */ + mlprandomize(network, _state); + ae_v_move(&w.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + minlbfgscreate(wcount, ae_minint(wcount, 10, _state), &w, &state, _state); + minlbfgssetcond(&state, 0.0, 0.0, wstep, maxits, _state); + while(minlbfgsiteration(&state, _state)) + { + ae_v_move(&network->weights.ptr.p_double[0], 1, &state.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + mlpgradnbatch(network, xy, npoints, &state.f, &state.g, _state); + v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + state.f = state.f+0.5*decay*v; + ae_v_addd(&state.g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + rep->ngrad = rep->ngrad+1; + } + minlbfgsresults(&state, &w, &internalrep, _state); + ae_v_move(&network->weights.ptr.p_double[0], 1, &w.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + + /* + * Compare with best + */ + v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = mlperrorn(network, xy, npoints, _state)+0.5*decay*v; + if( ae_fp_less(e,ebest) ) + { + ae_v_move(&wbest.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + ebest = e; + } + } + + /* + * The best network + */ + ae_v_move(&network->weights.ptr.p_double[0], 1, &wbest.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Neural network training using early stopping (base algorithm - L-BFGS with +regularization). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + TrnXY - training set + TrnSize - training set size, TrnSize>0 + ValXY - validation set + ValSize - validation set size, ValSize>0 + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts, either: + * strictly positive number - algorithm make specified + number of restarts from random position. + * -1, in which case algorithm makes exactly one run + from the initial state of the network (no randomization). + If you don't know what Restarts to choose, choose one + one the following: + * -1 (deterministic start) + * +1 (one random restart) + * +5 (moderate amount of random restarts) + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1, ...). + * 2, task has been solved, stopping criterion met - + sufficiently small step size. Not expected (we + use EARLY stopping) but possible and not an + error. + * 6, task has been solved, stopping criterion met - + increasing of validation set error. + Rep - training report + +NOTE: + +Algorithm stops if validation set error increases for a long enough or +step size is small enought (there are task where validation set may +decrease for eternity). In any case solution returned corresponds to the +minimum of validation set error. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlptraines(multilayerperceptron* network, + /* Real */ ae_matrix* trnxy, + ae_int_t trnsize, + /* Real */ ae_matrix* valxy, + ae_int_t valsize, + double decay, + ae_int_t restarts, + ae_int_t* info, + mlpreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t pass; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_vector w; + ae_vector wbest; + double e; + double v; + double ebest; + ae_vector wfinal; + double efinal; + ae_int_t itcnt; + ae_int_t itbest; + minlbfgsreport internalrep; + minlbfgsstate state; + double wstep; + ae_bool needrandomization; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _mlpreport_clear(rep); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wbest, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wfinal, 0, DT_REAL, _state, ae_true); + _minlbfgsreport_init(&internalrep, _state, ae_true); + _minlbfgsstate_init(&state, _state, ae_true); + + wstep = 0.001; + + /* + * Test inputs, parse flags, read network geometry + */ + if( ((trnsize<=0||valsize<=0)||(restarts<1&&restarts!=-1))||ae_fp_less(decay,0) ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( restarts==-1 ) + { + needrandomization = ae_false; + restarts = 1; + } + else + { + needrandomization = ae_true; + } + mlpproperties(network, &nin, &nout, &wcount, _state); + if( mlpissoftmax(network, _state) ) + { + for(i=0; i<=trnsize-1; i++) + { + if( ae_round(trnxy->ptr.pp_double[i][nin], _state)<0||ae_round(trnxy->ptr.pp_double[i][nin], _state)>=nout ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + for(i=0; i<=valsize-1; i++) + { + if( ae_round(valxy->ptr.pp_double[i][nin], _state)<0||ae_round(valxy->ptr.pp_double[i][nin], _state)>=nout ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + } + *info = 2; + + /* + * Prepare + */ + mlpinitpreprocessor(network, trnxy, trnsize, _state); + ae_vector_set_length(&w, wcount-1+1, _state); + ae_vector_set_length(&wbest, wcount-1+1, _state); + ae_vector_set_length(&wfinal, wcount-1+1, _state); + efinal = ae_maxrealnumber; + for(i=0; i<=wcount-1; i++) + { + wfinal.ptr.p_double[i] = 0; + } + + /* + * Multiple starts + */ + rep->ncholesky = 0; + rep->nhess = 0; + rep->ngrad = 0; + for(pass=1; pass<=restarts; pass++) + { + + /* + * Process + */ + if( needrandomization ) + { + mlprandomize(network, _state); + } + ebest = mlperror(network, valxy, valsize, _state); + ae_v_move(&wbest.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + itbest = 0; + itcnt = 0; + ae_v_move(&w.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + minlbfgscreate(wcount, ae_minint(wcount, 10, _state), &w, &state, _state); + minlbfgssetcond(&state, 0.0, 0.0, wstep, 0, _state); + minlbfgssetxrep(&state, ae_true, _state); + while(minlbfgsiteration(&state, _state)) + { + + /* + * Calculate gradient + */ + if( state.needfg ) + { + ae_v_move(&network->weights.ptr.p_double[0], 1, &state.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + mlpgradnbatch(network, trnxy, trnsize, &state.f, &state.g, _state); + v = ae_v_dotproduct(&network->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + state.f = state.f+0.5*decay*v; + ae_v_addd(&state.g.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + rep->ngrad = rep->ngrad+1; + } + + /* + * Validation set + */ + if( state.xupdated ) + { + ae_v_move(&network->weights.ptr.p_double[0], 1, &state.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + e = mlperror(network, valxy, valsize, _state); + if( ae_fp_less(e,ebest) ) + { + ebest = e; + ae_v_move(&wbest.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + itbest = itcnt; + } + if( itcnt>30&&ae_fp_greater(itcnt,1.5*itbest) ) + { + *info = 6; + break; + } + itcnt = itcnt+1; + } + } + minlbfgsresults(&state, &w, &internalrep, _state); + + /* + * Compare with final answer + */ + if( ae_fp_less(ebest,efinal) ) + { + ae_v_move(&wfinal.ptr.p_double[0], 1, &wbest.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + efinal = ebest; + } + } + + /* + * The best network + */ + ae_v_move(&network->weights.ptr.p_double[0], 1, &wfinal.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Cross-validation estimate of generalization error. + +Base algorithm - L-BFGS. + +INPUT PARAMETERS: + Network - neural network with initialized geometry. Network is + not changed during cross-validation - it is used only + as a representative of its architecture. + XY - training set. + SSize - training set size + Decay - weight decay, same as in MLPTrainLBFGS + Restarts - number of restarts, >0. + restarts are counted for each partition separately, so + total number of restarts will be Restarts*FoldsCount. + WStep - stopping criterion, same as in MLPTrainLBFGS + MaxIts - stopping criterion, same as in MLPTrainLBFGS + FoldsCount - number of folds in k-fold cross-validation, + 2<=FoldsCount<=SSize. + recommended value: 10. + +OUTPUT PARAMETERS: + Info - return code, same as in MLPTrainLBFGS + Rep - report, same as in MLPTrainLM/MLPTrainLBFGS + CVRep - generalization error estimates + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcvlbfgs(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + double wstep, + ae_int_t maxits, + ae_int_t foldscount, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* cvrep, + ae_state *_state) +{ + + *info = 0; + _mlpreport_clear(rep); + _mlpcvreport_clear(cvrep); + + mlptrain_mlpkfoldcvgeneral(network, xy, npoints, decay, restarts, foldscount, ae_false, wstep, maxits, info, rep, cvrep, _state); +} + + +/************************************************************************* +Cross-validation estimate of generalization error. + +Base algorithm - Levenberg-Marquardt. + +INPUT PARAMETERS: + Network - neural network with initialized geometry. Network is + not changed during cross-validation - it is used only + as a representative of its architecture. + XY - training set. + SSize - training set size + Decay - weight decay, same as in MLPTrainLBFGS + Restarts - number of restarts, >0. + restarts are counted for each partition separately, so + total number of restarts will be Restarts*FoldsCount. + FoldsCount - number of folds in k-fold cross-validation, + 2<=FoldsCount<=SSize. + recommended value: 10. + +OUTPUT PARAMETERS: + Info - return code, same as in MLPTrainLBFGS + Rep - report, same as in MLPTrainLM/MLPTrainLBFGS + CVRep - generalization error estimates + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcvlm(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t foldscount, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* cvrep, + ae_state *_state) +{ + + *info = 0; + _mlpreport_clear(rep); + _mlpcvreport_clear(cvrep); + + mlptrain_mlpkfoldcvgeneral(network, xy, npoints, decay, restarts, foldscount, ae_true, 0.0, 0, info, rep, cvrep, _state); +} + + +/************************************************************************* +This function estimates generalization error using cross-validation on the +current dataset with current training settings. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * FoldsCount cross-validation rounds (always) + ! * NRestarts training sessions performed within each of + ! cross-validation rounds (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. Network is not changed during cross- + validation and is not trained - it is used only as + representative of its architecture. I.e., we estimate + generalization properties of ARCHITECTURE, not some + specific network. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that for each cross-validation + round specified number of random restarts is + performed, with best network being chosen after + training. + * NRestarts=0 is same as NRestarts=1 + FoldsCount - number of folds in k-fold cross-validation: + * 2<=FoldsCount<=size of dataset + * recommended value: 10. + * values larger than dataset size will be silently + truncated down to dataset size + +OUTPUT PARAMETERS: + Rep - structure which contains cross-validation estimates: + * Rep.RelCLSError - fraction of misclassified cases. + * Rep.AvgCE - acerage cross-entropy + * Rep.RMSError - root-mean-square error + * Rep.AvgError - average error + * Rep.AvgRelError - average relative error + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + or subset with only one point was given, zeros are returned as + estimates. + +NOTE: this method performs FoldsCount cross-validation rounds, each one + with NRestarts random starts. Thus, FoldsCount*NRestarts networks + are trained in total. + +NOTE: Rep.RelCLSError/Rep.AvgCE are zero on regression problems. + +NOTE: on classification problems Rep.RMSError/Rep.AvgError/Rep.AvgRelError + contain errors in prediction of posterior probabilities. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcv(mlptrainer* s, + multilayerperceptron* network, + ae_int_t nrestarts, + ae_int_t foldscount, + mlpreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_shared_pool pooldatacv; + mlpparallelizationcv datacv; + mlpparallelizationcv *sdatacv; + ae_smart_ptr _sdatacv; + ae_matrix cvy; + ae_vector folds; + ae_vector buf; + ae_vector dy; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t rowsize; + ae_int_t ntype; + ae_int_t ttype; + ae_int_t i; + ae_int_t j; + ae_int_t k; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + _mlpreport_clear(rep); + ae_shared_pool_init(&pooldatacv, _state, ae_true); + _mlpparallelizationcv_init(&datacv, _state, ae_true); + ae_smart_ptr_init(&_sdatacv, (void**)&sdatacv, _state, ae_true); + ae_matrix_init(&cvy, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&folds, 0, DT_INT, _state, ae_true); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); + _hqrndstate_init(&rs, _state, ae_true); + + if( !mlpissoftmax(network, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + if( s->rcpar ) + { + ttype = 0; + } + else + { + ttype = 1; + } + ae_assert(ntype==ttype, "MLPKFoldCV: type of input network is not similar to network type in trainer object", _state); + ae_assert(s->npoints>=0, "MLPKFoldCV: possible trainer S is not initialized(S.NPoints<0)", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + ae_assert(s->nin==nin, "MLPKFoldCV: number of inputs in trainer is not equal to number of inputs in network", _state); + ae_assert(s->nout==nout, "MLPKFoldCV: number of outputs in trainer is not equal to number of outputs in network", _state); + ae_assert(nrestarts>=0, "MLPKFoldCV: NRestarts<0", _state); + ae_assert(foldscount>=2, "MLPKFoldCV: FoldsCount<2", _state); + if( foldscount>s->npoints ) + { + foldscount = s->npoints; + } + rep->relclserror = 0; + rep->avgce = 0; + rep->rmserror = 0; + rep->avgerror = 0; + rep->avgrelerror = 0; + hqrndrandomize(&rs, _state); + rep->ngrad = 0; + rep->nhess = 0; + rep->ncholesky = 0; + if( s->npoints==0||s->npoints==1 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Read network geometry, test parameters + */ + if( s->rcpar ) + { + rowsize = nin+nout; + ae_vector_set_length(&dy, nout, _state); + dserrallocate(-nout, &buf, _state); + } + else + { + rowsize = nin+1; + ae_vector_set_length(&dy, 1, _state); + dserrallocate(nout, &buf, _state); + } + + /* + * Folds + */ + ae_vector_set_length(&folds, s->npoints, _state); + for(i=0; i<=s->npoints-1; i++) + { + folds.ptr.p_int[i] = i*foldscount/s->npoints; + } + for(i=0; i<=s->npoints-2; i++) + { + j = i+hqrnduniformi(&rs, s->npoints-i, _state); + if( j!=i ) + { + k = folds.ptr.p_int[i]; + folds.ptr.p_int[i] = folds.ptr.p_int[j]; + folds.ptr.p_int[j] = k; + } + } + ae_matrix_set_length(&cvy, s->npoints, nout, _state); + + /* + * Initialize SEED-value for shared pool + */ + datacv.ngrad = 0; + mlpcopy(network, &datacv.network, _state); + ae_vector_set_length(&datacv.subset, s->npoints, _state); + ae_vector_set_length(&datacv.xyrow, rowsize, _state); + ae_vector_set_length(&datacv.y, nout, _state); + + /* + * Create shared pool + */ + ae_shared_pool_set_seed(&pooldatacv, &datacv, sizeof(datacv), _mlpparallelizationcv_init, _mlpparallelizationcv_init_copy, _mlpparallelizationcv_destroy, _state); + + /* + * Parallelization + */ + mlptrain_mthreadcv(s, rowsize, nrestarts, &folds, 0, foldscount, &cvy, &pooldatacv, _state); + + /* + * Calculate value for NGrad + */ + ae_shared_pool_first_recycled(&pooldatacv, &_sdatacv, _state); + while(sdatacv!=NULL) + { + rep->ngrad = rep->ngrad+sdatacv->ngrad; + ae_shared_pool_next_recycled(&pooldatacv, &_sdatacv, _state); + } + + /* + * Connect of results and calculate cross-validation error + */ + for(i=0; i<=s->npoints-1; i++) + { + if( s->datatype==0 ) + { + ae_v_move(&datacv.xyrow.ptr.p_double[0], 1, &s->densexy.ptr.pp_double[i][0], 1, ae_v_len(0,rowsize-1)); + } + if( s->datatype==1 ) + { + sparsegetrow(&s->sparsexy, i, &datacv.xyrow, _state); + } + ae_v_move(&datacv.y.ptr.p_double[0], 1, &cvy.ptr.pp_double[i][0], 1, ae_v_len(0,nout-1)); + if( s->rcpar ) + { + ae_v_move(&dy.ptr.p_double[0], 1, &datacv.xyrow.ptr.p_double[nin], 1, ae_v_len(0,nout-1)); + } + else + { + dy.ptr.p_double[0] = datacv.xyrow.ptr.p_double[nin]; + } + dserraccumulate(&buf, &datacv.y, &dy, _state); + } + dserrfinish(&buf, _state); + rep->relclserror = buf.ptr.p_double[0]; + rep->avgce = buf.ptr.p_double[1]; + rep->rmserror = buf.ptr.p_double[2]; + rep->avgerror = buf.ptr.p_double[3]; + rep->avgrelerror = buf.ptr.p_double[4]; + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlpkfoldcv(mlptrainer* s, + multilayerperceptron* network, + ae_int_t nrestarts, + ae_int_t foldscount, + mlpreport* rep, ae_state *_state) +{ + mlpkfoldcv(s,network,nrestarts,foldscount,rep, _state); +} + + +/************************************************************************* +Creation of the network trainer object for regression networks + +INPUT PARAMETERS: + NIn - number of inputs, NIn>=1 + NOut - number of outputs, NOut>=1 + +OUTPUT PARAMETERS: + S - neural network trainer object. + This structure can be used to train any regression + network with NIn inputs and NOut outputs. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatetrainer(ae_int_t nin, + ae_int_t nout, + mlptrainer* s, + ae_state *_state) +{ + + _mlptrainer_clear(s); + + ae_assert(nin>=1, "MLPCreateTrainer: NIn<1.", _state); + ae_assert(nout>=1, "MLPCreateTrainer: NOut<1.", _state); + s->nin = nin; + s->nout = nout; + s->rcpar = ae_true; + s->lbfgsfactor = mlptrain_defaultlbfgsfactor; + s->decay = 1.0E-6; + mlpsetcond(s, 0, 0, _state); + s->datatype = 0; + s->npoints = 0; + mlpsetalgobatch(s, _state); +} + + +/************************************************************************* +Creation of the network trainer object for classification networks + +INPUT PARAMETERS: + NIn - number of inputs, NIn>=1 + NClasses - number of classes, NClasses>=2 + +OUTPUT PARAMETERS: + S - neural network trainer object. + This structure can be used to train any classification + network with NIn inputs and NOut outputs. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatetrainercls(ae_int_t nin, + ae_int_t nclasses, + mlptrainer* s, + ae_state *_state) +{ + + _mlptrainer_clear(s); + + ae_assert(nin>=1, "MLPCreateTrainerCls: NIn<1.", _state); + ae_assert(nclasses>=2, "MLPCreateTrainerCls: NClasses<2.", _state); + s->nin = nin; + s->nout = nclasses; + s->rcpar = ae_false; + s->lbfgsfactor = mlptrain_defaultlbfgsfactor; + s->decay = 1.0E-6; + mlpsetcond(s, 0, 0, _state); + s->datatype = 0; + s->npoints = 0; + mlpsetalgobatch(s, _state); +} + + +/************************************************************************* +This function sets "current dataset" of the trainer object to one passed +by user. + +INPUT PARAMETERS: + S - trainer object + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. + NPoints - points count, >=0. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +datasetformat is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetdataset(mlptrainer* s, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + ae_int_t ndim; + ae_int_t i; + ae_int_t j; + + + ae_assert(s->nin>=1, "MLPSetDataset: possible parameter S is not initialized or spoiled(S.NIn<=0).", _state); + ae_assert(npoints>=0, "MLPSetDataset: NPoint<0", _state); + ae_assert(npoints<=xy->rows, "MLPSetDataset: invalid size of matrix XY(NPoint more then rows of matrix XY)", _state); + s->datatype = 0; + s->npoints = npoints; + if( npoints==0 ) + { + return; + } + if( s->rcpar ) + { + ae_assert(s->nout>=1, "MLPSetDataset: possible parameter S is not initialized or is spoiled(NOut<1 for regression).", _state); + ndim = s->nin+s->nout; + ae_assert(ndim<=xy->cols, "MLPSetDataset: invalid size of matrix XY(too few columns in matrix XY).", _state); + ae_assert(apservisfinitematrix(xy, npoints, ndim, _state), "MLPSetDataset: parameter XY contains Infinite or NaN.", _state); + } + else + { + ae_assert(s->nout>=2, "MLPSetDataset: possible parameter S is not initialized or is spoiled(NClasses<2 for classifier).", _state); + ndim = s->nin+1; + ae_assert(ndim<=xy->cols, "MLPSetDataset: invalid size of matrix XY(too few columns in matrix XY).", _state); + ae_assert(apservisfinitematrix(xy, npoints, ndim, _state), "MLPSetDataset: parameter XY contains Infinite or NaN.", _state); + for(i=0; i<=npoints-1; i++) + { + ae_assert(ae_round(xy->ptr.pp_double[i][s->nin], _state)>=0&&ae_round(xy->ptr.pp_double[i][s->nin], _state)nout, "MLPSetDataset: invalid parameter XY(in classifier used nonexistent class number: either XY[.,NIn]<0 or XY[.,NIn]>=NClasses).", _state); + } + } + rmatrixsetlengthatleast(&s->densexy, npoints, ndim, _state); + for(i=0; i<=npoints-1; i++) + { + for(j=0; j<=ndim-1; j++) + { + s->densexy.ptr.pp_double[i][j] = xy->ptr.pp_double[i][j]; + } + } +} + + +/************************************************************************* +This function sets "current dataset" of the trainer object to one passed +by user (sparse matrix is used to store dataset). + +INPUT PARAMETERS: + S - trainer object + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Any sparse storage format can be used: + Hash-table, CRS... + NPoints - points count, >=0 + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +datasetformat is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetsparsedataset(mlptrainer* s, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state) +{ + double v; + ae_int_t t0; + ae_int_t t1; + ae_int_t i; + ae_int_t j; + + + + /* + * Check correctness of the data + */ + ae_assert(s->nin>0, "MLPSetSparseDataset: possible parameter S is not initialized or spoiled(S.NIn<=0).", _state); + ae_assert(npoints>=0, "MLPSetSparseDataset: NPoint<0", _state); + ae_assert(npoints<=sparsegetnrows(xy, _state), "MLPSetSparseDataset: invalid size of sparse matrix XY(NPoint more then rows of matrix XY)", _state); + if( npoints>0 ) + { + t0 = 0; + t1 = 0; + if( s->rcpar ) + { + ae_assert(s->nout>=1, "MLPSetSparseDataset: possible parameter S is not initialized or is spoiled(NOut<1 for regression).", _state); + ae_assert(s->nin+s->nout<=sparsegetncols(xy, _state), "MLPSetSparseDataset: invalid size of sparse matrix XY(too few columns in sparse matrix XY).", _state); + while(sparseenumerate(xy, &t0, &t1, &i, &j, &v, _state)) + { + if( inin+s->nout ) + { + ae_assert(ae_isfinite(v, _state), "MLPSetSparseDataset: sparse matrix XY contains Infinite or NaN.", _state); + } + } + } + else + { + ae_assert(s->nout>=2, "MLPSetSparseDataset: possible parameter S is not initialized or is spoiled(NClasses<2 for classifier).", _state); + ae_assert(s->nin+1<=sparsegetncols(xy, _state), "MLPSetSparseDataset: invalid size of sparse matrix XY(too few columns in sparse matrix XY).", _state); + while(sparseenumerate(xy, &t0, &t1, &i, &j, &v, _state)) + { + if( inin ) + { + if( j!=s->nin ) + { + ae_assert(ae_isfinite(v, _state), "MLPSetSparseDataset: sparse matrix XY contains Infinite or NaN.", _state); + } + else + { + ae_assert((ae_isfinite(v, _state)&&ae_round(v, _state)>=0)&&ae_round(v, _state)nout, "MLPSetSparseDataset: invalid sparse matrix XY(in classifier used nonexistent class number: either XY[.,NIn]<0 or XY[.,NIn]>=NClasses).", _state); + } + } + } + } + } + + /* + * Set dataset + */ + s->datatype = 1; + s->npoints = npoints; + sparsecopytocrs(xy, &s->sparsexy, _state); +} + + +/************************************************************************* +This function sets weight decay coefficient which is used for training. + +INPUT PARAMETERS: + S - trainer object + Decay - weight decay coefficient, >=0. Weight decay term + 'Decay*||Weights||^2' is added to error function. If + you don't know what Decay to choose, use 1.0E-3. + Weight decay can be set to zero, in this case network + is trained without weight decay. + +NOTE: by default network uses some small nonzero value for weight decay. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetdecay(mlptrainer* s, double decay, ae_state *_state) +{ + + + ae_assert(ae_isfinite(decay, _state), "MLPSetDecay: parameter Decay contains Infinite or NaN.", _state); + ae_assert(ae_fp_greater_eq(decay,0), "MLPSetDecay: Decay<0.", _state); + s->decay = decay; +} + + +/************************************************************************* +This function sets stopping criteria for the optimizer. + +INPUT PARAMETERS: + S - trainer object + WStep - stopping criterion. Algorithm stops if step size is + less than WStep. Recommended value - 0.01. Zero step + size means stopping after MaxIts iterations. + WStep>=0. + MaxIts - stopping criterion. Algorithm stops after MaxIts + epochs (full passes over entire dataset). Zero MaxIts + means stopping when step is sufficiently small. + MaxIts>=0. + +NOTE: by default, WStep=0.005 and MaxIts=0 are used. These values are also + used when MLPSetCond() is called with WStep=0 and MaxIts=0. + +NOTE: these stopping criteria are used for all kinds of neural training - + from "conventional" networks to early stopping ensembles. When used + for "conventional" networks, they are used as the only stopping + criteria. When combined with early stopping, they used as ADDITIONAL + stopping criteria which can terminate early stopping algorithm. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetcond(mlptrainer* s, + double wstep, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(wstep, _state), "MLPSetCond: parameter WStep contains Infinite or NaN.", _state); + ae_assert(ae_fp_greater_eq(wstep,0), "MLPSetCond: WStep<0.", _state); + ae_assert(maxits>=0, "MLPSetCond: MaxIts<0.", _state); + if( ae_fp_neq(wstep,0)||maxits!=0 ) + { + s->wstep = wstep; + s->maxits = maxits; + } + else + { + s->wstep = 0.005; + s->maxits = 0; + } +} + + +/************************************************************************* +This function sets training algorithm: batch training using L-BFGS will be +used. + +This algorithm: +* the most robust for small-scale problems, but may be too slow for large + scale ones. +* perfoms full pass through the dataset before performing step +* uses conditions specified by MLPSetCond() for stopping +* is default one used by trainer object + +INPUT PARAMETERS: + S - trainer object + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetalgobatch(mlptrainer* s, ae_state *_state) +{ + + + s->algokind = 0; +} + + +/************************************************************************* +This function trains neural network passed to this function, using current +dataset (one which was passed to MLPSetDataset() or MLPSetSparseDataset()) +and current training settings. Training from NRestarts random starting +positions is performed, best network is chosen. + +Training is performed using current training algorithm. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * NRestarts training sessions performed within each of + ! cross-validation rounds (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that specified number of random + restarts are performed, best network is chosen after + training + * NRestarts=0 means that current state of the network + is used for training. + +OUTPUT PARAMETERS: + Network - trained network + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + network is filled by zero values. Same behavior for functions + MLPStartTraining and MLPContinueTraining. + +NOTE: this method uses sum-of-squares error function for training. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlptrainnetwork(mlptrainer* s, + multilayerperceptron* network, + ae_int_t nrestarts, + mlpreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntype; + ae_int_t ttype; + ae_shared_pool trnpool; + + ae_frame_make(_state, &_frame_block); + _mlpreport_clear(rep); + ae_shared_pool_init(&trnpool, _state, ae_true); + + ae_assert(s->npoints>=0, "MLPTrainNetwork: parameter S is not initialized or is spoiled(S.NPoints<0)", _state); + if( !mlpissoftmax(network, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + if( s->rcpar ) + { + ttype = 0; + } + else + { + ttype = 1; + } + ae_assert(ntype==ttype, "MLPTrainNetwork: type of input network is not similar to network type in trainer object", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + ae_assert(s->nin==nin, "MLPTrainNetwork: number of inputs in trainer is not equal to number of inputs in network", _state); + ae_assert(s->nout==nout, "MLPTrainNetwork: number of outputs in trainer is not equal to number of outputs in network", _state); + ae_assert(nrestarts>=0, "MLPTrainNetwork: NRestarts<0.", _state); + + /* + * Train + */ + mlptrain_mlptrainnetworkx(s, nrestarts, -1, &s->subset, -1, &s->subset, 0, network, rep, ae_true, &trnpool, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlptrainnetwork(mlptrainer* s, + multilayerperceptron* network, + ae_int_t nrestarts, + mlpreport* rep, ae_state *_state) +{ + mlptrainnetwork(s,network,nrestarts,rep, _state); +} + + +/************************************************************************* +IMPORTANT: this is an "expert" version of the MLPTrain() function. We do + not recommend you to use it unless you are pretty sure that you + need ability to monitor training progress. + +This function performs step-by-step training of the neural network. Here +"step-by-step" means that training starts with MLPStartTraining() call, +and then user subsequently calls MLPContinueTraining() to perform one more +iteration of the training. + +After call to this function trainer object remembers network and is ready +to train it. However, no training is performed until first call to +MLPContinueTraining() function. Subsequent calls to MLPContinueTraining() +will advance training progress one iteration further. + +EXAMPLE: + > + > ...initialize network and trainer object.... + > + > MLPStartTraining(Trainer, Network, True) + > while MLPContinueTraining(Trainer, Network) do + > ...visualize training progress... + > + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. + RandomStart - randomize network before training or not: + * True means that network is randomized and its + initial state (one which was passed to the trainer + object) is lost. + * False means that training is started from the + current state of the network + +OUTPUT PARAMETERS: + Network - neural network which is ready to training (weights are + initialized, preprocessor is initialized using current + training set) + +NOTE: this method uses sum-of-squares error function for training. + +NOTE: it is expected that trainer object settings are NOT changed during + step-by-step training, i.e. no one changes stopping criteria or + training set during training. It is possible and there is no defense + against such actions, but algorithm behavior in such cases is + undefined and can be unpredictable. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpstarttraining(mlptrainer* s, + multilayerperceptron* network, + ae_bool randomstart, + ae_state *_state) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntype; + ae_int_t ttype; + + + ae_assert(s->npoints>=0, "MLPStartTraining: parameter S is not initialized or is spoiled(S.NPoints<0)", _state); + if( !mlpissoftmax(network, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + if( s->rcpar ) + { + ttype = 0; + } + else + { + ttype = 1; + } + ae_assert(ntype==ttype, "MLPStartTraining: type of input network is not similar to network type in trainer object", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + ae_assert(s->nin==nin, "MLPStartTraining: number of inputs in trainer is not equal to number of inputs in the network.", _state); + ae_assert(s->nout==nout, "MLPStartTraining: number of outputs in trainer is not equal to number of outputs in the network.", _state); + + /* + * Initialize temporaries + */ + mlptrain_initmlptrnsession(network, randomstart, s, &s->session, _state); + + /* + * Train network + */ + mlptrain_mlpstarttrainingx(s, randomstart, -1, &s->subset, -1, &s->session, _state); + + /* + * Update network + */ + mlpcopytunableparameters(&s->session.network, network, _state); +} + + +/************************************************************************* +IMPORTANT: this is an "expert" version of the MLPTrain() function. We do + not recommend you to use it unless you are pretty sure that you + need ability to monitor training progress. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +This function performs step-by-step training of the neural network. Here +"step-by-step" means that training starts with MLPStartTraining() call, +and then user subsequently calls MLPContinueTraining() to perform one more +iteration of the training. + +This function performs one more iteration of the training and returns +either True (training continues) or False (training stopped). In case True +was returned, Network weights are updated according to the current state +of the optimization progress. In case False was returned, no additional +updates is performed (previous update of the network weights moved us to +the final point, and no additional updates is needed). + +EXAMPLE: + > + > [initialize network and trainer object] + > + > MLPStartTraining(Trainer, Network, True) + > while MLPContinueTraining(Trainer, Network) do + > [visualize training progress] + > + +INPUT PARAMETERS: + S - trainer object + Network - neural network structure, which is used to store + current state of the training process. + +OUTPUT PARAMETERS: + Network - weights of the neural network are rewritten by the + current approximation. + +NOTE: this method uses sum-of-squares error function for training. + +NOTE: it is expected that trainer object settings are NOT changed during + step-by-step training, i.e. no one changes stopping criteria or + training set during training. It is possible and there is no defense + against such actions, but algorithm behavior in such cases is + undefined and can be unpredictable. + +NOTE: It is expected that Network is the same one which was passed to + MLPStartTraining() function. However, THIS function checks only + following: + * that number of network inputs is consistent with trainer object + settings + * that number of network outputs/classes is consistent with trainer + object settings + * that number of network weights is the same as number of weights in + the network passed to MLPStartTraining() function + Exception is thrown when these conditions are violated. + + It is also expected that you do not change state of the network on + your own - the only party who has right to change network during its + training is a trainer object. Any attempt to interfere with trainer + may lead to unpredictable results. + + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +ae_bool mlpcontinuetraining(mlptrainer* s, + multilayerperceptron* network, + ae_state *_state) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntype; + ae_int_t ttype; + ae_bool result; + + + ae_assert(s->npoints>=0, "MLPContinueTraining: parameter S is not initialized or is spoiled(S.NPoints<0)", _state); + if( s->rcpar ) + { + ttype = 0; + } + else + { + ttype = 1; + } + if( !mlpissoftmax(network, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + ae_assert(ntype==ttype, "MLPContinueTraining: type of input network is not similar to network type in trainer object.", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + ae_assert(s->nin==nin, "MLPContinueTraining: number of inputs in trainer is not equal to number of inputs in the network.", _state); + ae_assert(s->nout==nout, "MLPContinueTraining: number of outputs in trainer is not equal to number of outputs in the network.", _state); + result = mlptrain_mlpcontinuetrainingx(s, &s->subset, -1, &s->ngradbatch, &s->session, _state); + if( result ) + { + ae_v_move(&network->weights.ptr.p_double[0], 1, &s->session.network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + } + return result; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +ae_bool _pexec_mlpcontinuetraining(mlptrainer* s, + multilayerperceptron* network, ae_state *_state) +{ + return mlpcontinuetraining(s,network, _state); +} + + +/************************************************************************* +Training neural networks ensemble using bootstrap aggregating (bagging). +Modified Levenberg-Marquardt algorithm is used as base training method. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpebagginglm(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* ooberrors, + ae_state *_state) +{ + + *info = 0; + _mlpreport_clear(rep); + _mlpcvreport_clear(ooberrors); + + mlptrain_mlpebagginginternal(ensemble, xy, npoints, decay, restarts, 0.0, 0, ae_true, info, rep, ooberrors, _state); +} + + +/************************************************************************* +Training neural networks ensemble using bootstrap aggregating (bagging). +L-BFGS algorithm is used as base training method. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + WStep - stopping criterion, same as in MLPTrainLBFGS + MaxIts - stopping criterion, same as in MLPTrainLBFGS + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -8, if both WStep=0 and MaxIts=0 + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpebagginglbfgs(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + double wstep, + ae_int_t maxits, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* ooberrors, + ae_state *_state) +{ + + *info = 0; + _mlpreport_clear(rep); + _mlpcvreport_clear(ooberrors); + + mlptrain_mlpebagginginternal(ensemble, xy, npoints, decay, restarts, wstep, maxits, ae_false, info, rep, ooberrors, _state); +} + + +/************************************************************************* +Training neural networks ensemble using early stopping. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 6, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpetraines(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t* info, + mlpreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t k; + ae_int_t ccount; + ae_int_t pcount; + ae_matrix trnxy; + ae_matrix valxy; + ae_int_t trnsize; + ae_int_t valsize; + ae_int_t tmpinfo; + mlpreport tmprep; + modelerrors moderr; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _mlpreport_clear(rep); + ae_matrix_init(&trnxy, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&valxy, 0, 0, DT_REAL, _state, ae_true); + _mlpreport_init(&tmprep, _state, ae_true); + _modelerrors_init(&moderr, _state, ae_true); + + nin = mlpgetinputscount(&ensemble->network, _state); + nout = mlpgetoutputscount(&ensemble->network, _state); + wcount = mlpgetweightscount(&ensemble->network, _state); + if( (npoints<2||restarts<1)||ae_fp_less(decay,0) ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( mlpissoftmax(&ensemble->network, _state) ) + { + for(i=0; i<=npoints-1; i++) + { + if( ae_round(xy->ptr.pp_double[i][nin], _state)<0||ae_round(xy->ptr.pp_double[i][nin], _state)>=nout ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + } + *info = 6; + + /* + * allocate + */ + if( mlpissoftmax(&ensemble->network, _state) ) + { + ccount = nin+1; + pcount = nin; + } + else + { + ccount = nin+nout; + pcount = nin+nout; + } + ae_matrix_set_length(&trnxy, npoints, ccount, _state); + ae_matrix_set_length(&valxy, npoints, ccount, _state); + rep->ngrad = 0; + rep->nhess = 0; + rep->ncholesky = 0; + + /* + * train networks + */ + for(k=0; k<=ensemble->ensemblesize-1; k++) + { + + /* + * Split set + */ + do + { + trnsize = 0; + valsize = 0; + for(i=0; i<=npoints-1; i++) + { + if( ae_fp_less(ae_randomreal(_state),0.66) ) + { + + /* + * Assign sample to training set + */ + ae_v_move(&trnxy.ptr.pp_double[trnsize][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,ccount-1)); + trnsize = trnsize+1; + } + else + { + + /* + * Assign sample to validation set + */ + ae_v_move(&valxy.ptr.pp_double[valsize][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,ccount-1)); + valsize = valsize+1; + } + } + } + while(!(trnsize!=0&&valsize!=0)); + + /* + * Train + */ + mlptraines(&ensemble->network, &trnxy, trnsize, &valxy, valsize, decay, restarts, &tmpinfo, &tmprep, _state); + if( tmpinfo<0 ) + { + *info = tmpinfo; + ae_frame_leave(_state); + return; + } + + /* + * save results + */ + ae_v_move(&ensemble->weights.ptr.p_double[k*wcount], 1, &ensemble->network.weights.ptr.p_double[0], 1, ae_v_len(k*wcount,(k+1)*wcount-1)); + ae_v_move(&ensemble->columnmeans.ptr.p_double[k*pcount], 1, &ensemble->network.columnmeans.ptr.p_double[0], 1, ae_v_len(k*pcount,(k+1)*pcount-1)); + ae_v_move(&ensemble->columnsigmas.ptr.p_double[k*pcount], 1, &ensemble->network.columnsigmas.ptr.p_double[0], 1, ae_v_len(k*pcount,(k+1)*pcount-1)); + rep->ngrad = rep->ngrad+tmprep.ngrad; + rep->nhess = rep->nhess+tmprep.nhess; + rep->ncholesky = rep->ncholesky+tmprep.ncholesky; + } + mlpeallerrorsx(ensemble, xy, &ensemble->network.dummysxy, npoints, 0, &ensemble->network.dummyidx, 0, npoints, 0, &ensemble->network.buf, &moderr, _state); + rep->relclserror = moderr.relclserror; + rep->avgce = moderr.avgce; + rep->rmserror = moderr.rmserror; + rep->avgerror = moderr.avgerror; + rep->avgrelerror = moderr.avgrelerror; + ae_frame_leave(_state); +} + + +/************************************************************************* +This function trains neural network ensemble passed to this function using +current dataset and early stopping training algorithm. Each early stopping +round performs NRestarts random restarts (thus, EnsembleSize*NRestarts +training rounds is performed in total). + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * EnsembleSize training sessions performed for each of ensemble + ! members (always parallelized) + ! * NRestarts training sessions performed within each of training + ! sessions (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object; + Ensemble - neural network ensemble. It must have same number of + inputs and outputs/classes as was specified during + creation of the trainer object. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that specified number of random + restarts are performed during each ES round; + * NRestarts=0 is silently replaced by 1. + +OUTPUT PARAMETERS: + Ensemble - trained ensemble; + Rep - it contains all type of errors. + +NOTE: this training method uses BOTH early stopping and weight decay! So, + you should select weight decay before starting training just as you + select it before training "conventional" networks. + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + or single-point dataset was passed, ensemble is filled by zero + values. + +NOTE: this method uses sum-of-squares error function for training. + + -- ALGLIB -- + Copyright 22.08.2012 by Bochkanov Sergey +*************************************************************************/ +void mlptrainensemblees(mlptrainer* s, + mlpensemble* ensemble, + ae_int_t nrestarts, + mlpreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t ntype; + ae_int_t ttype; + ae_shared_pool esessions; + sinteger sgrad; + modelerrors tmprep; + + ae_frame_make(_state, &_frame_block); + _mlpreport_clear(rep); + ae_shared_pool_init(&esessions, _state, ae_true); + _sinteger_init(&sgrad, _state, ae_true); + _modelerrors_init(&tmprep, _state, ae_true); + + ae_assert(s->npoints>=0, "MLPTrainEnsembleES: parameter S is not initialized or is spoiled(S.NPoints<0)", _state); + if( !mlpeissoftmax(ensemble, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + if( s->rcpar ) + { + ttype = 0; + } + else + { + ttype = 1; + } + ae_assert(ntype==ttype, "MLPTrainEnsembleES: internal error - type of input network is not similar to network type in trainer object", _state); + nin = mlpgetinputscount(&ensemble->network, _state); + ae_assert(s->nin==nin, "MLPTrainEnsembleES: number of inputs in trainer is not equal to number of inputs in ensemble network", _state); + nout = mlpgetoutputscount(&ensemble->network, _state); + ae_assert(s->nout==nout, "MLPTrainEnsembleES: number of outputs in trainer is not equal to number of outputs in ensemble network", _state); + ae_assert(nrestarts>=0, "MLPTrainEnsembleES: NRestarts<0.", _state); + + /* + * Initialize parameter Rep + */ + rep->relclserror = 0; + rep->avgce = 0; + rep->rmserror = 0; + rep->avgerror = 0; + rep->avgrelerror = 0; + rep->ngrad = 0; + rep->nhess = 0; + rep->ncholesky = 0; + + /* + * Allocate + */ + ivectorsetlengthatleast(&s->subset, s->npoints, _state); + ivectorsetlengthatleast(&s->valsubset, s->npoints, _state); + + /* + * Start training + * + * NOTE: ESessions is not initialized because MLPTrainEnsembleX + * needs uninitialized pool. + */ + sgrad.val = 0; + mlptrain_mlptrainensemblex(s, ensemble, 0, ensemble->ensemblesize, nrestarts, 0, &sgrad, ae_true, &esessions, _state); + rep->ngrad = sgrad.val; + + /* + * Calculate errors. + */ + if( s->datatype==0 ) + { + mlpeallerrorsx(ensemble, &s->densexy, &s->sparsexy, s->npoints, 0, &ensemble->network.dummyidx, 0, s->npoints, 0, &ensemble->network.buf, &tmprep, _state); + } + if( s->datatype==1 ) + { + mlpeallerrorsx(ensemble, &s->densexy, &s->sparsexy, s->npoints, 1, &ensemble->network.dummyidx, 0, s->npoints, 0, &ensemble->network.buf, &tmprep, _state); + } + rep->relclserror = tmprep.relclserror; + rep->avgce = tmprep.avgce; + rep->rmserror = tmprep.rmserror; + rep->avgerror = tmprep.avgerror; + rep->avgrelerror = tmprep.avgrelerror; + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_mlptrainensemblees(mlptrainer* s, + mlpensemble* ensemble, + ae_int_t nrestarts, + mlpreport* rep, ae_state *_state) +{ + mlptrainensemblees(s,ensemble,nrestarts,rep, _state); +} + + +/************************************************************************* +Internal cross-validation subroutine +*************************************************************************/ +static void mlptrain_mlpkfoldcvgeneral(multilayerperceptron* n, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t foldscount, + ae_bool lmalgorithm, + double wstep, + ae_int_t maxits, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* cvrep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t fold; + ae_int_t j; + ae_int_t k; + multilayerperceptron network; + ae_int_t nin; + ae_int_t nout; + ae_int_t rowlen; + ae_int_t wcount; + ae_int_t nclasses; + ae_int_t tssize; + ae_int_t cvssize; + ae_matrix cvset; + ae_matrix testset; + ae_vector folds; + ae_int_t relcnt; + mlpreport internalrep; + ae_vector x; + ae_vector y; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _mlpreport_clear(rep); + _mlpcvreport_clear(cvrep); + _multilayerperceptron_init(&network, _state, ae_true); + ae_matrix_init(&cvset, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&testset, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&folds, 0, DT_INT, _state, ae_true); + _mlpreport_init(&internalrep, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + + + /* + * Read network geometry, test parameters + */ + mlpproperties(n, &nin, &nout, &wcount, _state); + if( mlpissoftmax(n, _state) ) + { + nclasses = nout; + rowlen = nin+1; + } + else + { + nclasses = -nout; + rowlen = nin+nout; + } + if( (npoints<=0||foldscount<2)||foldscount>npoints ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + mlpcopy(n, &network, _state); + + /* + * K-fold out cross-validation. + * First, estimate generalization error + */ + ae_matrix_set_length(&testset, npoints-1+1, rowlen-1+1, _state); + ae_matrix_set_length(&cvset, npoints-1+1, rowlen-1+1, _state); + ae_vector_set_length(&x, nin-1+1, _state); + ae_vector_set_length(&y, nout-1+1, _state); + mlptrain_mlpkfoldsplit(xy, npoints, nclasses, foldscount, ae_false, &folds, _state); + cvrep->relclserror = 0; + cvrep->avgce = 0; + cvrep->rmserror = 0; + cvrep->avgerror = 0; + cvrep->avgrelerror = 0; + rep->ngrad = 0; + rep->nhess = 0; + rep->ncholesky = 0; + relcnt = 0; + for(fold=0; fold<=foldscount-1; fold++) + { + + /* + * Separate set + */ + tssize = 0; + cvssize = 0; + for(i=0; i<=npoints-1; i++) + { + if( folds.ptr.p_int[i]==fold ) + { + ae_v_move(&testset.ptr.pp_double[tssize][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,rowlen-1)); + tssize = tssize+1; + } + else + { + ae_v_move(&cvset.ptr.pp_double[cvssize][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,rowlen-1)); + cvssize = cvssize+1; + } + } + + /* + * Train on CV training set + */ + if( lmalgorithm ) + { + mlptrainlm(&network, &cvset, cvssize, decay, restarts, info, &internalrep, _state); + } + else + { + mlptrainlbfgs(&network, &cvset, cvssize, decay, restarts, wstep, maxits, info, &internalrep, _state); + } + if( *info<0 ) + { + cvrep->relclserror = 0; + cvrep->avgce = 0; + cvrep->rmserror = 0; + cvrep->avgerror = 0; + cvrep->avgrelerror = 0; + ae_frame_leave(_state); + return; + } + rep->ngrad = rep->ngrad+internalrep.ngrad; + rep->nhess = rep->nhess+internalrep.nhess; + rep->ncholesky = rep->ncholesky+internalrep.ncholesky; + + /* + * Estimate error using CV test set + */ + if( mlpissoftmax(&network, _state) ) + { + + /* + * classification-only code + */ + cvrep->relclserror = cvrep->relclserror+mlpclserror(&network, &testset, tssize, _state); + cvrep->avgce = cvrep->avgce+mlperrorn(&network, &testset, tssize, _state); + } + for(i=0; i<=tssize-1; i++) + { + ae_v_move(&x.ptr.p_double[0], 1, &testset.ptr.pp_double[i][0], 1, ae_v_len(0,nin-1)); + mlpprocess(&network, &x, &y, _state); + if( mlpissoftmax(&network, _state) ) + { + + /* + * Classification-specific code + */ + k = ae_round(testset.ptr.pp_double[i][nin], _state); + for(j=0; j<=nout-1; j++) + { + if( j==k ) + { + cvrep->rmserror = cvrep->rmserror+ae_sqr(y.ptr.p_double[j]-1, _state); + cvrep->avgerror = cvrep->avgerror+ae_fabs(y.ptr.p_double[j]-1, _state); + cvrep->avgrelerror = cvrep->avgrelerror+ae_fabs(y.ptr.p_double[j]-1, _state); + relcnt = relcnt+1; + } + else + { + cvrep->rmserror = cvrep->rmserror+ae_sqr(y.ptr.p_double[j], _state); + cvrep->avgerror = cvrep->avgerror+ae_fabs(y.ptr.p_double[j], _state); + } + } + } + else + { + + /* + * Regression-specific code + */ + for(j=0; j<=nout-1; j++) + { + cvrep->rmserror = cvrep->rmserror+ae_sqr(y.ptr.p_double[j]-testset.ptr.pp_double[i][nin+j], _state); + cvrep->avgerror = cvrep->avgerror+ae_fabs(y.ptr.p_double[j]-testset.ptr.pp_double[i][nin+j], _state); + if( ae_fp_neq(testset.ptr.pp_double[i][nin+j],0) ) + { + cvrep->avgrelerror = cvrep->avgrelerror+ae_fabs((y.ptr.p_double[j]-testset.ptr.pp_double[i][nin+j])/testset.ptr.pp_double[i][nin+j], _state); + relcnt = relcnt+1; + } + } + } + } + } + if( mlpissoftmax(&network, _state) ) + { + cvrep->relclserror = cvrep->relclserror/npoints; + cvrep->avgce = cvrep->avgce/(ae_log(2, _state)*npoints); + } + cvrep->rmserror = ae_sqrt(cvrep->rmserror/(npoints*nout), _state); + cvrep->avgerror = cvrep->avgerror/(npoints*nout); + if( relcnt>0 ) + { + cvrep->avgrelerror = cvrep->avgrelerror/relcnt; + } + *info = 1; + ae_frame_leave(_state); +} + + +/************************************************************************* +Subroutine prepares K-fold split of the training set. + +NOTES: + "NClasses>0" means that we have classification task. + "NClasses<0" means regression task with -NClasses real outputs. +*************************************************************************/ +static void mlptrain_mlpkfoldsplit(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nclasses, + ae_int_t foldscount, + ae_bool stratifiedsplits, + /* Integer */ ae_vector* folds, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(folds); + _hqrndstate_init(&rs, _state, ae_true); + + + /* + * test parameters + */ + ae_assert(npoints>0, "MLPKFoldSplit: wrong NPoints!", _state); + ae_assert(nclasses>1||nclasses<0, "MLPKFoldSplit: wrong NClasses!", _state); + ae_assert(foldscount>=2&&foldscount<=npoints, "MLPKFoldSplit: wrong FoldsCount!", _state); + ae_assert(!stratifiedsplits, "MLPKFoldSplit: stratified splits are not supported!", _state); + + /* + * Folds + */ + hqrndrandomize(&rs, _state); + ae_vector_set_length(folds, npoints-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + folds->ptr.p_int[i] = i*foldscount/npoints; + } + for(i=0; i<=npoints-2; i++) + { + j = i+hqrnduniformi(&rs, npoints-i, _state); + if( j!=i ) + { + k = folds->ptr.p_int[i]; + folds->ptr.p_int[i] = folds->ptr.p_int[j]; + folds->ptr.p_int[j] = k; + } + } + ae_frame_leave(_state); +} + + +static void mlptrain_mthreadcv(mlptrainer* s, + ae_int_t rowsize, + ae_int_t nrestarts, + /* Integer */ ae_vector* folds, + ae_int_t fold, + ae_int_t dfold, + /* Real */ ae_matrix* cvy, + ae_shared_pool* pooldatacv, + ae_state *_state) +{ + ae_frame _frame_block; + mlpparallelizationcv *datacv; + ae_smart_ptr _datacv; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_smart_ptr_init(&_datacv, (void**)&datacv, _state, ae_true); + + if( fold==dfold-1 ) + { + + /* + * Separate set + */ + ae_shared_pool_retrieve(pooldatacv, &_datacv, _state); + datacv->subsetsize = 0; + for(i=0; i<=s->npoints-1; i++) + { + if( folds->ptr.p_int[i]!=fold ) + { + datacv->subset.ptr.p_int[datacv->subsetsize] = i; + datacv->subsetsize = datacv->subsetsize+1; + } + } + + /* + * Train on CV training set + */ + mlptrain_mlptrainnetworkx(s, nrestarts, -1, &datacv->subset, datacv->subsetsize, &datacv->subset, 0, &datacv->network, &datacv->rep, ae_true, &datacv->trnpool, _state); + datacv->ngrad = datacv->ngrad+datacv->rep.ngrad; + + /* + * Estimate error using CV test set + */ + for(i=0; i<=s->npoints-1; i++) + { + if( folds->ptr.p_int[i]==fold ) + { + if( s->datatype==0 ) + { + ae_v_move(&datacv->xyrow.ptr.p_double[0], 1, &s->densexy.ptr.pp_double[i][0], 1, ae_v_len(0,rowsize-1)); + } + if( s->datatype==1 ) + { + sparsegetrow(&s->sparsexy, i, &datacv->xyrow, _state); + } + mlpprocess(&datacv->network, &datacv->xyrow, &datacv->y, _state); + ae_v_move(&cvy->ptr.pp_double[i][0], 1, &datacv->y.ptr.p_double[0], 1, ae_v_len(0,s->nout-1)); + } + } + ae_shared_pool_recycle(pooldatacv, &_datacv, _state); + } + else + { + ae_assert(foldDFold-1).", _state); + mlptrain_mthreadcv(s, rowsize, nrestarts, folds, fold, (fold+dfold)/2, cvy, pooldatacv, _state); + mlptrain_mthreadcv(s, rowsize, nrestarts, folds, (fold+dfold)/2, dfold, cvy, pooldatacv, _state); + } + ae_frame_leave(_state); +} + + +static void mlptrain_mlptrainnetworkx(mlptrainer* s, + ae_int_t nrestarts, + ae_int_t algokind, + /* Integer */ ae_vector* trnsubset, + ae_int_t trnsubsetsize, + /* Integer */ ae_vector* valsubset, + ae_int_t valsubsetsize, + multilayerperceptron* network, + mlpreport* rep, + ae_bool isrootcall, + ae_shared_pool* sessions, + ae_state *_state) +{ + ae_frame _frame_block; + modelerrors modrep; + double eval; + double ebest; + ae_int_t ngradbatch; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t pcount; + ae_int_t itbest; + ae_int_t itcnt; + ae_int_t ntype; + ae_int_t ttype; + ae_bool rndstart; + ae_int_t i; + ae_int_t nr0; + ae_int_t nr1; + mlpreport rep0; + mlpreport rep1; + ae_bool randomizenetwork; + double bestrmserror; + smlptrnsession *psession; + ae_smart_ptr _psession; + + ae_frame_make(_state, &_frame_block); + _modelerrors_init(&modrep, _state, ae_true); + _mlpreport_init(&rep0, _state, ae_true); + _mlpreport_init(&rep1, _state, ae_true); + ae_smart_ptr_init(&_psession, (void**)&psession, _state, ae_true); + + mlpproperties(network, &nin, &nout, &wcount, _state); + + /* + * Process root call + */ + if( isrootcall ) + { + + /* + * Check correctness of parameters + */ + ae_assert(algokind==0||algokind==-1, "MLPTrainNetworkX: unexpected AlgoKind", _state); + ae_assert(s->npoints>=0, "MLPTrainNetworkX: internal error - parameter S is not initialized or is spoiled(S.NPoints<0)", _state); + if( s->rcpar ) + { + ttype = 0; + } + else + { + ttype = 1; + } + if( !mlpissoftmax(network, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + ae_assert(ntype==ttype, "MLPTrainNetworkX: internal error - type of the training network is not similar to network type in trainer object", _state); + ae_assert(s->nin==nin, "MLPTrainNetworkX: internal error - number of inputs in trainer is not equal to number of inputs in the training network.", _state); + ae_assert(s->nout==nout, "MLPTrainNetworkX: internal error - number of outputs in trainer is not equal to number of outputs in the training network.", _state); + ae_assert(nrestarts>=0, "MLPTrainNetworkX: internal error - NRestarts<0.", _state); + ae_assert(trnsubset->cnt>=trnsubsetsize, "MLPTrainNetworkX: internal error - parameter TrnSubsetSize more than input subset size(Length(TrnSubset)ptr.p_int[i]>=0&&trnsubset->ptr.p_int[i]<=s->npoints-1, "MLPTrainNetworkX: internal error - parameter TrnSubset contains incorrect index(TrnSubset[I]<0 or TrnSubset[I]>S.NPoints-1)", _state); + } + ae_assert(valsubset->cnt>=valsubsetsize, "MLPTrainNetworkX: internal error - parameter ValSubsetSize more than input subset size(Length(ValSubset)ptr.p_int[i]>=0&&valsubset->ptr.p_int[i]<=s->npoints-1, "MLPTrainNetworkX: internal error - parameter ValSubset contains incorrect index(ValSubset[I]<0 or ValSubset[I]>S.NPoints-1)", _state); + } + + /* + * Train + */ + randomizenetwork = nrestarts>0; + mlptrain_initmlptrnsessions(network, randomizenetwork, s, sessions, _state); + mlptrain_mlptrainnetworkx(s, nrestarts, algokind, trnsubset, trnsubsetsize, valsubset, valsubsetsize, network, rep, ae_false, sessions, _state); + + /* + * Choose best network + */ + bestrmserror = ae_maxrealnumber; + ae_shared_pool_first_recycled(sessions, &_psession, _state); + while(psession!=NULL) + { + if( ae_fp_less(psession->bestrmserror,bestrmserror) ) + { + mlpimporttunableparameters(network, &psession->bestparameters, _state); + bestrmserror = psession->bestrmserror; + } + ae_shared_pool_next_recycled(sessions, &_psession, _state); + } + + /* + * Calculate errors + */ + if( s->datatype==0 ) + { + mlpallerrorssubset(network, &s->densexy, s->npoints, trnsubset, trnsubsetsize, &modrep, _state); + } + if( s->datatype==1 ) + { + mlpallerrorssparsesubset(network, &s->sparsexy, s->npoints, trnsubset, trnsubsetsize, &modrep, _state); + } + rep->relclserror = modrep.relclserror; + rep->avgce = modrep.avgce; + rep->rmserror = modrep.rmserror; + rep->avgerror = modrep.avgerror; + rep->avgrelerror = modrep.avgrelerror; + + /* + * Done + */ + ae_frame_leave(_state); + return; + } + + /* + * Split problem, if we have more than 1 restart + */ + if( nrestarts>=2 ) + { + + /* + * Divide problem with NRestarts into two: NR0 and NR1. + */ + nr0 = nrestarts/2; + nr1 = nrestarts-nr0; + mlptrain_mlptrainnetworkx(s, nr0, algokind, trnsubset, trnsubsetsize, valsubset, valsubsetsize, network, &rep0, ae_false, sessions, _state); + mlptrain_mlptrainnetworkx(s, nr1, algokind, trnsubset, trnsubsetsize, valsubset, valsubsetsize, network, &rep1, ae_false, sessions, _state); + + /* + * Aggregate results + */ + rep->ngrad = rep0.ngrad+rep1.ngrad; + rep->nhess = rep0.nhess+rep1.nhess; + rep->ncholesky = rep0.ncholesky+rep1.ncholesky; + + /* + * Done :) + */ + ae_frame_leave(_state); + return; + } + + /* + * Execution with NRestarts=1 or NRestarts=0: + * * NRestarts=1 means that network is restarted from random position + * * NRestarts=0 means that network is not randomized + */ + ae_assert(nrestarts==0||nrestarts==1, "MLPTrainNetworkX: internal error", _state); + rep->ngrad = 0; + rep->nhess = 0; + rep->ncholesky = 0; + ae_shared_pool_retrieve(sessions, &_psession, _state); + if( ((s->datatype==0||s->datatype==1)&&s->npoints>0)&&trnsubsetsize!=0 ) + { + + /* + * Train network using combination of early stopping and step-size + * and step-count based criteria. Network state with best value of + * validation set error is stored in WBuf0. When validation set is + * zero, most recent state of network is stored. + */ + rndstart = nrestarts!=0; + ngradbatch = 0; + eval = 0; + ebest = 0; + itbest = 0; + itcnt = 0; + mlptrain_mlpstarttrainingx(s, rndstart, algokind, trnsubset, trnsubsetsize, psession, _state); + if( s->datatype==0 ) + { + ebest = mlperrorsubset(&psession->network, &s->densexy, s->npoints, valsubset, valsubsetsize, _state); + } + if( s->datatype==1 ) + { + ebest = mlperrorsparsesubset(&psession->network, &s->sparsexy, s->npoints, valsubset, valsubsetsize, _state); + } + ae_v_move(&psession->wbuf0.ptr.p_double[0], 1, &psession->network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + while(mlptrain_mlpcontinuetrainingx(s, trnsubset, trnsubsetsize, &ngradbatch, psession, _state)) + { + if( s->datatype==0 ) + { + eval = mlperrorsubset(&psession->network, &s->densexy, s->npoints, valsubset, valsubsetsize, _state); + } + if( s->datatype==1 ) + { + eval = mlperrorsparsesubset(&psession->network, &s->sparsexy, s->npoints, valsubset, valsubsetsize, _state); + } + if( ae_fp_less_eq(eval,ebest)||valsubsetsize==0 ) + { + ae_v_move(&psession->wbuf0.ptr.p_double[0], 1, &psession->network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + ebest = eval; + itbest = itcnt; + } + if( itcnt>30&&ae_fp_greater(itcnt,1.5*itbest) ) + { + break; + } + itcnt = itcnt+1; + } + ae_v_move(&psession->network.weights.ptr.p_double[0], 1, &psession->wbuf0.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + rep->ngrad = ngradbatch; + } + else + { + for(i=0; i<=wcount-1; i++) + { + psession->network.weights.ptr.p_double[i] = 0; + } + } + + /* + * Evaluate network performance and update PSession.BestParameters/BestRMSError + * (if needed). + */ + if( s->datatype==0 ) + { + mlpallerrorssubset(&psession->network, &s->densexy, s->npoints, trnsubset, trnsubsetsize, &modrep, _state); + } + if( s->datatype==1 ) + { + mlpallerrorssparsesubset(&psession->network, &s->sparsexy, s->npoints, trnsubset, trnsubsetsize, &modrep, _state); + } + if( ae_fp_less(modrep.rmserror,psession->bestrmserror) ) + { + mlpexporttunableparameters(&psession->network, &psession->bestparameters, &pcount, _state); + psession->bestrmserror = modrep.rmserror; + } + + /* + * Move session back to pool + */ + ae_shared_pool_recycle(sessions, &_psession, _state); + ae_frame_leave(_state); +} + + +static void mlptrain_mlptrainensemblex(mlptrainer* s, + mlpensemble* ensemble, + ae_int_t idx0, + ae_int_t idx1, + ae_int_t nrestarts, + ae_int_t trainingmethod, + sinteger* ngrad, + ae_bool isrootcall, + ae_shared_pool* esessions, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t pcount; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t trnsubsetsize; + ae_int_t valsubsetsize; + ae_int_t k0; + sinteger ngrad0; + sinteger ngrad1; + mlpetrnsession *psession; + ae_smart_ptr _psession; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + _sinteger_init(&ngrad0, _state, ae_true); + _sinteger_init(&ngrad1, _state, ae_true); + ae_smart_ptr_init(&_psession, (void**)&psession, _state, ae_true); + _hqrndstate_init(&rs, _state, ae_true); + + nin = mlpgetinputscount(&ensemble->network, _state); + nout = mlpgetoutputscount(&ensemble->network, _state); + wcount = mlpgetweightscount(&ensemble->network, _state); + if( mlpissoftmax(&ensemble->network, _state) ) + { + pcount = nin; + } + else + { + pcount = nin+nout; + } + if( nrestarts<=0 ) + { + nrestarts = 1; + } + + /* + * Handle degenerate case + */ + if( s->npoints<2 ) + { + for(i=idx0; i<=idx1-1; i++) + { + for(j=0; j<=wcount-1; j++) + { + ensemble->weights.ptr.p_double[i*wcount+j] = 0.0; + } + for(j=0; j<=pcount-1; j++) + { + ensemble->columnmeans.ptr.p_double[i*pcount+j] = 0.0; + ensemble->columnsigmas.ptr.p_double[i*pcount+j] = 1.0; + } + } + ae_frame_leave(_state); + return; + } + + /* + * Process root call + */ + if( isrootcall ) + { + + /* + * Prepare: + * * prepare MLPETrnSessions + * * fill ensemble by zeros (helps to detect errors) + */ + mlptrain_initmlpetrnsessions(&ensemble->network, s, esessions, _state); + for(i=idx0; i<=idx1-1; i++) + { + for(j=0; j<=wcount-1; j++) + { + ensemble->weights.ptr.p_double[i*wcount+j] = 0.0; + } + for(j=0; j<=pcount-1; j++) + { + ensemble->columnmeans.ptr.p_double[i*pcount+j] = 0.0; + ensemble->columnsigmas.ptr.p_double[i*pcount+j] = 0.0; + } + } + + /* + * Train in non-root mode and exit + */ + mlptrain_mlptrainensemblex(s, ensemble, idx0, idx1, nrestarts, trainingmethod, ngrad, ae_false, esessions, _state); + ae_frame_leave(_state); + return; + } + + /* + * Split problem + */ + if( idx1-idx0>=2 ) + { + k0 = (idx1-idx0)/2; + ngrad0.val = 0; + ngrad1.val = 0; + mlptrain_mlptrainensemblex(s, ensemble, idx0, idx0+k0, nrestarts, trainingmethod, &ngrad0, ae_false, esessions, _state); + mlptrain_mlptrainensemblex(s, ensemble, idx0+k0, idx1, nrestarts, trainingmethod, &ngrad1, ae_false, esessions, _state); + ngrad->val = ngrad0.val+ngrad1.val; + ae_frame_leave(_state); + return; + } + + /* + * Retrieve and prepare session + */ + ae_shared_pool_retrieve(esessions, &_psession, _state); + + /* + * Train + */ + hqrndrandomize(&rs, _state); + for(k=idx0; k<=idx1-1; k++) + { + + /* + * Split set + */ + trnsubsetsize = 0; + valsubsetsize = 0; + if( trainingmethod==0 ) + { + do + { + trnsubsetsize = 0; + valsubsetsize = 0; + for(i=0; i<=s->npoints-1; i++) + { + if( ae_fp_less(ae_randomreal(_state),0.66) ) + { + + /* + * Assign sample to training set + */ + psession->trnsubset.ptr.p_int[trnsubsetsize] = i; + trnsubsetsize = trnsubsetsize+1; + } + else + { + + /* + * Assign sample to validation set + */ + psession->valsubset.ptr.p_int[valsubsetsize] = i; + valsubsetsize = valsubsetsize+1; + } + } + } + while(!(trnsubsetsize!=0&&valsubsetsize!=0)); + } + if( trainingmethod==1 ) + { + valsubsetsize = 0; + trnsubsetsize = s->npoints; + for(i=0; i<=s->npoints-1; i++) + { + psession->trnsubset.ptr.p_int[i] = hqrnduniformi(&rs, s->npoints, _state); + } + } + + /* + * Train + */ + mlptrain_mlptrainnetworkx(s, nrestarts, -1, &psession->trnsubset, trnsubsetsize, &psession->valsubset, valsubsetsize, &psession->network, &psession->mlprep, ae_true, &psession->mlpsessions, _state); + ngrad->val = ngrad->val+psession->mlprep.ngrad; + + /* + * Save results + */ + ae_v_move(&ensemble->weights.ptr.p_double[k*wcount], 1, &psession->network.weights.ptr.p_double[0], 1, ae_v_len(k*wcount,(k+1)*wcount-1)); + ae_v_move(&ensemble->columnmeans.ptr.p_double[k*pcount], 1, &psession->network.columnmeans.ptr.p_double[0], 1, ae_v_len(k*pcount,(k+1)*pcount-1)); + ae_v_move(&ensemble->columnsigmas.ptr.p_double[k*pcount], 1, &psession->network.columnsigmas.ptr.p_double[0], 1, ae_v_len(k*pcount,(k+1)*pcount-1)); + } + + /* + * Recycle session + */ + ae_shared_pool_recycle(esessions, &_psession, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function performs step-by-step training of the neural network. Here +"step-by-step" means that training starts with MLPStartTrainingX call, +and then user subsequently calls MLPContinueTrainingX to perform one more +iteration of the training. + +After call to this function trainer object remembers network and is ready +to train it. However, no training is performed until first call to +MLPContinueTraining() function. Subsequent calls to MLPContinueTraining() +will advance traing progress one iteration further. + + + -- ALGLIB -- + Copyright 13.08.2012 by Bochkanov Sergey +*************************************************************************/ +static void mlptrain_mlpstarttrainingx(mlptrainer* s, + ae_bool randomstart, + ae_int_t algokind, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + smlptrnsession* session, + ae_state *_state) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntype; + ae_int_t ttype; + ae_int_t i; + + + + /* + * Check parameters + */ + ae_assert(s->npoints>=0, "MLPStartTrainingX: internal error - parameter S is not initialized or is spoiled(S.NPoints<0)", _state); + ae_assert(algokind==0||algokind==-1, "MLPStartTrainingX: unexpected AlgoKind", _state); + if( s->rcpar ) + { + ttype = 0; + } + else + { + ttype = 1; + } + if( !mlpissoftmax(&session->network, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + ae_assert(ntype==ttype, "MLPStartTrainingX: internal error - type of the resulting network is not similar to network type in trainer object", _state); + mlpproperties(&session->network, &nin, &nout, &wcount, _state); + ae_assert(s->nin==nin, "MLPStartTrainingX: number of inputs in trainer is not equal to number of inputs in the network.", _state); + ae_assert(s->nout==nout, "MLPStartTrainingX: number of outputs in trainer is not equal to number of outputs in the network.", _state); + ae_assert(subset->cnt>=subsetsize, "MLPStartTrainingX: internal error - parameter SubsetSize more than input subset size(Length(Subset)ptr.p_int[i]>=0&&subset->ptr.p_int[i]<=s->npoints-1, "MLPStartTrainingX: internal error - parameter Subset contains incorrect index(Subset[I]<0 or Subset[I]>S.NPoints-1)", _state); + } + + /* + * Prepare session + */ + minlbfgssetcond(&session->optimizer, 0.0, 0.0, s->wstep, s->maxits, _state); + if( s->npoints>0&&subsetsize!=0 ) + { + if( randomstart ) + { + mlprandomize(&session->network, _state); + } + minlbfgsrestartfrom(&session->optimizer, &session->network.weights, _state); + } + else + { + for(i=0; i<=wcount-1; i++) + { + session->network.weights.ptr.p_double[i] = 0; + } + } + if( algokind==-1 ) + { + session->algoused = s->algokind; + if( s->algokind==1 ) + { + session->minibatchsize = s->minibatchsize; + } + } + else + { + session->algoused = 0; + } + hqrndrandomize(&session->generator, _state); + ae_vector_set_length(&session->rstate.ia, 15+1, _state); + ae_vector_set_length(&session->rstate.ra, 1+1, _state); + session->rstate.stage = -1; +} + + +/************************************************************************* +This function performs step-by-step training of the neural network. Here +"step-by-step" means that training starts with MLPStartTrainingX call, +and then user subsequently calls MLPContinueTrainingX to perform one more +iteration of the training. + +This function performs one more iteration of the training and returns +either True (training continues) or False (training stopped). In case True +was returned, Network weights are updated according to the current state +of the optimization progress. In case False was returned, no additional +updates is performed (previous update of the network weights moved us to +the final point, and no additional updates is needed). + +EXAMPLE: + > + > [initialize network and trainer object] + > + > MLPStartTraining(Trainer, Network, True) + > while MLPContinueTraining(Trainer, Network) do + > [visualize training progress] + > + + + -- ALGLIB -- + Copyright 13.08.2012 by Bochkanov Sergey +*************************************************************************/ +static ae_bool mlptrain_mlpcontinuetrainingx(mlptrainer* s, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_int_t* ngradbatch, + smlptrnsession* session, + ae_state *_state) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t twcount; + ae_int_t ntype; + ae_int_t ttype; + double decay; + double v; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t trnsetsize; + ae_int_t epoch; + ae_int_t minibatchcount; + ae_int_t minibatchidx; + ae_int_t cursize; + ae_int_t idx0; + ae_int_t idx1; + ae_bool result; + + + + /* + * 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( session->rstate.stage>=0 ) + { + nin = session->rstate.ia.ptr.p_int[0]; + nout = session->rstate.ia.ptr.p_int[1]; + wcount = session->rstate.ia.ptr.p_int[2]; + twcount = session->rstate.ia.ptr.p_int[3]; + ntype = session->rstate.ia.ptr.p_int[4]; + ttype = session->rstate.ia.ptr.p_int[5]; + i = session->rstate.ia.ptr.p_int[6]; + j = session->rstate.ia.ptr.p_int[7]; + k = session->rstate.ia.ptr.p_int[8]; + trnsetsize = session->rstate.ia.ptr.p_int[9]; + epoch = session->rstate.ia.ptr.p_int[10]; + minibatchcount = session->rstate.ia.ptr.p_int[11]; + minibatchidx = session->rstate.ia.ptr.p_int[12]; + cursize = session->rstate.ia.ptr.p_int[13]; + idx0 = session->rstate.ia.ptr.p_int[14]; + idx1 = session->rstate.ia.ptr.p_int[15]; + decay = session->rstate.ra.ptr.p_double[0]; + v = session->rstate.ra.ptr.p_double[1]; + } + else + { + nin = -983; + nout = -989; + wcount = -834; + twcount = 900; + ntype = -287; + ttype = 364; + i = 214; + j = -338; + k = -686; + trnsetsize = 912; + epoch = 585; + minibatchcount = 497; + minibatchidx = -271; + cursize = -581; + idx0 = 745; + idx1 = -533; + decay = -77; + v = 678; + } + if( session->rstate.stage==0 ) + { + goto lbl_0; + } + + /* + * Routine body + */ + + /* + * Check correctness of inputs + */ + ae_assert(s->npoints>=0, "MLPContinueTrainingX: internal error - parameter S is not initialized or is spoiled(S.NPoints<0).", _state); + if( s->rcpar ) + { + ttype = 0; + } + else + { + ttype = 1; + } + if( !mlpissoftmax(&session->network, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + ae_assert(ntype==ttype, "MLPContinueTrainingX: internal error - type of the resulting network is not similar to network type in trainer object.", _state); + mlpproperties(&session->network, &nin, &nout, &wcount, _state); + ae_assert(s->nin==nin, "MLPContinueTrainingX: internal error - number of inputs in trainer is not equal to number of inputs in the network.", _state); + ae_assert(s->nout==nout, "MLPContinueTrainingX: internal error - number of outputs in trainer is not equal to number of outputs in the network.", _state); + ae_assert(subset->cnt>=subsetsize, "MLPContinueTrainingX: internal error - parameter SubsetSize more than input subset size(Length(Subset)ptr.p_int[i]>=0&&subset->ptr.p_int[i]<=s->npoints-1, "MLPContinueTrainingX: internal error - parameter Subset contains incorrect index(Subset[I]<0 or Subset[I]>S.NPoints-1).", _state); + } + + /* + * Quick exit on empty training set + */ + if( s->npoints==0||subsetsize==0 ) + { + result = ae_false; + return result; + } + + /* + * Minibatch training + */ + if( session->algoused==1 ) + { + ae_assert(ae_false, "MINIBATCH TRAINING IS NOT IMPLEMENTED YET", _state); + } + + /* + * Last option: full batch training + */ + decay = s->decay; +lbl_1: + if( !minlbfgsiteration(&session->optimizer, _state) ) + { + goto lbl_2; + } + if( !session->optimizer.xupdated ) + { + goto lbl_3; + } + ae_v_move(&session->network.weights.ptr.p_double[0], 1, &session->optimizer.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + session->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: +lbl_3: + ae_v_move(&session->network.weights.ptr.p_double[0], 1, &session->optimizer.x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + if( s->datatype==0 ) + { + mlpgradbatchsubset(&session->network, &s->densexy, s->npoints, subset, subsetsize, &session->optimizer.f, &session->optimizer.g, _state); + } + if( s->datatype==1 ) + { + mlpgradbatchsparsesubset(&session->network, &s->sparsexy, s->npoints, subset, subsetsize, &session->optimizer.f, &session->optimizer.g, _state); + } + + /* + * Increment number of operations performed on batch gradient + */ + *ngradbatch = *ngradbatch+1; + v = ae_v_dotproduct(&session->network.weights.ptr.p_double[0], 1, &session->network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + session->optimizer.f = session->optimizer.f+0.5*decay*v; + ae_v_addd(&session->optimizer.g.ptr.p_double[0], 1, &session->network.weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + goto lbl_1; +lbl_2: + minlbfgsresultsbuf(&session->optimizer, &session->network.weights, &session->optimizerrep, _state); + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + session->rstate.ia.ptr.p_int[0] = nin; + session->rstate.ia.ptr.p_int[1] = nout; + session->rstate.ia.ptr.p_int[2] = wcount; + session->rstate.ia.ptr.p_int[3] = twcount; + session->rstate.ia.ptr.p_int[4] = ntype; + session->rstate.ia.ptr.p_int[5] = ttype; + session->rstate.ia.ptr.p_int[6] = i; + session->rstate.ia.ptr.p_int[7] = j; + session->rstate.ia.ptr.p_int[8] = k; + session->rstate.ia.ptr.p_int[9] = trnsetsize; + session->rstate.ia.ptr.p_int[10] = epoch; + session->rstate.ia.ptr.p_int[11] = minibatchcount; + session->rstate.ia.ptr.p_int[12] = minibatchidx; + session->rstate.ia.ptr.p_int[13] = cursize; + session->rstate.ia.ptr.p_int[14] = idx0; + session->rstate.ia.ptr.p_int[15] = idx1; + session->rstate.ra.ptr.p_double[0] = decay; + session->rstate.ra.ptr.p_double[1] = v; + return result; +} + + +/************************************************************************* +Internal bagging subroutine. + + -- ALGLIB -- + Copyright 19.02.2009 by Bochkanov Sergey +*************************************************************************/ +static void mlptrain_mlpebagginginternal(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + double wstep, + ae_int_t maxits, + ae_bool lmalgorithm, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* ooberrors, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix xys; + ae_vector s; + ae_matrix oobbuf; + ae_vector oobcntbuf; + ae_vector x; + ae_vector y; + ae_vector dy; + ae_vector dsbuf; + ae_int_t ccnt; + ae_int_t pcnt; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double v; + mlpreport tmprep; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _mlpreport_clear(rep); + _mlpcvreport_clear(ooberrors); + ae_matrix_init(&xys, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&s, 0, DT_BOOL, _state, ae_true); + ae_matrix_init(&oobbuf, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&oobcntbuf, 0, DT_INT, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dsbuf, 0, DT_REAL, _state, ae_true); + _mlpreport_init(&tmprep, _state, ae_true); + _hqrndstate_init(&rs, _state, ae_true); + + nin = mlpgetinputscount(&ensemble->network, _state); + nout = mlpgetoutputscount(&ensemble->network, _state); + wcount = mlpgetweightscount(&ensemble->network, _state); + + /* + * Test for inputs + */ + if( (!lmalgorithm&&ae_fp_eq(wstep,0))&&maxits==0 ) + { + *info = -8; + ae_frame_leave(_state); + return; + } + if( ((npoints<=0||restarts<1)||ae_fp_less(wstep,0))||maxits<0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( mlpissoftmax(&ensemble->network, _state) ) + { + for(i=0; i<=npoints-1; i++) + { + if( ae_round(xy->ptr.pp_double[i][nin], _state)<0||ae_round(xy->ptr.pp_double[i][nin], _state)>=nout ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + } + + /* + * allocate temporaries + */ + *info = 2; + rep->ngrad = 0; + rep->nhess = 0; + rep->ncholesky = 0; + ooberrors->relclserror = 0; + ooberrors->avgce = 0; + ooberrors->rmserror = 0; + ooberrors->avgerror = 0; + ooberrors->avgrelerror = 0; + if( mlpissoftmax(&ensemble->network, _state) ) + { + ccnt = nin+1; + pcnt = nin; + } + else + { + ccnt = nin+nout; + pcnt = nin+nout; + } + ae_matrix_set_length(&xys, npoints, ccnt, _state); + ae_vector_set_length(&s, npoints, _state); + ae_matrix_set_length(&oobbuf, npoints, nout, _state); + ae_vector_set_length(&oobcntbuf, npoints, _state); + ae_vector_set_length(&x, nin, _state); + ae_vector_set_length(&y, nout, _state); + if( mlpissoftmax(&ensemble->network, _state) ) + { + ae_vector_set_length(&dy, 1, _state); + } + else + { + ae_vector_set_length(&dy, nout, _state); + } + for(i=0; i<=npoints-1; i++) + { + for(j=0; j<=nout-1; j++) + { + oobbuf.ptr.pp_double[i][j] = 0; + } + } + for(i=0; i<=npoints-1; i++) + { + oobcntbuf.ptr.p_int[i] = 0; + } + + /* + * main bagging cycle + */ + hqrndrandomize(&rs, _state); + for(k=0; k<=ensemble->ensemblesize-1; k++) + { + + /* + * prepare dataset + */ + for(i=0; i<=npoints-1; i++) + { + s.ptr.p_bool[i] = ae_false; + } + for(i=0; i<=npoints-1; i++) + { + j = hqrnduniformi(&rs, npoints, _state); + s.ptr.p_bool[j] = ae_true; + ae_v_move(&xys.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[j][0], 1, ae_v_len(0,ccnt-1)); + } + + /* + * train + */ + if( lmalgorithm ) + { + mlptrainlm(&ensemble->network, &xys, npoints, decay, restarts, info, &tmprep, _state); + } + else + { + mlptrainlbfgs(&ensemble->network, &xys, npoints, decay, restarts, wstep, maxits, info, &tmprep, _state); + } + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * save results + */ + rep->ngrad = rep->ngrad+tmprep.ngrad; + rep->nhess = rep->nhess+tmprep.nhess; + rep->ncholesky = rep->ncholesky+tmprep.ncholesky; + ae_v_move(&ensemble->weights.ptr.p_double[k*wcount], 1, &ensemble->network.weights.ptr.p_double[0], 1, ae_v_len(k*wcount,(k+1)*wcount-1)); + ae_v_move(&ensemble->columnmeans.ptr.p_double[k*pcnt], 1, &ensemble->network.columnmeans.ptr.p_double[0], 1, ae_v_len(k*pcnt,(k+1)*pcnt-1)); + ae_v_move(&ensemble->columnsigmas.ptr.p_double[k*pcnt], 1, &ensemble->network.columnsigmas.ptr.p_double[0], 1, ae_v_len(k*pcnt,(k+1)*pcnt-1)); + + /* + * OOB estimates + */ + for(i=0; i<=npoints-1; i++) + { + if( !s.ptr.p_bool[i] ) + { + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nin-1)); + mlpprocess(&ensemble->network, &x, &y, _state); + ae_v_add(&oobbuf.ptr.pp_double[i][0], 1, &y.ptr.p_double[0], 1, ae_v_len(0,nout-1)); + oobcntbuf.ptr.p_int[i] = oobcntbuf.ptr.p_int[i]+1; + } + } + } + + /* + * OOB estimates + */ + if( mlpissoftmax(&ensemble->network, _state) ) + { + dserrallocate(nout, &dsbuf, _state); + } + else + { + dserrallocate(-nout, &dsbuf, _state); + } + for(i=0; i<=npoints-1; i++) + { + if( oobcntbuf.ptr.p_int[i]!=0 ) + { + v = (double)1/(double)oobcntbuf.ptr.p_int[i]; + ae_v_moved(&y.ptr.p_double[0], 1, &oobbuf.ptr.pp_double[i][0], 1, ae_v_len(0,nout-1), v); + if( mlpissoftmax(&ensemble->network, _state) ) + { + dy.ptr.p_double[0] = xy->ptr.pp_double[i][nin]; + } + else + { + ae_v_moved(&dy.ptr.p_double[0], 1, &xy->ptr.pp_double[i][nin], 1, ae_v_len(0,nout-1), v); + } + dserraccumulate(&dsbuf, &y, &dy, _state); + } + } + dserrfinish(&dsbuf, _state); + ooberrors->relclserror = dsbuf.ptr.p_double[0]; + ooberrors->avgce = dsbuf.ptr.p_double[1]; + ooberrors->rmserror = dsbuf.ptr.p_double[2]; + ooberrors->avgerror = dsbuf.ptr.p_double[3]; + ooberrors->avgrelerror = dsbuf.ptr.p_double[4]; + ae_frame_leave(_state); +} + + +/************************************************************************* +This function initializes temporaries needed for training session. + + + -- ALGLIB -- + Copyright 01.07.2013 by Bochkanov Sergey +*************************************************************************/ +static void mlptrain_initmlptrnsession(multilayerperceptron* networktrained, + ae_bool randomizenetwork, + mlptrainer* trainer, + smlptrnsession* session, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t pcount; + ae_vector dummysubset; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&dummysubset, 0, DT_INT, _state, ae_true); + + + /* + * Prepare network: + * * copy input network to Session.Network + * * re-initialize preprocessor and weights if RandomizeNetwork=True + */ + mlpcopy(networktrained, &session->network, _state); + if( randomizenetwork ) + { + ae_assert(trainer->datatype==0||trainer->datatype==1, "InitTemporaries: unexpected Trainer.DataType", _state); + if( trainer->datatype==0 ) + { + mlpinitpreprocessorsubset(&session->network, &trainer->densexy, trainer->npoints, &dummysubset, -1, _state); + } + if( trainer->datatype==1 ) + { + mlpinitpreprocessorsparsesubset(&session->network, &trainer->sparsexy, trainer->npoints, &dummysubset, -1, _state); + } + mlprandomize(&session->network, _state); + session->randomizenetwork = ae_true; + } + else + { + session->randomizenetwork = ae_false; + } + + /* + * Determine network geometry and initialize optimizer + */ + mlpproperties(&session->network, &nin, &nout, &wcount, _state); + minlbfgscreate(wcount, ae_minint(wcount, trainer->lbfgsfactor, _state), &session->network.weights, &session->optimizer, _state); + minlbfgssetxrep(&session->optimizer, ae_true, _state); + + /* + * Create buffers + */ + ae_vector_set_length(&session->wbuf0, wcount, _state); + ae_vector_set_length(&session->wbuf1, wcount, _state); + + /* + * Initialize session result + */ + mlpexporttunableparameters(&session->network, &session->bestparameters, &pcount, _state); + session->bestrmserror = ae_maxrealnumber; + ae_frame_leave(_state); +} + + +/************************************************************************* +This function initializes temporaries needed for training session. + +*************************************************************************/ +static void mlptrain_initmlptrnsessions(multilayerperceptron* networktrained, + ae_bool randomizenetwork, + mlptrainer* trainer, + ae_shared_pool* sessions, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector dummysubset; + smlptrnsession t; + smlptrnsession *p; + ae_smart_ptr _p; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&dummysubset, 0, DT_INT, _state, ae_true); + _smlptrnsession_init(&t, _state, ae_true); + ae_smart_ptr_init(&_p, (void**)&p, _state, ae_true); + + if( ae_shared_pool_is_initialized(sessions) ) + { + + /* + * Pool was already initialized. + * Clear sessions stored in the pool. + */ + ae_shared_pool_first_recycled(sessions, &_p, _state); + while(p!=NULL) + { + ae_assert(mlpsamearchitecture(&p->network, networktrained, _state), "InitMLPTrnSessions: internal consistency error", _state); + p->bestrmserror = ae_maxrealnumber; + ae_shared_pool_next_recycled(sessions, &_p, _state); + } + } + else + { + + /* + * Prepare session and seed pool + */ + mlptrain_initmlptrnsession(networktrained, randomizenetwork, trainer, &t, _state); + ae_shared_pool_set_seed(sessions, &t, sizeof(t), _smlptrnsession_init, _smlptrnsession_init_copy, _smlptrnsession_destroy, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function initializes temporaries needed for ensemble training. + +*************************************************************************/ +static void mlptrain_initmlpetrnsession(multilayerperceptron* individualnetwork, + mlptrainer* trainer, + mlpetrnsession* session, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector dummysubset; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&dummysubset, 0, DT_INT, _state, ae_true); + + + /* + * Prepare network: + * * copy input network to Session.Network + * * re-initialize preprocessor and weights if RandomizeNetwork=True + */ + mlpcopy(individualnetwork, &session->network, _state); + mlptrain_initmlptrnsessions(individualnetwork, ae_true, trainer, &session->mlpsessions, _state); + ivectorsetlengthatleast(&session->trnsubset, trainer->npoints, _state); + ivectorsetlengthatleast(&session->valsubset, trainer->npoints, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function initializes temporaries needed for training session. + +*************************************************************************/ +static void mlptrain_initmlpetrnsessions(multilayerperceptron* individualnetwork, + mlptrainer* trainer, + ae_shared_pool* sessions, + ae_state *_state) +{ + ae_frame _frame_block; + mlpetrnsession t; + + ae_frame_make(_state, &_frame_block); + _mlpetrnsession_init(&t, _state, ae_true); + + if( !ae_shared_pool_is_initialized(sessions) ) + { + mlptrain_initmlpetrnsession(individualnetwork, trainer, &t, _state); + ae_shared_pool_set_seed(sessions, &t, sizeof(t), _mlpetrnsession_init, _mlpetrnsession_init_copy, _mlpetrnsession_destroy, _state); + } + ae_frame_leave(_state); +} + + +ae_bool _mlpreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mlpreport *p = (mlpreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _mlpreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mlpreport *dst = (mlpreport*)_dst; + mlpreport *src = (mlpreport*)_src; + dst->relclserror = src->relclserror; + dst->avgce = src->avgce; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + dst->ngrad = src->ngrad; + dst->nhess = src->nhess; + dst->ncholesky = src->ncholesky; + return ae_true; +} + + +void _mlpreport_clear(void* _p) +{ + mlpreport *p = (mlpreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _mlpreport_destroy(void* _p) +{ + mlpreport *p = (mlpreport*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _mlpcvreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mlpcvreport *p = (mlpcvreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _mlpcvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mlpcvreport *dst = (mlpcvreport*)_dst; + mlpcvreport *src = (mlpcvreport*)_src; + dst->relclserror = src->relclserror; + dst->avgce = src->avgce; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + return ae_true; +} + + +void _mlpcvreport_clear(void* _p) +{ + mlpcvreport *p = (mlpcvreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _mlpcvreport_destroy(void* _p) +{ + mlpcvreport *p = (mlpcvreport*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _smlptrnsession_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + smlptrnsession *p = (smlptrnsession*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->bestparameters, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_multilayerperceptron_init(&p->network, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsstate_init(&p->optimizer, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsreport_init(&p->optimizerrep, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->wbuf0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->wbuf1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->allminibatches, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->currentminibatch, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + if( !_hqrndstate_init(&p->generator, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _smlptrnsession_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + smlptrnsession *dst = (smlptrnsession*)_dst; + smlptrnsession *src = (smlptrnsession*)_src; + if( !ae_vector_init_copy(&dst->bestparameters, &src->bestparameters, _state, make_automatic) ) + return ae_false; + dst->bestrmserror = src->bestrmserror; + dst->randomizenetwork = src->randomizenetwork; + if( !_multilayerperceptron_init_copy(&dst->network, &src->network, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsstate_init_copy(&dst->optimizer, &src->optimizer, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsreport_init_copy(&dst->optimizerrep, &src->optimizerrep, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->wbuf0, &src->wbuf0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->wbuf1, &src->wbuf1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->allminibatches, &src->allminibatches, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->currentminibatch, &src->currentminibatch, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + dst->algoused = src->algoused; + dst->minibatchsize = src->minibatchsize; + if( !_hqrndstate_init_copy(&dst->generator, &src->generator, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _smlptrnsession_clear(void* _p) +{ + smlptrnsession *p = (smlptrnsession*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->bestparameters); + _multilayerperceptron_clear(&p->network); + _minlbfgsstate_clear(&p->optimizer); + _minlbfgsreport_clear(&p->optimizerrep); + ae_vector_clear(&p->wbuf0); + ae_vector_clear(&p->wbuf1); + ae_vector_clear(&p->allminibatches); + ae_vector_clear(&p->currentminibatch); + _rcommstate_clear(&p->rstate); + _hqrndstate_clear(&p->generator); +} + + +void _smlptrnsession_destroy(void* _p) +{ + smlptrnsession *p = (smlptrnsession*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->bestparameters); + _multilayerperceptron_destroy(&p->network); + _minlbfgsstate_destroy(&p->optimizer); + _minlbfgsreport_destroy(&p->optimizerrep); + ae_vector_destroy(&p->wbuf0); + ae_vector_destroy(&p->wbuf1); + ae_vector_destroy(&p->allminibatches); + ae_vector_destroy(&p->currentminibatch); + _rcommstate_destroy(&p->rstate); + _hqrndstate_destroy(&p->generator); +} + + +ae_bool _mlpetrnsession_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mlpetrnsession *p = (mlpetrnsession*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->trnsubset, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->valsubset, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init(&p->mlpsessions, _state, make_automatic) ) + return ae_false; + if( !_mlpreport_init(&p->mlprep, _state, make_automatic) ) + return ae_false; + if( !_multilayerperceptron_init(&p->network, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _mlpetrnsession_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mlpetrnsession *dst = (mlpetrnsession*)_dst; + mlpetrnsession *src = (mlpetrnsession*)_src; + if( !ae_vector_init_copy(&dst->trnsubset, &src->trnsubset, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->valsubset, &src->valsubset, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init_copy(&dst->mlpsessions, &src->mlpsessions, _state, make_automatic) ) + return ae_false; + if( !_mlpreport_init_copy(&dst->mlprep, &src->mlprep, _state, make_automatic) ) + return ae_false; + if( !_multilayerperceptron_init_copy(&dst->network, &src->network, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _mlpetrnsession_clear(void* _p) +{ + mlpetrnsession *p = (mlpetrnsession*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->trnsubset); + ae_vector_clear(&p->valsubset); + ae_shared_pool_clear(&p->mlpsessions); + _mlpreport_clear(&p->mlprep); + _multilayerperceptron_clear(&p->network); +} + + +void _mlpetrnsession_destroy(void* _p) +{ + mlpetrnsession *p = (mlpetrnsession*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->trnsubset); + ae_vector_destroy(&p->valsubset); + ae_shared_pool_destroy(&p->mlpsessions); + _mlpreport_destroy(&p->mlprep); + _multilayerperceptron_destroy(&p->network); +} + + +ae_bool _mlptrainer_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mlptrainer *p = (mlptrainer*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->densexy, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_sparsematrix_init(&p->sparsexy, _state, make_automatic) ) + return ae_false; + if( !_smlptrnsession_init(&p->session, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->subset, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->valsubset, 0, DT_INT, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _mlptrainer_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mlptrainer *dst = (mlptrainer*)_dst; + mlptrainer *src = (mlptrainer*)_src; + dst->nin = src->nin; + dst->nout = src->nout; + dst->rcpar = src->rcpar; + dst->lbfgsfactor = src->lbfgsfactor; + dst->decay = src->decay; + dst->wstep = src->wstep; + dst->maxits = src->maxits; + dst->datatype = src->datatype; + dst->npoints = src->npoints; + if( !ae_matrix_init_copy(&dst->densexy, &src->densexy, _state, make_automatic) ) + return ae_false; + if( !_sparsematrix_init_copy(&dst->sparsexy, &src->sparsexy, _state, make_automatic) ) + return ae_false; + if( !_smlptrnsession_init_copy(&dst->session, &src->session, _state, make_automatic) ) + return ae_false; + dst->ngradbatch = src->ngradbatch; + if( !ae_vector_init_copy(&dst->subset, &src->subset, _state, make_automatic) ) + return ae_false; + dst->subsetsize = src->subsetsize; + if( !ae_vector_init_copy(&dst->valsubset, &src->valsubset, _state, make_automatic) ) + return ae_false; + dst->valsubsetsize = src->valsubsetsize; + dst->algokind = src->algokind; + dst->minibatchsize = src->minibatchsize; + return ae_true; +} + + +void _mlptrainer_clear(void* _p) +{ + mlptrainer *p = (mlptrainer*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->densexy); + _sparsematrix_clear(&p->sparsexy); + _smlptrnsession_clear(&p->session); + ae_vector_clear(&p->subset); + ae_vector_clear(&p->valsubset); +} + + +void _mlptrainer_destroy(void* _p) +{ + mlptrainer *p = (mlptrainer*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->densexy); + _sparsematrix_destroy(&p->sparsexy); + _smlptrnsession_destroy(&p->session); + ae_vector_destroy(&p->subset); + ae_vector_destroy(&p->valsubset); +} + + +ae_bool _mlpparallelizationcv_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mlpparallelizationcv *p = (mlpparallelizationcv*)_p; + ae_touch_ptr((void*)p); + if( !_multilayerperceptron_init(&p->network, _state, make_automatic) ) + return ae_false; + if( !_mlpreport_init(&p->rep, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->subset, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xyrow, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_shared_pool_init(&p->trnpool, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _mlpparallelizationcv_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mlpparallelizationcv *dst = (mlpparallelizationcv*)_dst; + mlpparallelizationcv *src = (mlpparallelizationcv*)_src; + if( !_multilayerperceptron_init_copy(&dst->network, &src->network, _state, make_automatic) ) + return ae_false; + if( !_mlpreport_init_copy(&dst->rep, &src->rep, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->subset, &src->subset, _state, make_automatic) ) + return ae_false; + dst->subsetsize = src->subsetsize; + if( !ae_vector_init_copy(&dst->xyrow, &src->xyrow, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + dst->ngrad = src->ngrad; + if( !ae_shared_pool_init_copy(&dst->trnpool, &src->trnpool, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _mlpparallelizationcv_clear(void* _p) +{ + mlpparallelizationcv *p = (mlpparallelizationcv*)_p; + ae_touch_ptr((void*)p); + _multilayerperceptron_clear(&p->network); + _mlpreport_clear(&p->rep); + ae_vector_clear(&p->subset); + ae_vector_clear(&p->xyrow); + ae_vector_clear(&p->y); + ae_shared_pool_clear(&p->trnpool); +} + + +void _mlpparallelizationcv_destroy(void* _p) +{ + mlpparallelizationcv *p = (mlpparallelizationcv*)_p; + ae_touch_ptr((void*)p); + _multilayerperceptron_destroy(&p->network); + _mlpreport_destroy(&p->rep); + ae_vector_destroy(&p->subset); + ae_vector_destroy(&p->xyrow); + ae_vector_destroy(&p->y); + ae_shared_pool_destroy(&p->trnpool); +} + + + + +/************************************************************************* +Principal components analysis + +Subroutine builds orthogonal basis where first axis corresponds to +direction with maximum variance, second axis maximizes variance in subspace +orthogonal to first axis and so on. + +It should be noted that, unlike LDA, PCA does not use class labels. + +INPUT PARAMETERS: + X - dataset, array[0..NPoints-1,0..NVars-1]. + matrix contains ONLY INDEPENDENT VARIABLES. + NPoints - dataset size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + +ÂÛÕÎÄÍÛÅ ÏÀÐÀÌÅÒÐÛ: + Info - return code: + * -4, if SVD subroutine haven't converged + * -1, if wrong parameters has been passed (NPoints<0, + NVars<1) + * 1, if task is solved + S2 - array[0..NVars-1]. variance values corresponding + to basis vectors. + V - array[0..NVars-1,0..NVars-1] + matrix, whose columns store basis vectors. + + -- ALGLIB -- + Copyright 25.08.2008 by Bochkanov Sergey +*************************************************************************/ +void pcabuildbasis(/* Real */ ae_matrix* x, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + /* Real */ ae_vector* s2, + /* Real */ ae_matrix* v, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix a; + ae_matrix u; + ae_matrix vt; + ae_vector m; + ae_vector t; + ae_int_t i; + ae_int_t j; + double mean; + double variance; + double skewness; + double kurtosis; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(s2); + ae_matrix_clear(v); + ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&m, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + + /* + * Check input data + */ + if( npoints<0||nvars<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * Special case: NPoints=0 + */ + if( npoints==0 ) + { + ae_vector_set_length(s2, nvars-1+1, _state); + ae_matrix_set_length(v, nvars-1+1, nvars-1+1, _state); + for(i=0; i<=nvars-1; i++) + { + s2->ptr.p_double[i] = 0; + } + for(i=0; i<=nvars-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + if( i==j ) + { + v->ptr.pp_double[i][j] = 1; + } + else + { + v->ptr.pp_double[i][j] = 0; + } + } + } + ae_frame_leave(_state); + return; + } + + /* + * Calculate means + */ + ae_vector_set_length(&m, nvars-1+1, _state); + ae_vector_set_length(&t, npoints-1+1, _state); + for(j=0; j<=nvars-1; j++) + { + ae_v_move(&t.ptr.p_double[0], 1, &x->ptr.pp_double[0][j], x->stride, ae_v_len(0,npoints-1)); + samplemoments(&t, npoints, &mean, &variance, &skewness, &kurtosis, _state); + m.ptr.p_double[j] = mean; + } + + /* + * Center, apply SVD, prepare output + */ + ae_matrix_set_length(&a, ae_maxint(npoints, nvars, _state)-1+1, nvars-1+1, _state); + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&a.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,nvars-1)); + ae_v_sub(&a.ptr.pp_double[i][0], 1, &m.ptr.p_double[0], 1, ae_v_len(0,nvars-1)); + } + for(i=npoints; i<=nvars-1; i++) + { + for(j=0; j<=nvars-1; j++) + { + a.ptr.pp_double[i][j] = 0; + } + } + if( !rmatrixsvd(&a, ae_maxint(npoints, nvars, _state), nvars, 0, 1, 2, s2, &u, &vt, _state) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + if( npoints!=1 ) + { + for(i=0; i<=nvars-1; i++) + { + s2->ptr.p_double[i] = ae_sqr(s2->ptr.p_double[i], _state)/(npoints-1); + } + } + ae_matrix_set_length(v, nvars-1+1, nvars-1+1, _state); + copyandtranspose(&vt, 0, nvars-1, 0, nvars-1, v, 0, nvars-1, 0, nvars-1, _state); + ae_frame_leave(_state); +} + + + +} + diff --git a/psdlag/src/dataanalysis.h b/psdlag/src/dataanalysis.h new file mode 100644 index 0000000..4aed876 --- /dev/null +++ b/psdlag/src/dataanalysis.h @@ -0,0 +1,7394 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _dataanalysis_pkg_h +#define _dataanalysis_pkg_h +#include "ap.h" +#include "alglibinternal.h" +#include "linalg.h" +#include "statistics.h" +#include "alglibmisc.h" +#include "specialfunctions.h" +#include "solvers.h" +#include "optimization.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + double relclserror; + double avgce; + double rmserror; + double avgerror; + double avgrelerror; +} cvreport; +typedef struct +{ + ae_int_t npoints; + ae_int_t nfeatures; + ae_int_t disttype; + ae_matrix xy; + ae_matrix d; + ae_int_t ahcalgo; + ae_int_t kmeansrestarts; + ae_int_t kmeansmaxits; +} clusterizerstate; +typedef struct +{ + ae_int_t npoints; + ae_vector p; + ae_matrix z; + ae_matrix pz; + ae_matrix pm; + ae_vector mergedist; +} ahcreport; +typedef struct +{ + ae_int_t npoints; + ae_int_t nfeatures; + ae_int_t terminationtype; + ae_int_t k; + ae_matrix c; + ae_vector cidx; +} kmeansreport; +typedef struct +{ + ae_int_t nvars; + ae_int_t nclasses; + ae_int_t ntrees; + ae_int_t bufsize; + ae_vector trees; +} decisionforest; +typedef struct +{ + double relclserror; + double avgce; + double rmserror; + double avgerror; + double avgrelerror; + double oobrelclserror; + double oobavgce; + double oobrmserror; + double oobavgerror; + double oobavgrelerror; +} dfreport; +typedef struct +{ + ae_vector treebuf; + ae_vector idxbuf; + ae_vector tmpbufr; + ae_vector tmpbufr2; + ae_vector tmpbufi; + ae_vector classibuf; + ae_vector sortrbuf; + ae_vector sortrbuf2; + ae_vector sortibuf; + ae_vector varpool; + ae_vector evsbin; + ae_vector evssplits; +} dfinternalbuffers; +typedef struct +{ + ae_vector w; +} linearmodel; +typedef struct +{ + ae_matrix c; + double rmserror; + double avgerror; + double avgrelerror; + double cvrmserror; + double cvavgerror; + double cvavgrelerror; + ae_int_t ncvdefects; + ae_vector cvdefects; +} lrreport; +typedef struct +{ + double relclserror; + double avgce; + double rmserror; + double avgerror; + double avgrelerror; +} modelerrors; +typedef struct +{ + double f; + ae_vector g; +} smlpgrad; +typedef struct +{ + ae_int_t hlnetworktype; + ae_int_t hlnormtype; + ae_vector hllayersizes; + ae_vector hlconnections; + ae_vector hlneurons; + ae_vector structinfo; + ae_vector weights; + ae_vector columnmeans; + ae_vector columnsigmas; + ae_vector neurons; + ae_vector dfdnet; + ae_vector derror; + ae_vector x; + ae_vector y; + ae_matrix xy; + ae_vector xyrow; + ae_vector nwbuf; + ae_vector integerbuf; + modelerrors err; + ae_vector rndbuf; + ae_shared_pool buf; + ae_shared_pool gradbuf; + ae_matrix dummydxy; + sparsematrix dummysxy; + ae_vector dummyidx; + ae_shared_pool dummypool; +} multilayerperceptron; +typedef struct +{ + ae_vector w; +} logitmodel; +typedef struct +{ + ae_bool brackt; + ae_bool stage1; + ae_int_t infoc; + double dg; + double dgm; + double dginit; + double dgtest; + double dgx; + double dgxm; + double dgy; + double dgym; + double finit; + double ftest1; + double fm; + double fx; + double fxm; + double fy; + double fym; + double stx; + double sty; + double stmin; + double stmax; + double width; + double width1; + double xtrapf; +} logitmcstate; +typedef struct +{ + ae_int_t ngrad; + ae_int_t nhess; +} mnlreport; +typedef struct +{ + ae_int_t n; + ae_vector states; + ae_int_t npairs; + ae_matrix data; + ae_matrix ec; + ae_matrix bndl; + ae_matrix bndu; + ae_matrix c; + ae_vector ct; + ae_int_t ccnt; + ae_vector pw; + ae_matrix priorp; + double regterm; + minbleicstate bs; + ae_int_t repinneriterationscount; + ae_int_t repouteriterationscount; + ae_int_t repnfev; + ae_int_t repterminationtype; + minbleicreport br; + ae_vector tmpp; + ae_vector effectivew; + ae_vector effectivebndl; + ae_vector effectivebndu; + ae_matrix effectivec; + ae_vector effectivect; + ae_vector h; + ae_matrix p; +} mcpdstate; +typedef struct +{ + ae_int_t inneriterationscount; + ae_int_t outeriterationscount; + ae_int_t nfev; + ae_int_t terminationtype; +} mcpdreport; +typedef struct +{ + ae_int_t ensemblesize; + ae_vector weights; + ae_vector columnmeans; + ae_vector columnsigmas; + multilayerperceptron network; + ae_vector y; +} mlpensemble; +typedef struct +{ + double relclserror; + double avgce; + double rmserror; + double avgerror; + double avgrelerror; + ae_int_t ngrad; + ae_int_t nhess; + ae_int_t ncholesky; +} mlpreport; +typedef struct +{ + double relclserror; + double avgce; + double rmserror; + double avgerror; + double avgrelerror; +} mlpcvreport; +typedef struct +{ + ae_vector bestparameters; + double bestrmserror; + ae_bool randomizenetwork; + multilayerperceptron network; + minlbfgsstate optimizer; + minlbfgsreport optimizerrep; + ae_vector wbuf0; + ae_vector wbuf1; + ae_vector allminibatches; + ae_vector currentminibatch; + rcommstate rstate; + ae_int_t algoused; + ae_int_t minibatchsize; + hqrndstate generator; +} smlptrnsession; +typedef struct +{ + ae_vector trnsubset; + ae_vector valsubset; + ae_shared_pool mlpsessions; + mlpreport mlprep; + multilayerperceptron network; +} mlpetrnsession; +typedef struct +{ + ae_int_t nin; + ae_int_t nout; + ae_bool rcpar; + ae_int_t lbfgsfactor; + double decay; + double wstep; + ae_int_t maxits; + ae_int_t datatype; + ae_int_t npoints; + ae_matrix densexy; + sparsematrix sparsexy; + smlptrnsession session; + ae_int_t ngradbatch; + ae_vector subset; + ae_int_t subsetsize; + ae_vector valsubset; + ae_int_t valsubsetsize; + ae_int_t algokind; + ae_int_t minibatchsize; +} mlptrainer; +typedef struct +{ + multilayerperceptron network; + mlpreport rep; + ae_vector subset; + ae_int_t subsetsize; + ae_vector xyrow; + ae_vector y; + ae_int_t ngrad; + ae_shared_pool trnpool; +} mlpparallelizationcv; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + + +/************************************************************************* +This structure is a clusterization engine. + +You should not try to access its fields directly. +Use ALGLIB functions in order to work with this object. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +class _clusterizerstate_owner +{ +public: + _clusterizerstate_owner(); + _clusterizerstate_owner(const _clusterizerstate_owner &rhs); + _clusterizerstate_owner& operator=(const _clusterizerstate_owner &rhs); + virtual ~_clusterizerstate_owner(); + alglib_impl::clusterizerstate* c_ptr(); + alglib_impl::clusterizerstate* c_ptr() const; +protected: + alglib_impl::clusterizerstate *p_struct; +}; +class clusterizerstate : public _clusterizerstate_owner +{ +public: + clusterizerstate(); + clusterizerstate(const clusterizerstate &rhs); + clusterizerstate& operator=(const clusterizerstate &rhs); + virtual ~clusterizerstate(); + +}; + + +/************************************************************************* +This structure is used to store results of the agglomerative hierarchical +clustering (AHC). + +Following information is returned: + +* NPoints contains number of points in the original dataset + +* Z contains information about merges performed (see below). Z contains + indexes from the original (unsorted) dataset and it can be used when you + need to know what points were merged. However, it is not convenient when + you want to build a dendrograd (see below). + +* if you want to build dendrogram, you can use Z, but it is not good + option, because Z contains indexes from unsorted dataset. Dendrogram + built from such dataset is likely to have intersections. So, you have to + reorder you points before building dendrogram. + Permutation which reorders point is returned in P. Another representation + of merges, which is more convenient for dendorgram construction, is + returned in PM. + +* more information on format of Z, P and PM can be found below and in the + examples from ALGLIB Reference Manual. + +FORMAL DESCRIPTION OF FIELDS: + NPoints number of points + Z array[NPoints-1,2], contains indexes of clusters + linked in pairs to form clustering tree. I-th row + corresponds to I-th merge: + * Z[I,0] - index of the first cluster to merge + * Z[I,1] - index of the second cluster to merge + * Z[I,0]=0 + NFeatures number of variables, >=1 + TerminationType completion code: + * -5 if distance type is anything different from + Euclidean metric + * -3 for degenerate dataset: a) less than K distinct + points, b) K=0 for non-empty dataset. + * +1 for successful completion + K number of clusters + C array[K,NFeatures], rows of the array store centers + CIdx array[NPoints], which contains cluster indexes + + -- ALGLIB -- + Copyright 27.11.2012 by Bochkanov Sergey +*************************************************************************/ +class _kmeansreport_owner +{ +public: + _kmeansreport_owner(); + _kmeansreport_owner(const _kmeansreport_owner &rhs); + _kmeansreport_owner& operator=(const _kmeansreport_owner &rhs); + virtual ~_kmeansreport_owner(); + alglib_impl::kmeansreport* c_ptr(); + alglib_impl::kmeansreport* c_ptr() const; +protected: + alglib_impl::kmeansreport *p_struct; +}; +class kmeansreport : public _kmeansreport_owner +{ +public: + kmeansreport(); + kmeansreport(const kmeansreport &rhs); + kmeansreport& operator=(const kmeansreport &rhs); + virtual ~kmeansreport(); + ae_int_t &npoints; + ae_int_t &nfeatures; + ae_int_t &terminationtype; + ae_int_t &k; + real_2d_array c; + integer_1d_array cidx; + +}; + + + +/************************************************************************* + +*************************************************************************/ +class _decisionforest_owner +{ +public: + _decisionforest_owner(); + _decisionforest_owner(const _decisionforest_owner &rhs); + _decisionforest_owner& operator=(const _decisionforest_owner &rhs); + virtual ~_decisionforest_owner(); + alglib_impl::decisionforest* c_ptr(); + alglib_impl::decisionforest* c_ptr() const; +protected: + alglib_impl::decisionforest *p_struct; +}; +class decisionforest : public _decisionforest_owner +{ +public: + decisionforest(); + decisionforest(const decisionforest &rhs); + decisionforest& operator=(const decisionforest &rhs); + virtual ~decisionforest(); + +}; + + +/************************************************************************* + +*************************************************************************/ +class _dfreport_owner +{ +public: + _dfreport_owner(); + _dfreport_owner(const _dfreport_owner &rhs); + _dfreport_owner& operator=(const _dfreport_owner &rhs); + virtual ~_dfreport_owner(); + alglib_impl::dfreport* c_ptr(); + alglib_impl::dfreport* c_ptr() const; +protected: + alglib_impl::dfreport *p_struct; +}; +class dfreport : public _dfreport_owner +{ +public: + dfreport(); + dfreport(const dfreport &rhs); + dfreport& operator=(const dfreport &rhs); + virtual ~dfreport(); + double &relclserror; + double &avgce; + double &rmserror; + double &avgerror; + double &avgrelerror; + double &oobrelclserror; + double &oobavgce; + double &oobrmserror; + double &oobavgerror; + double &oobavgrelerror; + +}; + +/************************************************************************* + +*************************************************************************/ +class _linearmodel_owner +{ +public: + _linearmodel_owner(); + _linearmodel_owner(const _linearmodel_owner &rhs); + _linearmodel_owner& operator=(const _linearmodel_owner &rhs); + virtual ~_linearmodel_owner(); + alglib_impl::linearmodel* c_ptr(); + alglib_impl::linearmodel* c_ptr() const; +protected: + alglib_impl::linearmodel *p_struct; +}; +class linearmodel : public _linearmodel_owner +{ +public: + linearmodel(); + linearmodel(const linearmodel &rhs); + linearmodel& operator=(const linearmodel &rhs); + virtual ~linearmodel(); + +}; + + +/************************************************************************* +LRReport structure contains additional information about linear model: +* C - covariation matrix, array[0..NVars,0..NVars]. + C[i,j] = Cov(A[i],A[j]) +* RMSError - root mean square error on a training set +* AvgError - average error on a training set +* AvgRelError - average relative error on a training set (excluding + observations with zero function value). +* CVRMSError - leave-one-out cross-validation estimate of + generalization error. Calculated using fast algorithm + with O(NVars*NPoints) complexity. +* CVAvgError - cross-validation estimate of average error +* CVAvgRelError - cross-validation estimate of average relative error + +All other fields of the structure are intended for internal use and should +not be used outside ALGLIB. +*************************************************************************/ +class _lrreport_owner +{ +public: + _lrreport_owner(); + _lrreport_owner(const _lrreport_owner &rhs); + _lrreport_owner& operator=(const _lrreport_owner &rhs); + virtual ~_lrreport_owner(); + alglib_impl::lrreport* c_ptr(); + alglib_impl::lrreport* c_ptr() const; +protected: + alglib_impl::lrreport *p_struct; +}; +class lrreport : public _lrreport_owner +{ +public: + lrreport(); + lrreport(const lrreport &rhs); + lrreport& operator=(const lrreport &rhs); + virtual ~lrreport(); + real_2d_array c; + double &rmserror; + double &avgerror; + double &avgrelerror; + double &cvrmserror; + double &cvavgerror; + double &cvavgrelerror; + ae_int_t &ncvdefects; + integer_1d_array cvdefects; + +}; + + + + + +/************************************************************************* +Model's errors: + * RelCLSError - fraction of misclassified cases. + * AvgCE - acerage cross-entropy + * RMSError - root-mean-square error + * AvgError - average error + * AvgRelError - average relative error + +NOTE 1: RelCLSError/AvgCE are zero on regression problems. + +NOTE 2: on classification problems RMSError/AvgError/AvgRelError contain + errors in prediction of posterior probabilities +*************************************************************************/ +class _modelerrors_owner +{ +public: + _modelerrors_owner(); + _modelerrors_owner(const _modelerrors_owner &rhs); + _modelerrors_owner& operator=(const _modelerrors_owner &rhs); + virtual ~_modelerrors_owner(); + alglib_impl::modelerrors* c_ptr(); + alglib_impl::modelerrors* c_ptr() const; +protected: + alglib_impl::modelerrors *p_struct; +}; +class modelerrors : public _modelerrors_owner +{ +public: + modelerrors(); + modelerrors(const modelerrors &rhs); + modelerrors& operator=(const modelerrors &rhs); + virtual ~modelerrors(); + double &relclserror; + double &avgce; + double &rmserror; + double &avgerror; + double &avgrelerror; + +}; + + +/************************************************************************* + +*************************************************************************/ +class _multilayerperceptron_owner +{ +public: + _multilayerperceptron_owner(); + _multilayerperceptron_owner(const _multilayerperceptron_owner &rhs); + _multilayerperceptron_owner& operator=(const _multilayerperceptron_owner &rhs); + virtual ~_multilayerperceptron_owner(); + alglib_impl::multilayerperceptron* c_ptr(); + alglib_impl::multilayerperceptron* c_ptr() const; +protected: + alglib_impl::multilayerperceptron *p_struct; +}; +class multilayerperceptron : public _multilayerperceptron_owner +{ +public: + multilayerperceptron(); + multilayerperceptron(const multilayerperceptron &rhs); + multilayerperceptron& operator=(const multilayerperceptron &rhs); + virtual ~multilayerperceptron(); + +}; + +/************************************************************************* + +*************************************************************************/ +class _logitmodel_owner +{ +public: + _logitmodel_owner(); + _logitmodel_owner(const _logitmodel_owner &rhs); + _logitmodel_owner& operator=(const _logitmodel_owner &rhs); + virtual ~_logitmodel_owner(); + alglib_impl::logitmodel* c_ptr(); + alglib_impl::logitmodel* c_ptr() const; +protected: + alglib_impl::logitmodel *p_struct; +}; +class logitmodel : public _logitmodel_owner +{ +public: + logitmodel(); + logitmodel(const logitmodel &rhs); + logitmodel& operator=(const logitmodel &rhs); + virtual ~logitmodel(); + +}; + + +/************************************************************************* +MNLReport structure contains information about training process: +* NGrad - number of gradient calculations +* NHess - number of Hessian calculations +*************************************************************************/ +class _mnlreport_owner +{ +public: + _mnlreport_owner(); + _mnlreport_owner(const _mnlreport_owner &rhs); + _mnlreport_owner& operator=(const _mnlreport_owner &rhs); + virtual ~_mnlreport_owner(); + alglib_impl::mnlreport* c_ptr(); + alglib_impl::mnlreport* c_ptr() const; +protected: + alglib_impl::mnlreport *p_struct; +}; +class mnlreport : public _mnlreport_owner +{ +public: + mnlreport(); + mnlreport(const mnlreport &rhs); + mnlreport& operator=(const mnlreport &rhs); + virtual ~mnlreport(); + ae_int_t &ngrad; + ae_int_t &nhess; + +}; + +/************************************************************************* +This structure is a MCPD (Markov Chains for Population Data) solver. + +You should use ALGLIB functions in order to work with this object. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +class _mcpdstate_owner +{ +public: + _mcpdstate_owner(); + _mcpdstate_owner(const _mcpdstate_owner &rhs); + _mcpdstate_owner& operator=(const _mcpdstate_owner &rhs); + virtual ~_mcpdstate_owner(); + alglib_impl::mcpdstate* c_ptr(); + alglib_impl::mcpdstate* c_ptr() const; +protected: + alglib_impl::mcpdstate *p_struct; +}; +class mcpdstate : public _mcpdstate_owner +{ +public: + mcpdstate(); + mcpdstate(const mcpdstate &rhs); + mcpdstate& operator=(const mcpdstate &rhs); + virtual ~mcpdstate(); + +}; + + +/************************************************************************* +This structure is a MCPD training report: + InnerIterationsCount - number of inner iterations of the + underlying optimization algorithm + OuterIterationsCount - number of outer iterations of the + underlying optimization algorithm + NFEV - number of merit function evaluations + TerminationType - termination type + (same as for MinBLEIC optimizer, positive + values denote success, negative ones - + failure) + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +class _mcpdreport_owner +{ +public: + _mcpdreport_owner(); + _mcpdreport_owner(const _mcpdreport_owner &rhs); + _mcpdreport_owner& operator=(const _mcpdreport_owner &rhs); + virtual ~_mcpdreport_owner(); + alglib_impl::mcpdreport* c_ptr(); + alglib_impl::mcpdreport* c_ptr() const; +protected: + alglib_impl::mcpdreport *p_struct; +}; +class mcpdreport : public _mcpdreport_owner +{ +public: + mcpdreport(); + mcpdreport(const mcpdreport &rhs); + mcpdreport& operator=(const mcpdreport &rhs); + virtual ~mcpdreport(); + ae_int_t &inneriterationscount; + ae_int_t &outeriterationscount; + ae_int_t &nfev; + ae_int_t &terminationtype; + +}; + +/************************************************************************* +Neural networks ensemble +*************************************************************************/ +class _mlpensemble_owner +{ +public: + _mlpensemble_owner(); + _mlpensemble_owner(const _mlpensemble_owner &rhs); + _mlpensemble_owner& operator=(const _mlpensemble_owner &rhs); + virtual ~_mlpensemble_owner(); + alglib_impl::mlpensemble* c_ptr(); + alglib_impl::mlpensemble* c_ptr() const; +protected: + alglib_impl::mlpensemble *p_struct; +}; +class mlpensemble : public _mlpensemble_owner +{ +public: + mlpensemble(); + mlpensemble(const mlpensemble &rhs); + mlpensemble& operator=(const mlpensemble &rhs); + virtual ~mlpensemble(); + +}; + +/************************************************************************* +Training report: + * RelCLSError - fraction of misclassified cases. + * AvgCE - acerage cross-entropy + * RMSError - root-mean-square error + * AvgError - average error + * AvgRelError - average relative error + * NGrad - number of gradient calculations + * NHess - number of Hessian calculations + * NCholesky - number of Cholesky decompositions + +NOTE 1: RelCLSError/AvgCE are zero on regression problems. + +NOTE 2: on classification problems RMSError/AvgError/AvgRelError contain + errors in prediction of posterior probabilities +*************************************************************************/ +class _mlpreport_owner +{ +public: + _mlpreport_owner(); + _mlpreport_owner(const _mlpreport_owner &rhs); + _mlpreport_owner& operator=(const _mlpreport_owner &rhs); + virtual ~_mlpreport_owner(); + alglib_impl::mlpreport* c_ptr(); + alglib_impl::mlpreport* c_ptr() const; +protected: + alglib_impl::mlpreport *p_struct; +}; +class mlpreport : public _mlpreport_owner +{ +public: + mlpreport(); + mlpreport(const mlpreport &rhs); + mlpreport& operator=(const mlpreport &rhs); + virtual ~mlpreport(); + double &relclserror; + double &avgce; + double &rmserror; + double &avgerror; + double &avgrelerror; + ae_int_t &ngrad; + ae_int_t &nhess; + ae_int_t &ncholesky; + +}; + + +/************************************************************************* +Cross-validation estimates of generalization error +*************************************************************************/ +class _mlpcvreport_owner +{ +public: + _mlpcvreport_owner(); + _mlpcvreport_owner(const _mlpcvreport_owner &rhs); + _mlpcvreport_owner& operator=(const _mlpcvreport_owner &rhs); + virtual ~_mlpcvreport_owner(); + alglib_impl::mlpcvreport* c_ptr(); + alglib_impl::mlpcvreport* c_ptr() const; +protected: + alglib_impl::mlpcvreport *p_struct; +}; +class mlpcvreport : public _mlpcvreport_owner +{ +public: + mlpcvreport(); + mlpcvreport(const mlpcvreport &rhs); + mlpcvreport& operator=(const mlpcvreport &rhs); + virtual ~mlpcvreport(); + double &relclserror; + double &avgce; + double &rmserror; + double &avgerror; + double &avgrelerror; + +}; + + +/************************************************************************* +Trainer object for neural network. + +You should not try to access fields of this object directly - use ALGLIB +functions to work with this object. +*************************************************************************/ +class _mlptrainer_owner +{ +public: + _mlptrainer_owner(); + _mlptrainer_owner(const _mlptrainer_owner &rhs); + _mlptrainer_owner& operator=(const _mlptrainer_owner &rhs); + virtual ~_mlptrainer_owner(); + alglib_impl::mlptrainer* c_ptr(); + alglib_impl::mlptrainer* c_ptr() const; +protected: + alglib_impl::mlptrainer *p_struct; +}; +class mlptrainer : public _mlptrainer_owner +{ +public: + mlptrainer(); + mlptrainer(const mlptrainer &rhs); + mlptrainer& operator=(const mlptrainer &rhs); + virtual ~mlptrainer(); + +}; + +/************************************************************************* +Optimal binary classification + +Algorithms finds optimal (=with minimal cross-entropy) binary partition. +Internal subroutine. + +INPUT PARAMETERS: + A - array[0..N-1], variable + C - array[0..N-1], class numbers (0 or 1). + N - array size + +OUTPUT PARAMETERS: + Info - completetion code: + * -3, all values of A[] are same (partition is impossible) + * -2, one of C[] is incorrect (<0, >1) + * -1, incorrect pararemets were passed (N<=0). + * 1, OK + Threshold- partiton boundary. Left part contains values which are + strictly less than Threshold. Right part contains values + which are greater than or equal to Threshold. + PAL, PBL- probabilities P(0|v=Threshold) and P(1|v>=Threshold) + CVE - cross-validation estimate of cross-entropy + + -- ALGLIB -- + Copyright 22.05.2008 by Bochkanov Sergey +*************************************************************************/ +void dsoptimalsplit2(const real_1d_array &a, const integer_1d_array &c, const ae_int_t n, ae_int_t &info, double &threshold, double &pal, double &pbl, double &par, double &pbr, double &cve); + + +/************************************************************************* +Optimal partition, internal subroutine. Fast version. + +Accepts: + A array[0..N-1] array of attributes array[0..N-1] + C array[0..N-1] array of class labels + TiesBuf array[0..N] temporaries (ties) + CntBuf array[0..2*NC-1] temporaries (counts) + Alpha centering factor (0<=alpha<=1, recommended value - 0.05) + BufR array[0..N-1] temporaries + BufI array[0..N-1] temporaries + +Output: + Info error code (">0"=OK, "<0"=bad) + RMS training set RMS error + CVRMS leave-one-out RMS error + +Note: + content of all arrays is changed by subroutine; + it doesn't allocate temporaries. + + -- ALGLIB -- + Copyright 11.12.2008 by Bochkanov Sergey +*************************************************************************/ +void dsoptimalsplit2fast(real_1d_array &a, integer_1d_array &c, integer_1d_array &tiesbuf, integer_1d_array &cntbuf, real_1d_array &bufr, integer_1d_array &bufi, const ae_int_t n, const ae_int_t nc, const double alpha, ae_int_t &info, double &threshold, double &rms, double &cvrms); + +/************************************************************************* +This function initializes clusterizer object. Newly initialized object is +empty, i.e. it does not contain dataset. You should use it as follows: +1. creation +2. dataset is added with ClusterizerSetPoints() +3. additional parameters are set +3. clusterization is performed with one of the clustering functions + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizercreate(clusterizerstate &s); + + +/************************************************************************* +This function adds dataset to the clusterizer structure. + +This function overrides all previous calls of ClusterizerSetPoints() or +ClusterizerSetDistances(). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + XY - array[NPoints,NFeatures], dataset + NPoints - number of points, >=0 + NFeatures- number of features, >=1 + DistType- distance function: + * 0 Chebyshev distance (L-inf norm) + * 1 city block distance (L1 norm) + * 2 Euclidean distance (L2 norm) + * 10 Pearson correlation: + dist(a,b) = 1-corr(a,b) + * 11 Absolute Pearson correlation: + dist(a,b) = 1-|corr(a,b)| + * 12 Uncentered Pearson correlation (cosine of the angle): + dist(a,b) = a'*b/(|a|*|b|) + * 13 Absolute uncentered Pearson correlation + dist(a,b) = |a'*b|/(|a|*|b|) + * 20 Spearman rank correlation: + dist(a,b) = 1-rankcorr(a,b) + * 21 Absolute Spearman rank correlation + dist(a,b) = 1-|rankcorr(a,b)| + +NOTE 1: different distance functions have different performance penalty: + * Euclidean or Pearson correlation distances are the fastest ones + * Spearman correlation distance function is a bit slower + * city block and Chebyshev distances are order of magnitude slower + + The reason behing difference in performance is that correlation-based + distance functions are computed using optimized linear algebra kernels, + while Chebyshev and city block distance functions are computed using + simple nested loops with two branches at each iteration. + +NOTE 2: different clustering algorithms have different limitations: + * agglomerative hierarchical clustering algorithms may be used with + any kind of distance metric + * k-means++ clustering algorithm may be used only with Euclidean + distance function + Thus, list of specific clustering algorithms you may use depends + on distance function you specify when you set your dataset. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetpoints(const clusterizerstate &s, const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype); +void clusterizersetpoints(const clusterizerstate &s, const real_2d_array &xy, const ae_int_t disttype); + + +/************************************************************************* +This function adds dataset given by distance matrix to the clusterizer +structure. It is important that dataset is not given explicitly - only +distance matrix is given. + +This function overrides all previous calls of ClusterizerSetPoints() or +ClusterizerSetDistances(). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + D - array[NPoints,NPoints], distance matrix given by its upper + or lower triangle (main diagonal is ignored because its + entries are expected to be zero). + NPoints - number of points + IsUpper - whether upper or lower triangle of D is given. + +NOTE 1: different clustering algorithms have different limitations: + * agglomerative hierarchical clustering algorithms may be used with + any kind of distance metric, including one which is given by + distance matrix + * k-means++ clustering algorithm may be used only with Euclidean + distance function and explicitly given points - it can not be + used with dataset given by distance matrix + Thus, if you call this function, you will be unable to use k-means + clustering algorithm to process your problem. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetdistances(const clusterizerstate &s, const real_2d_array &d, const ae_int_t npoints, const bool isupper); +void clusterizersetdistances(const clusterizerstate &s, const real_2d_array &d, const bool isupper); + + +/************************************************************************* +This function sets agglomerative hierarchical clustering algorithm + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + Algo - algorithm type: + * 0 complete linkage (default algorithm) + * 1 single linkage + * 2 unweighted average linkage + * 3 weighted average linkage + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetahcalgo(const clusterizerstate &s, const ae_int_t algo); + + +/************************************************************************* +This function sets k-means++ properties : number of restarts and maximum +number of iterations per one run. + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + Restarts- restarts count, >=1. + k-means++ algorithm performs several restarts and chooses + best set of centers (one with minimum squared distance). + MaxIts - maximum number of k-means iterations performed during one + run. >=0, zero value means that algorithm performs unlimited + number of iterations. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizersetkmeanslimits(const clusterizerstate &s, const ae_int_t restarts, const ae_int_t maxits); + + +/************************************************************************* +This function performs agglomerative hierarchical clustering + +FOR USERS OF SMP EDITION: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Multicore version is pretty efficient on large + ! problems which need more than 1.000.000 operations to be solved, + ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU + ! cycles), but gives no speed-up for small problems (less than 100.000 + ! operations). + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + +OUTPUT PARAMETERS: + Rep - clustering results; see description of AHCReport + structure for more information. + +NOTE 1: hierarchical clustering algorithms require large amounts of memory. + In particular, this implementation needs sizeof(double)*NPoints^2 + bytes, which are used to store distance matrix. In case we work + with user-supplied matrix, this amount is multiplied by 2 (we have + to store original matrix and to work with its copy). + + For example, problem with 10000 points would require 800M of RAM, + even when working in a 1-dimensional space. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizerrunahc(const clusterizerstate &s, ahcreport &rep); +void smp_clusterizerrunahc(const clusterizerstate &s, ahcreport &rep); + + +/************************************************************************* +This function performs clustering by k-means++ algorithm. + +You may change algorithm properties like number of restarts or iterations +limit by calling ClusterizerSetKMeansLimits() functions. + +INPUT PARAMETERS: + S - clusterizer state, initialized by ClusterizerCreate() + K - number of clusters, K>=0. + K can be zero only when algorithm is called for empty + dataset, in this case completion code is set to + success (+1). + If K=0 and dataset size is non-zero, we can not + meaningfully assign points to some center (there are no + centers because K=0) and return -3 as completion code + (failure). + +OUTPUT PARAMETERS: + Rep - clustering results; see description of KMeansReport + structure for more information. + +NOTE 1: k-means clustering can be performed only for datasets with + Euclidean distance function. Algorithm will return negative + completion code in Rep.TerminationType in case dataset was added + to clusterizer with DistType other than Euclidean (or dataset was + specified by distance matrix instead of explicitly given points). + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizerrunkmeans(const clusterizerstate &s, const ae_int_t k, kmeansreport &rep); + + +/************************************************************************* +This function returns distance matrix for dataset + +FOR USERS OF SMP EDITION: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Multicore version is pretty efficient on large + ! problems which need more than 1.000.000 operations to be solved, + ! gives moderate speed-up in mid-range (from 100.000 to 1.000.000 CPU + ! cycles), but gives no speed-up for small problems (less than 100.000 + ! operations). + +INPUT PARAMETERS: + XY - array[NPoints,NFeatures], dataset + NPoints - number of points, >=0 + NFeatures- number of features, >=1 + DistType- distance function: + * 0 Chebyshev distance (L-inf norm) + * 1 city block distance (L1 norm) + * 2 Euclidean distance (L2 norm) + * 10 Pearson correlation: + dist(a,b) = 1-corr(a,b) + * 11 Absolute Pearson correlation: + dist(a,b) = 1-|corr(a,b)| + * 12 Uncentered Pearson correlation (cosine of the angle): + dist(a,b) = a'*b/(|a|*|b|) + * 13 Absolute uncentered Pearson correlation + dist(a,b) = |a'*b|/(|a|*|b|) + * 20 Spearman rank correlation: + dist(a,b) = 1-rankcorr(a,b) + * 21 Absolute Spearman rank correlation + dist(a,b) = 1-|rankcorr(a,b)| + +OUTPUT PARAMETERS: + D - array[NPoints,NPoints], distance matrix + (full matrix is returned, with lower and upper triangles) + +NOTES: different distance functions have different performance penalty: + * Euclidean or Pearson correlation distances are the fastest ones + * Spearman correlation distance function is a bit slower + * city block and Chebyshev distances are order of magnitude slower + + The reason behing difference in performance is that correlation-based + distance functions are computed using optimized linear algebra kernels, + while Chebyshev and city block distance functions are computed using + simple nested loops with two branches at each iteration. + + -- ALGLIB -- + Copyright 10.07.2012 by Bochkanov Sergey +*************************************************************************/ +void clusterizergetdistances(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype, real_2d_array &d); +void smp_clusterizergetdistances(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures, const ae_int_t disttype, real_2d_array &d); + + +/************************************************************************* +This function takes as input clusterization report Rep, desired clusters +count K, and builds top K clusters from hierarchical clusterization tree. +It returns assignment of points to clusters (array of cluster indexes). + +INPUT PARAMETERS: + Rep - report from ClusterizerRunAHC() performed on XY + K - desired number of clusters, 1<=K<=NPoints. + K can be zero only when NPoints=0. + +OUTPUT PARAMETERS: + CIdx - array[NPoints], I-th element contains cluster index (from + 0 to K-1) for I-th point of the dataset. + CZ - array[K]. This array allows to convert cluster indexes + returned by this function to indexes used by Rep.Z. J-th + cluster returned by this function corresponds to CZ[J]-th + cluster stored in Rep.Z/PZ/PM. + It is guaranteed that CZ[I]=0 + +OUTPUT PARAMETERS: + K - number of clusters, 1<=K<=NPoints + CIdx - array[NPoints], I-th element contains cluster index (from + 0 to K-1) for I-th point of the dataset. + CZ - array[K]. This array allows to convert cluster indexes + returned by this function to indexes used by Rep.Z. J-th + cluster returned by this function corresponds to CZ[J]-th + cluster stored in Rep.Z/PZ/PM. + It is guaranteed that CZ[I]=1 + NVars - number of independent variables, NVars>=1 + NClasses - task type: + * NClasses=1 - regression task with one + dependent variable + * NClasses>1 - classification task with + NClasses classes. + NTrees - number of trees in a forest, NTrees>=1. + recommended values: 50-100. + R - percent of a training set used to build + individual trees. 01). + * 1, if task has been solved + DF - model built + Rep - training report, contains error on a training set + and out-of-bag estimates of generalization error. + + -- ALGLIB -- + Copyright 19.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfbuildrandomdecisionforest(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, const ae_int_t ntrees, const double r, ae_int_t &info, decisionforest &df, dfreport &rep); + + +/************************************************************************* +This subroutine builds random decision forest. +This function gives ability to tune number of variables used when choosing +best split. + +INPUT PARAMETERS: + XY - training set + NPoints - training set size, NPoints>=1 + NVars - number of independent variables, NVars>=1 + NClasses - task type: + * NClasses=1 - regression task with one + dependent variable + * NClasses>1 - classification task with + NClasses classes. + NTrees - number of trees in a forest, NTrees>=1. + recommended values: 50-100. + NRndVars - number of variables used when choosing best split + R - percent of a training set used to build + individual trees. 01). + * 1, if task has been solved + DF - model built + Rep - training report, contains error on a training set + and out-of-bag estimates of generalization error. + + -- ALGLIB -- + Copyright 19.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfbuildrandomdecisionforestx1(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, const ae_int_t ntrees, const ae_int_t nrndvars, const double r, ae_int_t &info, decisionforest &df, dfreport &rep); + + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + DF - decision forest model + X - input vector, array[0..NVars-1]. + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + +See also DFProcessI. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +void dfprocess(const decisionforest &df, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +'interactive' variant of DFProcess for languages like Python which support +constructs like "Y = DFProcessI(DF,X)" and interactive mode of interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 28.02.2010 by Bochkanov Sergey +*************************************************************************/ +void dfprocessi(const decisionforest &df, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +Relative classification error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + percent of incorrectly classified cases. + Zero if model solves regression task. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfrelclserror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + CrossEntropy/(NPoints*LN(2)). + Zero if model solves regression task. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgce(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + root mean square error. + Its meaning for regression task is obvious. As for + classification task, RMS error means error when estimating posterior + probabilities. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfrmserror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for + classification task, it means average error when estimating posterior + probabilities. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgerror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average relative error on the test set + +INPUT PARAMETERS: + DF - decision forest model + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for + classification task, it means average relative error when estimating + posterior probability of belonging to the correct class. + + -- ALGLIB -- + Copyright 16.02.2009 by Bochkanov Sergey +*************************************************************************/ +double dfavgrelerror(const decisionforest &df, const real_2d_array &xy, const ae_int_t npoints); + +/************************************************************************* +Linear regression + +Subroutine builds model: + + Y = A(0)*X[0] + ... + A(N-1)*X[N-1] + A(N) + +and model found in ALGLIB format, covariation matrix, training set errors +(rms, average, average relative) and leave-one-out cross-validation +estimate of the generalization error. CV estimate calculated using fast +algorithm with O(NPoints*NVars) complexity. + +When covariation matrix is calculated standard deviations of function +values are assumed to be equal to RMS error on the training set. + +INPUT PARAMETERS: + XY - training set, array [0..NPoints-1,0..NVars]: + * NVars columns - independent variables + * last column - dependent variable + NPoints - training set size, NPoints>NVars+1 + NVars - number of independent variables + +OUTPUT PARAMETERS: + Info - return code: + * -255, in case of unknown internal error + * -4, if internal SVD subroutine haven't converged + * -1, if incorrect parameters was passed (NPoints0. + NPoints - training set size, NPoints>NVars+1 + NVars - number of independent variables + +OUTPUT PARAMETERS: + Info - return code: + * -255, in case of unknown internal error + * -4, if internal SVD subroutine haven't converged + * -1, if incorrect parameters was passed (NPoints=0 + K - K>=1 (K can be larger than N , such cases will be + correctly handled). Window width. K=1 corresponds to + identity transformation (nothing changes). + +OUTPUT PARAMETERS: + X - array, whose first N elements were processed with SMA(K) + +NOTE 1: this function uses efficient in-place algorithm which does not + allocate temporary arrays. + +NOTE 2: this algorithm makes only one pass through array and uses running + sum to speed-up calculation of the averages. Additional measures + are taken to ensure that running sum on a long sequence of zero + elements will be correctly reset to zero even in the presence of + round-off error. + +NOTE 3: this is unsymmetric version of the algorithm, which does NOT + averages points after the current one. Only X[i], X[i-1], ... are + used when calculating new value of X[i]. We should also note that + this algorithm uses BOTH previous points and current one, i.e. + new value of X[i] depends on BOTH previous point and X[i] itself. + + -- ALGLIB -- + Copyright 25.10.2011 by Bochkanov Sergey +*************************************************************************/ +void filtersma(real_1d_array &x, const ae_int_t n, const ae_int_t k); +void filtersma(real_1d_array &x, const ae_int_t k); + + +/************************************************************************* +Filters: exponential moving averages. + +This filter replaces array by results of EMA(alpha) filter. EMA(alpha) is +defined as filter which replaces X[] by S[]: + S[0] = X[0] + S[t] = alpha*X[t] + (1-alpha)*S[t-1] + +INPUT PARAMETERS: + X - array[N], array to process. It can be larger than N, + in this case only first N points are processed. + N - points count, N>=0 + alpha - 0=0 + K - K>=1 (K can be larger than N , such cases will be + correctly handled). Window width. K=1 corresponds to + identity transformation (nothing changes). + +OUTPUT PARAMETERS: + X - array, whose first N elements were processed with SMA(K) + +NOTE 1: this function uses efficient in-place algorithm which does not + allocate temporary arrays. + +NOTE 2: this algorithm makes only one pass through array and uses running + sum to speed-up calculation of the averages. Additional measures + are taken to ensure that running sum on a long sequence of zero + elements will be correctly reset to zero even in the presence of + round-off error. + +NOTE 3: this is unsymmetric version of the algorithm, which does NOT + averages points after the current one. Only X[i], X[i-1], ... are + used when calculating new value of X[i]. We should also note that + this algorithm uses BOTH previous points and current one, i.e. + new value of X[i] depends on BOTH previous point and X[i] itself. + + -- ALGLIB -- + Copyright 25.10.2011 by Bochkanov Sergey +*************************************************************************/ +void filterlrma(real_1d_array &x, const ae_int_t n, const ae_int_t k); +void filterlrma(real_1d_array &x, const ae_int_t k); + +/************************************************************************* +Multiclass Fisher LDA + +Subroutine finds coefficients of linear combination which optimally separates +training set on classes. + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars]. + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + + +OUTPUT PARAMETERS: + Info - return code: + * -4, if internal EVD subroutine hasn't converged + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed (NPoints<0, + NVars<1, NClasses<2) + * 1, if task has been solved + * 2, if there was a multicollinearity in training set, + but task has been solved. + W - linear combination coefficients, array[0..NVars-1] + + -- ALGLIB -- + Copyright 31.05.2008 by Bochkanov Sergey +*************************************************************************/ +void fisherlda(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, ae_int_t &info, real_1d_array &w); + + +/************************************************************************* +N-dimensional multiclass Fisher LDA + +Subroutine finds coefficients of linear combinations which optimally separates +training set on classes. It returns N-dimensional basis whose vector are sorted +by quality of training set separation (in descending order). + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars]. + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + + +OUTPUT PARAMETERS: + Info - return code: + * -4, if internal EVD subroutine hasn't converged + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed (NPoints<0, + NVars<1, NClasses<2) + * 1, if task has been solved + * 2, if there was a multicollinearity in training set, + but task has been solved. + W - basis, array[0..NVars-1,0..NVars-1] + columns of matrix stores basis vectors, sorted by + quality of training set separation (in descending order) + + -- ALGLIB -- + Copyright 31.05.2008 by Bochkanov Sergey +*************************************************************************/ +void fisherldan(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nvars, const ae_int_t nclasses, ae_int_t &info, real_2d_array &w); + +/************************************************************************* +This function serializes data structure to string. + +Important properties of s_out: +* it contains alphanumeric characters, dots, underscores, minus signs +* these symbols are grouped into words, which are separated by spaces + and Windows-style (CR+LF) newlines +* although serializer uses spaces and CR+LF as separators, you can + replace any separator character by arbitrary combination of spaces, + tabs, Windows or Unix newlines. It allows flexible reformatting of + the string in case you want to include it into text or XML file. + But you should not insert separators into the middle of the "words" + nor you should change case of letters. +* s_out can be freely moved between 32-bit and 64-bit systems, little + and big endian machines, and so on. You can serialize structure on + 32-bit machine and unserialize it on 64-bit one (or vice versa), or + serialize it on SPARC and unserialize on x86. You can also + serialize it in C++ version of ALGLIB and unserialize in C# one, + and vice versa. +*************************************************************************/ +void mlpserialize(multilayerperceptron &obj, std::string &s_out); + + +/************************************************************************* +This function unserializes data structure from string. +*************************************************************************/ +void mlpunserialize(std::string &s_in, multilayerperceptron &obj); + + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers, with linear output layer. Network weights are filled with small +random values. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate0(const ae_int_t nin, const ae_int_t nout, multilayerperceptron &network); + + +/************************************************************************* +Same as MLPCreate0, but with one hidden layer (NHid neurons) with +non-linear activation function. Output layer is linear. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, multilayerperceptron &network); + + +/************************************************************************* +Same as MLPCreate0, but with two hidden layers (NHid1 and NHid2 neurons) +with non-linear activation function. Output layer is linear. + $ALL + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreate2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, multilayerperceptron &network); + + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers with non-linear output layer. Network weights are filled with small +random values. + +Activation function of the output layer takes values: + + (B, +INF), if D>=0 + +or + + (-INF, B), if D<0. + + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb0(const ae_int_t nin, const ae_int_t nout, const double b, const double d, multilayerperceptron &network); + + +/************************************************************************* +Same as MLPCreateB0 but with non-linear hidden layer. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double b, const double d, multilayerperceptron &network); + + +/************************************************************************* +Same as MLPCreateB0 but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreateb2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double b, const double d, multilayerperceptron &network); + + +/************************************************************************* +Creates neural network with NIn inputs, NOut outputs, without hidden +layers with non-linear output layer. Network weights are filled with small +random values. Activation function of the output layer takes values [A,B]. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater0(const ae_int_t nin, const ae_int_t nout, const double a, const double b, multilayerperceptron &network); + + +/************************************************************************* +Same as MLPCreateR0, but with non-linear hidden layer. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double a, const double b, multilayerperceptron &network); + + +/************************************************************************* +Same as MLPCreateR0, but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 30.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlpcreater2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double a, const double b, multilayerperceptron &network); + + +/************************************************************************* +Creates classifier network with NIn inputs and NOut possible classes. +Network contains no hidden layers and linear output layer with SOFTMAX- +normalization (so outputs sums up to 1.0 and converge to posterior +probabilities). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec0(const ae_int_t nin, const ae_int_t nout, multilayerperceptron &network); + + +/************************************************************************* +Same as MLPCreateC0, but with one non-linear hidden layer. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, multilayerperceptron &network); + + +/************************************************************************* +Same as MLPCreateC0, but with two non-linear hidden layers. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatec2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, multilayerperceptron &network); + + +/************************************************************************* +Randomization of neural network weights + + -- ALGLIB -- + Copyright 06.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlprandomize(const multilayerperceptron &network); + + +/************************************************************************* +Randomization of neural network weights and standartisator + + -- ALGLIB -- + Copyright 10.03.2008 by Bochkanov Sergey +*************************************************************************/ +void mlprandomizefull(const multilayerperceptron &network); + + +/************************************************************************* +Returns information about initialized network: number of inputs, outputs, +weights. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpproperties(const multilayerperceptron &network, ae_int_t &nin, ae_int_t &nout, ae_int_t &wcount); + + +/************************************************************************* +Returns number of inputs. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetinputscount(const multilayerperceptron &network); + + +/************************************************************************* +Returns number of outputs. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetoutputscount(const multilayerperceptron &network); + + +/************************************************************************* +Returns number of weights. + + -- ALGLIB -- + Copyright 19.10.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetweightscount(const multilayerperceptron &network); + + +/************************************************************************* +Tells whether network is SOFTMAX-normalized (i.e. classifier) or not. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +bool mlpissoftmax(const multilayerperceptron &network); + + +/************************************************************************* +This function returns total number of layers (including input, hidden and +output layers). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetlayerscount(const multilayerperceptron &network); + + +/************************************************************************* +This function returns size of K-th layer. + +K=0 corresponds to input layer, K=CNT-1 corresponds to output layer. + +Size of the output layer is always equal to the number of outputs, although +when we have softmax-normalized network, last neuron doesn't have any +connections - it is just zero. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpgetlayersize(const multilayerperceptron &network, const ae_int_t k); + + +/************************************************************************* +This function returns offset/scaling coefficients for I-th input of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + +OUTPUT PARAMETERS: + Mean - mean term + Sigma - sigma term, guaranteed to be nonzero. + +I-th input is passed through linear transformation + IN[i] = (IN[i]-Mean)/Sigma +before feeding to the network + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetinputscaling(const multilayerperceptron &network, const ae_int_t i, double &mean, double &sigma); + + +/************************************************************************* +This function returns offset/scaling coefficients for I-th output of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + +OUTPUT PARAMETERS: + Mean - mean term + Sigma - sigma term, guaranteed to be nonzero. + +I-th output is passed through linear transformation + OUT[i] = OUT[i]*Sigma+Mean +before returning it to user. In case we have SOFTMAX-normalized network, +we return (Mean,Sigma)=(0.0,1.0). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetoutputscaling(const multilayerperceptron &network, const ae_int_t i, double &mean, double &sigma); + + +/************************************************************************* +This function returns information about Ith neuron of Kth layer + +INPUT PARAMETERS: + Network - network + K - layer index + I - neuron index (within layer) + +OUTPUT PARAMETERS: + FKind - activation function type (used by MLPActivationFunction()) + this value is zero for input or linear neurons + Threshold - also called offset, bias + zero for input neurons + +NOTE: this function throws exception if layer or neuron with given index +do not exists. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpgetneuroninfo(const multilayerperceptron &network, const ae_int_t k, const ae_int_t i, ae_int_t &fkind, double &threshold); + + +/************************************************************************* +This function returns information about connection from I0-th neuron of +K0-th layer to I1-th neuron of K1-th layer. + +INPUT PARAMETERS: + Network - network + K0 - layer index + I0 - neuron index (within layer) + K1 - layer index + I1 - neuron index (within layer) + +RESULT: + connection weight (zero for non-existent connections) + +This function: +1. throws exception if layer or neuron with given index do not exists. +2. returns zero if neurons exist, but there is no connection between them + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +double mlpgetweight(const multilayerperceptron &network, const ae_int_t k0, const ae_int_t i0, const ae_int_t k1, const ae_int_t i1); + + +/************************************************************************* +This function sets offset/scaling coefficients for I-th input of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + Mean - mean term + Sigma - sigma term (if zero, will be replaced by 1.0) + +NTE: I-th input is passed through linear transformation + IN[i] = (IN[i]-Mean)/Sigma +before feeding to the network. This function sets Mean and Sigma. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetinputscaling(const multilayerperceptron &network, const ae_int_t i, const double mean, const double sigma); + + +/************************************************************************* +This function sets offset/scaling coefficients for I-th output of the +network. + +INPUT PARAMETERS: + Network - network + I - input index + Mean - mean term + Sigma - sigma term (if zero, will be replaced by 1.0) + +OUTPUT PARAMETERS: + +NOTE: I-th output is passed through linear transformation + OUT[i] = OUT[i]*Sigma+Mean +before returning it to user. This function sets Sigma/Mean. In case we +have SOFTMAX-normalized network, you can not set (Sigma,Mean) to anything +other than(0.0,1.0) - this function will throw exception. + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetoutputscaling(const multilayerperceptron &network, const ae_int_t i, const double mean, const double sigma); + + +/************************************************************************* +This function modifies information about Ith neuron of Kth layer + +INPUT PARAMETERS: + Network - network + K - layer index + I - neuron index (within layer) + FKind - activation function type (used by MLPActivationFunction()) + this value must be zero for input neurons + (you can not set activation function for input neurons) + Threshold - also called offset, bias + this value must be zero for input neurons + (you can not set threshold for input neurons) + +NOTES: +1. this function throws exception if layer or neuron with given index do + not exists. +2. this function also throws exception when you try to set non-linear + activation function for input neurons (any kind of network) or for output + neurons of classifier network. +3. this function throws exception when you try to set non-zero threshold for + input neurons (any kind of network). + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetneuroninfo(const multilayerperceptron &network, const ae_int_t k, const ae_int_t i, const ae_int_t fkind, const double threshold); + + +/************************************************************************* +This function modifies information about connection from I0-th neuron of +K0-th layer to I1-th neuron of K1-th layer. + +INPUT PARAMETERS: + Network - network + K0 - layer index + I0 - neuron index (within layer) + K1 - layer index + I1 - neuron index (within layer) + W - connection weight (must be zero for non-existent + connections) + +This function: +1. throws exception if layer or neuron with given index do not exists. +2. throws exception if you try to set non-zero weight for non-existent + connection + + -- ALGLIB -- + Copyright 25.03.2011 by Bochkanov Sergey +*************************************************************************/ +void mlpsetweight(const multilayerperceptron &network, const ae_int_t k0, const ae_int_t i0, const ae_int_t k1, const ae_int_t i1, const double w); + + +/************************************************************************* +Neural network activation function + +INPUT PARAMETERS: + NET - neuron input + K - function index (zero for linear function) + +OUTPUT PARAMETERS: + F - function + DF - its derivative + D2F - its second derivative + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpactivationfunction(const double net, const ae_int_t k, double &f, double &df, double &d2f); + + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + Network - neural network + X - input vector, array[0..NIn-1]. + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + +See also MLPProcessI + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpprocess(const multilayerperceptron &network, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +'interactive' variant of MLPProcess for languages like Python which +support constructs like "Y = MLPProcess(NN,X)" and interactive mode of the +interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 21.09.2010 by Bochkanov Sergey +*************************************************************************/ +void mlpprocessi(const multilayerperceptron &network, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +Error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x, depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlperror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); +double smp_mlperror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Error of the neural network on dataset given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x, depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0 + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); +double smp_mlperrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); + + +/************************************************************************* +Natural error function for neural network, internal subroutine. + +NOTE: this function is single-threaded. Unlike other error function, it +receives no speed-up from being executed in SMP mode. + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlperrorn(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize); + + +/************************************************************************* +Classification error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: + classification error (number of misclassified cases) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); +ae_int_t smp_mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Relative classification error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Percent of incorrectly classified cases. Works both for classifier +networks and general purpose networks used as classifiers. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 25.12.2008 by Bochkanov Sergey +*************************************************************************/ +double mlprelclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); +double smp_mlprelclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Relative classification error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. Sparse matrix must use CRS format + for storage. + NPoints - points count, >=0. + +RESULT: +Percent of incorrectly classified cases. Works both for classifier +networks and general purpose networks used as classifiers. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlprelclserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); +double smp_mlprelclserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +CrossEntropy/(NPoints*LN(2)). +Zero if network solves regression task. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 08.01.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpavgce(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); +double smp_mlpavgce(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set given by +sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +CrossEntropy/(NPoints*LN(2)). +Zero if network solves regression task. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 9.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgcesparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); +double smp_mlpavgcesparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); + + +/************************************************************************* +RMS error on the test set given. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Root mean square error. Its meaning for regression task is obvious. As for +classification task, RMS error means error when estimating posterior +probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +double mlprmserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); +double smp_mlprmserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +RMS error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Root mean square error. Its meaning for regression task is obvious. As for +classification task, RMS error means error when estimating posterior +probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlprmserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); +double smp_mlprmserrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); + + +/************************************************************************* +Average absolute error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average error when estimating posterior probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 11.03.2008 by Bochkanov Sergey +*************************************************************************/ +double mlpavgerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); +double smp_mlpavgerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average absolute error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average error when estimating posterior probabilities. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); +double smp_mlpavgerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); + + +/************************************************************************* +Average relative error on the test set. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + NPoints - points count. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average relative error when estimating posterior probability of +belonging to the correct class. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 11.03.2008 by Bochkanov Sergey +*************************************************************************/ +double mlpavgrelerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); +double smp_mlpavgrelerror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average relative error on the test set given by sparse matrix. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + NPoints - points count, >=0. + +RESULT: +Its meaning for regression task is obvious. As for classification task, it +means average relative error when estimating posterior probability of +belonging to the correct class. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 09.08.2012 by Bochkanov Sergey +*************************************************************************/ +double mlpavgrelerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); +double smp_mlpavgrelerrorsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t npoints); + + +/************************************************************************* +Gradient calculation + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + X - input vector, length of array must be at least NIn + DesiredY- desired outputs, length of array must be at least NOut + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgrad(const multilayerperceptron &network, const real_1d_array &x, const real_1d_array &desiredy, double &e, real_1d_array &grad); + + +/************************************************************************* +Gradient calculation (natural error function is used) + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + X - input vector, length of array must be at least NIn + DesiredY- desired outputs, length of array must be at least NOut + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, sum-of-squares for regression networks, + cross-entropy for classification networks. + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradn(const multilayerperceptron &network, const real_1d_array &x, const real_1d_array &desiredy, double &e, real_1d_array &grad); + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in dense format; one sample = one row: + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad); +void smp_mlpgradbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad); + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs given by sparse +matrices + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in sparse format; one sample = one row: + * MATRIX MUST BE STORED IN CRS FORMAT + * first NIn columns contain inputs. + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t ssize, double &e, real_1d_array &grad); +void smp_mlpgradbatchsparse(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t ssize, double &e, real_1d_array &grad); + + +/************************************************************************* +Batch gradient calculation for a subset of dataset + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in dense format; one sample = one row: + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SetSize - real size of XY, SetSize>=0; + Idx - subset of SubsetSize elements, array[SubsetSize]: + * Idx[I] stores row index in the original dataset which is + given by XY. Gradient is calculated with respect to rows + whose indexes are stored in Idx[]. + * Idx[] must store correct indexes; this function throws + an exception in case incorrect index (less than 0 or + larger than rows(XY)) is given + * Idx[] may store indexes in any order and even with + repetitions. + SubsetSize- number of elements in Idx[] array: + * positive value means that subset given by Idx[] is processed + * zero value results in zero gradient + * negative value means that full dataset is processed + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, + array[WCount] + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad); +void smp_mlpgradbatchsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad); + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs for a subset of +dataset given by set of indexes. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset in sparse format; one sample = one row: + * MATRIX MUST BE STORED IN CRS FORMAT + * first NIn columns contain inputs, + * for regression problem, next NOut columns store + desired outputs. + * for classification problem, next column (just one!) + stores class number. + SetSize - real size of XY, SetSize>=0; + Idx - subset of SubsetSize elements, array[SubsetSize]: + * Idx[I] stores row index in the original dataset which is + given by XY. Gradient is calculated with respect to rows + whose indexes are stored in Idx[]. + * Idx[] must store correct indexes; this function throws + an exception in case incorrect index (less than 0 or + larger than rows(XY)) is given + * Idx[] may store indexes in any order and even with + repetitions. + SubsetSize- number of elements in Idx[] array: + * positive value means that subset given by Idx[] is processed + * zero value results in zero gradient + * negative value means that full dataset is processed + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, SUM(sqr(y[i]-desiredy[i])/2,i) + Grad - gradient of E with respect to weights of network, + array[WCount] + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatchSparse + function. + + -- ALGLIB -- + Copyright 26.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpgradbatchsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad); +void smp_mlpgradbatchsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &idx, const ae_int_t subsetsize, double &e, real_1d_array &grad); + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs +(natural error function is used) + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - set of inputs/outputs; one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SSize - number of elements in XY + Grad - possibly preallocated array. If size of array is smaller + than WCount, it will be reallocated. It is recommended to + reuse previously allocated array to reduce allocation + overhead. + +OUTPUT PARAMETERS: + E - error function, sum-of-squares for regression networks, + cross-entropy for classification networks. + Grad - gradient of E with respect to weights of network, array[WCount] + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpgradnbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad); + + +/************************************************************************* +Batch Hessian calculation (natural error function) using R-algorithm. +Internal subroutine. + + -- ALGLIB -- + Copyright 26.01.2008 by Bochkanov Sergey. + + Hessian calculation based on R-algorithm described in + "Fast Exact Multiplication by the Hessian", + B. A. Pearlmutter, + Neural Computation, 1994. +*************************************************************************/ +void mlphessiannbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad, real_2d_array &h); + + +/************************************************************************* +Batch Hessian calculation using R-algorithm. +Internal subroutine. + + -- ALGLIB -- + Copyright 26.01.2008 by Bochkanov Sergey. + + Hessian calculation based on R-algorithm described in + "Fast Exact Multiplication by the Hessian", + B. A. Pearlmutter, + Neural Computation, 1994. +*************************************************************************/ +void mlphessianbatch(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize, double &e, real_1d_array &grad, real_2d_array &h); + + +/************************************************************************* +Calculation of all types of errors. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset; one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +OUTPUT PARAMETERS: + Rep - it contains all type of errors. + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpallerrorssubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep); +void smp_mlpallerrorssubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep); + + +/************************************************************************* +Calculation of all types of errors on sparse dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - network initialized with one of the network creation funcs + XY - original dataset given by sparse matrix; + one sample = one row; + first NIn columns contain inputs, + next NOut columns - desired outputs. + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +OUTPUT PARAMETERS: + Rep - it contains all type of errors. + +NOTE: when SubsetSize<0 is used full dataset by call MLPGradBatch function. + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpallerrorssparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep); +void smp_mlpallerrorssparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize, modelerrors &rep); + + +/************************************************************************* +Error of the neural network on dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + SetSize - real size of XY, SetSize>=0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize); +double smp_mlperrorsubset(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize); + + +/************************************************************************* +Error of the neural network on sparse dataset. + + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support + ! + ! First improvement gives close-to-linear speedup on multicore systems. + ! Second improvement gives constant speedup (2-3x depending on your CPU) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Sparse matrix must use CRS format for + storage. + SetSize - real size of XY, SetSize>=0; + it is used when SubsetSize<0; + Subset - subset of SubsetSize elements, array[SubsetSize]; + SubsetSize- number of elements in Subset[] array. + +RESULT: + sum-of-squares error, SUM(sqr(y[i]-desired_y[i])/2) + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +dataset format is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 04.09.2012 by Bochkanov Sergey +*************************************************************************/ +double mlperrorsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize); +double smp_mlperrorsparsesubset(const multilayerperceptron &network, const sparsematrix &xy, const ae_int_t setsize, const integer_1d_array &subset, const ae_int_t subsetsize); + +/************************************************************************* +This subroutine trains logit model. + +INPUT PARAMETERS: + XY - training set, array[0..NPoints-1,0..NVars] + First NVars columns store values of independent + variables, next column stores number of class (from 0 + to NClasses-1) which dataset element belongs to. Fractional + values are rounded to nearest integer. + NPoints - training set size, NPoints>=1 + NVars - number of independent variables, NVars>=1 + NClasses - number of classes, NClasses>=2 + +OUTPUT PARAMETERS: + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints=1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreate(const ae_int_t n, mcpdstate &s); + + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Entry-state" model, i.e. model where transition from X[i] to X[i+1] +is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +and one selected component of X[] is called "entry" state and is treated +in a special way: + system state always transits from "entry" state to some another state + system state can not transit from any state into "entry" state +Such conditions basically mean that row of P which corresponds to "entry" +state is zero. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant - at every moment of time there is some + (unpredictable) amount of "new" individuals, which can transit into one + of the states at the next turn, but still no one leaves population +* you want to model transitions of individuals from one state into another +* but you do NOT want to predict amount of "new" individuals because it + does not depends on individuals already present (hence system can not + transit INTO entry state - it can only transit FROM it). + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + EntryState- index of entry state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateentry(const ae_int_t n, const ae_int_t entrystate, mcpdstate &s); + + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Exit-state" model, i.e. model where transition from X[i] to X[i+1] +is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +and one selected component of X[] is called "exit" state and is treated +in a special way: + system state can transit from any state into "exit" state + system state can not transit from "exit" state into any other state + transition operator discards "exit" state (makes it zero at each turn) +Such conditions basically mean that column of P which corresponds to +"exit" state is zero. Multiplication by such P may decrease sum of vector +components. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant - individuals can move into "exit" state + and leave population at the next turn, but there are no new individuals +* amount of individuals which leave population can be predicted +* you want to model transitions of individuals from one state into another + (including transitions into the "exit" state) + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + ExitState- index of exit state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateexit(const ae_int_t n, const ae_int_t exitstate, mcpdstate &s); + + +/************************************************************************* +DESCRIPTION: + +This function is a specialized version of MCPDCreate() function, and we +recommend you to read comments for this function for general information +about MCPD solver. + +This function creates MCPD (Markov Chains for Population Data) solver +for "Entry-Exit-states" model, i.e. model where transition from X[i] to +X[i+1] is modelled as + X[i+1] = P*X[i] +where + X[i] and X[i+1] are N-dimensional state vectors + P is a N*N transition matrix +one selected component of X[] is called "entry" state and is treated in a +special way: + system state always transits from "entry" state to some another state + system state can not transit from any state into "entry" state +and another one component of X[] is called "exit" state and is treated in +a special way too: + system state can transit from any state into "exit" state + system state can not transit from "exit" state into any other state + transition operator discards "exit" state (makes it zero at each turn) +Such conditions basically mean that: + row of P which corresponds to "entry" state is zero + column of P which corresponds to "exit" state is zero +Multiplication by such P may decrease sum of vector components. + +Such models arise when: +* there is some population of individuals +* individuals can have different states +* individuals can transit from one state to another +* population size is NOT constant +* at every moment of time there is some (unpredictable) amount of "new" + individuals, which can transit into one of the states at the next turn +* some individuals can move (predictably) into "exit" state and leave + population at the next turn +* you want to model transitions of individuals from one state into another, + including transitions from the "entry" state and into the "exit" state. +* but you do NOT want to predict amount of "new" individuals because it + does not depends on individuals already present (hence system can not + transit INTO entry state - it can only transit FROM it). + +This model is discussed in more details in the ALGLIB User Guide (see +http://www.alglib.net/dataanalysis/ for more data). + +INPUT PARAMETERS: + N - problem dimension, N>=2 + EntryState- index of entry state, in 0..N-1 + ExitState- index of exit state, in 0..N-1 + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdcreateentryexit(const ae_int_t n, const ae_int_t entrystate, const ae_int_t exitstate, mcpdstate &s); + + +/************************************************************************* +This function is used to add a track - sequence of system states at the +different moments of its evolution. + +You may add one or several tracks to the MCPD solver. In case you have +several tracks, they won't overwrite each other. For example, if you pass +two tracks, A1-A2-A3 (system at t=A+1, t=A+2 and t=A+3) and B1-B2-B3, then +solver will try to model transitions from t=A+1 to t=A+2, t=A+2 to t=A+3, +t=B+1 to t=B+2, t=B+2 to t=B+3. But it WONT mix these two tracks - i.e. it +wont try to model transition from t=A+3 to t=B+1. + +INPUT PARAMETERS: + S - solver + XY - track, array[K,N]: + * I-th row is a state at t=I + * elements of XY must be non-negative (exception will be + thrown on negative elements) + K - number of points in a track + * if given, only leading K rows of XY are used + * if not given, automatically determined from size of XY + +NOTES: + +1. Track may contain either proportional or population data: + * with proportional data all rows of XY must sum to 1.0, i.e. we have + proportions instead of absolute population values + * with population data rows of XY contain population counts and generally + do not sum to 1.0 (although they still must be non-negative) + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdaddtrack(const mcpdstate &s, const real_2d_array &xy, const ae_int_t k); +void mcpdaddtrack(const mcpdstate &s, const real_2d_array &xy); + + +/************************************************************************* +This function is used to add equality constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to place equality constraints on arbitrary +subset of elements of P. Set of constraints is specified by EC, which may +contain either NAN's or finite numbers from [0,1]. NAN denotes absence of +constraint, finite number denotes equality constraint on specific element +of P. + +You can also use MCPDAddEC() function which allows to ADD equality +constraint for one element of P without changing constraints for other +elements. + +These functions (MCPDSetEC and MCPDAddEC) interact as follows: +* there is internal matrix of equality constraints which is stored in the + MCPD solver +* MCPDSetEC() replaces this matrix by another one (SET) +* MCPDAddEC() modifies one element of this matrix and leaves other ones + unchanged (ADD) +* thus MCPDAddEC() call preserves all modifications done by previous + calls, while MCPDSetEC() completely discards all changes done to the + equality constraints. + +INPUT PARAMETERS: + S - solver + EC - equality constraints, array[N,N]. Elements of EC can be + either NAN's or finite numbers from [0,1]. NAN denotes + absence of constraints, while finite value denotes + equality constraint on the corresponding element of P. + +NOTES: + +1. infinite values of EC will lead to exception being thrown. Values less +than 0.0 or greater than 1.0 will lead to error code being returned after +call to MCPDSolve(). + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetec(const mcpdstate &s, const real_2d_array &ec); + + +/************************************************************************* +This function is used to add equality constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to ADD equality constraint for one element of P +without changing constraints for other elements. + +You can also use MCPDSetEC() function which allows you to specify +arbitrary set of equality constraints in one call. + +These functions (MCPDSetEC and MCPDAddEC) interact as follows: +* there is internal matrix of equality constraints which is stored in the + MCPD solver +* MCPDSetEC() replaces this matrix by another one (SET) +* MCPDAddEC() modifies one element of this matrix and leaves other ones + unchanged (ADD) +* thus MCPDAddEC() call preserves all modifications done by previous + calls, while MCPDSetEC() completely discards all changes done to the + equality constraints. + +INPUT PARAMETERS: + S - solver + I - row index of element being constrained + J - column index of element being constrained + C - value (constraint for P[I,J]). Can be either NAN (no + constraint) or finite value from [0,1]. + +NOTES: + +1. infinite values of C will lead to exception being thrown. Values less +than 0.0 or greater than 1.0 will lead to error code being returned after +call to MCPDSolve(). + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdaddec(const mcpdstate &s, const ae_int_t i, const ae_int_t j, const double c); + + +/************************************************************************* +This function is used to add bound constraints on the elements of the +transition matrix P. + +MCPD solver has four types of constraints which can be placed on P: +* user-specified equality constraints (optional) +* user-specified bound constraints (optional) +* user-specified general linear constraints (optional) +* basic constraints (always present): + * non-negativity: P[i,j]>=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to place bound constraints on arbitrary +subset of elements of P. Set of constraints is specified by BndL/BndU +matrices, which may contain arbitrary combination of finite numbers or +infinities (like -INF=0 + * consistency: every column of P sums to 1.0 + +Final constraints which are passed to the underlying optimizer are +calculated as intersection of all present constraints. For example, you +may specify boundary constraint on P[0,0] and equality one: + 0.1<=P[0,0]<=0.9 + P[0,0]=0.5 +Such combination of constraints will be silently reduced to their +intersection, which is P[0,0]=0.5. + +This function can be used to ADD bound constraint for one element of P +without changing constraints for other elements. + +You can also use MCPDSetBC() function which allows to place bound +constraints on arbitrary subset of elements of P. Set of constraints is +specified by BndL/BndU matrices, which may contain arbitrary combination +of finite numbers or infinities (like -INF=" (CT[i]>0). + +Your constraint may involve only some subset of P (less than N*N elements). +For example it can be something like + P[0,0] + P[0,1] = 0.5 +In this case you still should pass matrix with N*N+1 columns, but all its +elements (except for C[0,0], C[0,1] and C[0,N*N-1]) will be zero. + +INPUT PARAMETERS: + S - solver + C - array[K,N*N+1] - coefficients of constraints + (see above for complete description) + CT - array[K] - constraint types + (see above for complete description) + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetlc(const mcpdstate &s, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k); +void mcpdsetlc(const mcpdstate &s, const real_2d_array &c, const integer_1d_array &ct); + + +/************************************************************************* +This function allows to tune amount of Tikhonov regularization being +applied to your problem. + +By default, regularizing term is equal to r*||P-prior_P||^2, where r is a +small non-zero value, P is transition matrix, prior_P is identity matrix, +||X||^2 is a sum of squared elements of X. + +This function allows you to change coefficient r. You can also change +prior values with MCPDSetPrior() function. + +INPUT PARAMETERS: + S - solver + V - regularization coefficient, finite non-negative value. It + is not recommended to specify zero value unless you are + pretty sure that you want it. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsettikhonovregularizer(const mcpdstate &s, const double v); + + +/************************************************************************* +This function allows to set prior values used for regularization of your +problem. + +By default, regularizing term is equal to r*||P-prior_P||^2, where r is a +small non-zero value, P is transition matrix, prior_P is identity matrix, +||X||^2 is a sum of squared elements of X. + +This function allows you to change prior values prior_P. You can also +change r with MCPDSetTikhonovRegularizer() function. + +INPUT PARAMETERS: + S - solver + PP - array[N,N], matrix of prior values: + 1. elements must be real numbers from [0,1] + 2. columns must sum to 1.0. + First property is checked (exception is thrown otherwise), + while second one is not checked/enforced. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetprior(const mcpdstate &s, const real_2d_array &pp); + + +/************************************************************************* +This function is used to change prediction weights + +MCPD solver scales prediction errors as follows + Error(P) = ||W*(y-P*x)||^2 +where + x is a system state at time t + y is a system state at time t+1 + P is a transition matrix + W is a diagonal scaling matrix + +By default, weights are chosen in order to minimize relative prediction +error instead of absolute one. For example, if one component of state is +about 0.5 in magnitude and another one is about 0.05, then algorithm will +make corresponding weights equal to 2.0 and 20.0. + +INPUT PARAMETERS: + S - solver + PW - array[N], weights: + * must be non-negative values (exception will be thrown otherwise) + * zero values will be replaced by automatically chosen values + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsetpredictionweights(const mcpdstate &s, const real_1d_array &pw); + + +/************************************************************************* +This function is used to start solution of the MCPD problem. + +After return from this function, you can use MCPDResults() to get solution +and completion code. + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdsolve(const mcpdstate &s); + + +/************************************************************************* +MCPD results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + P - array[N,N], transition matrix + Rep - optimization report. You should check Rep.TerminationType + in order to distinguish successful termination from + unsuccessful one. Speaking short, positive values denote + success, negative ones are failures. + More information about fields of this structure can be + found in the comments on MCPDReport datatype. + + + -- ALGLIB -- + Copyright 23.05.2010 by Bochkanov Sergey +*************************************************************************/ +void mcpdresults(const mcpdstate &s, real_2d_array &p, mcpdreport &rep); + +/************************************************************************* +This function serializes data structure to string. + +Important properties of s_out: +* it contains alphanumeric characters, dots, underscores, minus signs +* these symbols are grouped into words, which are separated by spaces + and Windows-style (CR+LF) newlines +* although serializer uses spaces and CR+LF as separators, you can + replace any separator character by arbitrary combination of spaces, + tabs, Windows or Unix newlines. It allows flexible reformatting of + the string in case you want to include it into text or XML file. + But you should not insert separators into the middle of the "words" + nor you should change case of letters. +* s_out can be freely moved between 32-bit and 64-bit systems, little + and big endian machines, and so on. You can serialize structure on + 32-bit machine and unserialize it on 64-bit one (or vice versa), or + serialize it on SPARC and unserialize on x86. You can also + serialize it in C++ version of ALGLIB and unserialize in C# one, + and vice versa. +*************************************************************************/ +void mlpeserialize(mlpensemble &obj, std::string &s_out); + + +/************************************************************************* +This function unserializes data structure from string. +*************************************************************************/ +void mlpeunserialize(std::string &s_in, mlpensemble &obj); + + +/************************************************************************* +Like MLPCreate0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate0(const ae_int_t nin, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreate1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreate2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreate2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateB0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb0(const ae_int_t nin, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateB1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateB2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreateb2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double b, const double d, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateR0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater0(const ae_int_t nin, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateR1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateR2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreater2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const double a, const double b, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateC0, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec0(const ae_int_t nin, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateC1, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec1(const ae_int_t nin, const ae_int_t nhid, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Like MLPCreateC2, but for ensembles. + + -- ALGLIB -- + Copyright 18.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatec2(const ae_int_t nin, const ae_int_t nhid1, const ae_int_t nhid2, const ae_int_t nout, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Creates ensemble from network. Only network geometry is copied. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpecreatefromnetwork(const multilayerperceptron &network, const ae_int_t ensemblesize, mlpensemble &ensemble); + + +/************************************************************************* +Randomization of MLP ensemble + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlperandomize(const mlpensemble &ensemble); + + +/************************************************************************* +Return ensemble properties (number of inputs and outputs). + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeproperties(const mlpensemble &ensemble, ae_int_t &nin, ae_int_t &nout); + + +/************************************************************************* +Return normalization type (whether ensemble is SOFTMAX-normalized or not). + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +bool mlpeissoftmax(const mlpensemble &ensemble); + + +/************************************************************************* +Procesing + +INPUT PARAMETERS: + Ensemble- neural networks ensemble + X - input vector, array[0..NIn-1]. + Y - (possibly) preallocated buffer; if size of Y is less than + NOut, it will be reallocated. If it is large enough, it + is NOT reallocated, so we can save some time on reallocation. + + +OUTPUT PARAMETERS: + Y - result. Regression estimate when solving regression task, + vector of posterior probabilities for classification task. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeprocess(const mlpensemble &ensemble, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +'interactive' variant of MLPEProcess for languages like Python which +support constructs like "Y = MLPEProcess(LM,X)" and interactive mode of the +interpreter + +This function allocates new array on each call, so it is significantly +slower than its 'non-interactive' counterpart, but it is more convenient +when you call it from command line. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpeprocessi(const mlpensemble &ensemble, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +Relative classification error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + percent of incorrectly classified cases. + Works both for classifier betwork and for regression networks which +are used as classifiers. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlperelclserror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + CrossEntropy/(NPoints*LN(2)). + Zero if ensemble solves regression task. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgce(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +RMS error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + root mean square error. + Its meaning for regression task is obvious. As for classification task +RMS error means error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpermserror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for classification task +it means average error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgerror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +Average relative error on the test set + +INPUT PARAMETERS: + Ensemble- ensemble + XY - test set + NPoints - test set size + +RESULT: + Its meaning for regression task is obvious. As for classification task +it means average relative error when estimating posterior probabilities. + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +double mlpeavgrelerror(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints); + +/************************************************************************* +Neural network training using modified Levenberg-Marquardt with exact +Hessian calculation and regularization. Subroutine trains neural network +with restarts from random positions. Algorithm is well suited for small +and medium scale problems (hundreds of weights). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts from random position, >0. + If you don't know what Restarts to choose, use 2. + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -9, if internal matrix inverse subroutine failed + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlptrainlm(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep); + + +/************************************************************************* +Neural network training using L-BFGS algorithm with regularization. +Subroutine trains neural network with restarts from random positions. +Algorithm is well suited for problems of any dimensionality (memory +requirements and step complexity are linear by weights number). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts from random position, >0. + If you don't know what Restarts to choose, use 2. + WStep - stopping criterion. Algorithm stops if step size is + less than WStep. Recommended value - 0.01. Zero step + size means stopping after MaxIts iterations. + MaxIts - stopping criterion. Algorithm stops after MaxIts + iterations (NOT gradient calculations). Zero MaxIts + means stopping when step is sufficiently small. + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -8, if both WStep=0 and MaxIts=0 + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlptrainlbfgs(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, ae_int_t &info, mlpreport &rep); + + +/************************************************************************* +Neural network training using early stopping (base algorithm - L-BFGS with +regularization). + +INPUT PARAMETERS: + Network - neural network with initialized geometry + TrnXY - training set + TrnSize - training set size, TrnSize>0 + ValXY - validation set + ValSize - validation set size, ValSize>0 + Decay - weight decay constant, >=0.001 + Decay term 'Decay*||Weights||^2' is added to error + function. + If you don't know what Decay to choose, use 0.001. + Restarts - number of restarts, either: + * strictly positive number - algorithm make specified + number of restarts from random position. + * -1, in which case algorithm makes exactly one run + from the initial state of the network (no randomization). + If you don't know what Restarts to choose, choose one + one the following: + * -1 (deterministic start) + * +1 (one random restart) + * +5 (moderate amount of random restarts) + +OUTPUT PARAMETERS: + Network - trained neural network. + Info - return code: + * -2, if there is a point with class number + outside of [0..NOut-1]. + * -1, if wrong parameters specified + (NPoints<0, Restarts<1, ...). + * 2, task has been solved, stopping criterion met - + sufficiently small step size. Not expected (we + use EARLY stopping) but possible and not an + error. + * 6, task has been solved, stopping criterion met - + increasing of validation set error. + Rep - training report + +NOTE: + +Algorithm stops if validation set error increases for a long enough or +step size is small enought (there are task where validation set may +decrease for eternity). In any case solution returned corresponds to the +minimum of validation set error. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlptraines(const multilayerperceptron &network, const real_2d_array &trnxy, const ae_int_t trnsize, const real_2d_array &valxy, const ae_int_t valsize, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep); + + +/************************************************************************* +Cross-validation estimate of generalization error. + +Base algorithm - L-BFGS. + +INPUT PARAMETERS: + Network - neural network with initialized geometry. Network is + not changed during cross-validation - it is used only + as a representative of its architecture. + XY - training set. + SSize - training set size + Decay - weight decay, same as in MLPTrainLBFGS + Restarts - number of restarts, >0. + restarts are counted for each partition separately, so + total number of restarts will be Restarts*FoldsCount. + WStep - stopping criterion, same as in MLPTrainLBFGS + MaxIts - stopping criterion, same as in MLPTrainLBFGS + FoldsCount - number of folds in k-fold cross-validation, + 2<=FoldsCount<=SSize. + recommended value: 10. + +OUTPUT PARAMETERS: + Info - return code, same as in MLPTrainLBFGS + Rep - report, same as in MLPTrainLM/MLPTrainLBFGS + CVRep - generalization error estimates + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcvlbfgs(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, const ae_int_t foldscount, ae_int_t &info, mlpreport &rep, mlpcvreport &cvrep); + + +/************************************************************************* +Cross-validation estimate of generalization error. + +Base algorithm - Levenberg-Marquardt. + +INPUT PARAMETERS: + Network - neural network with initialized geometry. Network is + not changed during cross-validation - it is used only + as a representative of its architecture. + XY - training set. + SSize - training set size + Decay - weight decay, same as in MLPTrainLBFGS + Restarts - number of restarts, >0. + restarts are counted for each partition separately, so + total number of restarts will be Restarts*FoldsCount. + FoldsCount - number of folds in k-fold cross-validation, + 2<=FoldsCount<=SSize. + recommended value: 10. + +OUTPUT PARAMETERS: + Info - return code, same as in MLPTrainLBFGS + Rep - report, same as in MLPTrainLM/MLPTrainLBFGS + CVRep - generalization error estimates + + -- ALGLIB -- + Copyright 09.12.2007 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcvlm(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const ae_int_t foldscount, ae_int_t &info, mlpreport &rep, mlpcvreport &cvrep); + + +/************************************************************************* +This function estimates generalization error using cross-validation on the +current dataset with current training settings. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * FoldsCount cross-validation rounds (always) + ! * NRestarts training sessions performed within each of + ! cross-validation rounds (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. Network is not changed during cross- + validation and is not trained - it is used only as + representative of its architecture. I.e., we estimate + generalization properties of ARCHITECTURE, not some + specific network. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that for each cross-validation + round specified number of random restarts is + performed, with best network being chosen after + training. + * NRestarts=0 is same as NRestarts=1 + FoldsCount - number of folds in k-fold cross-validation: + * 2<=FoldsCount<=size of dataset + * recommended value: 10. + * values larger than dataset size will be silently + truncated down to dataset size + +OUTPUT PARAMETERS: + Rep - structure which contains cross-validation estimates: + * Rep.RelCLSError - fraction of misclassified cases. + * Rep.AvgCE - acerage cross-entropy + * Rep.RMSError - root-mean-square error + * Rep.AvgError - average error + * Rep.AvgRelError - average relative error + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + or subset with only one point was given, zeros are returned as + estimates. + +NOTE: this method performs FoldsCount cross-validation rounds, each one + with NRestarts random starts. Thus, FoldsCount*NRestarts networks + are trained in total. + +NOTE: Rep.RelCLSError/Rep.AvgCE are zero on regression problems. + +NOTE: on classification problems Rep.RMSError/Rep.AvgError/Rep.AvgRelError + contain errors in prediction of posterior probabilities. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpkfoldcv(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, const ae_int_t foldscount, mlpreport &rep); +void smp_mlpkfoldcv(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, const ae_int_t foldscount, mlpreport &rep); + + +/************************************************************************* +Creation of the network trainer object for regression networks + +INPUT PARAMETERS: + NIn - number of inputs, NIn>=1 + NOut - number of outputs, NOut>=1 + +OUTPUT PARAMETERS: + S - neural network trainer object. + This structure can be used to train any regression + network with NIn inputs and NOut outputs. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatetrainer(const ae_int_t nin, const ae_int_t nout, mlptrainer &s); + + +/************************************************************************* +Creation of the network trainer object for classification networks + +INPUT PARAMETERS: + NIn - number of inputs, NIn>=1 + NClasses - number of classes, NClasses>=2 + +OUTPUT PARAMETERS: + S - neural network trainer object. + This structure can be used to train any classification + network with NIn inputs and NOut outputs. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpcreatetrainercls(const ae_int_t nin, const ae_int_t nclasses, mlptrainer &s); + + +/************************************************************************* +This function sets "current dataset" of the trainer object to one passed +by user. + +INPUT PARAMETERS: + S - trainer object + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. + NPoints - points count, >=0. + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +datasetformat is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetdataset(const mlptrainer &s, const real_2d_array &xy, const ae_int_t npoints); + + +/************************************************************************* +This function sets "current dataset" of the trainer object to one passed +by user (sparse matrix is used to store dataset). + +INPUT PARAMETERS: + S - trainer object + XY - training set, see below for information on the + training set format. This function checks correctness + of the dataset (no NANs/INFs, class numbers are + correct) and throws exception when incorrect dataset + is passed. Any sparse storage format can be used: + Hash-table, CRS... + NPoints - points count, >=0 + +DATASET FORMAT: + +This function uses two different dataset formats - one for regression +networks, another one for classification networks. + +For regression networks with NIn inputs and NOut outputs following dataset +format is used: +* dataset is given by NPoints*(NIn+NOut) matrix +* each row corresponds to one example +* first NIn columns are inputs, next NOut columns are outputs + +For classification networks with NIn inputs and NClasses clases following +datasetformat is used: +* dataset is given by NPoints*(NIn+1) matrix +* each row corresponds to one example +* first NIn columns are inputs, last column stores class number (from 0 to + NClasses-1). + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetsparsedataset(const mlptrainer &s, const sparsematrix &xy, const ae_int_t npoints); + + +/************************************************************************* +This function sets weight decay coefficient which is used for training. + +INPUT PARAMETERS: + S - trainer object + Decay - weight decay coefficient, >=0. Weight decay term + 'Decay*||Weights||^2' is added to error function. If + you don't know what Decay to choose, use 1.0E-3. + Weight decay can be set to zero, in this case network + is trained without weight decay. + +NOTE: by default network uses some small nonzero value for weight decay. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetdecay(const mlptrainer &s, const double decay); + + +/************************************************************************* +This function sets stopping criteria for the optimizer. + +INPUT PARAMETERS: + S - trainer object + WStep - stopping criterion. Algorithm stops if step size is + less than WStep. Recommended value - 0.01. Zero step + size means stopping after MaxIts iterations. + WStep>=0. + MaxIts - stopping criterion. Algorithm stops after MaxIts + epochs (full passes over entire dataset). Zero MaxIts + means stopping when step is sufficiently small. + MaxIts>=0. + +NOTE: by default, WStep=0.005 and MaxIts=0 are used. These values are also + used when MLPSetCond() is called with WStep=0 and MaxIts=0. + +NOTE: these stopping criteria are used for all kinds of neural training - + from "conventional" networks to early stopping ensembles. When used + for "conventional" networks, they are used as the only stopping + criteria. When combined with early stopping, they used as ADDITIONAL + stopping criteria which can terminate early stopping algorithm. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetcond(const mlptrainer &s, const double wstep, const ae_int_t maxits); + + +/************************************************************************* +This function sets training algorithm: batch training using L-BFGS will be +used. + +This algorithm: +* the most robust for small-scale problems, but may be too slow for large + scale ones. +* perfoms full pass through the dataset before performing step +* uses conditions specified by MLPSetCond() for stopping +* is default one used by trainer object + +INPUT PARAMETERS: + S - trainer object + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetalgobatch(const mlptrainer &s); + + +/************************************************************************* +This function trains neural network passed to this function, using current +dataset (one which was passed to MLPSetDataset() or MLPSetSparseDataset()) +and current training settings. Training from NRestarts random starting +positions is performed, best network is chosen. + +Training is performed using current training algorithm. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * NRestarts training sessions performed within each of + ! cross-validation rounds (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that specified number of random + restarts are performed, best network is chosen after + training + * NRestarts=0 means that current state of the network + is used for training. + +OUTPUT PARAMETERS: + Network - trained network + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + network is filled by zero values. Same behavior for functions + MLPStartTraining and MLPContinueTraining. + +NOTE: this method uses sum-of-squares error function for training. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlptrainnetwork(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, mlpreport &rep); +void smp_mlptrainnetwork(const mlptrainer &s, const multilayerperceptron &network, const ae_int_t nrestarts, mlpreport &rep); + + +/************************************************************************* +IMPORTANT: this is an "expert" version of the MLPTrain() function. We do + not recommend you to use it unless you are pretty sure that you + need ability to monitor training progress. + +This function performs step-by-step training of the neural network. Here +"step-by-step" means that training starts with MLPStartTraining() call, +and then user subsequently calls MLPContinueTraining() to perform one more +iteration of the training. + +After call to this function trainer object remembers network and is ready +to train it. However, no training is performed until first call to +MLPContinueTraining() function. Subsequent calls to MLPContinueTraining() +will advance training progress one iteration further. + +EXAMPLE: + > + > ...initialize network and trainer object.... + > + > MLPStartTraining(Trainer, Network, True) + > while MLPContinueTraining(Trainer, Network) do + > ...visualize training progress... + > + +INPUT PARAMETERS: + S - trainer object + Network - neural network. It must have same number of inputs and + output/classes as was specified during creation of the + trainer object. + RandomStart - randomize network before training or not: + * True means that network is randomized and its + initial state (one which was passed to the trainer + object) is lost. + * False means that training is started from the + current state of the network + +OUTPUT PARAMETERS: + Network - neural network which is ready to training (weights are + initialized, preprocessor is initialized using current + training set) + +NOTE: this method uses sum-of-squares error function for training. + +NOTE: it is expected that trainer object settings are NOT changed during + step-by-step training, i.e. no one changes stopping criteria or + training set during training. It is possible and there is no defense + against such actions, but algorithm behavior in such cases is + undefined and can be unpredictable. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpstarttraining(const mlptrainer &s, const multilayerperceptron &network, const bool randomstart); + + +/************************************************************************* +IMPORTANT: this is an "expert" version of the MLPTrain() function. We do + not recommend you to use it unless you are pretty sure that you + need ability to monitor training progress. + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +This function performs step-by-step training of the neural network. Here +"step-by-step" means that training starts with MLPStartTraining() call, +and then user subsequently calls MLPContinueTraining() to perform one more +iteration of the training. + +This function performs one more iteration of the training and returns +either True (training continues) or False (training stopped). In case True +was returned, Network weights are updated according to the current state +of the optimization progress. In case False was returned, no additional +updates is performed (previous update of the network weights moved us to +the final point, and no additional updates is needed). + +EXAMPLE: + > + > [initialize network and trainer object] + > + > MLPStartTraining(Trainer, Network, True) + > while MLPContinueTraining(Trainer, Network) do + > [visualize training progress] + > + +INPUT PARAMETERS: + S - trainer object + Network - neural network structure, which is used to store + current state of the training process. + +OUTPUT PARAMETERS: + Network - weights of the neural network are rewritten by the + current approximation. + +NOTE: this method uses sum-of-squares error function for training. + +NOTE: it is expected that trainer object settings are NOT changed during + step-by-step training, i.e. no one changes stopping criteria or + training set during training. It is possible and there is no defense + against such actions, but algorithm behavior in such cases is + undefined and can be unpredictable. + +NOTE: It is expected that Network is the same one which was passed to + MLPStartTraining() function. However, THIS function checks only + following: + * that number of network inputs is consistent with trainer object + settings + * that number of network outputs/classes is consistent with trainer + object settings + * that number of network weights is the same as number of weights in + the network passed to MLPStartTraining() function + Exception is thrown when these conditions are violated. + + It is also expected that you do not change state of the network on + your own - the only party who has right to change network during its + training is a trainer object. Any attempt to interfere with trainer + may lead to unpredictable results. + + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +bool mlpcontinuetraining(const mlptrainer &s, const multilayerperceptron &network); +bool smp_mlpcontinuetraining(const mlptrainer &s, const multilayerperceptron &network); + + +/************************************************************************* +Training neural networks ensemble using bootstrap aggregating (bagging). +Modified Levenberg-Marquardt algorithm is used as base training method. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpebagginglm(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep, mlpcvreport &ooberrors); + + +/************************************************************************* +Training neural networks ensemble using bootstrap aggregating (bagging). +L-BFGS algorithm is used as base training method. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + WStep - stopping criterion, same as in MLPTrainLBFGS + MaxIts - stopping criterion, same as in MLPTrainLBFGS + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -8, if both WStep=0 and MaxIts=0 + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 2, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 17.02.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpebagginglbfgs(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, const double wstep, const ae_int_t maxits, ae_int_t &info, mlpreport &rep, mlpcvreport &ooberrors); + + +/************************************************************************* +Training neural networks ensemble using early stopping. + +INPUT PARAMETERS: + Ensemble - model with initialized geometry + XY - training set + NPoints - training set size + Decay - weight decay coefficient, >=0.001 + Restarts - restarts, >0. + +OUTPUT PARAMETERS: + Ensemble - trained model + Info - return code: + * -2, if there is a point with class number + outside of [0..NClasses-1]. + * -1, if incorrect parameters was passed + (NPoints<0, Restarts<1). + * 6, if task has been solved. + Rep - training report. + OOBErrors - out-of-bag generalization error estimate + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void mlpetraines(const mlpensemble &ensemble, const real_2d_array &xy, const ae_int_t npoints, const double decay, const ae_int_t restarts, ae_int_t &info, mlpreport &rep); + + +/************************************************************************* +This function trains neural network ensemble passed to this function using +current dataset and early stopping training algorithm. Each early stopping +round performs NRestarts random restarts (thus, EnsembleSize*NRestarts +training rounds is performed in total). + +FOR USERS OF COMMERCIAL EDITION: + + ! Commercial version of ALGLIB includes two important improvements of + ! this function: + ! * multicore support (C++ and C# computational cores) + ! * SSE support (C++ computational core) + ! + ! Second improvement gives constant speedup (2-3X). First improvement + ! gives close-to-linear speedup on multicore systems. Following + ! operations can be executed in parallel: + ! * EnsembleSize training sessions performed for each of ensemble + ! members (always parallelized) + ! * NRestarts training sessions performed within each of training + ! sessions (if NRestarts>1) + ! * gradient calculation over large dataset (if dataset is large enough) + ! + ! In order to use multicore features you have to: + ! * use commercial version of ALGLIB + ! * call this function with "smp_" prefix, which indicates that + ! multicore code will be used (for multicore support) + ! + ! In order to use SSE features you have to: + ! * use commercial version of ALGLIB on Intel processors + ! * use C++ computational core + ! + ! This note is given for users of commercial edition; if you use GPL + ! edition, you still will be able to call smp-version of this function, + ! but all computations will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + +INPUT PARAMETERS: + S - trainer object; + Ensemble - neural network ensemble. It must have same number of + inputs and outputs/classes as was specified during + creation of the trainer object. + NRestarts - number of restarts, >=0: + * NRestarts>0 means that specified number of random + restarts are performed during each ES round; + * NRestarts=0 is silently replaced by 1. + +OUTPUT PARAMETERS: + Ensemble - trained ensemble; + Rep - it contains all type of errors. + +NOTE: this training method uses BOTH early stopping and weight decay! So, + you should select weight decay before starting training just as you + select it before training "conventional" networks. + +NOTE: when no dataset was specified with MLPSetDataset/SetSparseDataset(), + or single-point dataset was passed, ensemble is filled by zero + values. + +NOTE: this method uses sum-of-squares error function for training. + + -- ALGLIB -- + Copyright 22.08.2012 by Bochkanov Sergey +*************************************************************************/ +void mlptrainensemblees(const mlptrainer &s, const mlpensemble &ensemble, const ae_int_t nrestarts, mlpreport &rep); +void smp_mlptrainensemblees(const mlptrainer &s, const mlpensemble &ensemble, const ae_int_t nrestarts, mlpreport &rep); + +/************************************************************************* +Principal components analysis + +Subroutine builds orthogonal basis where first axis corresponds to +direction with maximum variance, second axis maximizes variance in subspace +orthogonal to first axis and so on. + +It should be noted that, unlike LDA, PCA does not use class labels. + +INPUT PARAMETERS: + X - dataset, array[0..NPoints-1,0..NVars-1]. + matrix contains ONLY INDEPENDENT VARIABLES. + NPoints - dataset size, NPoints>=0 + NVars - number of independent variables, NVars>=1 + +ÂÛÕÎÄÍÛÅ ÏÀÐÀÌÅÒÐÛ: + Info - return code: + * -4, if SVD subroutine haven't converged + * -1, if wrong parameters has been passed (NPoints<0, + NVars<1) + * 1, if task is solved + S2 - array[0..NVars-1]. variance values corresponding + to basis vectors. + V - array[0..NVars-1,0..NVars-1] + matrix, whose columns store basis vectors. + + -- ALGLIB -- + Copyright 25.08.2008 by Bochkanov Sergey +*************************************************************************/ +void pcabuildbasis(const real_2d_array &x, const ae_int_t npoints, const ae_int_t nvars, ae_int_t &info, real_1d_array &s2, real_2d_array &v); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void dserrallocate(ae_int_t nclasses, + /* Real */ ae_vector* buf, + ae_state *_state); +void dserraccumulate(/* Real */ ae_vector* buf, + /* Real */ ae_vector* y, + /* Real */ ae_vector* desiredy, + ae_state *_state); +void dserrfinish(/* Real */ ae_vector* buf, ae_state *_state); +void dsnormalize(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + /* Real */ ae_vector* means, + /* Real */ ae_vector* sigmas, + ae_state *_state); +void dsnormalizec(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + /* Real */ ae_vector* means, + /* Real */ ae_vector* sigmas, + ae_state *_state); +double dsgetmeanmindistance(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_state *_state); +void dstie(/* Real */ ae_vector* a, + ae_int_t n, + /* Integer */ ae_vector* ties, + ae_int_t* tiecount, + /* Integer */ ae_vector* p1, + /* Integer */ ae_vector* p2, + ae_state *_state); +void dstiefasti(/* Real */ ae_vector* a, + /* Integer */ ae_vector* b, + ae_int_t n, + /* Integer */ ae_vector* ties, + ae_int_t* tiecount, + /* Real */ ae_vector* bufr, + /* Integer */ ae_vector* bufi, + ae_state *_state); +void dsoptimalsplit2(/* Real */ ae_vector* a, + /* Integer */ ae_vector* c, + ae_int_t n, + ae_int_t* info, + double* threshold, + double* pal, + double* pbl, + double* par, + double* pbr, + double* cve, + ae_state *_state); +void dsoptimalsplit2fast(/* Real */ ae_vector* a, + /* Integer */ ae_vector* c, + /* Integer */ ae_vector* tiesbuf, + /* Integer */ ae_vector* cntbuf, + /* Real */ ae_vector* bufr, + /* Integer */ ae_vector* bufi, + ae_int_t n, + ae_int_t nc, + double alpha, + ae_int_t* info, + double* threshold, + double* rms, + double* cvrms, + ae_state *_state); +void dssplitk(/* Real */ ae_vector* a, + /* Integer */ ae_vector* c, + ae_int_t n, + ae_int_t nc, + ae_int_t kmax, + ae_int_t* info, + /* Real */ ae_vector* thresholds, + ae_int_t* ni, + double* cve, + ae_state *_state); +void dsoptimalsplitk(/* Real */ ae_vector* a, + /* Integer */ ae_vector* c, + ae_int_t n, + ae_int_t nc, + ae_int_t kmax, + ae_int_t* info, + /* Real */ ae_vector* thresholds, + ae_int_t* ni, + double* cve, + ae_state *_state); +ae_bool _cvreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _cvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _cvreport_clear(void* _p); +void _cvreport_destroy(void* _p); +void clusterizercreate(clusterizerstate* s, ae_state *_state); +void clusterizersetpoints(clusterizerstate* s, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_int_t disttype, + ae_state *_state); +void clusterizersetdistances(clusterizerstate* s, + /* Real */ ae_matrix* d, + ae_int_t npoints, + ae_bool isupper, + ae_state *_state); +void clusterizersetahcalgo(clusterizerstate* s, + ae_int_t algo, + ae_state *_state); +void clusterizersetkmeanslimits(clusterizerstate* s, + ae_int_t restarts, + ae_int_t maxits, + ae_state *_state); +void clusterizerrunahc(clusterizerstate* s, + ahcreport* rep, + ae_state *_state); +void _pexec_clusterizerrunahc(clusterizerstate* s, + ahcreport* rep, ae_state *_state); +void clusterizerrunkmeans(clusterizerstate* s, + ae_int_t k, + kmeansreport* rep, + ae_state *_state); +void clusterizergetdistances(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_int_t disttype, + /* Real */ ae_matrix* d, + ae_state *_state); +void _pexec_clusterizergetdistances(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_int_t disttype, + /* Real */ ae_matrix* d, ae_state *_state); +void clusterizergetkclusters(ahcreport* rep, + ae_int_t k, + /* Integer */ ae_vector* cidx, + /* Integer */ ae_vector* cz, + ae_state *_state); +void clusterizerseparatedbydist(ahcreport* rep, + double r, + ae_int_t* k, + /* Integer */ ae_vector* cidx, + /* Integer */ ae_vector* cz, + ae_state *_state); +void clusterizerseparatedbycorr(ahcreport* rep, + double r, + ae_int_t* k, + /* Integer */ ae_vector* cidx, + /* Integer */ ae_vector* cz, + ae_state *_state); +void kmeansgenerateinternal(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t k, + ae_int_t maxits, + ae_int_t restarts, + ae_int_t* info, + /* Real */ ae_matrix* ccol, + ae_bool needccol, + /* Real */ ae_matrix* crow, + ae_bool needcrow, + /* Integer */ ae_vector* xyc, + ae_state *_state); +ae_bool _clusterizerstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _clusterizerstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _clusterizerstate_clear(void* _p); +void _clusterizerstate_destroy(void* _p); +ae_bool _ahcreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _ahcreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _ahcreport_clear(void* _p); +void _ahcreport_destroy(void* _p); +ae_bool _kmeansreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _kmeansreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _kmeansreport_clear(void* _p); +void _kmeansreport_destroy(void* _p); +void kmeansgenerate(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t k, + ae_int_t restarts, + ae_int_t* info, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* xyc, + ae_state *_state); +void dfbuildrandomdecisionforest(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t ntrees, + double r, + ae_int_t* info, + decisionforest* df, + dfreport* rep, + ae_state *_state); +void dfbuildrandomdecisionforestx1(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t ntrees, + ae_int_t nrndvars, + double r, + ae_int_t* info, + decisionforest* df, + dfreport* rep, + ae_state *_state); +void dfbuildinternal(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t ntrees, + ae_int_t samplesize, + ae_int_t nfeatures, + ae_int_t flags, + ae_int_t* info, + decisionforest* df, + dfreport* rep, + ae_state *_state); +void dfprocess(decisionforest* df, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void dfprocessi(decisionforest* df, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +double dfrelclserror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double dfavgce(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double dfrmserror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double dfavgerror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double dfavgrelerror(decisionforest* df, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +void dfcopy(decisionforest* df1, decisionforest* df2, ae_state *_state); +void dfalloc(ae_serializer* s, decisionforest* forest, ae_state *_state); +void dfserialize(ae_serializer* s, + decisionforest* forest, + ae_state *_state); +void dfunserialize(ae_serializer* s, + decisionforest* forest, + ae_state *_state); +ae_bool _decisionforest_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _decisionforest_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _decisionforest_clear(void* _p); +void _decisionforest_destroy(void* _p); +ae_bool _dfreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _dfreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _dfreport_clear(void* _p); +void _dfreport_destroy(void* _p); +ae_bool _dfinternalbuffers_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _dfinternalbuffers_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _dfinternalbuffers_clear(void* _p); +void _dfinternalbuffers_destroy(void* _p); +void lrbuild(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + linearmodel* lm, + lrreport* ar, + ae_state *_state); +void lrbuilds(/* Real */ ae_matrix* xy, + /* Real */ ae_vector* s, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + linearmodel* lm, + lrreport* ar, + ae_state *_state); +void lrbuildzs(/* Real */ ae_matrix* xy, + /* Real */ ae_vector* s, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + linearmodel* lm, + lrreport* ar, + ae_state *_state); +void lrbuildz(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + linearmodel* lm, + lrreport* ar, + ae_state *_state); +void lrunpack(linearmodel* lm, + /* Real */ ae_vector* v, + ae_int_t* nvars, + ae_state *_state); +void lrpack(/* Real */ ae_vector* v, + ae_int_t nvars, + linearmodel* lm, + ae_state *_state); +double lrprocess(linearmodel* lm, + /* Real */ ae_vector* x, + ae_state *_state); +double lrrmserror(linearmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double lravgerror(linearmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double lravgrelerror(linearmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +void lrcopy(linearmodel* lm1, linearmodel* lm2, ae_state *_state); +void lrlines(/* Real */ ae_matrix* xy, + /* Real */ ae_vector* s, + ae_int_t n, + ae_int_t* info, + double* a, + double* b, + double* vara, + double* varb, + double* covab, + double* corrab, + double* p, + ae_state *_state); +void lrline(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t* info, + double* a, + double* b, + ae_state *_state); +ae_bool _linearmodel_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _linearmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _linearmodel_clear(void* _p); +void _linearmodel_destroy(void* _p); +ae_bool _lrreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _lrreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _lrreport_clear(void* _p); +void _lrreport_destroy(void* _p); +void filtersma(/* Real */ ae_vector* x, + ae_int_t n, + ae_int_t k, + ae_state *_state); +void filterema(/* Real */ ae_vector* x, + ae_int_t n, + double alpha, + ae_state *_state); +void filterlrma(/* Real */ ae_vector* x, + ae_int_t n, + ae_int_t k, + ae_state *_state); +void fisherlda(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t* info, + /* Real */ ae_vector* w, + ae_state *_state); +void fisherldan(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t* info, + /* Real */ ae_matrix* w, + ae_state *_state); +ae_int_t mlpgradsplitcost(ae_state *_state); +ae_int_t mlpgradsplitsize(ae_state *_state); +void mlpcreate0(ae_int_t nin, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state); +void mlpcreate1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state); +void mlpcreate2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state); +void mlpcreateb0(ae_int_t nin, + ae_int_t nout, + double b, + double d, + multilayerperceptron* network, + ae_state *_state); +void mlpcreateb1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + double b, + double d, + multilayerperceptron* network, + ae_state *_state); +void mlpcreateb2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + double b, + double d, + multilayerperceptron* network, + ae_state *_state); +void mlpcreater0(ae_int_t nin, + ae_int_t nout, + double a, + double b, + multilayerperceptron* network, + ae_state *_state); +void mlpcreater1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + double a, + double b, + multilayerperceptron* network, + ae_state *_state); +void mlpcreater2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + double a, + double b, + multilayerperceptron* network, + ae_state *_state); +void mlpcreatec0(ae_int_t nin, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state); +void mlpcreatec1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state); +void mlpcreatec2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + multilayerperceptron* network, + ae_state *_state); +void mlpcopy(multilayerperceptron* network1, + multilayerperceptron* network2, + ae_state *_state); +void mlpcopyshared(multilayerperceptron* network1, + multilayerperceptron* network2, + ae_state *_state); +ae_bool mlpsamearchitecture(multilayerperceptron* network1, + multilayerperceptron* network2, + ae_state *_state); +void mlpcopytunableparameters(multilayerperceptron* network1, + multilayerperceptron* network2, + ae_state *_state); +void mlpexporttunableparameters(multilayerperceptron* network, + /* Real */ ae_vector* p, + ae_int_t* pcount, + ae_state *_state); +void mlpimporttunableparameters(multilayerperceptron* network, + /* Real */ ae_vector* p, + ae_state *_state); +void mlpserializeold(multilayerperceptron* network, + /* Real */ ae_vector* ra, + ae_int_t* rlen, + ae_state *_state); +void mlpunserializeold(/* Real */ ae_vector* ra, + multilayerperceptron* network, + ae_state *_state); +void mlprandomize(multilayerperceptron* network, ae_state *_state); +void mlprandomizefull(multilayerperceptron* network, ae_state *_state); +void mlpinitpreprocessor(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + ae_state *_state); +void mlpinitpreprocessorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t ssize, + ae_state *_state); +void mlpinitpreprocessorsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + ae_state *_state); +void mlpinitpreprocessorsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + ae_state *_state); +void mlpproperties(multilayerperceptron* network, + ae_int_t* nin, + ae_int_t* nout, + ae_int_t* wcount, + ae_state *_state); +ae_int_t mlpntotal(multilayerperceptron* network, ae_state *_state); +ae_int_t mlpgetinputscount(multilayerperceptron* network, + ae_state *_state); +ae_int_t mlpgetoutputscount(multilayerperceptron* network, + ae_state *_state); +ae_int_t mlpgetweightscount(multilayerperceptron* network, + ae_state *_state); +ae_bool mlpissoftmax(multilayerperceptron* network, ae_state *_state); +ae_int_t mlpgetlayerscount(multilayerperceptron* network, + ae_state *_state); +ae_int_t mlpgetlayersize(multilayerperceptron* network, + ae_int_t k, + ae_state *_state); +void mlpgetinputscaling(multilayerperceptron* network, + ae_int_t i, + double* mean, + double* sigma, + ae_state *_state); +void mlpgetoutputscaling(multilayerperceptron* network, + ae_int_t i, + double* mean, + double* sigma, + ae_state *_state); +void mlpgetneuroninfo(multilayerperceptron* network, + ae_int_t k, + ae_int_t i, + ae_int_t* fkind, + double* threshold, + ae_state *_state); +double mlpgetweight(multilayerperceptron* network, + ae_int_t k0, + ae_int_t i0, + ae_int_t k1, + ae_int_t i1, + ae_state *_state); +void mlpsetinputscaling(multilayerperceptron* network, + ae_int_t i, + double mean, + double sigma, + ae_state *_state); +void mlpsetoutputscaling(multilayerperceptron* network, + ae_int_t i, + double mean, + double sigma, + ae_state *_state); +void mlpsetneuroninfo(multilayerperceptron* network, + ae_int_t k, + ae_int_t i, + ae_int_t fkind, + double threshold, + ae_state *_state); +void mlpsetweight(multilayerperceptron* network, + ae_int_t k0, + ae_int_t i0, + ae_int_t k1, + ae_int_t i1, + double w, + ae_state *_state); +void mlpactivationfunction(double net, + ae_int_t k, + double* f, + double* df, + double* d2f, + ae_state *_state); +void mlpprocess(multilayerperceptron* network, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void mlpprocessi(multilayerperceptron* network, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +double mlperror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlperror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state); +double mlperrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlperrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state); +double mlperrorn(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + ae_state *_state); +ae_int_t mlpclserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +ae_int_t _pexec_mlpclserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state); +double mlprelclserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlprelclserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state); +double mlprelclserrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlprelclserrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state); +double mlpavgce(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlpavgce(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state); +double mlpavgcesparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlpavgcesparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state); +double mlprmserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlprmserror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state); +double mlprmserrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlprmserrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state); +double mlpavgerror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlpavgerror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state); +double mlpavgerrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlpavgerrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state); +double mlpavgrelerror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlpavgrelerror(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, ae_state *_state); +double mlpavgrelerrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state); +double _pexec_mlpavgrelerrorsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t npoints, ae_state *_state); +void mlpgrad(multilayerperceptron* network, + /* Real */ ae_vector* x, + /* Real */ ae_vector* desiredy, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state); +void mlpgradn(multilayerperceptron* network, + /* Real */ ae_vector* x, + /* Real */ ae_vector* desiredy, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state); +void mlpgradbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state); +void _pexec_mlpgradbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, ae_state *_state); +void mlpgradbatchsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state); +void _pexec_mlpgradbatchsparse(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, ae_state *_state); +void mlpgradbatchsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state); +void _pexec_mlpgradbatchsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + double* e, + /* Real */ ae_vector* grad, ae_state *_state); +void mlpgradbatchsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state); +void _pexec_mlpgradbatchsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* idx, + ae_int_t subsetsize, + double* e, + /* Real */ ae_vector* grad, ae_state *_state); +void mlpgradbatchx(multilayerperceptron* network, + /* Real */ ae_matrix* densexy, + sparsematrix* sparsexy, + ae_int_t datasetsize, + ae_int_t datasettype, + /* Integer */ ae_vector* idx, + ae_int_t subset0, + ae_int_t subset1, + ae_int_t subsettype, + ae_shared_pool* buf, + ae_shared_pool* gradbuf, + ae_state *_state); +void mlpgradnbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + ae_state *_state); +void mlphessiannbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + /* Real */ ae_matrix* h, + ae_state *_state); +void mlphessianbatch(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + double* e, + /* Real */ ae_vector* grad, + /* Real */ ae_matrix* h, + ae_state *_state); +void mlpinternalprocessvector(/* Integer */ ae_vector* structinfo, + /* Real */ ae_vector* weights, + /* Real */ ae_vector* columnmeans, + /* Real */ ae_vector* columnsigmas, + /* Real */ ae_vector* neurons, + /* Real */ ae_vector* dfdnet, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void mlpalloc(ae_serializer* s, + multilayerperceptron* network, + ae_state *_state); +void mlpserialize(ae_serializer* s, + multilayerperceptron* network, + ae_state *_state); +void mlpunserialize(ae_serializer* s, + multilayerperceptron* network, + ae_state *_state); +void mlpallerrorssubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + modelerrors* rep, + ae_state *_state); +void _pexec_mlpallerrorssubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + modelerrors* rep, ae_state *_state); +void mlpallerrorssparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + modelerrors* rep, + ae_state *_state); +void _pexec_mlpallerrorssparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + modelerrors* rep, ae_state *_state); +double mlperrorsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_state *_state); +double _pexec_mlperrorsubset(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, ae_state *_state); +double mlperrorsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_state *_state); +double _pexec_mlperrorsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, ae_state *_state); +void mlpallerrorsx(multilayerperceptron* network, + /* Real */ ae_matrix* densexy, + sparsematrix* sparsexy, + ae_int_t datasetsize, + ae_int_t datasettype, + /* Integer */ ae_vector* idx, + ae_int_t subset0, + ae_int_t subset1, + ae_int_t subsettype, + ae_shared_pool* buf, + modelerrors* rep, + ae_state *_state); +ae_bool _modelerrors_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _modelerrors_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _modelerrors_clear(void* _p); +void _modelerrors_destroy(void* _p); +ae_bool _smlpgrad_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _smlpgrad_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _smlpgrad_clear(void* _p); +void _smlpgrad_destroy(void* _p); +ae_bool _multilayerperceptron_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _multilayerperceptron_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _multilayerperceptron_clear(void* _p); +void _multilayerperceptron_destroy(void* _p); +void mnltrainh(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t nclasses, + ae_int_t* info, + logitmodel* lm, + mnlreport* rep, + ae_state *_state); +void mnlprocess(logitmodel* lm, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void mnlprocessi(logitmodel* lm, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void mnlunpack(logitmodel* lm, + /* Real */ ae_matrix* a, + ae_int_t* nvars, + ae_int_t* nclasses, + ae_state *_state); +void mnlpack(/* Real */ ae_matrix* a, + ae_int_t nvars, + ae_int_t nclasses, + logitmodel* lm, + ae_state *_state); +void mnlcopy(logitmodel* lm1, logitmodel* lm2, ae_state *_state); +double mnlavgce(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double mnlrelclserror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double mnlrmserror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double mnlavgerror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double mnlavgrelerror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t ssize, + ae_state *_state); +ae_int_t mnlclserror(logitmodel* lm, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +ae_bool _logitmodel_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _logitmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _logitmodel_clear(void* _p); +void _logitmodel_destroy(void* _p); +ae_bool _logitmcstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _logitmcstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _logitmcstate_clear(void* _p); +void _logitmcstate_destroy(void* _p); +ae_bool _mnlreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mnlreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mnlreport_clear(void* _p); +void _mnlreport_destroy(void* _p); +void mcpdcreate(ae_int_t n, mcpdstate* s, ae_state *_state); +void mcpdcreateentry(ae_int_t n, + ae_int_t entrystate, + mcpdstate* s, + ae_state *_state); +void mcpdcreateexit(ae_int_t n, + ae_int_t exitstate, + mcpdstate* s, + ae_state *_state); +void mcpdcreateentryexit(ae_int_t n, + ae_int_t entrystate, + ae_int_t exitstate, + mcpdstate* s, + ae_state *_state); +void mcpdaddtrack(mcpdstate* s, + /* Real */ ae_matrix* xy, + ae_int_t k, + ae_state *_state); +void mcpdsetec(mcpdstate* s, + /* Real */ ae_matrix* ec, + ae_state *_state); +void mcpdaddec(mcpdstate* s, + ae_int_t i, + ae_int_t j, + double c, + ae_state *_state); +void mcpdsetbc(mcpdstate* s, + /* Real */ ae_matrix* bndl, + /* Real */ ae_matrix* bndu, + ae_state *_state); +void mcpdaddbc(mcpdstate* s, + ae_int_t i, + ae_int_t j, + double bndl, + double bndu, + ae_state *_state); +void mcpdsetlc(mcpdstate* s, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* ct, + ae_int_t k, + ae_state *_state); +void mcpdsettikhonovregularizer(mcpdstate* s, double v, ae_state *_state); +void mcpdsetprior(mcpdstate* s, + /* Real */ ae_matrix* pp, + ae_state *_state); +void mcpdsetpredictionweights(mcpdstate* s, + /* Real */ ae_vector* pw, + ae_state *_state); +void mcpdsolve(mcpdstate* s, ae_state *_state); +void mcpdresults(mcpdstate* s, + /* Real */ ae_matrix* p, + mcpdreport* rep, + ae_state *_state); +ae_bool _mcpdstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mcpdstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mcpdstate_clear(void* _p); +void _mcpdstate_destroy(void* _p); +ae_bool _mcpdreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mcpdreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mcpdreport_clear(void* _p); +void _mcpdreport_destroy(void* _p); +void mlpecreate0(ae_int_t nin, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreate1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreate2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreateb0(ae_int_t nin, + ae_int_t nout, + double b, + double d, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreateb1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + double b, + double d, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreateb2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + double b, + double d, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreater0(ae_int_t nin, + ae_int_t nout, + double a, + double b, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreater1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + double a, + double b, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreater2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + double a, + double b, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreatec0(ae_int_t nin, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreatec1(ae_int_t nin, + ae_int_t nhid, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreatec2(ae_int_t nin, + ae_int_t nhid1, + ae_int_t nhid2, + ae_int_t nout, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecreatefromnetwork(multilayerperceptron* network, + ae_int_t ensemblesize, + mlpensemble* ensemble, + ae_state *_state); +void mlpecopy(mlpensemble* ensemble1, + mlpensemble* ensemble2, + ae_state *_state); +void mlperandomize(mlpensemble* ensemble, ae_state *_state); +void mlpeproperties(mlpensemble* ensemble, + ae_int_t* nin, + ae_int_t* nout, + ae_state *_state); +ae_bool mlpeissoftmax(mlpensemble* ensemble, ae_state *_state); +void mlpeprocess(mlpensemble* ensemble, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void mlpeprocessi(mlpensemble* ensemble, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void mlpeallerrorsx(mlpensemble* ensemble, + /* Real */ ae_matrix* densexy, + sparsematrix* sparsexy, + ae_int_t datasetsize, + ae_int_t datasettype, + /* Integer */ ae_vector* idx, + ae_int_t subset0, + ae_int_t subset1, + ae_int_t subsettype, + ae_shared_pool* buf, + modelerrors* rep, + ae_state *_state); +void mlpeallerrorssparse(mlpensemble* ensemble, + sparsematrix* xy, + ae_int_t npoints, + double* relcls, + double* avgce, + double* rms, + double* avg, + double* avgrel, + ae_state *_state); +double mlperelclserror(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double mlpeavgce(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double mlpermserror(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double mlpeavgerror(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +double mlpeavgrelerror(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +void mlpealloc(ae_serializer* s, mlpensemble* ensemble, ae_state *_state); +void mlpeserialize(ae_serializer* s, + mlpensemble* ensemble, + ae_state *_state); +void mlpeunserialize(ae_serializer* s, + mlpensemble* ensemble, + ae_state *_state); +ae_bool _mlpensemble_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mlpensemble_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mlpensemble_clear(void* _p); +void _mlpensemble_destroy(void* _p); +void mlptrainlm(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t* info, + mlpreport* rep, + ae_state *_state); +void mlptrainlbfgs(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + double wstep, + ae_int_t maxits, + ae_int_t* info, + mlpreport* rep, + ae_state *_state); +void mlptraines(multilayerperceptron* network, + /* Real */ ae_matrix* trnxy, + ae_int_t trnsize, + /* Real */ ae_matrix* valxy, + ae_int_t valsize, + double decay, + ae_int_t restarts, + ae_int_t* info, + mlpreport* rep, + ae_state *_state); +void mlpkfoldcvlbfgs(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + double wstep, + ae_int_t maxits, + ae_int_t foldscount, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* cvrep, + ae_state *_state); +void mlpkfoldcvlm(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t foldscount, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* cvrep, + ae_state *_state); +void mlpkfoldcv(mlptrainer* s, + multilayerperceptron* network, + ae_int_t nrestarts, + ae_int_t foldscount, + mlpreport* rep, + ae_state *_state); +void _pexec_mlpkfoldcv(mlptrainer* s, + multilayerperceptron* network, + ae_int_t nrestarts, + ae_int_t foldscount, + mlpreport* rep, ae_state *_state); +void mlpcreatetrainer(ae_int_t nin, + ae_int_t nout, + mlptrainer* s, + ae_state *_state); +void mlpcreatetrainercls(ae_int_t nin, + ae_int_t nclasses, + mlptrainer* s, + ae_state *_state); +void mlpsetdataset(mlptrainer* s, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_state *_state); +void mlpsetsparsedataset(mlptrainer* s, + sparsematrix* xy, + ae_int_t npoints, + ae_state *_state); +void mlpsetdecay(mlptrainer* s, double decay, ae_state *_state); +void mlpsetcond(mlptrainer* s, + double wstep, + ae_int_t maxits, + ae_state *_state); +void mlpsetalgobatch(mlptrainer* s, ae_state *_state); +void mlptrainnetwork(mlptrainer* s, + multilayerperceptron* network, + ae_int_t nrestarts, + mlpreport* rep, + ae_state *_state); +void _pexec_mlptrainnetwork(mlptrainer* s, + multilayerperceptron* network, + ae_int_t nrestarts, + mlpreport* rep, ae_state *_state); +void mlpstarttraining(mlptrainer* s, + multilayerperceptron* network, + ae_bool randomstart, + ae_state *_state); +ae_bool mlpcontinuetraining(mlptrainer* s, + multilayerperceptron* network, + ae_state *_state); +ae_bool _pexec_mlpcontinuetraining(mlptrainer* s, + multilayerperceptron* network, ae_state *_state); +void mlpebagginglm(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* ooberrors, + ae_state *_state); +void mlpebagginglbfgs(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + double wstep, + ae_int_t maxits, + ae_int_t* info, + mlpreport* rep, + mlpcvreport* ooberrors, + ae_state *_state); +void mlpetraines(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double decay, + ae_int_t restarts, + ae_int_t* info, + mlpreport* rep, + ae_state *_state); +void mlptrainensemblees(mlptrainer* s, + mlpensemble* ensemble, + ae_int_t nrestarts, + mlpreport* rep, + ae_state *_state); +void _pexec_mlptrainensemblees(mlptrainer* s, + mlpensemble* ensemble, + ae_int_t nrestarts, + mlpreport* rep, ae_state *_state); +ae_bool _mlpreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mlpreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mlpreport_clear(void* _p); +void _mlpreport_destroy(void* _p); +ae_bool _mlpcvreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mlpcvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mlpcvreport_clear(void* _p); +void _mlpcvreport_destroy(void* _p); +ae_bool _smlptrnsession_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _smlptrnsession_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _smlptrnsession_clear(void* _p); +void _smlptrnsession_destroy(void* _p); +ae_bool _mlpetrnsession_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mlpetrnsession_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mlpetrnsession_clear(void* _p); +void _mlpetrnsession_destroy(void* _p); +ae_bool _mlptrainer_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mlptrainer_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mlptrainer_clear(void* _p); +void _mlptrainer_destroy(void* _p); +ae_bool _mlpparallelizationcv_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mlpparallelizationcv_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mlpparallelizationcv_clear(void* _p); +void _mlpparallelizationcv_destroy(void* _p); +void pcabuildbasis(/* Real */ ae_matrix* x, + ae_int_t npoints, + ae_int_t nvars, + ae_int_t* info, + /* Real */ ae_vector* s2, + /* Real */ ae_matrix* v, + ae_state *_state); + +} +#endif + diff --git a/psdlag/src/diffequations.cpp b/psdlag/src/diffequations.cpp new file mode 100644 index 0000000..268ecd0 --- /dev/null +++ b/psdlag/src/diffequations.cpp @@ -0,0 +1,1187 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "diffequations.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* + +*************************************************************************/ +_odesolverstate_owner::_odesolverstate_owner() +{ + p_struct = (alglib_impl::odesolverstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::odesolverstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_odesolverstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_odesolverstate_owner::_odesolverstate_owner(const _odesolverstate_owner &rhs) +{ + p_struct = (alglib_impl::odesolverstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::odesolverstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_odesolverstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_odesolverstate_owner& _odesolverstate_owner::operator=(const _odesolverstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_odesolverstate_clear(p_struct); + if( !alglib_impl::_odesolverstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_odesolverstate_owner::~_odesolverstate_owner() +{ + alglib_impl::_odesolverstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::odesolverstate* _odesolverstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::odesolverstate* _odesolverstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +odesolverstate::odesolverstate() : _odesolverstate_owner() ,needdy(p_struct->needdy),y(&p_struct->y),dy(&p_struct->dy),x(p_struct->x) +{ +} + +odesolverstate::odesolverstate(const odesolverstate &rhs):_odesolverstate_owner(rhs) ,needdy(p_struct->needdy),y(&p_struct->y),dy(&p_struct->dy),x(p_struct->x) +{ +} + +odesolverstate& odesolverstate::operator=(const odesolverstate &rhs) +{ + if( this==&rhs ) + return *this; + _odesolverstate_owner::operator=(rhs); + return *this; +} + +odesolverstate::~odesolverstate() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_odesolverreport_owner::_odesolverreport_owner() +{ + p_struct = (alglib_impl::odesolverreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::odesolverreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_odesolverreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_odesolverreport_owner::_odesolverreport_owner(const _odesolverreport_owner &rhs) +{ + p_struct = (alglib_impl::odesolverreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::odesolverreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_odesolverreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_odesolverreport_owner& _odesolverreport_owner::operator=(const _odesolverreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_odesolverreport_clear(p_struct); + if( !alglib_impl::_odesolverreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_odesolverreport_owner::~_odesolverreport_owner() +{ + alglib_impl::_odesolverreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::odesolverreport* _odesolverreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::odesolverreport* _odesolverreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +odesolverreport::odesolverreport() : _odesolverreport_owner() ,nfev(p_struct->nfev),terminationtype(p_struct->terminationtype) +{ +} + +odesolverreport::odesolverreport(const odesolverreport &rhs):_odesolverreport_owner(rhs) ,nfev(p_struct->nfev),terminationtype(p_struct->terminationtype) +{ +} + +odesolverreport& odesolverreport::operator=(const odesolverreport &rhs) +{ + if( this==&rhs ) + return *this; + _odesolverreport_owner::operator=(rhs); + return *this; +} + +odesolverreport::~odesolverreport() +{ +} + +/************************************************************************* +Cash-Karp adaptive ODE solver. + +This subroutine solves ODE Y'=f(Y,x) with initial conditions Y(xs)=Ys +(here Y may be single variable or vector of N variables). + +INPUT PARAMETERS: + Y - initial conditions, array[0..N-1]. + contains values of Y[] at X[0] + N - system size + X - points at which Y should be tabulated, array[0..M-1] + integrations starts at X[0], ends at X[M-1], intermediate + values at X[i] are returned too. + SHOULD BE ORDERED BY ASCENDING OR BY DESCENDING!!!! + M - number of intermediate points + first point + last point: + * M>2 means that you need both Y(X[M-1]) and M-2 values at + intermediate points + * M=2 means that you want just to integrate from X[0] to + X[1] and don't interested in intermediate values. + * M=1 means that you don't want to integrate :) + it is degenerate case, but it will be handled correctly. + * M<1 means error + Eps - tolerance (absolute/relative error on each step will be + less than Eps). When passing: + * Eps>0, it means desired ABSOLUTE error + * Eps<0, it means desired RELATIVE error. Relative errors + are calculated with respect to maximum values of Y seen + so far. Be careful to use this criterion when starting + from Y[] that are close to zero. + H - initial step lenth, it will be adjusted automatically + after the first step. If H=0, step will be selected + automatically (usualy it will be equal to 0.001 of + min(x[i]-x[j])). + +OUTPUT PARAMETERS + State - structure which stores algorithm state between subsequent + calls of OdeSolverIteration. Used for reverse communication. + This structure should be passed to the OdeSolverIteration + subroutine. + +SEE ALSO + AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults. + + + -- ALGLIB -- + Copyright 01.09.2009 by Bochkanov Sergey +*************************************************************************/ +void odesolverrkck(const real_1d_array &y, const ae_int_t n, const real_1d_array &x, const ae_int_t m, const double eps, const double h, odesolverstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::odesolverrkck(const_cast(y.c_ptr()), n, const_cast(x.c_ptr()), m, eps, h, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Cash-Karp adaptive ODE solver. + +This subroutine solves ODE Y'=f(Y,x) with initial conditions Y(xs)=Ys +(here Y may be single variable or vector of N variables). + +INPUT PARAMETERS: + Y - initial conditions, array[0..N-1]. + contains values of Y[] at X[0] + N - system size + X - points at which Y should be tabulated, array[0..M-1] + integrations starts at X[0], ends at X[M-1], intermediate + values at X[i] are returned too. + SHOULD BE ORDERED BY ASCENDING OR BY DESCENDING!!!! + M - number of intermediate points + first point + last point: + * M>2 means that you need both Y(X[M-1]) and M-2 values at + intermediate points + * M=2 means that you want just to integrate from X[0] to + X[1] and don't interested in intermediate values. + * M=1 means that you don't want to integrate :) + it is degenerate case, but it will be handled correctly. + * M<1 means error + Eps - tolerance (absolute/relative error on each step will be + less than Eps). When passing: + * Eps>0, it means desired ABSOLUTE error + * Eps<0, it means desired RELATIVE error. Relative errors + are calculated with respect to maximum values of Y seen + so far. Be careful to use this criterion when starting + from Y[] that are close to zero. + H - initial step lenth, it will be adjusted automatically + after the first step. If H=0, step will be selected + automatically (usualy it will be equal to 0.001 of + min(x[i]-x[j])). + +OUTPUT PARAMETERS + State - structure which stores algorithm state between subsequent + calls of OdeSolverIteration. Used for reverse communication. + This structure should be passed to the OdeSolverIteration + subroutine. + +SEE ALSO + AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults. + + + -- ALGLIB -- + Copyright 01.09.2009 by Bochkanov Sergey +*************************************************************************/ +void odesolverrkck(const real_1d_array &y, const real_1d_array &x, const double eps, const double h, odesolverstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + + n = y.length(); + m = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::odesolverrkck(const_cast(y.c_ptr()), n, const_cast(x.c_ptr()), m, eps, h, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool odesolveriteration(const odesolverstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::odesolveriteration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void odesolversolve(odesolverstate &state, + void (*diff)(const real_1d_array &y, double x, real_1d_array &dy, void *ptr), + void *ptr){ + alglib_impl::ae_state _alglib_env_state; + if( diff==NULL ) + throw ap_error("ALGLIB: error in 'odesolversolve()' (diff is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::odesolveriteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needdy ) + { + diff(state.y, state.x, state.dy, ptr); + continue; + } + throw ap_error("ALGLIB: unexpected error in 'odesolversolve'"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +ODE solver results + +Called after OdeSolverIteration returned False. + +INPUT PARAMETERS: + State - algorithm state (used by OdeSolverIteration). + +OUTPUT PARAMETERS: + M - number of tabulated values, M>=1 + XTbl - array[0..M-1], values of X + YTbl - array[0..M-1,0..N-1], values of Y in X[i] + Rep - solver report: + * Rep.TerminationType completetion code: + * -2 X is not ordered by ascending/descending or + there are non-distinct X[], i.e. X[i]=X[i+1] + * -1 incorrect parameters were specified + * 1 task has been solved + * Rep.NFEV contains number of function calculations + + -- ALGLIB -- + Copyright 01.09.2009 by Bochkanov Sergey +*************************************************************************/ +void odesolverresults(const odesolverstate &state, ae_int_t &m, real_1d_array &xtbl, real_2d_array &ytbl, odesolverreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::odesolverresults(const_cast(state.c_ptr()), &m, const_cast(xtbl.c_ptr()), const_cast(ytbl.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +static double odesolver_odesolvermaxgrow = 3.0; +static double odesolver_odesolvermaxshrink = 10.0; +static void odesolver_odesolverinit(ae_int_t solvertype, + /* Real */ ae_vector* y, + ae_int_t n, + /* Real */ ae_vector* x, + ae_int_t m, + double eps, + double h, + odesolverstate* state, + ae_state *_state); + + + + + +/************************************************************************* +Cash-Karp adaptive ODE solver. + +This subroutine solves ODE Y'=f(Y,x) with initial conditions Y(xs)=Ys +(here Y may be single variable or vector of N variables). + +INPUT PARAMETERS: + Y - initial conditions, array[0..N-1]. + contains values of Y[] at X[0] + N - system size + X - points at which Y should be tabulated, array[0..M-1] + integrations starts at X[0], ends at X[M-1], intermediate + values at X[i] are returned too. + SHOULD BE ORDERED BY ASCENDING OR BY DESCENDING!!!! + M - number of intermediate points + first point + last point: + * M>2 means that you need both Y(X[M-1]) and M-2 values at + intermediate points + * M=2 means that you want just to integrate from X[0] to + X[1] and don't interested in intermediate values. + * M=1 means that you don't want to integrate :) + it is degenerate case, but it will be handled correctly. + * M<1 means error + Eps - tolerance (absolute/relative error on each step will be + less than Eps). When passing: + * Eps>0, it means desired ABSOLUTE error + * Eps<0, it means desired RELATIVE error. Relative errors + are calculated with respect to maximum values of Y seen + so far. Be careful to use this criterion when starting + from Y[] that are close to zero. + H - initial step lenth, it will be adjusted automatically + after the first step. If H=0, step will be selected + automatically (usualy it will be equal to 0.001 of + min(x[i]-x[j])). + +OUTPUT PARAMETERS + State - structure which stores algorithm state between subsequent + calls of OdeSolverIteration. Used for reverse communication. + This structure should be passed to the OdeSolverIteration + subroutine. + +SEE ALSO + AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults. + + + -- ALGLIB -- + Copyright 01.09.2009 by Bochkanov Sergey +*************************************************************************/ +void odesolverrkck(/* Real */ ae_vector* y, + ae_int_t n, + /* Real */ ae_vector* x, + ae_int_t m, + double eps, + double h, + odesolverstate* state, + ae_state *_state) +{ + + _odesolverstate_clear(state); + + ae_assert(n>=1, "ODESolverRKCK: N<1!", _state); + ae_assert(m>=1, "ODESolverRKCK: M<1!", _state); + ae_assert(y->cnt>=n, "ODESolverRKCK: Length(Y)cnt>=m, "ODESolverRKCK: Length(X)rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + m = state->rstate.ia.ptr.p_int[1]; + i = state->rstate.ia.ptr.p_int[2]; + j = state->rstate.ia.ptr.p_int[3]; + k = state->rstate.ia.ptr.p_int[4]; + klimit = state->rstate.ia.ptr.p_int[5]; + gridpoint = state->rstate.ba.ptr.p_bool[0]; + xc = state->rstate.ra.ptr.p_double[0]; + v = state->rstate.ra.ptr.p_double[1]; + h = state->rstate.ra.ptr.p_double[2]; + h2 = state->rstate.ra.ptr.p_double[3]; + err = state->rstate.ra.ptr.p_double[4]; + maxgrowpow = state->rstate.ra.ptr.p_double[5]; + } + else + { + n = -983; + m = -989; + i = -834; + j = 900; + k = -287; + klimit = 364; + gridpoint = ae_false; + xc = -338; + v = -686; + h = 912; + h2 = 585; + err = 497; + maxgrowpow = -271; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + + /* + * Routine body + */ + + /* + * prepare + */ + if( state->repterminationtype!=0 ) + { + result = ae_false; + return result; + } + n = state->n; + m = state->m; + h = state->h; + maxgrowpow = ae_pow(odesolver_odesolvermaxgrow, 5, _state); + state->repnfev = 0; + + /* + * some preliminary checks for internal errors + * after this we assume that H>0 and M>1 + */ + ae_assert(ae_fp_greater(state->h,0), "ODESolver: internal error", _state); + ae_assert(m>1, "ODESolverIteration: internal error", _state); + + /* + * choose solver + */ + if( state->solvertype!=0 ) + { + goto lbl_1; + } + + /* + * Cask-Karp solver + * Prepare coefficients table. + * Check it for errors + */ + ae_vector_set_length(&state->rka, 6, _state); + state->rka.ptr.p_double[0] = 0; + state->rka.ptr.p_double[1] = (double)1/(double)5; + state->rka.ptr.p_double[2] = (double)3/(double)10; + state->rka.ptr.p_double[3] = (double)3/(double)5; + state->rka.ptr.p_double[4] = 1; + state->rka.ptr.p_double[5] = (double)7/(double)8; + ae_matrix_set_length(&state->rkb, 6, 5, _state); + state->rkb.ptr.pp_double[1][0] = (double)1/(double)5; + state->rkb.ptr.pp_double[2][0] = (double)3/(double)40; + state->rkb.ptr.pp_double[2][1] = (double)9/(double)40; + state->rkb.ptr.pp_double[3][0] = (double)3/(double)10; + state->rkb.ptr.pp_double[3][1] = -(double)9/(double)10; + state->rkb.ptr.pp_double[3][2] = (double)6/(double)5; + state->rkb.ptr.pp_double[4][0] = -(double)11/(double)54; + state->rkb.ptr.pp_double[4][1] = (double)5/(double)2; + state->rkb.ptr.pp_double[4][2] = -(double)70/(double)27; + state->rkb.ptr.pp_double[4][3] = (double)35/(double)27; + state->rkb.ptr.pp_double[5][0] = (double)1631/(double)55296; + state->rkb.ptr.pp_double[5][1] = (double)175/(double)512; + state->rkb.ptr.pp_double[5][2] = (double)575/(double)13824; + state->rkb.ptr.pp_double[5][3] = (double)44275/(double)110592; + state->rkb.ptr.pp_double[5][4] = (double)253/(double)4096; + ae_vector_set_length(&state->rkc, 6, _state); + state->rkc.ptr.p_double[0] = (double)37/(double)378; + state->rkc.ptr.p_double[1] = 0; + state->rkc.ptr.p_double[2] = (double)250/(double)621; + state->rkc.ptr.p_double[3] = (double)125/(double)594; + state->rkc.ptr.p_double[4] = 0; + state->rkc.ptr.p_double[5] = (double)512/(double)1771; + ae_vector_set_length(&state->rkcs, 6, _state); + state->rkcs.ptr.p_double[0] = (double)2825/(double)27648; + state->rkcs.ptr.p_double[1] = 0; + state->rkcs.ptr.p_double[2] = (double)18575/(double)48384; + state->rkcs.ptr.p_double[3] = (double)13525/(double)55296; + state->rkcs.ptr.p_double[4] = (double)277/(double)14336; + state->rkcs.ptr.p_double[5] = (double)1/(double)4; + ae_matrix_set_length(&state->rkk, 6, n, _state); + + /* + * Main cycle consists of two iterations: + * * outer where we travel from X[i-1] to X[i] + * * inner where we travel inside [X[i-1],X[i]] + */ + ae_matrix_set_length(&state->ytbl, m, n, _state); + ae_vector_set_length(&state->escale, n, _state); + ae_vector_set_length(&state->yn, n, _state); + ae_vector_set_length(&state->yns, n, _state); + xc = state->xg.ptr.p_double[0]; + ae_v_move(&state->ytbl.ptr.pp_double[0][0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(j=0; j<=n-1; j++) + { + state->escale.ptr.p_double[j] = 0; + } + i = 1; +lbl_3: + if( i>m-1 ) + { + goto lbl_5; + } + + /* + * begin inner iteration + */ +lbl_6: + if( ae_false ) + { + goto lbl_7; + } + + /* + * truncate step if needed (beyond right boundary). + * determine should we store X or not + */ + if( ae_fp_greater_eq(xc+h,state->xg.ptr.p_double[i]) ) + { + h = state->xg.ptr.p_double[i]-xc; + gridpoint = ae_true; + } + else + { + gridpoint = ae_false; + } + + /* + * Update error scale maximums + * + * These maximums are initialized by zeros, + * then updated every iterations. + */ + for(j=0; j<=n-1; j++) + { + state->escale.ptr.p_double[j] = ae_maxreal(state->escale.ptr.p_double[j], ae_fabs(state->yc.ptr.p_double[j], _state), _state); + } + + /* + * make one step: + * 1. calculate all info needed to do step + * 2. update errors scale maximums using values/derivatives + * obtained during (1) + * + * Take into account that we use scaling of X to reduce task + * to the form where x[0] < x[1] < ... < x[n-1]. So X is + * replaced by x=xscale*t, and dy/dx=f(y,x) is replaced + * by dy/dt=xscale*f(y,xscale*t). + */ + ae_v_move(&state->yn.ptr.p_double[0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->yns.ptr.p_double[0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + k = 0; +lbl_8: + if( k>5 ) + { + goto lbl_10; + } + + /* + * prepare data for the next update of YN/YNS + */ + state->x = state->xscale*(xc+state->rka.ptr.p_double[k]*h); + ae_v_move(&state->y.ptr.p_double[0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(j=0; j<=k-1; j++) + { + v = state->rkb.ptr.pp_double[k][j]; + ae_v_addd(&state->y.ptr.p_double[0], 1, &state->rkk.ptr.pp_double[j][0], 1, ae_v_len(0,n-1), v); + } + state->needdy = ae_true; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->needdy = ae_false; + state->repnfev = state->repnfev+1; + v = h*state->xscale; + ae_v_moved(&state->rkk.ptr.pp_double[k][0], 1, &state->dy.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + + /* + * update YN/YNS + */ + v = state->rkc.ptr.p_double[k]; + ae_v_addd(&state->yn.ptr.p_double[0], 1, &state->rkk.ptr.pp_double[k][0], 1, ae_v_len(0,n-1), v); + v = state->rkcs.ptr.p_double[k]; + ae_v_addd(&state->yns.ptr.p_double[0], 1, &state->rkk.ptr.pp_double[k][0], 1, ae_v_len(0,n-1), v); + k = k+1; + goto lbl_8; +lbl_10: + + /* + * estimate error + */ + err = 0; + for(j=0; j<=n-1; j++) + { + if( !state->fraceps ) + { + + /* + * absolute error is estimated + */ + err = ae_maxreal(err, ae_fabs(state->yn.ptr.p_double[j]-state->yns.ptr.p_double[j], _state), _state); + } + else + { + + /* + * Relative error is estimated + */ + v = state->escale.ptr.p_double[j]; + if( ae_fp_eq(v,0) ) + { + v = 1; + } + err = ae_maxreal(err, ae_fabs(state->yn.ptr.p_double[j]-state->yns.ptr.p_double[j], _state)/v, _state); + } + } + + /* + * calculate new step, restart if necessary + */ + if( ae_fp_less_eq(maxgrowpow*err,state->eps) ) + { + h2 = odesolver_odesolvermaxgrow*h; + } + else + { + h2 = h*ae_pow(state->eps/err, 0.2, _state); + } + if( ae_fp_less(h2,h/odesolver_odesolvermaxshrink) ) + { + h2 = h/odesolver_odesolvermaxshrink; + } + if( ae_fp_greater(err,state->eps) ) + { + h = h2; + goto lbl_6; + } + + /* + * advance position + */ + xc = xc+h; + ae_v_move(&state->yc.ptr.p_double[0], 1, &state->yn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * update H + */ + h = h2; + + /* + * break on grid point + */ + if( gridpoint ) + { + goto lbl_7; + } + goto lbl_6; +lbl_7: + + /* + * save result + */ + ae_v_move(&state->ytbl.ptr.pp_double[i][0], 1, &state->yc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + i = i+1; + goto lbl_3; +lbl_5: + state->repterminationtype = 1; + result = ae_false; + return result; +lbl_1: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = m; + state->rstate.ia.ptr.p_int[2] = i; + state->rstate.ia.ptr.p_int[3] = j; + state->rstate.ia.ptr.p_int[4] = k; + state->rstate.ia.ptr.p_int[5] = klimit; + state->rstate.ba.ptr.p_bool[0] = gridpoint; + state->rstate.ra.ptr.p_double[0] = xc; + state->rstate.ra.ptr.p_double[1] = v; + state->rstate.ra.ptr.p_double[2] = h; + state->rstate.ra.ptr.p_double[3] = h2; + state->rstate.ra.ptr.p_double[4] = err; + state->rstate.ra.ptr.p_double[5] = maxgrowpow; + return result; +} + + +/************************************************************************* +ODE solver results + +Called after OdeSolverIteration returned False. + +INPUT PARAMETERS: + State - algorithm state (used by OdeSolverIteration). + +OUTPUT PARAMETERS: + M - number of tabulated values, M>=1 + XTbl - array[0..M-1], values of X + YTbl - array[0..M-1,0..N-1], values of Y in X[i] + Rep - solver report: + * Rep.TerminationType completetion code: + * -2 X is not ordered by ascending/descending or + there are non-distinct X[], i.e. X[i]=X[i+1] + * -1 incorrect parameters were specified + * 1 task has been solved + * Rep.NFEV contains number of function calculations + + -- ALGLIB -- + Copyright 01.09.2009 by Bochkanov Sergey +*************************************************************************/ +void odesolverresults(odesolverstate* state, + ae_int_t* m, + /* Real */ ae_vector* xtbl, + /* Real */ ae_matrix* ytbl, + odesolverreport* rep, + ae_state *_state) +{ + double v; + ae_int_t i; + + *m = 0; + ae_vector_clear(xtbl); + ae_matrix_clear(ytbl); + _odesolverreport_clear(rep); + + rep->terminationtype = state->repterminationtype; + if( rep->terminationtype>0 ) + { + *m = state->m; + rep->nfev = state->repnfev; + ae_vector_set_length(xtbl, state->m, _state); + v = state->xscale; + ae_v_moved(&xtbl->ptr.p_double[0], 1, &state->xg.ptr.p_double[0], 1, ae_v_len(0,state->m-1), v); + ae_matrix_set_length(ytbl, state->m, state->n, _state); + for(i=0; i<=state->m-1; i++) + { + ae_v_move(&ytbl->ptr.pp_double[i][0], 1, &state->ytbl.ptr.pp_double[i][0], 1, ae_v_len(0,state->n-1)); + } + } + else + { + rep->nfev = 0; + } +} + + +/************************************************************************* +Internal initialization subroutine +*************************************************************************/ +static void odesolver_odesolverinit(ae_int_t solvertype, + /* Real */ ae_vector* y, + ae_int_t n, + /* Real */ ae_vector* x, + ae_int_t m, + double eps, + double h, + odesolverstate* state, + ae_state *_state) +{ + ae_int_t i; + double v; + + _odesolverstate_clear(state); + + + /* + * Prepare RComm + */ + ae_vector_set_length(&state->rstate.ia, 5+1, _state); + ae_vector_set_length(&state->rstate.ba, 0+1, _state); + ae_vector_set_length(&state->rstate.ra, 5+1, _state); + state->rstate.stage = -1; + state->needdy = ae_false; + + /* + * check parameters. + */ + if( (n<=0||m<1)||ae_fp_eq(eps,0) ) + { + state->repterminationtype = -1; + return; + } + if( ae_fp_less(h,0) ) + { + h = -h; + } + + /* + * quick exit if necessary. + * after this block we assume that M>1 + */ + if( m==1 ) + { + state->repnfev = 0; + state->repterminationtype = 1; + ae_matrix_set_length(&state->ytbl, 1, n, _state); + ae_v_move(&state->ytbl.ptr.pp_double[0][0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_vector_set_length(&state->xg, m, _state); + ae_v_move(&state->xg.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,m-1)); + return; + } + + /* + * check again: correct order of X[] + */ + if( ae_fp_eq(x->ptr.p_double[1],x->ptr.p_double[0]) ) + { + state->repterminationtype = -2; + return; + } + for(i=1; i<=m-1; i++) + { + if( (ae_fp_greater(x->ptr.p_double[1],x->ptr.p_double[0])&&ae_fp_less_eq(x->ptr.p_double[i],x->ptr.p_double[i-1]))||(ae_fp_less(x->ptr.p_double[1],x->ptr.p_double[0])&&ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i-1])) ) + { + state->repterminationtype = -2; + return; + } + } + + /* + * auto-select H if necessary + */ + if( ae_fp_eq(h,0) ) + { + v = ae_fabs(x->ptr.p_double[1]-x->ptr.p_double[0], _state); + for(i=2; i<=m-1; i++) + { + v = ae_minreal(v, ae_fabs(x->ptr.p_double[i]-x->ptr.p_double[i-1], _state), _state); + } + h = 0.001*v; + } + + /* + * store parameters + */ + state->n = n; + state->m = m; + state->h = h; + state->eps = ae_fabs(eps, _state); + state->fraceps = ae_fp_less(eps,0); + ae_vector_set_length(&state->xg, m, _state); + ae_v_move(&state->xg.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,m-1)); + if( ae_fp_greater(x->ptr.p_double[1],x->ptr.p_double[0]) ) + { + state->xscale = 1; + } + else + { + state->xscale = -1; + ae_v_muld(&state->xg.ptr.p_double[0], 1, ae_v_len(0,m-1), -1); + } + ae_vector_set_length(&state->yc, n, _state); + ae_v_move(&state->yc.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->solvertype = solvertype; + state->repterminationtype = 0; + + /* + * Allocate arrays + */ + ae_vector_set_length(&state->y, n, _state); + ae_vector_set_length(&state->dy, n, _state); +} + + +ae_bool _odesolverstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + odesolverstate *p = (odesolverstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->yc, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->escale, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xg, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->dy, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->ytbl, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->yn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->yns, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rka, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rkc, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rkcs, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->rkb, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->rkk, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _odesolverstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + odesolverstate *dst = (odesolverstate*)_dst; + odesolverstate *src = (odesolverstate*)_src; + dst->n = src->n; + dst->m = src->m; + dst->xscale = src->xscale; + dst->h = src->h; + dst->eps = src->eps; + dst->fraceps = src->fraceps; + if( !ae_vector_init_copy(&dst->yc, &src->yc, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->escale, &src->escale, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xg, &src->xg, _state, make_automatic) ) + return ae_false; + dst->solvertype = src->solvertype; + dst->needdy = src->needdy; + dst->x = src->x; + if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->dy, &src->dy, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->ytbl, &src->ytbl, _state, make_automatic) ) + return ae_false; + dst->repterminationtype = src->repterminationtype; + dst->repnfev = src->repnfev; + if( !ae_vector_init_copy(&dst->yn, &src->yn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->yns, &src->yns, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rka, &src->rka, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rkc, &src->rkc, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rkcs, &src->rkcs, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->rkb, &src->rkb, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->rkk, &src->rkk, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _odesolverstate_clear(void* _p) +{ + odesolverstate *p = (odesolverstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->yc); + ae_vector_clear(&p->escale); + ae_vector_clear(&p->xg); + ae_vector_clear(&p->y); + ae_vector_clear(&p->dy); + ae_matrix_clear(&p->ytbl); + ae_vector_clear(&p->yn); + ae_vector_clear(&p->yns); + ae_vector_clear(&p->rka); + ae_vector_clear(&p->rkc); + ae_vector_clear(&p->rkcs); + ae_matrix_clear(&p->rkb); + ae_matrix_clear(&p->rkk); + _rcommstate_clear(&p->rstate); +} + + +void _odesolverstate_destroy(void* _p) +{ + odesolverstate *p = (odesolverstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->yc); + ae_vector_destroy(&p->escale); + ae_vector_destroy(&p->xg); + ae_vector_destroy(&p->y); + ae_vector_destroy(&p->dy); + ae_matrix_destroy(&p->ytbl); + ae_vector_destroy(&p->yn); + ae_vector_destroy(&p->yns); + ae_vector_destroy(&p->rka); + ae_vector_destroy(&p->rkc); + ae_vector_destroy(&p->rkcs); + ae_matrix_destroy(&p->rkb); + ae_matrix_destroy(&p->rkk); + _rcommstate_destroy(&p->rstate); +} + + +ae_bool _odesolverreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + odesolverreport *p = (odesolverreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _odesolverreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + odesolverreport *dst = (odesolverreport*)_dst; + odesolverreport *src = (odesolverreport*)_src; + dst->nfev = src->nfev; + dst->terminationtype = src->terminationtype; + return ae_true; +} + + +void _odesolverreport_clear(void* _p) +{ + odesolverreport *p = (odesolverreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _odesolverreport_destroy(void* _p) +{ + odesolverreport *p = (odesolverreport*)_p; + ae_touch_ptr((void*)p); +} + + + +} + diff --git a/psdlag/src/diffequations.h b/psdlag/src/diffequations.h new file mode 100644 index 0000000..f288f9b --- /dev/null +++ b/psdlag/src/diffequations.h @@ -0,0 +1,267 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _diffequations_pkg_h +#define _diffequations_pkg_h +#include "ap.h" +#include "alglibinternal.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + ae_int_t n; + ae_int_t m; + double xscale; + double h; + double eps; + ae_bool fraceps; + ae_vector yc; + ae_vector escale; + ae_vector xg; + ae_int_t solvertype; + ae_bool needdy; + double x; + ae_vector y; + ae_vector dy; + ae_matrix ytbl; + ae_int_t repterminationtype; + ae_int_t repnfev; + ae_vector yn; + ae_vector yns; + ae_vector rka; + ae_vector rkc; + ae_vector rkcs; + ae_matrix rkb; + ae_matrix rkk; + rcommstate rstate; +} odesolverstate; +typedef struct +{ + ae_int_t nfev; + ae_int_t terminationtype; +} odesolverreport; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + +/************************************************************************* + +*************************************************************************/ +class _odesolverstate_owner +{ +public: + _odesolverstate_owner(); + _odesolverstate_owner(const _odesolverstate_owner &rhs); + _odesolverstate_owner& operator=(const _odesolverstate_owner &rhs); + virtual ~_odesolverstate_owner(); + alglib_impl::odesolverstate* c_ptr(); + alglib_impl::odesolverstate* c_ptr() const; +protected: + alglib_impl::odesolverstate *p_struct; +}; +class odesolverstate : public _odesolverstate_owner +{ +public: + odesolverstate(); + odesolverstate(const odesolverstate &rhs); + odesolverstate& operator=(const odesolverstate &rhs); + virtual ~odesolverstate(); + ae_bool &needdy; + real_1d_array y; + real_1d_array dy; + double &x; + +}; + + +/************************************************************************* + +*************************************************************************/ +class _odesolverreport_owner +{ +public: + _odesolverreport_owner(); + _odesolverreport_owner(const _odesolverreport_owner &rhs); + _odesolverreport_owner& operator=(const _odesolverreport_owner &rhs); + virtual ~_odesolverreport_owner(); + alglib_impl::odesolverreport* c_ptr(); + alglib_impl::odesolverreport* c_ptr() const; +protected: + alglib_impl::odesolverreport *p_struct; +}; +class odesolverreport : public _odesolverreport_owner +{ +public: + odesolverreport(); + odesolverreport(const odesolverreport &rhs); + odesolverreport& operator=(const odesolverreport &rhs); + virtual ~odesolverreport(); + ae_int_t &nfev; + ae_int_t &terminationtype; + +}; + +/************************************************************************* +Cash-Karp adaptive ODE solver. + +This subroutine solves ODE Y'=f(Y,x) with initial conditions Y(xs)=Ys +(here Y may be single variable or vector of N variables). + +INPUT PARAMETERS: + Y - initial conditions, array[0..N-1]. + contains values of Y[] at X[0] + N - system size + X - points at which Y should be tabulated, array[0..M-1] + integrations starts at X[0], ends at X[M-1], intermediate + values at X[i] are returned too. + SHOULD BE ORDERED BY ASCENDING OR BY DESCENDING!!!! + M - number of intermediate points + first point + last point: + * M>2 means that you need both Y(X[M-1]) and M-2 values at + intermediate points + * M=2 means that you want just to integrate from X[0] to + X[1] and don't interested in intermediate values. + * M=1 means that you don't want to integrate :) + it is degenerate case, but it will be handled correctly. + * M<1 means error + Eps - tolerance (absolute/relative error on each step will be + less than Eps). When passing: + * Eps>0, it means desired ABSOLUTE error + * Eps<0, it means desired RELATIVE error. Relative errors + are calculated with respect to maximum values of Y seen + so far. Be careful to use this criterion when starting + from Y[] that are close to zero. + H - initial step lenth, it will be adjusted automatically + after the first step. If H=0, step will be selected + automatically (usualy it will be equal to 0.001 of + min(x[i]-x[j])). + +OUTPUT PARAMETERS + State - structure which stores algorithm state between subsequent + calls of OdeSolverIteration. Used for reverse communication. + This structure should be passed to the OdeSolverIteration + subroutine. + +SEE ALSO + AutoGKSmoothW, AutoGKSingular, AutoGKIteration, AutoGKResults. + + + -- ALGLIB -- + Copyright 01.09.2009 by Bochkanov Sergey +*************************************************************************/ +void odesolverrkck(const real_1d_array &y, const ae_int_t n, const real_1d_array &x, const ae_int_t m, const double eps, const double h, odesolverstate &state); +void odesolverrkck(const real_1d_array &y, const real_1d_array &x, const double eps, const double h, odesolverstate &state); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool odesolveriteration(const odesolverstate &state); + + +/************************************************************************* +This function is used to launcn iterations of ODE solver + +It accepts following parameters: + diff - callback which calculates dy/dx for given y and x + ptr - optional pointer which is passed to diff; can be NULL + + + -- ALGLIB -- + Copyright 01.09.2009 by Bochkanov Sergey + +*************************************************************************/ +void odesolversolve(odesolverstate &state, + void (*diff)(const real_1d_array &y, double x, real_1d_array &dy, void *ptr), + void *ptr = NULL); + + +/************************************************************************* +ODE solver results + +Called after OdeSolverIteration returned False. + +INPUT PARAMETERS: + State - algorithm state (used by OdeSolverIteration). + +OUTPUT PARAMETERS: + M - number of tabulated values, M>=1 + XTbl - array[0..M-1], values of X + YTbl - array[0..M-1,0..N-1], values of Y in X[i] + Rep - solver report: + * Rep.TerminationType completetion code: + * -2 X is not ordered by ascending/descending or + there are non-distinct X[], i.e. X[i]=X[i+1] + * -1 incorrect parameters were specified + * 1 task has been solved + * Rep.NFEV contains number of function calculations + + -- ALGLIB -- + Copyright 01.09.2009 by Bochkanov Sergey +*************************************************************************/ +void odesolverresults(const odesolverstate &state, ae_int_t &m, real_1d_array &xtbl, real_2d_array &ytbl, odesolverreport &rep); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void odesolverrkck(/* Real */ ae_vector* y, + ae_int_t n, + /* Real */ ae_vector* x, + ae_int_t m, + double eps, + double h, + odesolverstate* state, + ae_state *_state); +ae_bool odesolveriteration(odesolverstate* state, ae_state *_state); +void odesolverresults(odesolverstate* state, + ae_int_t* m, + /* Real */ ae_vector* xtbl, + /* Real */ ae_matrix* ytbl, + odesolverreport* rep, + ae_state *_state); +ae_bool _odesolverstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _odesolverstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _odesolverstate_clear(void* _p); +void _odesolverstate_destroy(void* _p); +ae_bool _odesolverreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _odesolverreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _odesolverreport_clear(void* _p); +void _odesolverreport_destroy(void* _p); + +} +#endif + diff --git a/psdlag/src/fasttransforms.cpp b/psdlag/src/fasttransforms.cpp new file mode 100644 index 0000000..9b7864f --- /dev/null +++ b/psdlag/src/fasttransforms.cpp @@ -0,0 +1,3554 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "fasttransforms.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +1-dimensional complex FFT. + +Array size N may be arbitrary number (composite or prime). Composite N's +are handled with cache-oblivious variation of a Cooley-Tukey algorithm. +Small prime-factors are transformed using hard coded codelets (similar to +FFTW codelets, but without low-level optimization), large prime-factors +are handled with Bluestein's algorithm. + +Fastests transforms are for smooth N's (prime factors are 2, 3, 5 only), +most fast for powers of 2. When N have prime factors larger than these, +but orders of magnitude smaller than N, computations will be about 4 times +slower than for nearby highly composite N's. When N itself is prime, speed +will be 6 times lower. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - complex function to be transformed + N - problem size + +OUTPUT PARAMETERS + A - DFT of a input array, array[0..N-1] + A_out[j] = SUM(A_in[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fftc1d(complex_1d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fftc1d(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional complex FFT. + +Array size N may be arbitrary number (composite or prime). Composite N's +are handled with cache-oblivious variation of a Cooley-Tukey algorithm. +Small prime-factors are transformed using hard coded codelets (similar to +FFTW codelets, but without low-level optimization), large prime-factors +are handled with Bluestein's algorithm. + +Fastests transforms are for smooth N's (prime factors are 2, 3, 5 only), +most fast for powers of 2. When N have prime factors larger than these, +but orders of magnitude smaller than N, computations will be about 4 times +slower than for nearby highly composite N's. When N itself is prime, speed +will be 6 times lower. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - complex function to be transformed + N - problem size + +OUTPUT PARAMETERS + A - DFT of a input array, array[0..N-1] + A_out[j] = SUM(A_in[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fftc1d(complex_1d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = a.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fftc1d(const_cast(a.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional complex inverse FFT. + +Array size N may be arbitrary number (composite or prime). Algorithm has +O(N*logN) complexity for any N (composite or prime). + +See FFTC1D() description for more information about algorithm performance. + +INPUT PARAMETERS + A - array[0..N-1] - complex array to be transformed + N - problem size + +OUTPUT PARAMETERS + A - inverse DFT of a input array, array[0..N-1] + A_out[j] = SUM(A_in[k]/N*exp(+2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fftc1dinv(complex_1d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fftc1dinv(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional complex inverse FFT. + +Array size N may be arbitrary number (composite or prime). Algorithm has +O(N*logN) complexity for any N (composite or prime). + +See FFTC1D() description for more information about algorithm performance. + +INPUT PARAMETERS + A - array[0..N-1] - complex array to be transformed + N - problem size + +OUTPUT PARAMETERS + A - inverse DFT of a input array, array[0..N-1] + A_out[j] = SUM(A_in[k]/N*exp(+2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fftc1dinv(complex_1d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = a.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fftc1dinv(const_cast(a.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional real FFT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + F - DFT of a input array, array[0..N-1] + F[j] = SUM(A[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + +NOTE: + F[] satisfies symmetry property F[k] = conj(F[N-k]), so just one half +of array is usually needed. But for convinience subroutine returns full +complex array (with frequencies above N/2), so its result may be used by +other FFT-related subroutines. + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1d(const real_1d_array &a, const ae_int_t n, complex_1d_array &f) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fftr1d(const_cast(a.c_ptr()), n, const_cast(f.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional real FFT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + F - DFT of a input array, array[0..N-1] + F[j] = SUM(A[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + +NOTE: + F[] satisfies symmetry property F[k] = conj(F[N-k]), so just one half +of array is usually needed. But for convinience subroutine returns full +complex array (with frequencies above N/2), so its result may be used by +other FFT-related subroutines. + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1d(const real_1d_array &a, complex_1d_array &f) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = a.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fftr1d(const_cast(a.c_ptr()), n, const_cast(f.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional real inverse FFT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + F - array[0..floor(N/2)] - frequencies from forward real FFT + N - problem size + +OUTPUT PARAMETERS + A - inverse DFT of a input array, array[0..N-1] + +NOTE: + F[] should satisfy symmetry property F[k] = conj(F[N-k]), so just one +half of frequencies array is needed - elements from 0 to floor(N/2). F[0] +is ALWAYS real. If N is even F[floor(N/2)] is real too. If N is odd, then +F[floor(N/2)] has no special properties. + +Relying on properties noted above, FFTR1DInv subroutine uses only elements +from 0th to floor(N/2)-th. It ignores imaginary part of F[0], and in case +N is even it ignores imaginary part of F[floor(N/2)] too. + +When you call this function using full arguments list - "FFTR1DInv(F,N,A)" +- you can pass either either frequencies array with N elements or reduced +array with roughly N/2 elements - subroutine will successfully transform +both. + +If you call this function using reduced arguments list - "FFTR1DInv(F,A)" +- you must pass FULL array with N elements (although higher N/2 are still +not used) because array size is used to automatically determine FFT length + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1dinv(const complex_1d_array &f, const ae_int_t n, real_1d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fftr1dinv(const_cast(f.c_ptr()), n, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional real inverse FFT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + F - array[0..floor(N/2)] - frequencies from forward real FFT + N - problem size + +OUTPUT PARAMETERS + A - inverse DFT of a input array, array[0..N-1] + +NOTE: + F[] should satisfy symmetry property F[k] = conj(F[N-k]), so just one +half of frequencies array is needed - elements from 0 to floor(N/2). F[0] +is ALWAYS real. If N is even F[floor(N/2)] is real too. If N is odd, then +F[floor(N/2)] has no special properties. + +Relying on properties noted above, FFTR1DInv subroutine uses only elements +from 0th to floor(N/2)-th. It ignores imaginary part of F[0], and in case +N is even it ignores imaginary part of F[floor(N/2)] too. + +When you call this function using full arguments list - "FFTR1DInv(F,N,A)" +- you can pass either either frequencies array with N elements or reduced +array with roughly N/2 elements - subroutine will successfully transform +both. + +If you call this function using reduced arguments list - "FFTR1DInv(F,A)" +- you must pass FULL array with N elements (although higher N/2 are still +not used) because array size is used to automatically determine FFT length + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1dinv(const complex_1d_array &f, real_1d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = f.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fftr1dinv(const_cast(f.c_ptr()), n, const_cast(a.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional complex convolution. + +For given A/B returns conv(A,B) (non-circular). Subroutine can automatically +choose between three implementations: straightforward O(M*N) formula for +very small N (or M), overlap-add algorithm for cases where max(M,N) is +significantly larger than min(M,N), but O(M*N) algorithm is too slow, and +general FFT-based formula for cases where two previois algorithms are too +slow. + +Algorithm has max(M,N)*log(max(M,N)) complexity for any M/N. + +INPUT PARAMETERS + A - array[0..M-1] - complex function to be transformed + M - problem size + B - array[0..N-1] - complex function to be transformed + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..N+M-2]. + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1d(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::convc1d(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional complex non-circular deconvolution (inverse of ConvC1D()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - response + N - response length, N<=M + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-N]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dinv(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::convc1dinv(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional circular complex convolution. + +For given S/R returns conv(S,R) (circular). Algorithm has linearithmic +complexity for any M/N. + +IMPORTANT: normal convolution is commutative, i.e. it is symmetric - +conv(A,B)=conv(B,A). Cyclic convolution IS NOT. One function - S - is a +signal, periodic function, and another - R - is a response, non-periodic +function with limited length. + +INPUT PARAMETERS + S - array[0..M-1] - complex periodic signal + M - problem size + B - array[0..N-1] - complex non-periodic response + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dcircular(const complex_1d_array &s, const ae_int_t m, const complex_1d_array &r, const ae_int_t n, complex_1d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::convc1dcircular(const_cast(s.c_ptr()), m, const_cast(r.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional circular complex deconvolution (inverse of ConvC1DCircular()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved periodic signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - non-periodic response + N - response length + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-1]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dcircularinv(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::convc1dcircularinv(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional real convolution. + +Analogous to ConvC1D(), see ConvC1D() comments for more details. + +INPUT PARAMETERS + A - array[0..M-1] - real function to be transformed + M - problem size + B - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..N+M-2]. + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1d(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::convr1d(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional real deconvolution (inverse of ConvC1D()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - response + N - response length, N<=M + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-N]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dinv(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::convr1dinv(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional circular real convolution. + +Analogous to ConvC1DCircular(), see ConvC1DCircular() comments for more details. + +INPUT PARAMETERS + S - array[0..M-1] - real signal + M - problem size + B - array[0..N-1] - real response + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dcircular(const real_1d_array &s, const ae_int_t m, const real_1d_array &r, const ae_int_t n, real_1d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::convr1dcircular(const_cast(s.c_ptr()), m, const_cast(r.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional complex deconvolution (inverse of ConvC1D()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - response + N - response length + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-N]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dcircularinv(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::convr1dcircularinv(const_cast(a.c_ptr()), m, const_cast(b.c_ptr()), n, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional complex cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). + +Correlation is calculated using reduction to convolution. Algorithm with +max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info +about performance). + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrC1D(Signal, Pattern) = Pattern x Signal (using traditional + definition of cross-correlation, denoting cross-correlation as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - complex function to be transformed, + signal containing pattern + N - problem size + Pattern - array[0..M-1] - complex function to be transformed, + pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - cross-correlation, array[0..N+M-2]: + * positive lags are stored in R[0..N-1], + R[i] = sum(conj(pattern[j])*signal[i+j] + * negative lags are stored in R[N..N+M-2], + R[N+M-1-i] = sum(conj(pattern[j])*signal[-i+j] + +NOTE: + It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero +on [-K..M-1], you can still use this subroutine, just shift result by K. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrc1d(const complex_1d_array &signal, const ae_int_t n, const complex_1d_array &pattern, const ae_int_t m, complex_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::corrc1d(const_cast(signal.c_ptr()), n, const_cast(pattern.c_ptr()), m, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional circular complex cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (circular). +Algorithm has linearithmic complexity for any M/N. + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrC1DCircular(Signal, Pattern) = Pattern x Signal (using + traditional definition of cross-correlation, denoting cross-correlation + as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - complex function to be transformed, + periodic signal containing pattern + N - problem size + Pattern - array[0..M-1] - complex function to be transformed, + non-periodic pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrc1dcircular(const complex_1d_array &signal, const ae_int_t m, const complex_1d_array &pattern, const ae_int_t n, complex_1d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::corrc1dcircular(const_cast(signal.c_ptr()), m, const_cast(pattern.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional real cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). + +Correlation is calculated using reduction to convolution. Algorithm with +max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info +about performance). + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrR1D(Signal, Pattern) = Pattern x Signal (using traditional + definition of cross-correlation, denoting cross-correlation as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - real function to be transformed, + signal containing pattern + N - problem size + Pattern - array[0..M-1] - real function to be transformed, + pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - cross-correlation, array[0..N+M-2]: + * positive lags are stored in R[0..N-1], + R[i] = sum(pattern[j]*signal[i+j] + * negative lags are stored in R[N..N+M-2], + R[N+M-1-i] = sum(pattern[j]*signal[-i+j] + +NOTE: + It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero +on [-K..M-1], you can still use this subroutine, just shift result by K. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrr1d(const real_1d_array &signal, const ae_int_t n, const real_1d_array &pattern, const ae_int_t m, real_1d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::corrr1d(const_cast(signal.c_ptr()), n, const_cast(pattern.c_ptr()), m, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional circular real cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (circular). +Algorithm has linearithmic complexity for any M/N. + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrR1DCircular(Signal, Pattern) = Pattern x Signal (using + traditional definition of cross-correlation, denoting cross-correlation + as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - real function to be transformed, + periodic signal containing pattern + N - problem size + Pattern - array[0..M-1] - real function to be transformed, + non-periodic pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrr1dcircular(const real_1d_array &signal, const ae_int_t m, const real_1d_array &pattern, const ae_int_t n, real_1d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::corrr1dcircular(const_cast(signal.c_ptr()), m, const_cast(pattern.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional Fast Hartley Transform. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + A - FHT of a input array, array[0..N-1], + A_out[k] = sum(A_in[j]*(cos(2*pi*j*k/N)+sin(2*pi*j*k/N)), j=0..N-1) + + + -- ALGLIB -- + Copyright 04.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fhtr1d(real_1d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fhtr1d(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional inverse FHT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - complex array to be transformed + N - problem size + +OUTPUT PARAMETERS + A - inverse FHT of a input array, array[0..N-1] + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fhtr1dinv(real_1d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fhtr1dinv(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ + + + + + + + + + + + +/************************************************************************* +1-dimensional complex FFT. + +Array size N may be arbitrary number (composite or prime). Composite N's +are handled with cache-oblivious variation of a Cooley-Tukey algorithm. +Small prime-factors are transformed using hard coded codelets (similar to +FFTW codelets, but without low-level optimization), large prime-factors +are handled with Bluestein's algorithm. + +Fastests transforms are for smooth N's (prime factors are 2, 3, 5 only), +most fast for powers of 2. When N have prime factors larger than these, +but orders of magnitude smaller than N, computations will be about 4 times +slower than for nearby highly composite N's. When N itself is prime, speed +will be 6 times lower. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - complex function to be transformed + N - problem size + +OUTPUT PARAMETERS + A - DFT of a input array, array[0..N-1] + A_out[j] = SUM(A_in[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fftc1d(/* Complex */ ae_vector* a, ae_int_t n, ae_state *_state) +{ + ae_frame _frame_block; + fasttransformplan plan; + ae_int_t i; + ae_vector buf; + + ae_frame_make(_state, &_frame_block); + _fasttransformplan_init(&plan, _state, ae_true); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "FFTC1D: incorrect N!", _state); + ae_assert(a->cnt>=n, "FFTC1D: Length(A)ptr.p_complex[i].x; + buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; + } + + /* + * Generate plan and execute it. + * + * Plan is a combination of a successive factorizations of N and + * precomputed data. It is much like a FFTW plan, but is not stored + * between subroutine calls and is much simpler. + */ + ftcomplexfftplan(n, 1, &plan, _state); + ftapplyplan(&plan, &buf, 0, 1, _state); + + /* + * result + */ + for(i=0; i<=n-1; i++) + { + a->ptr.p_complex[i].x = buf.ptr.p_double[2*i+0]; + a->ptr.p_complex[i].y = buf.ptr.p_double[2*i+1]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional complex inverse FFT. + +Array size N may be arbitrary number (composite or prime). Algorithm has +O(N*logN) complexity for any N (composite or prime). + +See FFTC1D() description for more information about algorithm performance. + +INPUT PARAMETERS + A - array[0..N-1] - complex array to be transformed + N - problem size + +OUTPUT PARAMETERS + A - inverse DFT of a input array, array[0..N-1] + A_out[j] = SUM(A_in[k]/N*exp(+2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fftc1dinv(/* Complex */ ae_vector* a, ae_int_t n, ae_state *_state) +{ + ae_int_t i; + + + ae_assert(n>0, "FFTC1DInv: incorrect N!", _state); + ae_assert(a->cnt>=n, "FFTC1DInv: Length(A)ptr.p_complex[i].y = -a->ptr.p_complex[i].y; + } + fftc1d(a, n, _state); + for(i=0; i<=n-1; i++) + { + a->ptr.p_complex[i].x = a->ptr.p_complex[i].x/n; + a->ptr.p_complex[i].y = -a->ptr.p_complex[i].y/n; + } +} + + +/************************************************************************* +1-dimensional real FFT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + F - DFT of a input array, array[0..N-1] + F[j] = SUM(A[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + +NOTE: + F[] satisfies symmetry property F[k] = conj(F[N-k]), so just one half +of array is usually needed. But for convinience subroutine returns full +complex array (with frequencies above N/2), so its result may be used by +other FFT-related subroutines. + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1d(/* Real */ ae_vector* a, + ae_int_t n, + /* Complex */ ae_vector* f, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t n2; + ae_int_t idx; + ae_complex hn; + ae_complex hmnc; + ae_complex v; + ae_vector buf; + fasttransformplan plan; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(f); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + _fasttransformplan_init(&plan, _state, ae_true); + + ae_assert(n>0, "FFTR1D: incorrect N!", _state); + ae_assert(a->cnt>=n, "FFTR1D: Length(A)ptr.p_complex[0] = ae_complex_from_d(a->ptr.p_double[0]); + ae_frame_leave(_state); + return; + } + if( n==2 ) + { + ae_vector_set_length(f, 2, _state); + f->ptr.p_complex[0].x = a->ptr.p_double[0]+a->ptr.p_double[1]; + f->ptr.p_complex[0].y = 0; + f->ptr.p_complex[1].x = a->ptr.p_double[0]-a->ptr.p_double[1]; + f->ptr.p_complex[1].y = 0; + ae_frame_leave(_state); + return; + } + + /* + * Choose between odd-size and even-size FFTs + */ + if( n%2==0 ) + { + + /* + * even-size real FFT, use reduction to the complex task + */ + n2 = n/2; + ae_vector_set_length(&buf, n, _state); + ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ftcomplexfftplan(n2, 1, &plan, _state); + ftapplyplan(&plan, &buf, 0, 1, _state); + ae_vector_set_length(f, n, _state); + for(i=0; i<=n2; i++) + { + idx = 2*(i%n2); + hn.x = buf.ptr.p_double[idx+0]; + hn.y = buf.ptr.p_double[idx+1]; + idx = 2*((n2-i)%n2); + hmnc.x = buf.ptr.p_double[idx+0]; + hmnc.y = -buf.ptr.p_double[idx+1]; + v.x = -ae_sin(-2*ae_pi*i/n, _state); + v.y = ae_cos(-2*ae_pi*i/n, _state); + f->ptr.p_complex[i] = ae_c_sub(ae_c_add(hn,hmnc),ae_c_mul(v,ae_c_sub(hn,hmnc))); + f->ptr.p_complex[i].x = 0.5*f->ptr.p_complex[i].x; + f->ptr.p_complex[i].y = 0.5*f->ptr.p_complex[i].y; + } + for(i=n2+1; i<=n-1; i++) + { + f->ptr.p_complex[i] = ae_c_conj(f->ptr.p_complex[n-i], _state); + } + } + else + { + + /* + * use complex FFT + */ + ae_vector_set_length(f, n, _state); + for(i=0; i<=n-1; i++) + { + f->ptr.p_complex[i] = ae_complex_from_d(a->ptr.p_double[i]); + } + fftc1d(f, n, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional real inverse FFT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + F - array[0..floor(N/2)] - frequencies from forward real FFT + N - problem size + +OUTPUT PARAMETERS + A - inverse DFT of a input array, array[0..N-1] + +NOTE: + F[] should satisfy symmetry property F[k] = conj(F[N-k]), so just one +half of frequencies array is needed - elements from 0 to floor(N/2). F[0] +is ALWAYS real. If N is even F[floor(N/2)] is real too. If N is odd, then +F[floor(N/2)] has no special properties. + +Relying on properties noted above, FFTR1DInv subroutine uses only elements +from 0th to floor(N/2)-th. It ignores imaginary part of F[0], and in case +N is even it ignores imaginary part of F[floor(N/2)] too. + +When you call this function using full arguments list - "FFTR1DInv(F,N,A)" +- you can pass either either frequencies array with N elements or reduced +array with roughly N/2 elements - subroutine will successfully transform +both. + +If you call this function using reduced arguments list - "FFTR1DInv(F,A)" +- you must pass FULL array with N elements (although higher N/2 are still +not used) because array size is used to automatically determine FFT length + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1dinv(/* Complex */ ae_vector* f, + ae_int_t n, + /* Real */ ae_vector* a, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector h; + ae_vector fh; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(a); + ae_vector_init(&h, 0, DT_REAL, _state, ae_true); + ae_vector_init(&fh, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(n>0, "FFTR1DInv: incorrect N!", _state); + ae_assert(f->cnt>=ae_ifloor((double)n/(double)2, _state)+1, "FFTR1DInv: Length(F)ptr.p_complex[0].x, _state), "FFTR1DInv: F contains infinite or NAN values!", _state); + for(i=1; i<=ae_ifloor((double)n/(double)2, _state)-1; i++) + { + ae_assert(ae_isfinite(f->ptr.p_complex[i].x, _state)&&ae_isfinite(f->ptr.p_complex[i].y, _state), "FFTR1DInv: F contains infinite or NAN values!", _state); + } + ae_assert(ae_isfinite(f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].x, _state), "FFTR1DInv: F contains infinite or NAN values!", _state); + if( n%2!=0 ) + { + ae_assert(ae_isfinite(f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].y, _state), "FFTR1DInv: F contains infinite or NAN values!", _state); + } + + /* + * Special case: N=1, FFT is just identity transform. + * After this block we assume that N is strictly greater than 1. + */ + if( n==1 ) + { + ae_vector_set_length(a, 1, _state); + a->ptr.p_double[0] = f->ptr.p_complex[0].x; + ae_frame_leave(_state); + return; + } + + /* + * inverse real FFT is reduced to the inverse real FHT, + * which is reduced to the forward real FHT, + * which is reduced to the forward real FFT. + * + * Don't worry, it is really compact and efficient reduction :) + */ + ae_vector_set_length(&h, n, _state); + ae_vector_set_length(a, n, _state); + h.ptr.p_double[0] = f->ptr.p_complex[0].x; + for(i=1; i<=ae_ifloor((double)n/(double)2, _state)-1; i++) + { + h.ptr.p_double[i] = f->ptr.p_complex[i].x-f->ptr.p_complex[i].y; + h.ptr.p_double[n-i] = f->ptr.p_complex[i].x+f->ptr.p_complex[i].y; + } + if( n%2==0 ) + { + h.ptr.p_double[ae_ifloor((double)n/(double)2, _state)] = f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].x; + } + else + { + h.ptr.p_double[ae_ifloor((double)n/(double)2, _state)] = f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].x-f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].y; + h.ptr.p_double[ae_ifloor((double)n/(double)2, _state)+1] = f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].x+f->ptr.p_complex[ae_ifloor((double)n/(double)2, _state)].y; + } + fftr1d(&h, n, &fh, _state); + for(i=0; i<=n-1; i++) + { + a->ptr.p_double[i] = (fh.ptr.p_complex[i].x-fh.ptr.p_complex[i].y)/n; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. Never call it directly! + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1dinternaleven(/* Real */ ae_vector* a, + ae_int_t n, + /* Real */ ae_vector* buf, + fasttransformplan* plan, + ae_state *_state) +{ + double x; + double y; + ae_int_t i; + ae_int_t n2; + ae_int_t idx; + ae_complex hn; + ae_complex hmnc; + ae_complex v; + + + ae_assert(n>0&&n%2==0, "FFTR1DEvenInplace: incorrect N!", _state); + + /* + * Special cases: + * * N=2 + * + * After this block we assume that N is strictly greater than 2 + */ + if( n==2 ) + { + x = a->ptr.p_double[0]+a->ptr.p_double[1]; + y = a->ptr.p_double[0]-a->ptr.p_double[1]; + a->ptr.p_double[0] = x; + a->ptr.p_double[1] = y; + return; + } + + /* + * even-size real FFT, use reduction to the complex task + */ + n2 = n/2; + ae_v_move(&buf->ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ftapplyplan(plan, buf, 0, 1, _state); + a->ptr.p_double[0] = buf->ptr.p_double[0]+buf->ptr.p_double[1]; + for(i=1; i<=n2-1; i++) + { + idx = 2*(i%n2); + hn.x = buf->ptr.p_double[idx+0]; + hn.y = buf->ptr.p_double[idx+1]; + idx = 2*(n2-i); + hmnc.x = buf->ptr.p_double[idx+0]; + hmnc.y = -buf->ptr.p_double[idx+1]; + v.x = -ae_sin(-2*ae_pi*i/n, _state); + v.y = ae_cos(-2*ae_pi*i/n, _state); + v = ae_c_sub(ae_c_add(hn,hmnc),ae_c_mul(v,ae_c_sub(hn,hmnc))); + a->ptr.p_double[2*i+0] = 0.5*v.x; + a->ptr.p_double[2*i+1] = 0.5*v.y; + } + a->ptr.p_double[1] = buf->ptr.p_double[0]-buf->ptr.p_double[1]; +} + + +/************************************************************************* +Internal subroutine. Never call it directly! + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1dinvinternaleven(/* Real */ ae_vector* a, + ae_int_t n, + /* Real */ ae_vector* buf, + fasttransformplan* plan, + ae_state *_state) +{ + double x; + double y; + double t; + ae_int_t i; + ae_int_t n2; + + + ae_assert(n>0&&n%2==0, "FFTR1DInvInternalEven: incorrect N!", _state); + + /* + * Special cases: + * * N=2 + * + * After this block we assume that N is strictly greater than 2 + */ + if( n==2 ) + { + x = 0.5*(a->ptr.p_double[0]+a->ptr.p_double[1]); + y = 0.5*(a->ptr.p_double[0]-a->ptr.p_double[1]); + a->ptr.p_double[0] = x; + a->ptr.p_double[1] = y; + return; + } + + /* + * inverse real FFT is reduced to the inverse real FHT, + * which is reduced to the forward real FHT, + * which is reduced to the forward real FFT. + * + * Don't worry, it is really compact and efficient reduction :) + */ + n2 = n/2; + buf->ptr.p_double[0] = a->ptr.p_double[0]; + for(i=1; i<=n2-1; i++) + { + x = a->ptr.p_double[2*i+0]; + y = a->ptr.p_double[2*i+1]; + buf->ptr.p_double[i] = x-y; + buf->ptr.p_double[n-i] = x+y; + } + buf->ptr.p_double[n2] = a->ptr.p_double[1]; + fftr1dinternaleven(buf, n, a, plan, _state); + a->ptr.p_double[0] = buf->ptr.p_double[0]/n; + t = (double)1/(double)n; + for(i=1; i<=n2-1; i++) + { + x = buf->ptr.p_double[2*i+0]; + y = buf->ptr.p_double[2*i+1]; + a->ptr.p_double[i] = t*(x-y); + a->ptr.p_double[n-i] = t*(x+y); + } + a->ptr.p_double[n2] = buf->ptr.p_double[1]/n; +} + + + + +/************************************************************************* +1-dimensional complex convolution. + +For given A/B returns conv(A,B) (non-circular). Subroutine can automatically +choose between three implementations: straightforward O(M*N) formula for +very small N (or M), overlap-add algorithm for cases where max(M,N) is +significantly larger than min(M,N), but O(M*N) algorithm is too slow, and +general FFT-based formula for cases where two previois algorithms are too +slow. + +Algorithm has max(M,N)*log(max(M,N)) complexity for any M/N. + +INPUT PARAMETERS + A - array[0..M-1] - complex function to be transformed + M - problem size + B - array[0..N-1] - complex function to be transformed + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..N+M-2]. + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1d(/* Complex */ ae_vector* a, + ae_int_t m, + /* Complex */ ae_vector* b, + ae_int_t n, + /* Complex */ ae_vector* r, + ae_state *_state) +{ + + ae_vector_clear(r); + + ae_assert(n>0&&m>0, "ConvC1D: incorrect N or M!", _state); + + /* + * normalize task: make M>=N, + * so A will be longer that B. + */ + if( m0&&m>0)&&n<=m, "ConvC1DInv: incorrect N or M!", _state); + p = ftbasefindsmooth(m, _state); + ftcomplexfftplan(p, 1, &plan, _state); + ae_vector_set_length(&buf, 2*p, _state); + for(i=0; i<=m-1; i++) + { + buf.ptr.p_double[2*i+0] = a->ptr.p_complex[i].x; + buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; + } + for(i=m; i<=p-1; i++) + { + buf.ptr.p_double[2*i+0] = 0; + buf.ptr.p_double[2*i+1] = 0; + } + ae_vector_set_length(&buf2, 2*p, _state); + for(i=0; i<=n-1; i++) + { + buf2.ptr.p_double[2*i+0] = b->ptr.p_complex[i].x; + buf2.ptr.p_double[2*i+1] = b->ptr.p_complex[i].y; + } + for(i=n; i<=p-1; i++) + { + buf2.ptr.p_double[2*i+0] = 0; + buf2.ptr.p_double[2*i+1] = 0; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + ftapplyplan(&plan, &buf2, 0, 1, _state); + for(i=0; i<=p-1; i++) + { + c1.x = buf.ptr.p_double[2*i+0]; + c1.y = buf.ptr.p_double[2*i+1]; + c2.x = buf2.ptr.p_double[2*i+0]; + c2.y = buf2.ptr.p_double[2*i+1]; + c3 = ae_c_div(c1,c2); + buf.ptr.p_double[2*i+0] = c3.x; + buf.ptr.p_double[2*i+1] = -c3.y; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + t = (double)1/(double)p; + ae_vector_set_length(r, m-n+1, _state); + for(i=0; i<=m-n; i++) + { + r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; + r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional circular complex convolution. + +For given S/R returns conv(S,R) (circular). Algorithm has linearithmic +complexity for any M/N. + +IMPORTANT: normal convolution is commutative, i.e. it is symmetric - +conv(A,B)=conv(B,A). Cyclic convolution IS NOT. One function - S - is a +signal, periodic function, and another - R - is a response, non-periodic +function with limited length. + +INPUT PARAMETERS + S - array[0..M-1] - complex periodic signal + M - problem size + B - array[0..N-1] - complex non-periodic response + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dcircular(/* Complex */ ae_vector* s, + ae_int_t m, + /* Complex */ ae_vector* r, + ae_int_t n, + /* Complex */ ae_vector* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector buf; + ae_int_t i1; + ae_int_t i2; + ae_int_t j2; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(c); + ae_vector_init(&buf, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(n>0&&m>0, "ConvC1DCircular: incorrect N or M!", _state); + + /* + * normalize task: make M>=N, + * so A will be longer (at least - not shorter) that B. + */ + if( mptr.p_complex[i1], 1, "N", ae_v_len(0,j2)); + i1 = i1+m; + } + convc1dcircular(s, m, &buf, m, c, _state); + ae_frame_leave(_state); + return; + } + convc1dx(s, m, r, n, ae_true, -1, 0, c, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional circular complex deconvolution (inverse of ConvC1DCircular()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved periodic signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - non-periodic response + N - response length + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-1]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dcircularinv(/* Complex */ ae_vector* a, + ae_int_t m, + /* Complex */ ae_vector* b, + ae_int_t n, + /* Complex */ ae_vector* r, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t i1; + ae_int_t i2; + ae_int_t j2; + ae_vector buf; + ae_vector buf2; + ae_vector cbuf; + fasttransformplan plan; + ae_complex c1; + ae_complex c2; + ae_complex c3; + double t; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(r); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&buf2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&cbuf, 0, DT_COMPLEX, _state, ae_true); + _fasttransformplan_init(&plan, _state, ae_true); + + ae_assert(n>0&&m>0, "ConvC1DCircularInv: incorrect N or M!", _state); + + /* + * normalize task: make M>=N, + * so A will be longer (at least - not shorter) that B. + */ + if( mptr.p_complex[i1], 1, "N", ae_v_len(0,j2)); + i1 = i1+m; + } + convc1dcircularinv(a, m, &cbuf, m, r, _state); + ae_frame_leave(_state); + return; + } + + /* + * Task is normalized + */ + ftcomplexfftplan(m, 1, &plan, _state); + ae_vector_set_length(&buf, 2*m, _state); + for(i=0; i<=m-1; i++) + { + buf.ptr.p_double[2*i+0] = a->ptr.p_complex[i].x; + buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; + } + ae_vector_set_length(&buf2, 2*m, _state); + for(i=0; i<=n-1; i++) + { + buf2.ptr.p_double[2*i+0] = b->ptr.p_complex[i].x; + buf2.ptr.p_double[2*i+1] = b->ptr.p_complex[i].y; + } + for(i=n; i<=m-1; i++) + { + buf2.ptr.p_double[2*i+0] = 0; + buf2.ptr.p_double[2*i+1] = 0; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + ftapplyplan(&plan, &buf2, 0, 1, _state); + for(i=0; i<=m-1; i++) + { + c1.x = buf.ptr.p_double[2*i+0]; + c1.y = buf.ptr.p_double[2*i+1]; + c2.x = buf2.ptr.p_double[2*i+0]; + c2.y = buf2.ptr.p_double[2*i+1]; + c3 = ae_c_div(c1,c2); + buf.ptr.p_double[2*i+0] = c3.x; + buf.ptr.p_double[2*i+1] = -c3.y; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + t = (double)1/(double)m; + ae_vector_set_length(r, m, _state); + for(i=0; i<=m-1; i++) + { + r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; + r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional real convolution. + +Analogous to ConvC1D(), see ConvC1D() comments for more details. + +INPUT PARAMETERS + A - array[0..M-1] - real function to be transformed + M - problem size + B - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..N+M-2]. + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1d(/* Real */ ae_vector* a, + ae_int_t m, + /* Real */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* r, + ae_state *_state) +{ + + ae_vector_clear(r); + + ae_assert(n>0&&m>0, "ConvR1D: incorrect N or M!", _state); + + /* + * normalize task: make M>=N, + * so A will be longer that B. + */ + if( m0&&m>0)&&n<=m, "ConvR1DInv: incorrect N or M!", _state); + p = ftbasefindsmootheven(m, _state); + ae_vector_set_length(&buf, p, _state); + ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1)); + for(i=m; i<=p-1; i++) + { + buf.ptr.p_double[i] = 0; + } + ae_vector_set_length(&buf2, p, _state); + ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=n; i<=p-1; i++) + { + buf2.ptr.p_double[i] = 0; + } + ae_vector_set_length(&buf3, p, _state); + ftcomplexfftplan(p/2, 1, &plan, _state); + fftr1dinternaleven(&buf, p, &buf3, &plan, _state); + fftr1dinternaleven(&buf2, p, &buf3, &plan, _state); + buf.ptr.p_double[0] = buf.ptr.p_double[0]/buf2.ptr.p_double[0]; + buf.ptr.p_double[1] = buf.ptr.p_double[1]/buf2.ptr.p_double[1]; + for(i=1; i<=p/2-1; i++) + { + c1.x = buf.ptr.p_double[2*i+0]; + c1.y = buf.ptr.p_double[2*i+1]; + c2.x = buf2.ptr.p_double[2*i+0]; + c2.y = buf2.ptr.p_double[2*i+1]; + c3 = ae_c_div(c1,c2); + buf.ptr.p_double[2*i+0] = c3.x; + buf.ptr.p_double[2*i+1] = c3.y; + } + fftr1dinvinternaleven(&buf, p, &buf3, &plan, _state); + ae_vector_set_length(r, m-n+1, _state); + ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m-n)); + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional circular real convolution. + +Analogous to ConvC1DCircular(), see ConvC1DCircular() comments for more details. + +INPUT PARAMETERS + S - array[0..M-1] - real signal + M - problem size + B - array[0..N-1] - real response + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dcircular(/* Real */ ae_vector* s, + ae_int_t m, + /* Real */ ae_vector* r, + ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector buf; + ae_int_t i1; + ae_int_t i2; + ae_int_t j2; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(c); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0&&m>0, "ConvC1DCircular: incorrect N or M!", _state); + + /* + * normalize task: make M>=N, + * so A will be longer (at least - not shorter) that B. + */ + if( mptr.p_double[i1], 1, ae_v_len(0,j2)); + i1 = i1+m; + } + convr1dcircular(s, m, &buf, m, c, _state); + ae_frame_leave(_state); + return; + } + + /* + * reduce to usual convolution + */ + convr1dx(s, m, r, n, ae_true, -1, 0, c, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional complex deconvolution (inverse of ConvC1D()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - response + N - response length + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-N]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dcircularinv(/* Real */ ae_vector* a, + ae_int_t m, + /* Real */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* r, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t i1; + ae_int_t i2; + ae_int_t j2; + ae_vector buf; + ae_vector buf2; + ae_vector buf3; + ae_vector cbuf; + ae_vector cbuf2; + fasttransformplan plan; + ae_complex c1; + ae_complex c2; + ae_complex c3; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(r); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&buf2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&buf3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&cbuf, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&cbuf2, 0, DT_COMPLEX, _state, ae_true); + _fasttransformplan_init(&plan, _state, ae_true); + + ae_assert(n>0&&m>0, "ConvR1DCircularInv: incorrect N or M!", _state); + + /* + * normalize task: make M>=N, + * so A will be longer (at least - not shorter) that B. + */ + if( mptr.p_double[i1], 1, ae_v_len(0,j2)); + i1 = i1+m; + } + convr1dcircularinv(a, m, &buf, m, r, _state); + ae_frame_leave(_state); + return; + } + + /* + * Task is normalized + */ + if( m%2==0 ) + { + + /* + * size is even, use fast even-size FFT + */ + ae_vector_set_length(&buf, m, _state); + ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1)); + ae_vector_set_length(&buf2, m, _state); + ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=n; i<=m-1; i++) + { + buf2.ptr.p_double[i] = 0; + } + ae_vector_set_length(&buf3, m, _state); + ftcomplexfftplan(m/2, 1, &plan, _state); + fftr1dinternaleven(&buf, m, &buf3, &plan, _state); + fftr1dinternaleven(&buf2, m, &buf3, &plan, _state); + buf.ptr.p_double[0] = buf.ptr.p_double[0]/buf2.ptr.p_double[0]; + buf.ptr.p_double[1] = buf.ptr.p_double[1]/buf2.ptr.p_double[1]; + for(i=1; i<=m/2-1; i++) + { + c1.x = buf.ptr.p_double[2*i+0]; + c1.y = buf.ptr.p_double[2*i+1]; + c2.x = buf2.ptr.p_double[2*i+0]; + c2.y = buf2.ptr.p_double[2*i+1]; + c3 = ae_c_div(c1,c2); + buf.ptr.p_double[2*i+0] = c3.x; + buf.ptr.p_double[2*i+1] = c3.y; + } + fftr1dinvinternaleven(&buf, m, &buf3, &plan, _state); + ae_vector_set_length(r, m, _state); + ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m-1)); + } + else + { + + /* + * odd-size, use general real FFT + */ + fftr1d(a, m, &cbuf, _state); + ae_vector_set_length(&buf2, m, _state); + ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=n; i<=m-1; i++) + { + buf2.ptr.p_double[i] = 0; + } + fftr1d(&buf2, m, &cbuf2, _state); + for(i=0; i<=ae_ifloor((double)m/(double)2, _state); i++) + { + cbuf.ptr.p_complex[i] = ae_c_div(cbuf.ptr.p_complex[i],cbuf2.ptr.p_complex[i]); + } + fftr1dinv(&cbuf, m, r, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional complex convolution. + +Extended subroutine which allows to choose convolution algorithm. +Intended for internal use, ALGLIB users should call ConvC1D()/ConvC1DCircular(). + +INPUT PARAMETERS + A - array[0..M-1] - complex function to be transformed + M - problem size + B - array[0..N-1] - complex function to be transformed + N - problem size, N<=M + Alg - algorithm type: + *-2 auto-select Q for overlap-add + *-1 auto-select algorithm and parameters + * 0 straightforward formula for small N's + * 1 general FFT-based code + * 2 overlap-add with length Q + Q - length for overlap-add + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..N+M-1]. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dx(/* Complex */ ae_vector* a, + ae_int_t m, + /* Complex */ ae_vector* b, + ae_int_t n, + ae_bool circular, + ae_int_t alg, + ae_int_t q, + /* Complex */ ae_vector* r, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t p; + ae_int_t ptotal; + ae_int_t i1; + ae_int_t i2; + ae_int_t j1; + ae_int_t j2; + ae_vector bbuf; + ae_complex v; + double ax; + double ay; + double bx; + double by; + double t; + double tx; + double ty; + double flopcand; + double flopbest; + ae_int_t algbest; + fasttransformplan plan; + ae_vector buf; + ae_vector buf2; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(r); + ae_vector_init(&bbuf, 0, DT_COMPLEX, _state, ae_true); + _fasttransformplan_init(&plan, _state, ae_true); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&buf2, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0&&m>0, "ConvC1DX: incorrect N or M!", _state); + ae_assert(n<=m, "ConvC1DX: Nptr.p_complex[0]; + ae_v_cmovec(&r->ptr.p_complex[0], 1, &a->ptr.p_complex[0], 1, "N", ae_v_len(0,m-1), v); + ae_frame_leave(_state); + return; + } + + /* + * use straightforward formula + */ + if( circular ) + { + + /* + * circular convolution + */ + ae_vector_set_length(r, m, _state); + v = b->ptr.p_complex[0]; + ae_v_cmovec(&r->ptr.p_complex[0], 1, &a->ptr.p_complex[0], 1, "N", ae_v_len(0,m-1), v); + for(i=1; i<=n-1; i++) + { + v = b->ptr.p_complex[i]; + i1 = 0; + i2 = i-1; + j1 = m-i; + j2 = m-1; + ae_v_caddc(&r->ptr.p_complex[i1], 1, &a->ptr.p_complex[j1], 1, "N", ae_v_len(i1,i2), v); + i1 = i; + i2 = m-1; + j1 = 0; + j2 = m-i-1; + ae_v_caddc(&r->ptr.p_complex[i1], 1, &a->ptr.p_complex[j1], 1, "N", ae_v_len(i1,i2), v); + } + } + else + { + + /* + * non-circular convolution + */ + ae_vector_set_length(r, m+n-1, _state); + for(i=0; i<=m+n-2; i++) + { + r->ptr.p_complex[i] = ae_complex_from_d(0); + } + for(i=0; i<=n-1; i++) + { + v = b->ptr.p_complex[i]; + ae_v_caddc(&r->ptr.p_complex[i], 1, &a->ptr.p_complex[0], 1, "N", ae_v_len(i,i+m-1), v); + } + } + ae_frame_leave(_state); + return; + } + + /* + * general FFT-based code for + * circular and non-circular convolutions. + * + * First, if convolution is circular, we test whether M is smooth or not. + * If it is smooth, we just use M-length FFT to calculate convolution. + * If it is not, we calculate non-circular convolution and wrap it arount. + * + * IF convolution is non-circular, we use zero-padding + FFT. + */ + if( alg==1 ) + { + if( circular&&ftbaseissmooth(m, _state) ) + { + + /* + * special code for circular convolution with smooth M + */ + ftcomplexfftplan(m, 1, &plan, _state); + ae_vector_set_length(&buf, 2*m, _state); + for(i=0; i<=m-1; i++) + { + buf.ptr.p_double[2*i+0] = a->ptr.p_complex[i].x; + buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; + } + ae_vector_set_length(&buf2, 2*m, _state); + for(i=0; i<=n-1; i++) + { + buf2.ptr.p_double[2*i+0] = b->ptr.p_complex[i].x; + buf2.ptr.p_double[2*i+1] = b->ptr.p_complex[i].y; + } + for(i=n; i<=m-1; i++) + { + buf2.ptr.p_double[2*i+0] = 0; + buf2.ptr.p_double[2*i+1] = 0; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + ftapplyplan(&plan, &buf2, 0, 1, _state); + for(i=0; i<=m-1; i++) + { + ax = buf.ptr.p_double[2*i+0]; + ay = buf.ptr.p_double[2*i+1]; + bx = buf2.ptr.p_double[2*i+0]; + by = buf2.ptr.p_double[2*i+1]; + tx = ax*bx-ay*by; + ty = ax*by+ay*bx; + buf.ptr.p_double[2*i+0] = tx; + buf.ptr.p_double[2*i+1] = -ty; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + t = (double)1/(double)m; + ae_vector_set_length(r, m, _state); + for(i=0; i<=m-1; i++) + { + r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; + r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; + } + } + else + { + + /* + * M is non-smooth, general code (circular/non-circular): + * * first part is the same for circular and non-circular + * convolutions. zero padding, FFTs, inverse FFTs + * * second part differs: + * * for non-circular convolution we just copy array + * * for circular convolution we add array tail to its head + */ + p = ftbasefindsmooth(m+n-1, _state); + ftcomplexfftplan(p, 1, &plan, _state); + ae_vector_set_length(&buf, 2*p, _state); + for(i=0; i<=m-1; i++) + { + buf.ptr.p_double[2*i+0] = a->ptr.p_complex[i].x; + buf.ptr.p_double[2*i+1] = a->ptr.p_complex[i].y; + } + for(i=m; i<=p-1; i++) + { + buf.ptr.p_double[2*i+0] = 0; + buf.ptr.p_double[2*i+1] = 0; + } + ae_vector_set_length(&buf2, 2*p, _state); + for(i=0; i<=n-1; i++) + { + buf2.ptr.p_double[2*i+0] = b->ptr.p_complex[i].x; + buf2.ptr.p_double[2*i+1] = b->ptr.p_complex[i].y; + } + for(i=n; i<=p-1; i++) + { + buf2.ptr.p_double[2*i+0] = 0; + buf2.ptr.p_double[2*i+1] = 0; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + ftapplyplan(&plan, &buf2, 0, 1, _state); + for(i=0; i<=p-1; i++) + { + ax = buf.ptr.p_double[2*i+0]; + ay = buf.ptr.p_double[2*i+1]; + bx = buf2.ptr.p_double[2*i+0]; + by = buf2.ptr.p_double[2*i+1]; + tx = ax*bx-ay*by; + ty = ax*by+ay*bx; + buf.ptr.p_double[2*i+0] = tx; + buf.ptr.p_double[2*i+1] = -ty; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + t = (double)1/(double)p; + if( circular ) + { + + /* + * circular, add tail to head + */ + ae_vector_set_length(r, m, _state); + for(i=0; i<=m-1; i++) + { + r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; + r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; + } + for(i=m; i<=m+n-2; i++) + { + r->ptr.p_complex[i-m].x = r->ptr.p_complex[i-m].x+t*buf.ptr.p_double[2*i+0]; + r->ptr.p_complex[i-m].y = r->ptr.p_complex[i-m].y-t*buf.ptr.p_double[2*i+1]; + } + } + else + { + + /* + * non-circular, just copy + */ + ae_vector_set_length(r, m+n-1, _state); + for(i=0; i<=m+n-2; i++) + { + r->ptr.p_complex[i].x = t*buf.ptr.p_double[2*i+0]; + r->ptr.p_complex[i].y = -t*buf.ptr.p_double[2*i+1]; + } + } + } + ae_frame_leave(_state); + return; + } + + /* + * overlap-add method for + * circular and non-circular convolutions. + * + * First part of code (separate FFTs of input blocks) is the same + * for all types of convolution. Second part (overlapping outputs) + * differs for different types of convolution. We just copy output + * when convolution is non-circular. We wrap it around, if it is + * circular. + */ + if( alg==2 ) + { + ae_vector_set_length(&buf, 2*(q+n-1), _state); + + /* + * prepare R + */ + if( circular ) + { + ae_vector_set_length(r, m, _state); + for(i=0; i<=m-1; i++) + { + r->ptr.p_complex[i] = ae_complex_from_d(0); + } + } + else + { + ae_vector_set_length(r, m+n-1, _state); + for(i=0; i<=m+n-2; i++) + { + r->ptr.p_complex[i] = ae_complex_from_d(0); + } + } + + /* + * pre-calculated FFT(B) + */ + ae_vector_set_length(&bbuf, q+n-1, _state); + ae_v_cmove(&bbuf.ptr.p_complex[0], 1, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); + for(j=n; j<=q+n-2; j++) + { + bbuf.ptr.p_complex[j] = ae_complex_from_d(0); + } + fftc1d(&bbuf, q+n-1, _state); + + /* + * prepare FFT plan for chunks of A + */ + ftcomplexfftplan(q+n-1, 1, &plan, _state); + + /* + * main overlap-add cycle + */ + i = 0; + while(i<=m-1) + { + p = ae_minint(q, m-i, _state); + for(j=0; j<=p-1; j++) + { + buf.ptr.p_double[2*j+0] = a->ptr.p_complex[i+j].x; + buf.ptr.p_double[2*j+1] = a->ptr.p_complex[i+j].y; + } + for(j=p; j<=q+n-2; j++) + { + buf.ptr.p_double[2*j+0] = 0; + buf.ptr.p_double[2*j+1] = 0; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + for(j=0; j<=q+n-2; j++) + { + ax = buf.ptr.p_double[2*j+0]; + ay = buf.ptr.p_double[2*j+1]; + bx = bbuf.ptr.p_complex[j].x; + by = bbuf.ptr.p_complex[j].y; + tx = ax*bx-ay*by; + ty = ax*by+ay*bx; + buf.ptr.p_double[2*j+0] = tx; + buf.ptr.p_double[2*j+1] = -ty; + } + ftapplyplan(&plan, &buf, 0, 1, _state); + t = (double)1/(double)(q+n-1); + if( circular ) + { + j1 = ae_minint(i+p+n-2, m-1, _state)-i; + j2 = j1+1; + } + else + { + j1 = p+n-2; + j2 = j1+1; + } + for(j=0; j<=j1; j++) + { + r->ptr.p_complex[i+j].x = r->ptr.p_complex[i+j].x+buf.ptr.p_double[2*j+0]*t; + r->ptr.p_complex[i+j].y = r->ptr.p_complex[i+j].y-buf.ptr.p_double[2*j+1]*t; + } + for(j=j2; j<=p+n-2; j++) + { + r->ptr.p_complex[j-j2].x = r->ptr.p_complex[j-j2].x+buf.ptr.p_double[2*j+0]*t; + r->ptr.p_complex[j-j2].y = r->ptr.p_complex[j-j2].y-buf.ptr.p_double[2*j+1]*t; + } + i = i+p; + } + ae_frame_leave(_state); + return; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional real convolution. + +Extended subroutine which allows to choose convolution algorithm. +Intended for internal use, ALGLIB users should call ConvR1D(). + +INPUT PARAMETERS + A - array[0..M-1] - complex function to be transformed + M - problem size + B - array[0..N-1] - complex function to be transformed + N - problem size, N<=M + Alg - algorithm type: + *-2 auto-select Q for overlap-add + *-1 auto-select algorithm and parameters + * 0 straightforward formula for small N's + * 1 general FFT-based code + * 2 overlap-add with length Q + Q - length for overlap-add + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..N+M-1]. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dx(/* Real */ ae_vector* a, + ae_int_t m, + /* Real */ ae_vector* b, + ae_int_t n, + ae_bool circular, + ae_int_t alg, + ae_int_t q, + /* Real */ ae_vector* r, + ae_state *_state) +{ + ae_frame _frame_block; + double v; + ae_int_t i; + ae_int_t j; + ae_int_t p; + ae_int_t ptotal; + ae_int_t i1; + ae_int_t i2; + ae_int_t j1; + ae_int_t j2; + double ax; + double ay; + double bx; + double by; + double tx; + double ty; + double flopcand; + double flopbest; + ae_int_t algbest; + fasttransformplan plan; + ae_vector buf; + ae_vector buf2; + ae_vector buf3; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(r); + _fasttransformplan_init(&plan, _state, ae_true); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&buf2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&buf3, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0&&m>0, "ConvC1DX: incorrect N or M!", _state); + ae_assert(n<=m, "ConvC1DX: Nptr.p_double[0]; + ae_v_moved(&r->ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1), v); + ae_frame_leave(_state); + return; + } + + /* + * use straightforward formula + */ + if( circular ) + { + + /* + * circular convolution + */ + ae_vector_set_length(r, m, _state); + v = b->ptr.p_double[0]; + ae_v_moved(&r->ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1), v); + for(i=1; i<=n-1; i++) + { + v = b->ptr.p_double[i]; + i1 = 0; + i2 = i-1; + j1 = m-i; + j2 = m-1; + ae_v_addd(&r->ptr.p_double[i1], 1, &a->ptr.p_double[j1], 1, ae_v_len(i1,i2), v); + i1 = i; + i2 = m-1; + j1 = 0; + j2 = m-i-1; + ae_v_addd(&r->ptr.p_double[i1], 1, &a->ptr.p_double[j1], 1, ae_v_len(i1,i2), v); + } + } + else + { + + /* + * non-circular convolution + */ + ae_vector_set_length(r, m+n-1, _state); + for(i=0; i<=m+n-2; i++) + { + r->ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + v = b->ptr.p_double[i]; + ae_v_addd(&r->ptr.p_double[i], 1, &a->ptr.p_double[0], 1, ae_v_len(i,i+m-1), v); + } + } + ae_frame_leave(_state); + return; + } + + /* + * general FFT-based code for + * circular and non-circular convolutions. + * + * First, if convolution is circular, we test whether M is smooth or not. + * If it is smooth, we just use M-length FFT to calculate convolution. + * If it is not, we calculate non-circular convolution and wrap it arount. + * + * If convolution is non-circular, we use zero-padding + FFT. + * + * We assume that M+N-1>2 - we should call small case code otherwise + */ + if( alg==1 ) + { + ae_assert(m+n-1>2, "ConvR1DX: internal error!", _state); + if( (circular&&ftbaseissmooth(m, _state))&&m%2==0 ) + { + + /* + * special code for circular convolution with smooth even M + */ + ae_vector_set_length(&buf, m, _state); + ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1)); + ae_vector_set_length(&buf2, m, _state); + ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=n; i<=m-1; i++) + { + buf2.ptr.p_double[i] = 0; + } + ae_vector_set_length(&buf3, m, _state); + ftcomplexfftplan(m/2, 1, &plan, _state); + fftr1dinternaleven(&buf, m, &buf3, &plan, _state); + fftr1dinternaleven(&buf2, m, &buf3, &plan, _state); + buf.ptr.p_double[0] = buf.ptr.p_double[0]*buf2.ptr.p_double[0]; + buf.ptr.p_double[1] = buf.ptr.p_double[1]*buf2.ptr.p_double[1]; + for(i=1; i<=m/2-1; i++) + { + ax = buf.ptr.p_double[2*i+0]; + ay = buf.ptr.p_double[2*i+1]; + bx = buf2.ptr.p_double[2*i+0]; + by = buf2.ptr.p_double[2*i+1]; + tx = ax*bx-ay*by; + ty = ax*by+ay*bx; + buf.ptr.p_double[2*i+0] = tx; + buf.ptr.p_double[2*i+1] = ty; + } + fftr1dinvinternaleven(&buf, m, &buf3, &plan, _state); + ae_vector_set_length(r, m, _state); + ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m-1)); + } + else + { + + /* + * M is non-smooth or non-even, general code (circular/non-circular): + * * first part is the same for circular and non-circular + * convolutions. zero padding, FFTs, inverse FFTs + * * second part differs: + * * for non-circular convolution we just copy array + * * for circular convolution we add array tail to its head + */ + p = ftbasefindsmootheven(m+n-1, _state); + ae_vector_set_length(&buf, p, _state); + ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[0], 1, ae_v_len(0,m-1)); + for(i=m; i<=p-1; i++) + { + buf.ptr.p_double[i] = 0; + } + ae_vector_set_length(&buf2, p, _state); + ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=n; i<=p-1; i++) + { + buf2.ptr.p_double[i] = 0; + } + ae_vector_set_length(&buf3, p, _state); + ftcomplexfftplan(p/2, 1, &plan, _state); + fftr1dinternaleven(&buf, p, &buf3, &plan, _state); + fftr1dinternaleven(&buf2, p, &buf3, &plan, _state); + buf.ptr.p_double[0] = buf.ptr.p_double[0]*buf2.ptr.p_double[0]; + buf.ptr.p_double[1] = buf.ptr.p_double[1]*buf2.ptr.p_double[1]; + for(i=1; i<=p/2-1; i++) + { + ax = buf.ptr.p_double[2*i+0]; + ay = buf.ptr.p_double[2*i+1]; + bx = buf2.ptr.p_double[2*i+0]; + by = buf2.ptr.p_double[2*i+1]; + tx = ax*bx-ay*by; + ty = ax*by+ay*bx; + buf.ptr.p_double[2*i+0] = tx; + buf.ptr.p_double[2*i+1] = ty; + } + fftr1dinvinternaleven(&buf, p, &buf3, &plan, _state); + if( circular ) + { + + /* + * circular, add tail to head + */ + ae_vector_set_length(r, m, _state); + ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m-1)); + if( n>=2 ) + { + ae_v_add(&r->ptr.p_double[0], 1, &buf.ptr.p_double[m], 1, ae_v_len(0,n-2)); + } + } + else + { + + /* + * non-circular, just copy + */ + ae_vector_set_length(r, m+n-1, _state); + ae_v_move(&r->ptr.p_double[0], 1, &buf.ptr.p_double[0], 1, ae_v_len(0,m+n-2)); + } + } + ae_frame_leave(_state); + return; + } + + /* + * overlap-add method + */ + if( alg==2 ) + { + ae_assert((q+n-1)%2==0, "ConvR1DX: internal error!", _state); + ae_vector_set_length(&buf, q+n-1, _state); + ae_vector_set_length(&buf2, q+n-1, _state); + ae_vector_set_length(&buf3, q+n-1, _state); + ftcomplexfftplan((q+n-1)/2, 1, &plan, _state); + + /* + * prepare R + */ + if( circular ) + { + ae_vector_set_length(r, m, _state); + for(i=0; i<=m-1; i++) + { + r->ptr.p_double[i] = 0; + } + } + else + { + ae_vector_set_length(r, m+n-1, _state); + for(i=0; i<=m+n-2; i++) + { + r->ptr.p_double[i] = 0; + } + } + + /* + * pre-calculated FFT(B) + */ + ae_v_move(&buf2.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(j=n; j<=q+n-2; j++) + { + buf2.ptr.p_double[j] = 0; + } + fftr1dinternaleven(&buf2, q+n-1, &buf3, &plan, _state); + + /* + * main overlap-add cycle + */ + i = 0; + while(i<=m-1) + { + p = ae_minint(q, m-i, _state); + ae_v_move(&buf.ptr.p_double[0], 1, &a->ptr.p_double[i], 1, ae_v_len(0,p-1)); + for(j=p; j<=q+n-2; j++) + { + buf.ptr.p_double[j] = 0; + } + fftr1dinternaleven(&buf, q+n-1, &buf3, &plan, _state); + buf.ptr.p_double[0] = buf.ptr.p_double[0]*buf2.ptr.p_double[0]; + buf.ptr.p_double[1] = buf.ptr.p_double[1]*buf2.ptr.p_double[1]; + for(j=1; j<=(q+n-1)/2-1; j++) + { + ax = buf.ptr.p_double[2*j+0]; + ay = buf.ptr.p_double[2*j+1]; + bx = buf2.ptr.p_double[2*j+0]; + by = buf2.ptr.p_double[2*j+1]; + tx = ax*bx-ay*by; + ty = ax*by+ay*bx; + buf.ptr.p_double[2*j+0] = tx; + buf.ptr.p_double[2*j+1] = ty; + } + fftr1dinvinternaleven(&buf, q+n-1, &buf3, &plan, _state); + if( circular ) + { + j1 = ae_minint(i+p+n-2, m-1, _state)-i; + j2 = j1+1; + } + else + { + j1 = p+n-2; + j2 = j1+1; + } + ae_v_add(&r->ptr.p_double[i], 1, &buf.ptr.p_double[0], 1, ae_v_len(i,i+j1)); + if( p+n-2>=j2 ) + { + ae_v_add(&r->ptr.p_double[0], 1, &buf.ptr.p_double[j2], 1, ae_v_len(0,p+n-2-j2)); + } + i = i+p; + } + ae_frame_leave(_state); + return; + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +1-dimensional complex cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). + +Correlation is calculated using reduction to convolution. Algorithm with +max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info +about performance). + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrC1D(Signal, Pattern) = Pattern x Signal (using traditional + definition of cross-correlation, denoting cross-correlation as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - complex function to be transformed, + signal containing pattern + N - problem size + Pattern - array[0..M-1] - complex function to be transformed, + pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - cross-correlation, array[0..N+M-2]: + * positive lags are stored in R[0..N-1], + R[i] = sum(conj(pattern[j])*signal[i+j] + * negative lags are stored in R[N..N+M-2], + R[N+M-1-i] = sum(conj(pattern[j])*signal[-i+j] + +NOTE: + It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero +on [-K..M-1], you can still use this subroutine, just shift result by K. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrc1d(/* Complex */ ae_vector* signal, + ae_int_t n, + /* Complex */ ae_vector* pattern, + ae_int_t m, + /* Complex */ ae_vector* r, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector p; + ae_vector b; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(r); + ae_vector_init(&p, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&b, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(n>0&&m>0, "CorrC1D: incorrect N or M!", _state); + ae_vector_set_length(&p, m, _state); + for(i=0; i<=m-1; i++) + { + p.ptr.p_complex[m-1-i] = ae_c_conj(pattern->ptr.p_complex[i], _state); + } + convc1d(&p, m, signal, n, &b, _state); + ae_vector_set_length(r, m+n-1, _state); + ae_v_cmove(&r->ptr.p_complex[0], 1, &b.ptr.p_complex[m-1], 1, "N", ae_v_len(0,n-1)); + if( m+n-2>=n ) + { + ae_v_cmove(&r->ptr.p_complex[n], 1, &b.ptr.p_complex[0], 1, "N", ae_v_len(n,m+n-2)); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional circular complex cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (circular). +Algorithm has linearithmic complexity for any M/N. + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrC1DCircular(Signal, Pattern) = Pattern x Signal (using + traditional definition of cross-correlation, denoting cross-correlation + as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - complex function to be transformed, + periodic signal containing pattern + N - problem size + Pattern - array[0..M-1] - complex function to be transformed, + non-periodic pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrc1dcircular(/* Complex */ ae_vector* signal, + ae_int_t m, + /* Complex */ ae_vector* pattern, + ae_int_t n, + /* Complex */ ae_vector* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector p; + ae_vector b; + ae_int_t i1; + ae_int_t i2; + ae_int_t i; + ae_int_t j2; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(c); + ae_vector_init(&p, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&b, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(n>0&&m>0, "ConvC1DCircular: incorrect N or M!", _state); + + /* + * normalize task: make M>=N, + * so A will be longer (at least - not shorter) that B. + */ + if( mptr.p_complex[i1], 1, "N", ae_v_len(0,j2)); + i1 = i1+m; + } + corrc1dcircular(signal, m, &b, m, c, _state); + ae_frame_leave(_state); + return; + } + + /* + * Task is normalized + */ + ae_vector_set_length(&p, n, _state); + for(i=0; i<=n-1; i++) + { + p.ptr.p_complex[n-1-i] = ae_c_conj(pattern->ptr.p_complex[i], _state); + } + convc1dcircular(signal, m, &p, n, &b, _state); + ae_vector_set_length(c, m, _state); + ae_v_cmove(&c->ptr.p_complex[0], 1, &b.ptr.p_complex[n-1], 1, "N", ae_v_len(0,m-n)); + if( m-n+1<=m-1 ) + { + ae_v_cmove(&c->ptr.p_complex[m-n+1], 1, &b.ptr.p_complex[0], 1, "N", ae_v_len(m-n+1,m-1)); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional real cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). + +Correlation is calculated using reduction to convolution. Algorithm with +max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info +about performance). + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrR1D(Signal, Pattern) = Pattern x Signal (using traditional + definition of cross-correlation, denoting cross-correlation as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - real function to be transformed, + signal containing pattern + N - problem size + Pattern - array[0..M-1] - real function to be transformed, + pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - cross-correlation, array[0..N+M-2]: + * positive lags are stored in R[0..N-1], + R[i] = sum(pattern[j]*signal[i+j] + * negative lags are stored in R[N..N+M-2], + R[N+M-1-i] = sum(pattern[j]*signal[-i+j] + +NOTE: + It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero +on [-K..M-1], you can still use this subroutine, just shift result by K. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrr1d(/* Real */ ae_vector* signal, + ae_int_t n, + /* Real */ ae_vector* pattern, + ae_int_t m, + /* Real */ ae_vector* r, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector p; + ae_vector b; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(r); + ae_vector_init(&p, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0&&m>0, "CorrR1D: incorrect N or M!", _state); + ae_vector_set_length(&p, m, _state); + for(i=0; i<=m-1; i++) + { + p.ptr.p_double[m-1-i] = pattern->ptr.p_double[i]; + } + convr1d(&p, m, signal, n, &b, _state); + ae_vector_set_length(r, m+n-1, _state); + ae_v_move(&r->ptr.p_double[0], 1, &b.ptr.p_double[m-1], 1, ae_v_len(0,n-1)); + if( m+n-2>=n ) + { + ae_v_move(&r->ptr.p_double[n], 1, &b.ptr.p_double[0], 1, ae_v_len(n,m+n-2)); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional circular real cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (circular). +Algorithm has linearithmic complexity for any M/N. + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrR1DCircular(Signal, Pattern) = Pattern x Signal (using + traditional definition of cross-correlation, denoting cross-correlation + as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - real function to be transformed, + periodic signal containing pattern + N - problem size + Pattern - array[0..M-1] - real function to be transformed, + non-periodic pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrr1dcircular(/* Real */ ae_vector* signal, + ae_int_t m, + /* Real */ ae_vector* pattern, + ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector p; + ae_vector b; + ae_int_t i1; + ae_int_t i2; + ae_int_t i; + ae_int_t j2; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(c); + ae_vector_init(&p, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0&&m>0, "ConvC1DCircular: incorrect N or M!", _state); + + /* + * normalize task: make M>=N, + * so A will be longer (at least - not shorter) that B. + */ + if( mptr.p_double[i1], 1, ae_v_len(0,j2)); + i1 = i1+m; + } + corrr1dcircular(signal, m, &b, m, c, _state); + ae_frame_leave(_state); + return; + } + + /* + * Task is normalized + */ + ae_vector_set_length(&p, n, _state); + for(i=0; i<=n-1; i++) + { + p.ptr.p_double[n-1-i] = pattern->ptr.p_double[i]; + } + convr1dcircular(signal, m, &p, n, &b, _state); + ae_vector_set_length(c, m, _state); + ae_v_move(&c->ptr.p_double[0], 1, &b.ptr.p_double[n-1], 1, ae_v_len(0,m-n)); + if( m-n+1<=m-1 ) + { + ae_v_move(&c->ptr.p_double[m-n+1], 1, &b.ptr.p_double[0], 1, ae_v_len(m-n+1,m-1)); + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +1-dimensional Fast Hartley Transform. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + A - FHT of a input array, array[0..N-1], + A_out[k] = sum(A_in[j]*(cos(2*pi*j*k/N)+sin(2*pi*j*k/N)), j=0..N-1) + + + -- ALGLIB -- + Copyright 04.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fhtr1d(/* Real */ ae_vector* a, ae_int_t n, ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector fa; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&fa, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(n>0, "FHTR1D: incorrect N!", _state); + + /* + * Special case: N=1, FHT is just identity transform. + * After this block we assume that N is strictly greater than 1. + */ + if( n==1 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Reduce FHt to real FFT + */ + fftr1d(a, n, &fa, _state); + for(i=0; i<=n-1; i++) + { + a->ptr.p_double[i] = fa.ptr.p_complex[i].x-fa.ptr.p_complex[i].y; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +1-dimensional inverse FHT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - complex array to be transformed + N - problem size + +OUTPUT PARAMETERS + A - inverse FHT of a input array, array[0..N-1] + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fhtr1dinv(/* Real */ ae_vector* a, ae_int_t n, ae_state *_state) +{ + ae_int_t i; + + + ae_assert(n>0, "FHTR1DInv: incorrect N!", _state); + + /* + * Special case: N=1, iFHT is just identity transform. + * After this block we assume that N is strictly greater than 1. + */ + if( n==1 ) + { + return; + } + + /* + * Inverse FHT can be expressed in terms of the FHT as + * + * invfht(x) = fht(x)/N + */ + fhtr1d(a, n, _state); + for(i=0; i<=n-1; i++) + { + a->ptr.p_double[i] = a->ptr.p_double[i]/n; + } +} + + + +} + diff --git a/psdlag/src/fasttransforms.h b/psdlag/src/fasttransforms.h new file mode 100644 index 0000000..079da71 --- /dev/null +++ b/psdlag/src/fasttransforms.h @@ -0,0 +1,691 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _fasttransforms_pkg_h +#define _fasttransforms_pkg_h +#include "ap.h" +#include "alglibinternal.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +1-dimensional complex FFT. + +Array size N may be arbitrary number (composite or prime). Composite N's +are handled with cache-oblivious variation of a Cooley-Tukey algorithm. +Small prime-factors are transformed using hard coded codelets (similar to +FFTW codelets, but without low-level optimization), large prime-factors +are handled with Bluestein's algorithm. + +Fastests transforms are for smooth N's (prime factors are 2, 3, 5 only), +most fast for powers of 2. When N have prime factors larger than these, +but orders of magnitude smaller than N, computations will be about 4 times +slower than for nearby highly composite N's. When N itself is prime, speed +will be 6 times lower. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - complex function to be transformed + N - problem size + +OUTPUT PARAMETERS + A - DFT of a input array, array[0..N-1] + A_out[j] = SUM(A_in[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fftc1d(complex_1d_array &a, const ae_int_t n); +void fftc1d(complex_1d_array &a); + + +/************************************************************************* +1-dimensional complex inverse FFT. + +Array size N may be arbitrary number (composite or prime). Algorithm has +O(N*logN) complexity for any N (composite or prime). + +See FFTC1D() description for more information about algorithm performance. + +INPUT PARAMETERS + A - array[0..N-1] - complex array to be transformed + N - problem size + +OUTPUT PARAMETERS + A - inverse DFT of a input array, array[0..N-1] + A_out[j] = SUM(A_in[k]/N*exp(+2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fftc1dinv(complex_1d_array &a, const ae_int_t n); +void fftc1dinv(complex_1d_array &a); + + +/************************************************************************* +1-dimensional real FFT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + F - DFT of a input array, array[0..N-1] + F[j] = SUM(A[k]*exp(-2*pi*sqrt(-1)*j*k/N), k = 0..N-1) + +NOTE: + F[] satisfies symmetry property F[k] = conj(F[N-k]), so just one half +of array is usually needed. But for convinience subroutine returns full +complex array (with frequencies above N/2), so its result may be used by +other FFT-related subroutines. + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1d(const real_1d_array &a, const ae_int_t n, complex_1d_array &f); +void fftr1d(const real_1d_array &a, complex_1d_array &f); + + +/************************************************************************* +1-dimensional real inverse FFT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + F - array[0..floor(N/2)] - frequencies from forward real FFT + N - problem size + +OUTPUT PARAMETERS + A - inverse DFT of a input array, array[0..N-1] + +NOTE: + F[] should satisfy symmetry property F[k] = conj(F[N-k]), so just one +half of frequencies array is needed - elements from 0 to floor(N/2). F[0] +is ALWAYS real. If N is even F[floor(N/2)] is real too. If N is odd, then +F[floor(N/2)] has no special properties. + +Relying on properties noted above, FFTR1DInv subroutine uses only elements +from 0th to floor(N/2)-th. It ignores imaginary part of F[0], and in case +N is even it ignores imaginary part of F[floor(N/2)] too. + +When you call this function using full arguments list - "FFTR1DInv(F,N,A)" +- you can pass either either frequencies array with N elements or reduced +array with roughly N/2 elements - subroutine will successfully transform +both. + +If you call this function using reduced arguments list - "FFTR1DInv(F,A)" +- you must pass FULL array with N elements (although higher N/2 are still +not used) because array size is used to automatically determine FFT length + + + -- ALGLIB -- + Copyright 01.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fftr1dinv(const complex_1d_array &f, const ae_int_t n, real_1d_array &a); +void fftr1dinv(const complex_1d_array &f, real_1d_array &a); + +/************************************************************************* +1-dimensional complex convolution. + +For given A/B returns conv(A,B) (non-circular). Subroutine can automatically +choose between three implementations: straightforward O(M*N) formula for +very small N (or M), overlap-add algorithm for cases where max(M,N) is +significantly larger than min(M,N), but O(M*N) algorithm is too slow, and +general FFT-based formula for cases where two previois algorithms are too +slow. + +Algorithm has max(M,N)*log(max(M,N)) complexity for any M/N. + +INPUT PARAMETERS + A - array[0..M-1] - complex function to be transformed + M - problem size + B - array[0..N-1] - complex function to be transformed + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..N+M-2]. + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1d(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r); + + +/************************************************************************* +1-dimensional complex non-circular deconvolution (inverse of ConvC1D()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - response + N - response length, N<=M + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-N]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dinv(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r); + + +/************************************************************************* +1-dimensional circular complex convolution. + +For given S/R returns conv(S,R) (circular). Algorithm has linearithmic +complexity for any M/N. + +IMPORTANT: normal convolution is commutative, i.e. it is symmetric - +conv(A,B)=conv(B,A). Cyclic convolution IS NOT. One function - S - is a +signal, periodic function, and another - R - is a response, non-periodic +function with limited length. + +INPUT PARAMETERS + S - array[0..M-1] - complex periodic signal + M - problem size + B - array[0..N-1] - complex non-periodic response + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dcircular(const complex_1d_array &s, const ae_int_t m, const complex_1d_array &r, const ae_int_t n, complex_1d_array &c); + + +/************************************************************************* +1-dimensional circular complex deconvolution (inverse of ConvC1DCircular()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved periodic signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - non-periodic response + N - response length + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-1]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convc1dcircularinv(const complex_1d_array &a, const ae_int_t m, const complex_1d_array &b, const ae_int_t n, complex_1d_array &r); + + +/************************************************************************* +1-dimensional real convolution. + +Analogous to ConvC1D(), see ConvC1D() comments for more details. + +INPUT PARAMETERS + A - array[0..M-1] - real function to be transformed + M - problem size + B - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..N+M-2]. + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1d(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r); + + +/************************************************************************* +1-dimensional real deconvolution (inverse of ConvC1D()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - response + N - response length, N<=M + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-N]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that A is zero at T<0, B is zero too. If one or both +functions have non-zero values at negative T's, you can still use this +subroutine - just shift its result correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dinv(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r); + + +/************************************************************************* +1-dimensional circular real convolution. + +Analogous to ConvC1DCircular(), see ConvC1DCircular() comments for more details. + +INPUT PARAMETERS + S - array[0..M-1] - real signal + M - problem size + B - array[0..N-1] - real response + N - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dcircular(const real_1d_array &s, const ae_int_t m, const real_1d_array &r, const ae_int_t n, real_1d_array &c); + + +/************************************************************************* +1-dimensional complex deconvolution (inverse of ConvC1D()). + +Algorithm has M*log(M)) complexity for any M (composite or prime). + +INPUT PARAMETERS + A - array[0..M-1] - convolved signal, A = conv(R, B) + M - convolved signal length + B - array[0..N-1] - response + N - response length + +OUTPUT PARAMETERS + R - deconvolved signal. array[0..M-N]. + +NOTE: + deconvolution is unstable process and may result in division by zero +(if your response function is degenerate, i.e. has zero Fourier coefficient). + +NOTE: + It is assumed that B is zero at T<0. If it has non-zero values at +negative T's, you can still use this subroutine - just shift its result +correspondingly. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void convr1dcircularinv(const real_1d_array &a, const ae_int_t m, const real_1d_array &b, const ae_int_t n, real_1d_array &r); + +/************************************************************************* +1-dimensional complex cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). + +Correlation is calculated using reduction to convolution. Algorithm with +max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info +about performance). + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrC1D(Signal, Pattern) = Pattern x Signal (using traditional + definition of cross-correlation, denoting cross-correlation as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - complex function to be transformed, + signal containing pattern + N - problem size + Pattern - array[0..M-1] - complex function to be transformed, + pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - cross-correlation, array[0..N+M-2]: + * positive lags are stored in R[0..N-1], + R[i] = sum(conj(pattern[j])*signal[i+j] + * negative lags are stored in R[N..N+M-2], + R[N+M-1-i] = sum(conj(pattern[j])*signal[-i+j] + +NOTE: + It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero +on [-K..M-1], you can still use this subroutine, just shift result by K. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrc1d(const complex_1d_array &signal, const ae_int_t n, const complex_1d_array &pattern, const ae_int_t m, complex_1d_array &r); + + +/************************************************************************* +1-dimensional circular complex cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (circular). +Algorithm has linearithmic complexity for any M/N. + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrC1DCircular(Signal, Pattern) = Pattern x Signal (using + traditional definition of cross-correlation, denoting cross-correlation + as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - complex function to be transformed, + periodic signal containing pattern + N - problem size + Pattern - array[0..M-1] - complex function to be transformed, + non-periodic pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrc1dcircular(const complex_1d_array &signal, const ae_int_t m, const complex_1d_array &pattern, const ae_int_t n, complex_1d_array &c); + + +/************************************************************************* +1-dimensional real cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (non-circular). + +Correlation is calculated using reduction to convolution. Algorithm with +max(N,N)*log(max(N,N)) complexity is used (see ConvC1D() for more info +about performance). + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrR1D(Signal, Pattern) = Pattern x Signal (using traditional + definition of cross-correlation, denoting cross-correlation as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - real function to be transformed, + signal containing pattern + N - problem size + Pattern - array[0..M-1] - real function to be transformed, + pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - cross-correlation, array[0..N+M-2]: + * positive lags are stored in R[0..N-1], + R[i] = sum(pattern[j]*signal[i+j] + * negative lags are stored in R[N..N+M-2], + R[N+M-1-i] = sum(pattern[j]*signal[-i+j] + +NOTE: + It is assumed that pattern domain is [0..M-1]. If Pattern is non-zero +on [-K..M-1], you can still use this subroutine, just shift result by K. + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrr1d(const real_1d_array &signal, const ae_int_t n, const real_1d_array &pattern, const ae_int_t m, real_1d_array &r); + + +/************************************************************************* +1-dimensional circular real cross-correlation. + +For given Pattern/Signal returns corr(Pattern,Signal) (circular). +Algorithm has linearithmic complexity for any M/N. + +IMPORTANT: + for historical reasons subroutine accepts its parameters in reversed + order: CorrR1DCircular(Signal, Pattern) = Pattern x Signal (using + traditional definition of cross-correlation, denoting cross-correlation + as "x"). + +INPUT PARAMETERS + Signal - array[0..N-1] - real function to be transformed, + periodic signal containing pattern + N - problem size + Pattern - array[0..M-1] - real function to be transformed, + non-periodic pattern to search withing signal + M - problem size + +OUTPUT PARAMETERS + R - convolution: A*B. array[0..M-1]. + + + -- ALGLIB -- + Copyright 21.07.2009 by Bochkanov Sergey +*************************************************************************/ +void corrr1dcircular(const real_1d_array &signal, const ae_int_t m, const real_1d_array &pattern, const ae_int_t n, real_1d_array &c); + +/************************************************************************* +1-dimensional Fast Hartley Transform. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - real function to be transformed + N - problem size + +OUTPUT PARAMETERS + A - FHT of a input array, array[0..N-1], + A_out[k] = sum(A_in[j]*(cos(2*pi*j*k/N)+sin(2*pi*j*k/N)), j=0..N-1) + + + -- ALGLIB -- + Copyright 04.06.2009 by Bochkanov Sergey +*************************************************************************/ +void fhtr1d(real_1d_array &a, const ae_int_t n); + + +/************************************************************************* +1-dimensional inverse FHT. + +Algorithm has O(N*logN) complexity for any N (composite or prime). + +INPUT PARAMETERS + A - array[0..N-1] - complex array to be transformed + N - problem size + +OUTPUT PARAMETERS + A - inverse FHT of a input array, array[0..N-1] + + + -- ALGLIB -- + Copyright 29.05.2009 by Bochkanov Sergey +*************************************************************************/ +void fhtr1dinv(real_1d_array &a, const ae_int_t n); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void fftc1d(/* Complex */ ae_vector* a, ae_int_t n, ae_state *_state); +void fftc1dinv(/* Complex */ ae_vector* a, ae_int_t n, ae_state *_state); +void fftr1d(/* Real */ ae_vector* a, + ae_int_t n, + /* Complex */ ae_vector* f, + ae_state *_state); +void fftr1dinv(/* Complex */ ae_vector* f, + ae_int_t n, + /* Real */ ae_vector* a, + ae_state *_state); +void fftr1dinternaleven(/* Real */ ae_vector* a, + ae_int_t n, + /* Real */ ae_vector* buf, + fasttransformplan* plan, + ae_state *_state); +void fftr1dinvinternaleven(/* Real */ ae_vector* a, + ae_int_t n, + /* Real */ ae_vector* buf, + fasttransformplan* plan, + ae_state *_state); +void convc1d(/* Complex */ ae_vector* a, + ae_int_t m, + /* Complex */ ae_vector* b, + ae_int_t n, + /* Complex */ ae_vector* r, + ae_state *_state); +void convc1dinv(/* Complex */ ae_vector* a, + ae_int_t m, + /* Complex */ ae_vector* b, + ae_int_t n, + /* Complex */ ae_vector* r, + ae_state *_state); +void convc1dcircular(/* Complex */ ae_vector* s, + ae_int_t m, + /* Complex */ ae_vector* r, + ae_int_t n, + /* Complex */ ae_vector* c, + ae_state *_state); +void convc1dcircularinv(/* Complex */ ae_vector* a, + ae_int_t m, + /* Complex */ ae_vector* b, + ae_int_t n, + /* Complex */ ae_vector* r, + ae_state *_state); +void convr1d(/* Real */ ae_vector* a, + ae_int_t m, + /* Real */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* r, + ae_state *_state); +void convr1dinv(/* Real */ ae_vector* a, + ae_int_t m, + /* Real */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* r, + ae_state *_state); +void convr1dcircular(/* Real */ ae_vector* s, + ae_int_t m, + /* Real */ ae_vector* r, + ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state); +void convr1dcircularinv(/* Real */ ae_vector* a, + ae_int_t m, + /* Real */ ae_vector* b, + ae_int_t n, + /* Real */ ae_vector* r, + ae_state *_state); +void convc1dx(/* Complex */ ae_vector* a, + ae_int_t m, + /* Complex */ ae_vector* b, + ae_int_t n, + ae_bool circular, + ae_int_t alg, + ae_int_t q, + /* Complex */ ae_vector* r, + ae_state *_state); +void convr1dx(/* Real */ ae_vector* a, + ae_int_t m, + /* Real */ ae_vector* b, + ae_int_t n, + ae_bool circular, + ae_int_t alg, + ae_int_t q, + /* Real */ ae_vector* r, + ae_state *_state); +void corrc1d(/* Complex */ ae_vector* signal, + ae_int_t n, + /* Complex */ ae_vector* pattern, + ae_int_t m, + /* Complex */ ae_vector* r, + ae_state *_state); +void corrc1dcircular(/* Complex */ ae_vector* signal, + ae_int_t m, + /* Complex */ ae_vector* pattern, + ae_int_t n, + /* Complex */ ae_vector* c, + ae_state *_state); +void corrr1d(/* Real */ ae_vector* signal, + ae_int_t n, + /* Real */ ae_vector* pattern, + ae_int_t m, + /* Real */ ae_vector* r, + ae_state *_state); +void corrr1dcircular(/* Real */ ae_vector* signal, + ae_int_t m, + /* Real */ ae_vector* pattern, + ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state); +void fhtr1d(/* Real */ ae_vector* a, ae_int_t n, ae_state *_state); +void fhtr1dinv(/* Real */ ae_vector* a, ae_int_t n, ae_state *_state); + +} +#endif + diff --git a/psdlag/src/fittedlags.dat b/psdlag/src/fittedlags.dat new file mode 100644 index 0000000..a48c299 --- /dev/null +++ b/psdlag/src/fittedlags.dat @@ -0,0 +1,6 @@ +1.022e-01 9.694e-01 +3.260e-01 9.192e-01 +5.118e-01 9.776e-01 +3.254e-01 9.269e-01 +1.000e+00 9.659e-01 +1.000e+00 9.891e-01 diff --git a/psdlag/src/inc/def.hpp b/psdlag/src/inc/def.hpp new file mode 100644 index 0000000..ef14350 --- /dev/null +++ b/psdlag/src/inc/def.hpp @@ -0,0 +1,36 @@ +/* + * def.hpp + * + * Created on: May 24, 2013 + * Author: abduz + */ + +#ifndef DEF_HPP_ +#define DEF_HPP_ + +#include +#include +#include + +using namespace alglib; +using namespace std; + +typedef real_1d_array vec; +typedef real_2d_array vec2; +typedef integer_1d_array ivec; + + +class lcurve { +public: + int len; double dt; vec lc,lce,t; + lcurve(int n=1){t.setlength(n); lc.setlength(n); lce.setlength(n) ;len=n;dt=1.0;} + lcurve(vec& t_,vec& lc_,vec& lce_,double dt_){t=t_;lc=lc_;lce=lce_;len=t.length();dt=dt_;} + void demean(){double m=0;int i;for(i=0;i +#include +#include +#include + +#include "def.hpp" +#include "psd.hpp" +#include "lag.hpp" +#include "psdlag.hpp" +#include "mcmc.hpp" + + +void usage(); +void do_work( char* ); +void readLC( vector >&, string , int , int , int , bool ); + + +double mcmc_lag10( vec& x ,void*ptr ){ + int i,np = x.length(); for(i=0;i7){x[i]=7;}if(x[i]<-7){x[i]=-7;}} + Mod *mod = (Mod*) ptr; double logl=mod->loglikelihood(x); + return logl; +} + +double mcmc_psdlag10( vec& x ,void*ptr ){ + int i,np = x.length(); for(i=0;i7){x[i]=7;}if(x[i]<-7){x[i]=-7;}} + Mod *mod = (Mod*) ptr; double logl=mod->loglikelihood(x); + return logl; +} + +#endif /* MAIN_HPP_ */ diff --git a/psdlag/src/inc/mcmc.hpp b/psdlag/src/inc/mcmc.hpp new file mode 100644 index 0000000..ef50efb --- /dev/null +++ b/psdlag/src/inc/mcmc.hpp @@ -0,0 +1,35 @@ +/* + * mcmc.hpp + * + * Created on: May 14, 2013 + * Author: abduz + */ + +#ifndef MCMC_HPP_ +#define MCMC_HPP_ + +#include +#include +#include +#include +#include +using namespace alglib; +using namespace std; + +typedef real_1d_array vec; +typedef real_2d_array vec2; +typedef integer_1d_array ivec; +typedef integer_2d_array ivec2; + +class mcmc { + int npar; double(*loglikelihood)(vec&,void*); void*ptr; + hqrndstate rnd; +public: + int nrun,nburn,nwk,ncheck; double avalue; + mcmc(int np,double (*f)(vec&,void*),void *p); + void setseed(int s1,int s2 ){hqrndseed(s1,s2,rnd);} + void run( vec& , vec& , const char*fname="mcmc.dat"); + virtual ~mcmc(); +}; + +#endif /* MCMC_HPP_ */ diff --git a/psdlag/src/inc/mod.hpp b/psdlag/src/inc/mod.hpp new file mode 100644 index 0000000..008dbe6 --- /dev/null +++ b/psdlag/src/inc/mod.hpp @@ -0,0 +1,283 @@ +/* + * mod.hpp + * + * Created on: May 31, 2013 + * Author: azoghbi + */ + +#ifndef MOD_HPP_ +#define MOD_HPP_ + +#include "def.hpp" +#include +#include + +class mod { + + void _CSfq( vec , vector& , vector& ); + +public: + + int n,nfq,npar; + double dt,f1,f2; + vec lc,lce,t,FqL; + vector Cfq,Sfq,Cv,Cfq2,Sfq2; + + vec2 C,Ci,I,yyT,yyTmC,dC,C2,C3; + vec Cilc; + + ae_int_t info; densesolverreport rep; + + mod(); + virtual ~mod(); + + virtual void _C( vec ); + virtual void _dC( vec , int ); + virtual void step_pars( int , vec& , vec& ); + virtual void print_pars( vec& , vec& ); + virtual void print_pars( vec& , vec& , vec& ); + virtual void what_pars( int&, int& ); + + void setlc(){ lc.setlength(n); lce.setlength(n); t.setlength(n);} + void init( vec , int ); + double loglikelihood( vec ); + void dlikelihood( vec , double& , vec& , vec2& ); + void optimize( vec& , vec& ); +}; + +// ----------------------------------------- // +// ---------- mod container ---------------- // +// ----------------------------------------- // + +template +class Mod { + + int nmod,nfq; + vector mods; + +public: + int npar; + Mod( vector inlc , vec fqL ){ + int i; + nmod = inlc.size(); + for( i=0 ; i lc1, vector lc2 , vec fqL , vec pars ){ + int i; + nmod = lc1.size(); + for( i=0 ; i lc1, vector lc2 , vec fqL ){ + int i; + nmod = lc1.size(); + for( i=0 ; i ic,iv; sing = 0; + for( i=0; i 10 ){for(i=0;i ic,iv; np = npar - 1; + vec g; vec2 h,hi,iii; g.setlength(np); h.setlength(np,np); hi.setlength(np,np);iii.setlength(np,np); + ic.push_back(k); + + for( i=0 ; i10 ){for(i=0;itol ){ + phalf = (pu+pd)/2.0; + tmpp[ip] = phalf; + tmplike = opti( tmpp , errs , ip ); + dl = 2*(bestlike - tmplike); + cout << "+++ " << bestlike << " " << tmplike << " " << pars[ip] << " "<< phalf << " " << dl << endl; + if( dl>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "integration.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +Computation of nodes and weights for a Gauss quadrature formula + +The algorithm generates the N-point Gauss quadrature formula with weight +function given by coefficients alpha and beta of a recurrence relation +which generates a system of orthogonal polynomials: + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-1], alpha coefficients + Beta – array[0..N-1], beta coefficients + Zero-indexed element is not used and may be arbitrary. + Beta[I]>0. + Mu0 – zeroth moment of the weight function. + N – number of nodes of the quadrature formula, N>=1 + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gqgeneraterec(const_cast(alpha.c_ptr()), const_cast(beta.c_ptr()), mu0, n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Computation of nodes and weights for a Gauss-Lobatto quadrature formula + +The algorithm generates the N-point Gauss-Lobatto quadrature formula with +weight function given by coefficients alpha and beta of a recurrence which +generates a system of orthogonal polynomials. + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-2], alpha coefficients + Beta – array[0..N-2], beta coefficients. + Zero-indexed element is not used, may be arbitrary. + Beta[I]>0 + Mu0 – zeroth moment of the weighting function. + A – left boundary of the integration interval. + B – right boundary of the integration interval. + N – number of nodes of the quadrature formula, N>=3 + (including the left and right boundary nodes). + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslobattorec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const double b, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gqgenerategausslobattorec(const_cast(alpha.c_ptr()), const_cast(beta.c_ptr()), mu0, a, b, n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Computation of nodes and weights for a Gauss-Radau quadrature formula + +The algorithm generates the N-point Gauss-Radau quadrature formula with +weight function given by the coefficients alpha and beta of a recurrence +which generates a system of orthogonal polynomials. + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-2], alpha coefficients. + Beta – array[0..N-1], beta coefficients + Zero-indexed element is not used. + Beta[I]>0 + Mu0 – zeroth moment of the weighting function. + A – left boundary of the integration interval. + N – number of nodes of the quadrature formula, N>=2 + (including the left boundary node). + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategaussradaurec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gqgenerategaussradaurec(const_cast(alpha.c_ptr()), const_cast(beta.c_ptr()), mu0, a, n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N +nodes. + +INPUT PARAMETERS: + N - number of nodes, >=1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gqgenerategausslegendre(n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight +function W(x)=Power(1-x,Alpha)*Power(1+x,Beta). + +INPUT PARAMETERS: + N - number of nodes, >=1 + Alpha - power-law coefficient, Alpha>-1 + Beta - power-law coefficient, Beta>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. Alpha or Beta are too close + to -1 to obtain weights/nodes with high enough + accuracy, or, may be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha/Beta was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gqgenerategaussjacobi(n, alpha, beta, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with +weight function W(x)=Power(x,Alpha)*Exp(-x) + +INPUT PARAMETERS: + N - number of nodes, >=1 + Alpha - power-law coefficient, Alpha>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. Alpha is too close to -1 to + obtain weights/nodes with high enough accuracy + or, may be, N is too large. Try to use + multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslaguerre(const ae_int_t n, const double alpha, ae_int_t &info, real_1d_array &x, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gqgenerategausslaguerre(n, alpha, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with +weight function W(x)=Exp(-x*x) + +INPUT PARAMETERS: + N - number of nodes, >=1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. May be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausshermite(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gqgenerategausshermite(n, &info, const_cast(x.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Computation of nodes and weights of a Gauss-Kronrod quadrature formula + +The algorithm generates the N-point Gauss-Kronrod quadrature formula with +weight function given by coefficients alpha and beta of a recurrence +relation which generates a system of orthogonal polynomials: + + P-1(x) = 0 + P0(x) = 1 + Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zero moment Mu0 + + Mu0 = integral(W(x)dx,a,b) + + +INPUT PARAMETERS: + Alpha – alpha coefficients, array[0..floor(3*K/2)]. + Beta – beta coefficients, array[0..ceil(3*K/2)]. + Beta[0] is not used and may be arbitrary. + Beta[I]>0. + Mu0 – zeroth moment of the weight function. + N – number of nodes of the Gauss-Kronrod quadrature formula, + N >= 3, + N = 2*K+1. + +OUTPUT PARAMETERS: + Info - error code: + * -5 no real and positive Gauss-Kronrod formula can + be created for such a weight function with a + given number of nodes. + * -4 N is too large, task may be ill conditioned - + x[i]=x[i+1] found. + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + -- ALGLIB -- + Copyright 08.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gkqgeneraterec(const_cast(alpha.c_ptr()), const_cast(beta.c_ptr()), mu0, n, &info, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre +quadrature with N points. + +GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is +used depending on machine precision and number of nodes. + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gkqgenerategausslegendre(n, &info, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi +quadrature on [-1,1] with weight function + + W(x)=Power(1-x,Alpha)*Power(1+x,Beta). + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + Alpha - power-law coefficient, Alpha>-1 + Beta - power-law coefficient, Beta>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -5 no real and positive Gauss-Kronrod formula can + be created for such a weight function with a + given number of nodes. + * -4 an error was detected when calculating + weights/nodes. Alpha or Beta are too close + to -1 to obtain weights/nodes with high enough + accuracy, or, may be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + * +2 OK, but quadrature rule have exterior nodes, + x[0]<-1 or x[n-1]>+1 + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gkqgenerategaussjacobi(n, alpha, beta, &info, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes for quadrature with N points. + +Reduction to tridiagonal eigenproblem is used. + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqlegendrecalc(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gkqlegendrecalc(n, &info, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using +pre-calculated table. Nodes/weights were computed with accuracy up to +1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision +accuracy reduces to something about 2.0E-16 (depending on your compiler's +handling of long floating point constants). + +INPUT PARAMETERS: + N - number of Kronrod nodes. + N can be 15, 21, 31, 41, 51, 61. + +OUTPUT PARAMETERS: + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqlegendretbl(const ae_int_t n, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, double &eps) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::gkqlegendretbl(n, const_cast(x.c_ptr()), const_cast(wkronrod.c_ptr()), const_cast(wgauss.c_ptr()), &eps, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Integration report: +* TerminationType = completetion code: + * -5 non-convergence of Gauss-Kronrod nodes + calculation subroutine. + * -1 incorrect parameters were specified + * 1 OK +* Rep.NFEV countains number of function calculations +* Rep.NIntervals contains number of intervals [a,b] + was partitioned into. +*************************************************************************/ +_autogkreport_owner::_autogkreport_owner() +{ + p_struct = (alglib_impl::autogkreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_autogkreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_autogkreport_owner::_autogkreport_owner(const _autogkreport_owner &rhs) +{ + p_struct = (alglib_impl::autogkreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_autogkreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_autogkreport_owner& _autogkreport_owner::operator=(const _autogkreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_autogkreport_clear(p_struct); + if( !alglib_impl::_autogkreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_autogkreport_owner::~_autogkreport_owner() +{ + alglib_impl::_autogkreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::autogkreport* _autogkreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::autogkreport* _autogkreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +autogkreport::autogkreport() : _autogkreport_owner() ,terminationtype(p_struct->terminationtype),nfev(p_struct->nfev),nintervals(p_struct->nintervals) +{ +} + +autogkreport::autogkreport(const autogkreport &rhs):_autogkreport_owner(rhs) ,terminationtype(p_struct->terminationtype),nfev(p_struct->nfev),nintervals(p_struct->nintervals) +{ +} + +autogkreport& autogkreport::operator=(const autogkreport &rhs) +{ + if( this==&rhs ) + return *this; + _autogkreport_owner::operator=(rhs); + return *this; +} + +autogkreport::~autogkreport() +{ +} + + +/************************************************************************* +This structure stores state of the integration algorithm. + +Although this class has public fields, they are not intended for external +use. You should use ALGLIB functions to work with this class: +* autogksmooth()/AutoGKSmoothW()/... to create objects +* autogkintegrate() to begin integration +* autogkresults() to get results +*************************************************************************/ +_autogkstate_owner::_autogkstate_owner() +{ + p_struct = (alglib_impl::autogkstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_autogkstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_autogkstate_owner::_autogkstate_owner(const _autogkstate_owner &rhs) +{ + p_struct = (alglib_impl::autogkstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::autogkstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_autogkstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_autogkstate_owner& _autogkstate_owner::operator=(const _autogkstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_autogkstate_clear(p_struct); + if( !alglib_impl::_autogkstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_autogkstate_owner::~_autogkstate_owner() +{ + alglib_impl::_autogkstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::autogkstate* _autogkstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::autogkstate* _autogkstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +autogkstate::autogkstate() : _autogkstate_owner() ,needf(p_struct->needf),x(p_struct->x),xminusa(p_struct->xminusa),bminusx(p_struct->bminusx),f(p_struct->f) +{ +} + +autogkstate::autogkstate(const autogkstate &rhs):_autogkstate_owner(rhs) ,needf(p_struct->needf),x(p_struct->x),xminusa(p_struct->xminusa),bminusx(p_struct->bminusx),f(p_struct->f) +{ +} + +autogkstate& autogkstate::operator=(const autogkstate &rhs) +{ + if( this==&rhs ) + return *this; + _autogkstate_owner::operator=(rhs); + return *this; +} + +autogkstate::~autogkstate() +{ +} + +/************************************************************************* +Integration of a smooth function F(x) on a finite interval [a,b]. + +Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result +is calculated with accuracy close to the machine precision. + +Algorithm works well only with smooth integrands. It may be used with +continuous non-smooth integrands, but with less performance. + +It should never be used with integrands which have integrable singularities +at lower or upper limits - algorithm may crash. Use AutoGKSingular in such +cases. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmoothW, AutoGKSingular, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksmooth(const double a, const double b, autogkstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::autogksmooth(a, b, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Integration of a smooth function F(x) on a finite interval [a,b]. + +This subroutine is same as AutoGKSmooth(), but it guarantees that interval +[a,b] is partitioned into subintervals which have width at most XWidth. + +Subroutine can be used when integrating nearly-constant function with +narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth +subroutine can overlook them. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmooth, AutoGKSingular, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksmoothw(const double a, const double b, const double xwidth, autogkstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::autogksmoothw(a, b, xwidth, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Integration on a finite interval [A,B]. +Integrand have integrable singularities at A/B. + +F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known +alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates +from below can be used (but these estimates should be greater than -1 too). + +One of alpha/beta variables (or even both alpha/beta) may be equal to 0, +which means than function F(x) is non-singular at A/B. Anyway (singular at +bounds or not), function F(x) is supposed to be continuous on (A,B). + +Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result +is calculated with accuracy close to the machine precision. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + Alpha - power-law coefficient of the F(x) at A, + Alpha>-1 + Beta - power-law coefficient of the F(x) at B, + Beta>-1 + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmooth, AutoGKSmoothW, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksingular(const double a, const double b, const double alpha, const double beta, autogkstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::autogksingular(a, b, alpha, beta, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool autogkiteration(const autogkstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::autogkiteration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void autogkintegrate(autogkstate &state, + void (*func)(double x, double xminusa, double bminusx, double &y, void *ptr), + void *ptr){ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'autogkintegrate()' (func is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::autogkiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.x, state.xminusa, state.bminusx, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: unexpected error in 'autogkintegrate()'"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +Adaptive integration results + +Called after AutoGKIteration returned False. + +Input parameters: + State - algorithm state (used by AutoGKIteration). + +Output parameters: + V - integral(f(x)dx,a,b) + Rep - optimization report (see AutoGKReport description) + + -- ALGLIB -- + Copyright 14.11.2007 by Bochkanov Sergey +*************************************************************************/ +void autogkresults(const autogkstate &state, double &v, autogkreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::autogkresults(const_cast(state.c_ptr()), &v, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ + + + + +static ae_int_t autogk_maxsubintervals = 10000; +static void autogk_autogkinternalprepare(double a, + double b, + double eps, + double xwidth, + autogkinternalstate* state, + ae_state *_state); +static ae_bool autogk_autogkinternaliteration(autogkinternalstate* state, + ae_state *_state); +static void autogk_mheappop(/* Real */ ae_matrix* heap, + ae_int_t heapsize, + ae_int_t heapwidth, + ae_state *_state); +static void autogk_mheappush(/* Real */ ae_matrix* heap, + ae_int_t heapsize, + ae_int_t heapwidth, + ae_state *_state); +static void autogk_mheapresize(/* Real */ ae_matrix* heap, + ae_int_t* heapsize, + ae_int_t newheapsize, + ae_int_t heapwidth, + ae_state *_state); + + + + + +/************************************************************************* +Computation of nodes and weights for a Gauss quadrature formula + +The algorithm generates the N-point Gauss quadrature formula with weight +function given by coefficients alpha and beta of a recurrence relation +which generates a system of orthogonal polynomials: + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-1], alpha coefficients + Beta – array[0..N-1], beta coefficients + Zero-indexed element is not used and may be arbitrary. + Beta[I]>0. + Mu0 – zeroth moment of the weight function. + N – number of nodes of the quadrature formula, N>=1 + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgeneraterec(/* Real */ ae_vector* alpha, + /* Real */ ae_vector* beta, + double mu0, + ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector d; + ae_vector e; + ae_matrix z; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(x); + ae_vector_clear(w); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); + + if( n<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * Initialize + */ + ae_vector_set_length(&d, n, _state); + ae_vector_set_length(&e, n, _state); + for(i=1; i<=n-1; i++) + { + d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1]; + if( ae_fp_less_eq(beta->ptr.p_double[i],0) ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state); + } + d.ptr.p_double[n-1] = alpha->ptr.p_double[n-1]; + + /* + * EVD + */ + if( !smatrixtdevd(&d, &e, n, 3, &z, _state) ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Generate + */ + ae_vector_set_length(x, n, _state); + ae_vector_set_length(w, n, _state); + for(i=1; i<=n; i++) + { + x->ptr.p_double[i-1] = d.ptr.p_double[i-1]; + w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Computation of nodes and weights for a Gauss-Lobatto quadrature formula + +The algorithm generates the N-point Gauss-Lobatto quadrature formula with +weight function given by coefficients alpha and beta of a recurrence which +generates a system of orthogonal polynomials. + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-2], alpha coefficients + Beta – array[0..N-2], beta coefficients. + Zero-indexed element is not used, may be arbitrary. + Beta[I]>0 + Mu0 – zeroth moment of the weighting function. + A – left boundary of the integration interval. + B – right boundary of the integration interval. + N – number of nodes of the quadrature formula, N>=3 + (including the left and right boundary nodes). + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslobattorec(/* Real */ ae_vector* alpha, + /* Real */ ae_vector* beta, + double mu0, + double a, + double b, + ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _alpha; + ae_vector _beta; + ae_int_t i; + ae_vector d; + ae_vector e; + ae_matrix z; + double pim1a; + double pia; + double pim1b; + double pib; + double t; + double a11; + double a12; + double a21; + double a22; + double b1; + double b2; + double alph; + double bet; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_alpha, alpha, _state, ae_true); + alpha = &_alpha; + ae_vector_init_copy(&_beta, beta, _state, ae_true); + beta = &_beta; + *info = 0; + ae_vector_clear(x); + ae_vector_clear(w); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); + + if( n<=2 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * Initialize, D[1:N+1], E[1:N] + */ + n = n-2; + ae_vector_set_length(&d, n+2, _state); + ae_vector_set_length(&e, n+1, _state); + for(i=1; i<=n+1; i++) + { + d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1]; + } + for(i=1; i<=n; i++) + { + if( ae_fp_less_eq(beta->ptr.p_double[i],0) ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state); + } + + /* + * Caclulate Pn(a), Pn+1(a), Pn(b), Pn+1(b) + */ + beta->ptr.p_double[0] = 0; + pim1a = 0; + pia = 1; + pim1b = 0; + pib = 1; + for(i=1; i<=n+1; i++) + { + + /* + * Pi(a) + */ + t = (a-alpha->ptr.p_double[i-1])*pia-beta->ptr.p_double[i-1]*pim1a; + pim1a = pia; + pia = t; + + /* + * Pi(b) + */ + t = (b-alpha->ptr.p_double[i-1])*pib-beta->ptr.p_double[i-1]*pim1b; + pim1b = pib; + pib = t; + } + + /* + * Calculate alpha'(n+1), beta'(n+1) + */ + a11 = pia; + a12 = pim1a; + a21 = pib; + a22 = pim1b; + b1 = a*pia; + b2 = b*pib; + if( ae_fp_greater(ae_fabs(a11, _state),ae_fabs(a21, _state)) ) + { + a22 = a22-a12*a21/a11; + b2 = b2-b1*a21/a11; + bet = b2/a22; + alph = (b1-bet*a12)/a11; + } + else + { + a12 = a12-a22*a11/a21; + b1 = b1-b2*a11/a21; + bet = b1/a12; + alph = (b2-bet*a22)/a21; + } + if( ae_fp_less(bet,0) ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + d.ptr.p_double[n+1] = alph; + e.ptr.p_double[n] = ae_sqrt(bet, _state); + + /* + * EVD + */ + if( !smatrixtdevd(&d, &e, n+2, 3, &z, _state) ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Generate + */ + ae_vector_set_length(x, n+2, _state); + ae_vector_set_length(w, n+2, _state); + for(i=1; i<=n+2; i++) + { + x->ptr.p_double[i-1] = d.ptr.p_double[i-1]; + w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Computation of nodes and weights for a Gauss-Radau quadrature formula + +The algorithm generates the N-point Gauss-Radau quadrature formula with +weight function given by the coefficients alpha and beta of a recurrence +which generates a system of orthogonal polynomials. + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-2], alpha coefficients. + Beta – array[0..N-1], beta coefficients + Zero-indexed element is not used. + Beta[I]>0 + Mu0 – zeroth moment of the weighting function. + A – left boundary of the integration interval. + N – number of nodes of the quadrature formula, N>=2 + (including the left boundary node). + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategaussradaurec(/* Real */ ae_vector* alpha, + /* Real */ ae_vector* beta, + double mu0, + double a, + ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _alpha; + ae_vector _beta; + ae_int_t i; + ae_vector d; + ae_vector e; + ae_matrix z; + double polim1; + double poli; + double t; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_alpha, alpha, _state, ae_true); + alpha = &_alpha; + ae_vector_init_copy(&_beta, beta, _state, ae_true); + beta = &_beta; + *info = 0; + ae_vector_clear(x); + ae_vector_clear(w); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z, 0, 0, DT_REAL, _state, ae_true); + + if( n<2 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * Initialize, D[1:N], E[1:N] + */ + n = n-1; + ae_vector_set_length(&d, n+1, _state); + ae_vector_set_length(&e, n, _state); + for(i=1; i<=n; i++) + { + d.ptr.p_double[i-1] = alpha->ptr.p_double[i-1]; + if( ae_fp_less_eq(beta->ptr.p_double[i],0) ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + e.ptr.p_double[i-1] = ae_sqrt(beta->ptr.p_double[i], _state); + } + + /* + * Caclulate Pn(a), Pn-1(a), and D[N+1] + */ + beta->ptr.p_double[0] = 0; + polim1 = 0; + poli = 1; + for(i=1; i<=n; i++) + { + t = (a-alpha->ptr.p_double[i-1])*poli-beta->ptr.p_double[i-1]*polim1; + polim1 = poli; + poli = t; + } + d.ptr.p_double[n] = a-beta->ptr.p_double[n]*polim1/poli; + + /* + * EVD + */ + if( !smatrixtdevd(&d, &e, n+1, 3, &z, _state) ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Generate + */ + ae_vector_set_length(x, n+1, _state); + ae_vector_set_length(w, n+1, _state); + for(i=1; i<=n+1; i++) + { + x->ptr.p_double[i-1] = d.ptr.p_double[i-1]; + w->ptr.p_double[i-1] = mu0*ae_sqr(z.ptr.pp_double[0][i-1], _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N +nodes. + +INPUT PARAMETERS: + N - number of nodes, >=1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslegendre(ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector alpha; + ae_vector beta; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(x); + ae_vector_clear(w); + ae_vector_init(&alpha, 0, DT_REAL, _state, ae_true); + ae_vector_init(&beta, 0, DT_REAL, _state, ae_true); + + if( n<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&alpha, n, _state); + ae_vector_set_length(&beta, n, _state); + for(i=0; i<=n-1; i++) + { + alpha.ptr.p_double[i] = 0; + } + beta.ptr.p_double[0] = 2; + for(i=1; i<=n-1; i++) + { + beta.ptr.p_double[i] = 1/(4-1/ae_sqr(i, _state)); + } + gqgeneraterec(&alpha, &beta, beta.ptr.p_double[0], n, info, x, w, _state); + + /* + * test basic properties to detect errors + */ + if( *info>0 ) + { + if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) ) + { + *info = -4; + } + for(i=0; i<=n-2; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) + { + *info = -4; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight +function W(x)=Power(1-x,Alpha)*Power(1+x,Beta). + +INPUT PARAMETERS: + N - number of nodes, >=1 + Alpha - power-law coefficient, Alpha>-1 + Beta - power-law coefficient, Beta>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. Alpha or Beta are too close + to -1 to obtain weights/nodes with high enough + accuracy, or, may be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha/Beta was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategaussjacobi(ae_int_t n, + double alpha, + double beta, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector a; + ae_vector b; + double alpha2; + double beta2; + double apb; + double t; + ae_int_t i; + double s; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(x); + ae_vector_clear(w); + ae_vector_init(&a, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + + if( (n<1||ae_fp_less_eq(alpha,-1))||ae_fp_less_eq(beta,-1) ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&a, n, _state); + ae_vector_set_length(&b, n, _state); + apb = alpha+beta; + a.ptr.p_double[0] = (beta-alpha)/(apb+2); + t = (apb+1)*ae_log(2, _state)+lngamma(alpha+1, &s, _state)+lngamma(beta+1, &s, _state)-lngamma(apb+2, &s, _state); + if( ae_fp_greater(t,ae_log(ae_maxrealnumber, _state)) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + b.ptr.p_double[0] = ae_exp(t, _state); + if( n>1 ) + { + alpha2 = ae_sqr(alpha, _state); + beta2 = ae_sqr(beta, _state); + a.ptr.p_double[1] = (beta2-alpha2)/((apb+2)*(apb+4)); + b.ptr.p_double[1] = 4*(alpha+1)*(beta+1)/((apb+3)*ae_sqr(apb+2, _state)); + for(i=2; i<=n-1; i++) + { + a.ptr.p_double[i] = 0.25*(beta2-alpha2)/(i*i*(1+0.5*apb/i)*(1+0.5*(apb+2)/i)); + b.ptr.p_double[i] = 0.25*(1+alpha/i)*(1+beta/i)*(1+apb/i)/((1+0.5*(apb+1)/i)*(1+0.5*(apb-1)/i)*ae_sqr(1+0.5*apb/i, _state)); + } + } + gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state); + + /* + * test basic properties to detect errors + */ + if( *info>0 ) + { + if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) ) + { + *info = -4; + } + for(i=0; i<=n-2; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) + { + *info = -4; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with +weight function W(x)=Power(x,Alpha)*Exp(-x) + +INPUT PARAMETERS: + N - number of nodes, >=1 + Alpha - power-law coefficient, Alpha>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. Alpha is too close to -1 to + obtain weights/nodes with high enough accuracy + or, may be, N is too large. Try to use + multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslaguerre(ae_int_t n, + double alpha, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector a; + ae_vector b; + double t; + ae_int_t i; + double s; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(x); + ae_vector_clear(w); + ae_vector_init(&a, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + + if( n<1||ae_fp_less_eq(alpha,-1) ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&a, n, _state); + ae_vector_set_length(&b, n, _state); + a.ptr.p_double[0] = alpha+1; + t = lngamma(alpha+1, &s, _state); + if( ae_fp_greater_eq(t,ae_log(ae_maxrealnumber, _state)) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + b.ptr.p_double[0] = ae_exp(t, _state); + if( n>1 ) + { + for(i=1; i<=n-1; i++) + { + a.ptr.p_double[i] = 2*i+alpha+1; + b.ptr.p_double[i] = i*(i+alpha); + } + } + gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state); + + /* + * test basic properties to detect errors + */ + if( *info>0 ) + { + if( ae_fp_less(x->ptr.p_double[0],0) ) + { + *info = -4; + } + for(i=0; i<=n-2; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) + { + *info = -4; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with +weight function W(x)=Exp(-x*x) + +INPUT PARAMETERS: + N - number of nodes, >=1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. May be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausshermite(ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector a; + ae_vector b; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(x); + ae_vector_clear(w); + ae_vector_init(&a, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + + if( n<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&a, n, _state); + ae_vector_set_length(&b, n, _state); + for(i=0; i<=n-1; i++) + { + a.ptr.p_double[i] = 0; + } + b.ptr.p_double[0] = ae_sqrt(4*ae_atan(1, _state), _state); + if( n>1 ) + { + for(i=1; i<=n-1; i++) + { + b.ptr.p_double[i] = 0.5*i; + } + } + gqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, w, _state); + + /* + * test basic properties to detect errors + */ + if( *info>0 ) + { + for(i=0; i<=n-2; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) + { + *info = -4; + } + } + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +Computation of nodes and weights of a Gauss-Kronrod quadrature formula + +The algorithm generates the N-point Gauss-Kronrod quadrature formula with +weight function given by coefficients alpha and beta of a recurrence +relation which generates a system of orthogonal polynomials: + + P-1(x) = 0 + P0(x) = 1 + Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zero moment Mu0 + + Mu0 = integral(W(x)dx,a,b) + + +INPUT PARAMETERS: + Alpha – alpha coefficients, array[0..floor(3*K/2)]. + Beta – beta coefficients, array[0..ceil(3*K/2)]. + Beta[0] is not used and may be arbitrary. + Beta[I]>0. + Mu0 – zeroth moment of the weight function. + N – number of nodes of the Gauss-Kronrod quadrature formula, + N >= 3, + N = 2*K+1. + +OUTPUT PARAMETERS: + Info - error code: + * -5 no real and positive Gauss-Kronrod formula can + be created for such a weight function with a + given number of nodes. + * -4 N is too large, task may be ill conditioned - + x[i]=x[i+1] found. + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + -- ALGLIB -- + Copyright 08.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgeneraterec(/* Real */ ae_vector* alpha, + /* Real */ ae_vector* beta, + double mu0, + ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _alpha; + ae_vector _beta; + ae_vector ta; + ae_int_t i; + ae_int_t j; + ae_vector t; + ae_vector s; + ae_int_t wlen; + ae_int_t woffs; + double u; + ae_int_t m; + ae_int_t l; + ae_int_t k; + ae_vector xgtmp; + ae_vector wgtmp; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_alpha, alpha, _state, ae_true); + alpha = &_alpha; + ae_vector_init_copy(&_beta, beta, _state, ae_true); + beta = &_beta; + *info = 0; + ae_vector_clear(x); + ae_vector_clear(wkronrod); + ae_vector_clear(wgauss); + ae_vector_init(&ta, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&s, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xgtmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wgtmp, 0, DT_REAL, _state, ae_true); + + if( n%2!=1||n<3 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=ae_iceil((double)(3*(n/2))/(double)2, _state); i++) + { + if( ae_fp_less_eq(beta->ptr.p_double[i],0) ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + } + *info = 1; + + /* + * from external conventions about N/Beta/Mu0 to internal + */ + n = n/2; + beta->ptr.p_double[0] = mu0; + + /* + * Calculate Gauss nodes/weights, save them for later processing + */ + gqgeneraterec(alpha, beta, mu0, n, info, &xgtmp, &wgtmp, _state); + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Resize: + * * A from 0..floor(3*n/2) to 0..2*n + * * B from 0..ceil(3*n/2) to 0..2*n + */ + ae_vector_set_length(&ta, ae_ifloor((double)(3*n)/(double)2, _state)+1, _state); + ae_v_move(&ta.ptr.p_double[0], 1, &alpha->ptr.p_double[0], 1, ae_v_len(0,ae_ifloor((double)(3*n)/(double)2, _state))); + ae_vector_set_length(alpha, 2*n+1, _state); + ae_v_move(&alpha->ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,ae_ifloor((double)(3*n)/(double)2, _state))); + for(i=ae_ifloor((double)(3*n)/(double)2, _state)+1; i<=2*n; i++) + { + alpha->ptr.p_double[i] = 0; + } + ae_vector_set_length(&ta, ae_iceil((double)(3*n)/(double)2, _state)+1, _state); + ae_v_move(&ta.ptr.p_double[0], 1, &beta->ptr.p_double[0], 1, ae_v_len(0,ae_iceil((double)(3*n)/(double)2, _state))); + ae_vector_set_length(beta, 2*n+1, _state); + ae_v_move(&beta->ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,ae_iceil((double)(3*n)/(double)2, _state))); + for(i=ae_iceil((double)(3*n)/(double)2, _state)+1; i<=2*n; i++) + { + beta->ptr.p_double[i] = 0; + } + + /* + * Initialize T, S + */ + wlen = 2+n/2; + ae_vector_set_length(&t, wlen, _state); + ae_vector_set_length(&s, wlen, _state); + ae_vector_set_length(&ta, wlen, _state); + woffs = 1; + for(i=0; i<=wlen-1; i++) + { + t.ptr.p_double[i] = 0; + s.ptr.p_double[i] = 0; + } + + /* + * Algorithm from Dirk P. Laurie, "Calculation of Gauss-Kronrod quadrature rules", 1997. + */ + t.ptr.p_double[woffs+0] = beta->ptr.p_double[n+1]; + for(m=0; m<=n-2; m++) + { + u = 0; + for(k=(m+1)/2; k>=0; k--) + { + l = m-k; + u = u+(alpha->ptr.p_double[k+n+1]-alpha->ptr.p_double[l])*t.ptr.p_double[woffs+k]+beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+k-1]-beta->ptr.p_double[l]*s.ptr.p_double[woffs+k]; + s.ptr.p_double[woffs+k] = u; + } + ae_v_move(&ta.ptr.p_double[0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); + ae_v_move(&t.ptr.p_double[0], 1, &s.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); + ae_v_move(&s.ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); + } + for(j=n/2; j>=0; j--) + { + s.ptr.p_double[woffs+j] = s.ptr.p_double[woffs+j-1]; + } + for(m=n-1; m<=2*n-3; m++) + { + u = 0; + for(k=m+1-n; k<=(m-1)/2; k++) + { + l = m-k; + j = n-1-l; + u = u-(alpha->ptr.p_double[k+n+1]-alpha->ptr.p_double[l])*t.ptr.p_double[woffs+j]-beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+j]+beta->ptr.p_double[l]*s.ptr.p_double[woffs+j+1]; + s.ptr.p_double[woffs+j] = u; + } + if( m%2==0 ) + { + k = m/2; + alpha->ptr.p_double[k+n+1] = alpha->ptr.p_double[k]+(s.ptr.p_double[woffs+j]-beta->ptr.p_double[k+n+1]*s.ptr.p_double[woffs+j+1])/t.ptr.p_double[woffs+j+1]; + } + else + { + k = (m+1)/2; + beta->ptr.p_double[k+n+1] = s.ptr.p_double[woffs+j]/s.ptr.p_double[woffs+j+1]; + } + ae_v_move(&ta.ptr.p_double[0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); + ae_v_move(&t.ptr.p_double[0], 1, &s.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); + ae_v_move(&s.ptr.p_double[0], 1, &ta.ptr.p_double[0], 1, ae_v_len(0,wlen-1)); + } + alpha->ptr.p_double[2*n] = alpha->ptr.p_double[n-1]-beta->ptr.p_double[2*n]*s.ptr.p_double[woffs+0]/t.ptr.p_double[woffs+0]; + + /* + * calculation of Kronrod nodes and weights, unpacking of Gauss weights + */ + gqgeneraterec(alpha, beta, mu0, 2*n+1, info, x, wkronrod, _state); + if( *info==-2 ) + { + *info = -5; + } + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + for(i=0; i<=2*n-1; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) + { + *info = -4; + } + } + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + ae_vector_set_length(wgauss, 2*n+1, _state); + for(i=0; i<=2*n; i++) + { + wgauss->ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + wgauss->ptr.p_double[2*i+1] = wgtmp.ptr.p_double[i]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre +quadrature with N points. + +GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is +used depending on machine precision and number of nodes. + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgenerategausslegendre(ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + ae_state *_state) +{ + double eps; + + *info = 0; + ae_vector_clear(x); + ae_vector_clear(wkronrod); + ae_vector_clear(wgauss); + + if( ae_fp_greater(ae_machineepsilon,1.0E-32)&&(((((n==15||n==21)||n==31)||n==41)||n==51)||n==61) ) + { + *info = 1; + gkqlegendretbl(n, x, wkronrod, wgauss, &eps, _state); + } + else + { + gkqlegendrecalc(n, info, x, wkronrod, wgauss, _state); + } +} + + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi +quadrature on [-1,1] with weight function + + W(x)=Power(1-x,Alpha)*Power(1+x,Beta). + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + Alpha - power-law coefficient, Alpha>-1 + Beta - power-law coefficient, Beta>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -5 no real and positive Gauss-Kronrod formula can + be created for such a weight function with a + given number of nodes. + * -4 an error was detected when calculating + weights/nodes. Alpha or Beta are too close + to -1 to obtain weights/nodes with high enough + accuracy, or, may be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + * +2 OK, but quadrature rule have exterior nodes, + x[0]<-1 or x[n-1]>+1 + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgenerategaussjacobi(ae_int_t n, + double alpha, + double beta, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t clen; + ae_vector a; + ae_vector b; + double alpha2; + double beta2; + double apb; + double t; + ae_int_t i; + double s; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(x); + ae_vector_clear(wkronrod); + ae_vector_clear(wgauss); + ae_vector_init(&a, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + + if( n%2!=1||n<3 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( ae_fp_less_eq(alpha,-1)||ae_fp_less_eq(beta,-1) ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + clen = ae_iceil((double)(3*(n/2))/(double)2, _state)+1; + ae_vector_set_length(&a, clen, _state); + ae_vector_set_length(&b, clen, _state); + for(i=0; i<=clen-1; i++) + { + a.ptr.p_double[i] = 0; + } + apb = alpha+beta; + a.ptr.p_double[0] = (beta-alpha)/(apb+2); + t = (apb+1)*ae_log(2, _state)+lngamma(alpha+1, &s, _state)+lngamma(beta+1, &s, _state)-lngamma(apb+2, &s, _state); + if( ae_fp_greater(t,ae_log(ae_maxrealnumber, _state)) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + b.ptr.p_double[0] = ae_exp(t, _state); + if( clen>1 ) + { + alpha2 = ae_sqr(alpha, _state); + beta2 = ae_sqr(beta, _state); + a.ptr.p_double[1] = (beta2-alpha2)/((apb+2)*(apb+4)); + b.ptr.p_double[1] = 4*(alpha+1)*(beta+1)/((apb+3)*ae_sqr(apb+2, _state)); + for(i=2; i<=clen-1; i++) + { + a.ptr.p_double[i] = 0.25*(beta2-alpha2)/(i*i*(1+0.5*apb/i)*(1+0.5*(apb+2)/i)); + b.ptr.p_double[i] = 0.25*(1+alpha/i)*(1+beta/i)*(1+apb/i)/((1+0.5*(apb+1)/i)*(1+0.5*(apb-1)/i)*ae_sqr(1+0.5*apb/i, _state)); + } + } + gkqgeneraterec(&a, &b, b.ptr.p_double[0], n, info, x, wkronrod, wgauss, _state); + + /* + * test basic properties to detect errors + */ + if( *info>0 ) + { + if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) ) + { + *info = 2; + } + for(i=0; i<=n-2; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) + { + *info = -4; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes for quadrature with N points. + +Reduction to tridiagonal eigenproblem is used. + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqlegendrecalc(ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector alpha; + ae_vector beta; + ae_int_t alen; + ae_int_t blen; + double mu0; + ae_int_t k; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(x); + ae_vector_clear(wkronrod); + ae_vector_clear(wgauss); + ae_vector_init(&alpha, 0, DT_REAL, _state, ae_true); + ae_vector_init(&beta, 0, DT_REAL, _state, ae_true); + + if( n%2!=1||n<3 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + mu0 = 2; + alen = ae_ifloor((double)(3*(n/2))/(double)2, _state)+1; + blen = ae_iceil((double)(3*(n/2))/(double)2, _state)+1; + ae_vector_set_length(&alpha, alen, _state); + ae_vector_set_length(&beta, blen, _state); + for(k=0; k<=alen-1; k++) + { + alpha.ptr.p_double[k] = 0; + } + beta.ptr.p_double[0] = 2; + for(k=1; k<=blen-1; k++) + { + beta.ptr.p_double[k] = 1/(4-1/ae_sqr(k, _state)); + } + gkqgeneraterec(&alpha, &beta, mu0, n, info, x, wkronrod, wgauss, _state); + + /* + * test basic properties to detect errors + */ + if( *info>0 ) + { + if( ae_fp_less(x->ptr.p_double[0],-1)||ae_fp_greater(x->ptr.p_double[n-1],1) ) + { + *info = -4; + } + for(i=0; i<=n-2; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],x->ptr.p_double[i+1]) ) + { + *info = -4; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using +pre-calculated table. Nodes/weights were computed with accuracy up to +1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision +accuracy reduces to something about 2.0E-16 (depending on your compiler's +handling of long floating point constants). + +INPUT PARAMETERS: + N - number of Kronrod nodes. + N can be 15, 21, 31, 41, 51, 61. + +OUTPUT PARAMETERS: + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqlegendretbl(ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + double* eps, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t ng; + ae_vector p1; + ae_vector p2; + double tmp; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(x); + ae_vector_clear(wkronrod); + ae_vector_clear(wgauss); + *eps = 0; + ae_vector_init(&p1, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + ng = 0; + + /* + * Process + */ + ae_assert(((((n==15||n==21)||n==31)||n==41)||n==51)||n==61, "GKQNodesTbl: incorrect N!", _state); + ae_vector_set_length(x, n, _state); + ae_vector_set_length(wkronrod, n, _state); + ae_vector_set_length(wgauss, n, _state); + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = 0; + wkronrod->ptr.p_double[i] = 0; + wgauss->ptr.p_double[i] = 0; + } + *eps = ae_maxreal(ae_machineepsilon, 1.0E-32, _state); + if( n==15 ) + { + ng = 4; + wgauss->ptr.p_double[0] = 0.129484966168869693270611432679082; + wgauss->ptr.p_double[1] = 0.279705391489276667901467771423780; + wgauss->ptr.p_double[2] = 0.381830050505118944950369775488975; + wgauss->ptr.p_double[3] = 0.417959183673469387755102040816327; + x->ptr.p_double[0] = 0.991455371120812639206854697526329; + x->ptr.p_double[1] = 0.949107912342758524526189684047851; + x->ptr.p_double[2] = 0.864864423359769072789712788640926; + x->ptr.p_double[3] = 0.741531185599394439863864773280788; + x->ptr.p_double[4] = 0.586087235467691130294144838258730; + x->ptr.p_double[5] = 0.405845151377397166906606412076961; + x->ptr.p_double[6] = 0.207784955007898467600689403773245; + x->ptr.p_double[7] = 0.000000000000000000000000000000000; + wkronrod->ptr.p_double[0] = 0.022935322010529224963732008058970; + wkronrod->ptr.p_double[1] = 0.063092092629978553290700663189204; + wkronrod->ptr.p_double[2] = 0.104790010322250183839876322541518; + wkronrod->ptr.p_double[3] = 0.140653259715525918745189590510238; + wkronrod->ptr.p_double[4] = 0.169004726639267902826583426598550; + wkronrod->ptr.p_double[5] = 0.190350578064785409913256402421014; + wkronrod->ptr.p_double[6] = 0.204432940075298892414161999234649; + wkronrod->ptr.p_double[7] = 0.209482141084727828012999174891714; + } + if( n==21 ) + { + ng = 5; + wgauss->ptr.p_double[0] = 0.066671344308688137593568809893332; + wgauss->ptr.p_double[1] = 0.149451349150580593145776339657697; + wgauss->ptr.p_double[2] = 0.219086362515982043995534934228163; + wgauss->ptr.p_double[3] = 0.269266719309996355091226921569469; + wgauss->ptr.p_double[4] = 0.295524224714752870173892994651338; + x->ptr.p_double[0] = 0.995657163025808080735527280689003; + x->ptr.p_double[1] = 0.973906528517171720077964012084452; + x->ptr.p_double[2] = 0.930157491355708226001207180059508; + x->ptr.p_double[3] = 0.865063366688984510732096688423493; + x->ptr.p_double[4] = 0.780817726586416897063717578345042; + x->ptr.p_double[5] = 0.679409568299024406234327365114874; + x->ptr.p_double[6] = 0.562757134668604683339000099272694; + x->ptr.p_double[7] = 0.433395394129247190799265943165784; + x->ptr.p_double[8] = 0.294392862701460198131126603103866; + x->ptr.p_double[9] = 0.148874338981631210884826001129720; + x->ptr.p_double[10] = 0.000000000000000000000000000000000; + wkronrod->ptr.p_double[0] = 0.011694638867371874278064396062192; + wkronrod->ptr.p_double[1] = 0.032558162307964727478818972459390; + wkronrod->ptr.p_double[2] = 0.054755896574351996031381300244580; + wkronrod->ptr.p_double[3] = 0.075039674810919952767043140916190; + wkronrod->ptr.p_double[4] = 0.093125454583697605535065465083366; + wkronrod->ptr.p_double[5] = 0.109387158802297641899210590325805; + wkronrod->ptr.p_double[6] = 0.123491976262065851077958109831074; + wkronrod->ptr.p_double[7] = 0.134709217311473325928054001771707; + wkronrod->ptr.p_double[8] = 0.142775938577060080797094273138717; + wkronrod->ptr.p_double[9] = 0.147739104901338491374841515972068; + wkronrod->ptr.p_double[10] = 0.149445554002916905664936468389821; + } + if( n==31 ) + { + ng = 8; + wgauss->ptr.p_double[0] = 0.030753241996117268354628393577204; + wgauss->ptr.p_double[1] = 0.070366047488108124709267416450667; + wgauss->ptr.p_double[2] = 0.107159220467171935011869546685869; + wgauss->ptr.p_double[3] = 0.139570677926154314447804794511028; + wgauss->ptr.p_double[4] = 0.166269205816993933553200860481209; + wgauss->ptr.p_double[5] = 0.186161000015562211026800561866423; + wgauss->ptr.p_double[6] = 0.198431485327111576456118326443839; + wgauss->ptr.p_double[7] = 0.202578241925561272880620199967519; + x->ptr.p_double[0] = 0.998002298693397060285172840152271; + x->ptr.p_double[1] = 0.987992518020485428489565718586613; + x->ptr.p_double[2] = 0.967739075679139134257347978784337; + x->ptr.p_double[3] = 0.937273392400705904307758947710209; + x->ptr.p_double[4] = 0.897264532344081900882509656454496; + x->ptr.p_double[5] = 0.848206583410427216200648320774217; + x->ptr.p_double[6] = 0.790418501442465932967649294817947; + x->ptr.p_double[7] = 0.724417731360170047416186054613938; + x->ptr.p_double[8] = 0.650996741297416970533735895313275; + x->ptr.p_double[9] = 0.570972172608538847537226737253911; + x->ptr.p_double[10] = 0.485081863640239680693655740232351; + x->ptr.p_double[11] = 0.394151347077563369897207370981045; + x->ptr.p_double[12] = 0.299180007153168812166780024266389; + x->ptr.p_double[13] = 0.201194093997434522300628303394596; + x->ptr.p_double[14] = 0.101142066918717499027074231447392; + x->ptr.p_double[15] = 0.000000000000000000000000000000000; + wkronrod->ptr.p_double[0] = 0.005377479872923348987792051430128; + wkronrod->ptr.p_double[1] = 0.015007947329316122538374763075807; + wkronrod->ptr.p_double[2] = 0.025460847326715320186874001019653; + wkronrod->ptr.p_double[3] = 0.035346360791375846222037948478360; + wkronrod->ptr.p_double[4] = 0.044589751324764876608227299373280; + wkronrod->ptr.p_double[5] = 0.053481524690928087265343147239430; + wkronrod->ptr.p_double[6] = 0.062009567800670640285139230960803; + wkronrod->ptr.p_double[7] = 0.069854121318728258709520077099147; + wkronrod->ptr.p_double[8] = 0.076849680757720378894432777482659; + wkronrod->ptr.p_double[9] = 0.083080502823133021038289247286104; + wkronrod->ptr.p_double[10] = 0.088564443056211770647275443693774; + wkronrod->ptr.p_double[11] = 0.093126598170825321225486872747346; + wkronrod->ptr.p_double[12] = 0.096642726983623678505179907627589; + wkronrod->ptr.p_double[13] = 0.099173598721791959332393173484603; + wkronrod->ptr.p_double[14] = 0.100769845523875595044946662617570; + wkronrod->ptr.p_double[15] = 0.101330007014791549017374792767493; + } + if( n==41 ) + { + ng = 10; + wgauss->ptr.p_double[0] = 0.017614007139152118311861962351853; + wgauss->ptr.p_double[1] = 0.040601429800386941331039952274932; + wgauss->ptr.p_double[2] = 0.062672048334109063569506535187042; + wgauss->ptr.p_double[3] = 0.083276741576704748724758143222046; + wgauss->ptr.p_double[4] = 0.101930119817240435036750135480350; + wgauss->ptr.p_double[5] = 0.118194531961518417312377377711382; + wgauss->ptr.p_double[6] = 0.131688638449176626898494499748163; + wgauss->ptr.p_double[7] = 0.142096109318382051329298325067165; + wgauss->ptr.p_double[8] = 0.149172986472603746787828737001969; + wgauss->ptr.p_double[9] = 0.152753387130725850698084331955098; + x->ptr.p_double[0] = 0.998859031588277663838315576545863; + x->ptr.p_double[1] = 0.993128599185094924786122388471320; + x->ptr.p_double[2] = 0.981507877450250259193342994720217; + x->ptr.p_double[3] = 0.963971927277913791267666131197277; + x->ptr.p_double[4] = 0.940822633831754753519982722212443; + x->ptr.p_double[5] = 0.912234428251325905867752441203298; + x->ptr.p_double[6] = 0.878276811252281976077442995113078; + x->ptr.p_double[7] = 0.839116971822218823394529061701521; + x->ptr.p_double[8] = 0.795041428837551198350638833272788; + x->ptr.p_double[9] = 0.746331906460150792614305070355642; + x->ptr.p_double[10] = 0.693237656334751384805490711845932; + x->ptr.p_double[11] = 0.636053680726515025452836696226286; + x->ptr.p_double[12] = 0.575140446819710315342946036586425; + x->ptr.p_double[13] = 0.510867001950827098004364050955251; + x->ptr.p_double[14] = 0.443593175238725103199992213492640; + x->ptr.p_double[15] = 0.373706088715419560672548177024927; + x->ptr.p_double[16] = 0.301627868114913004320555356858592; + x->ptr.p_double[17] = 0.227785851141645078080496195368575; + x->ptr.p_double[18] = 0.152605465240922675505220241022678; + x->ptr.p_double[19] = 0.076526521133497333754640409398838; + x->ptr.p_double[20] = 0.000000000000000000000000000000000; + wkronrod->ptr.p_double[0] = 0.003073583718520531501218293246031; + wkronrod->ptr.p_double[1] = 0.008600269855642942198661787950102; + wkronrod->ptr.p_double[2] = 0.014626169256971252983787960308868; + wkronrod->ptr.p_double[3] = 0.020388373461266523598010231432755; + wkronrod->ptr.p_double[4] = 0.025882133604951158834505067096153; + wkronrod->ptr.p_double[5] = 0.031287306777032798958543119323801; + wkronrod->ptr.p_double[6] = 0.036600169758200798030557240707211; + wkronrod->ptr.p_double[7] = 0.041668873327973686263788305936895; + wkronrod->ptr.p_double[8] = 0.046434821867497674720231880926108; + wkronrod->ptr.p_double[9] = 0.050944573923728691932707670050345; + wkronrod->ptr.p_double[10] = 0.055195105348285994744832372419777; + wkronrod->ptr.p_double[11] = 0.059111400880639572374967220648594; + wkronrod->ptr.p_double[12] = 0.062653237554781168025870122174255; + wkronrod->ptr.p_double[13] = 0.065834597133618422111563556969398; + wkronrod->ptr.p_double[14] = 0.068648672928521619345623411885368; + wkronrod->ptr.p_double[15] = 0.071054423553444068305790361723210; + wkronrod->ptr.p_double[16] = 0.073030690332786667495189417658913; + wkronrod->ptr.p_double[17] = 0.074582875400499188986581418362488; + wkronrod->ptr.p_double[18] = 0.075704497684556674659542775376617; + wkronrod->ptr.p_double[19] = 0.076377867672080736705502835038061; + wkronrod->ptr.p_double[20] = 0.076600711917999656445049901530102; + } + if( n==51 ) + { + ng = 13; + wgauss->ptr.p_double[0] = 0.011393798501026287947902964113235; + wgauss->ptr.p_double[1] = 0.026354986615032137261901815295299; + wgauss->ptr.p_double[2] = 0.040939156701306312655623487711646; + wgauss->ptr.p_double[3] = 0.054904695975835191925936891540473; + wgauss->ptr.p_double[4] = 0.068038333812356917207187185656708; + wgauss->ptr.p_double[5] = 0.080140700335001018013234959669111; + wgauss->ptr.p_double[6] = 0.091028261982963649811497220702892; + wgauss->ptr.p_double[7] = 0.100535949067050644202206890392686; + wgauss->ptr.p_double[8] = 0.108519624474263653116093957050117; + wgauss->ptr.p_double[9] = 0.114858259145711648339325545869556; + wgauss->ptr.p_double[10] = 0.119455763535784772228178126512901; + wgauss->ptr.p_double[11] = 0.122242442990310041688959518945852; + wgauss->ptr.p_double[12] = 0.123176053726715451203902873079050; + x->ptr.p_double[0] = 0.999262104992609834193457486540341; + x->ptr.p_double[1] = 0.995556969790498097908784946893902; + x->ptr.p_double[2] = 0.988035794534077247637331014577406; + x->ptr.p_double[3] = 0.976663921459517511498315386479594; + x->ptr.p_double[4] = 0.961614986425842512418130033660167; + x->ptr.p_double[5] = 0.942974571228974339414011169658471; + x->ptr.p_double[6] = 0.920747115281701561746346084546331; + x->ptr.p_double[7] = 0.894991997878275368851042006782805; + x->ptr.p_double[8] = 0.865847065293275595448996969588340; + x->ptr.p_double[9] = 0.833442628760834001421021108693570; + x->ptr.p_double[10] = 0.797873797998500059410410904994307; + x->ptr.p_double[11] = 0.759259263037357630577282865204361; + x->ptr.p_double[12] = 0.717766406813084388186654079773298; + x->ptr.p_double[13] = 0.673566368473468364485120633247622; + x->ptr.p_double[14] = 0.626810099010317412788122681624518; + x->ptr.p_double[15] = 0.577662930241222967723689841612654; + x->ptr.p_double[16] = 0.526325284334719182599623778158010; + x->ptr.p_double[17] = 0.473002731445714960522182115009192; + x->ptr.p_double[18] = 0.417885382193037748851814394594572; + x->ptr.p_double[19] = 0.361172305809387837735821730127641; + x->ptr.p_double[20] = 0.303089538931107830167478909980339; + x->ptr.p_double[21] = 0.243866883720988432045190362797452; + x->ptr.p_double[22] = 0.183718939421048892015969888759528; + x->ptr.p_double[23] = 0.122864692610710396387359818808037; + x->ptr.p_double[24] = 0.061544483005685078886546392366797; + x->ptr.p_double[25] = 0.000000000000000000000000000000000; + wkronrod->ptr.p_double[0] = 0.001987383892330315926507851882843; + wkronrod->ptr.p_double[1] = 0.005561932135356713758040236901066; + wkronrod->ptr.p_double[2] = 0.009473973386174151607207710523655; + wkronrod->ptr.p_double[3] = 0.013236229195571674813656405846976; + wkronrod->ptr.p_double[4] = 0.016847817709128298231516667536336; + wkronrod->ptr.p_double[5] = 0.020435371145882835456568292235939; + wkronrod->ptr.p_double[6] = 0.024009945606953216220092489164881; + wkronrod->ptr.p_double[7] = 0.027475317587851737802948455517811; + wkronrod->ptr.p_double[8] = 0.030792300167387488891109020215229; + wkronrod->ptr.p_double[9] = 0.034002130274329337836748795229551; + wkronrod->ptr.p_double[10] = 0.037116271483415543560330625367620; + wkronrod->ptr.p_double[11] = 0.040083825504032382074839284467076; + wkronrod->ptr.p_double[12] = 0.042872845020170049476895792439495; + wkronrod->ptr.p_double[13] = 0.045502913049921788909870584752660; + wkronrod->ptr.p_double[14] = 0.047982537138836713906392255756915; + wkronrod->ptr.p_double[15] = 0.050277679080715671963325259433440; + wkronrod->ptr.p_double[16] = 0.052362885806407475864366712137873; + wkronrod->ptr.p_double[17] = 0.054251129888545490144543370459876; + wkronrod->ptr.p_double[18] = 0.055950811220412317308240686382747; + wkronrod->ptr.p_double[19] = 0.057437116361567832853582693939506; + wkronrod->ptr.p_double[20] = 0.058689680022394207961974175856788; + wkronrod->ptr.p_double[21] = 0.059720340324174059979099291932562; + wkronrod->ptr.p_double[22] = 0.060539455376045862945360267517565; + wkronrod->ptr.p_double[23] = 0.061128509717053048305859030416293; + wkronrod->ptr.p_double[24] = 0.061471189871425316661544131965264; + wkronrod->ptr.p_double[25] = 0.061580818067832935078759824240055; + } + if( n==61 ) + { + ng = 15; + wgauss->ptr.p_double[0] = 0.007968192496166605615465883474674; + wgauss->ptr.p_double[1] = 0.018466468311090959142302131912047; + wgauss->ptr.p_double[2] = 0.028784707883323369349719179611292; + wgauss->ptr.p_double[3] = 0.038799192569627049596801936446348; + wgauss->ptr.p_double[4] = 0.048402672830594052902938140422808; + wgauss->ptr.p_double[5] = 0.057493156217619066481721689402056; + wgauss->ptr.p_double[6] = 0.065974229882180495128128515115962; + wgauss->ptr.p_double[7] = 0.073755974737705206268243850022191; + wgauss->ptr.p_double[8] = 0.080755895229420215354694938460530; + wgauss->ptr.p_double[9] = 0.086899787201082979802387530715126; + wgauss->ptr.p_double[10] = 0.092122522237786128717632707087619; + wgauss->ptr.p_double[11] = 0.096368737174644259639468626351810; + wgauss->ptr.p_double[12] = 0.099593420586795267062780282103569; + wgauss->ptr.p_double[13] = 0.101762389748405504596428952168554; + wgauss->ptr.p_double[14] = 0.102852652893558840341285636705415; + x->ptr.p_double[0] = 0.999484410050490637571325895705811; + x->ptr.p_double[1] = 0.996893484074649540271630050918695; + x->ptr.p_double[2] = 0.991630996870404594858628366109486; + x->ptr.p_double[3] = 0.983668123279747209970032581605663; + x->ptr.p_double[4] = 0.973116322501126268374693868423707; + x->ptr.p_double[5] = 0.960021864968307512216871025581798; + x->ptr.p_double[6] = 0.944374444748559979415831324037439; + x->ptr.p_double[7] = 0.926200047429274325879324277080474; + x->ptr.p_double[8] = 0.905573307699907798546522558925958; + x->ptr.p_double[9] = 0.882560535792052681543116462530226; + x->ptr.p_double[10] = 0.857205233546061098958658510658944; + x->ptr.p_double[11] = 0.829565762382768397442898119732502; + x->ptr.p_double[12] = 0.799727835821839083013668942322683; + x->ptr.p_double[13] = 0.767777432104826194917977340974503; + x->ptr.p_double[14] = 0.733790062453226804726171131369528; + x->ptr.p_double[15] = 0.697850494793315796932292388026640; + x->ptr.p_double[16] = 0.660061064126626961370053668149271; + x->ptr.p_double[17] = 0.620526182989242861140477556431189; + x->ptr.p_double[18] = 0.579345235826361691756024932172540; + x->ptr.p_double[19] = 0.536624148142019899264169793311073; + x->ptr.p_double[20] = 0.492480467861778574993693061207709; + x->ptr.p_double[21] = 0.447033769538089176780609900322854; + x->ptr.p_double[22] = 0.400401254830394392535476211542661; + x->ptr.p_double[23] = 0.352704725530878113471037207089374; + x->ptr.p_double[24] = 0.304073202273625077372677107199257; + x->ptr.p_double[25] = 0.254636926167889846439805129817805; + x->ptr.p_double[26] = 0.204525116682309891438957671002025; + x->ptr.p_double[27] = 0.153869913608583546963794672743256; + x->ptr.p_double[28] = 0.102806937966737030147096751318001; + x->ptr.p_double[29] = 0.051471842555317695833025213166723; + x->ptr.p_double[30] = 0.000000000000000000000000000000000; + wkronrod->ptr.p_double[0] = 0.001389013698677007624551591226760; + wkronrod->ptr.p_double[1] = 0.003890461127099884051267201844516; + wkronrod->ptr.p_double[2] = 0.006630703915931292173319826369750; + wkronrod->ptr.p_double[3] = 0.009273279659517763428441146892024; + wkronrod->ptr.p_double[4] = 0.011823015253496341742232898853251; + wkronrod->ptr.p_double[5] = 0.014369729507045804812451432443580; + wkronrod->ptr.p_double[6] = 0.016920889189053272627572289420322; + wkronrod->ptr.p_double[7] = 0.019414141193942381173408951050128; + wkronrod->ptr.p_double[8] = 0.021828035821609192297167485738339; + wkronrod->ptr.p_double[9] = 0.024191162078080601365686370725232; + wkronrod->ptr.p_double[10] = 0.026509954882333101610601709335075; + wkronrod->ptr.p_double[11] = 0.028754048765041292843978785354334; + wkronrod->ptr.p_double[12] = 0.030907257562387762472884252943092; + wkronrod->ptr.p_double[13] = 0.032981447057483726031814191016854; + wkronrod->ptr.p_double[14] = 0.034979338028060024137499670731468; + wkronrod->ptr.p_double[15] = 0.036882364651821229223911065617136; + wkronrod->ptr.p_double[16] = 0.038678945624727592950348651532281; + wkronrod->ptr.p_double[17] = 0.040374538951535959111995279752468; + wkronrod->ptr.p_double[18] = 0.041969810215164246147147541285970; + wkronrod->ptr.p_double[19] = 0.043452539701356069316831728117073; + wkronrod->ptr.p_double[20] = 0.044814800133162663192355551616723; + wkronrod->ptr.p_double[21] = 0.046059238271006988116271735559374; + wkronrod->ptr.p_double[22] = 0.047185546569299153945261478181099; + wkronrod->ptr.p_double[23] = 0.048185861757087129140779492298305; + wkronrod->ptr.p_double[24] = 0.049055434555029778887528165367238; + wkronrod->ptr.p_double[25] = 0.049795683427074206357811569379942; + wkronrod->ptr.p_double[26] = 0.050405921402782346840893085653585; + wkronrod->ptr.p_double[27] = 0.050881795898749606492297473049805; + wkronrod->ptr.p_double[28] = 0.051221547849258772170656282604944; + wkronrod->ptr.p_double[29] = 0.051426128537459025933862879215781; + wkronrod->ptr.p_double[30] = 0.051494729429451567558340433647099; + } + + /* + * copy nodes + */ + for(i=n-1; i>=n/2; i--) + { + x->ptr.p_double[i] = -x->ptr.p_double[n-1-i]; + } + + /* + * copy Kronrod weights + */ + for(i=n-1; i>=n/2; i--) + { + wkronrod->ptr.p_double[i] = wkronrod->ptr.p_double[n-1-i]; + } + + /* + * copy Gauss weights + */ + for(i=ng-1; i>=0; i--) + { + wgauss->ptr.p_double[n-2-2*i] = wgauss->ptr.p_double[i]; + wgauss->ptr.p_double[1+2*i] = wgauss->ptr.p_double[i]; + } + for(i=0; i<=n/2; i++) + { + wgauss->ptr.p_double[2*i] = 0; + } + + /* + * reorder + */ + tagsort(x, n, &p1, &p2, _state); + for(i=0; i<=n-1; i++) + { + tmp = wkronrod->ptr.p_double[i]; + wkronrod->ptr.p_double[i] = wkronrod->ptr.p_double[p2.ptr.p_int[i]]; + wkronrod->ptr.p_double[p2.ptr.p_int[i]] = tmp; + tmp = wgauss->ptr.p_double[i]; + wgauss->ptr.p_double[i] = wgauss->ptr.p_double[p2.ptr.p_int[i]]; + wgauss->ptr.p_double[p2.ptr.p_int[i]] = tmp; + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +Integration of a smooth function F(x) on a finite interval [a,b]. + +Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result +is calculated with accuracy close to the machine precision. + +Algorithm works well only with smooth integrands. It may be used with +continuous non-smooth integrands, but with less performance. + +It should never be used with integrands which have integrable singularities +at lower or upper limits - algorithm may crash. Use AutoGKSingular in such +cases. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmoothW, AutoGKSingular, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksmooth(double a, + double b, + autogkstate* state, + ae_state *_state) +{ + + _autogkstate_clear(state); + + ae_assert(ae_isfinite(a, _state), "AutoGKSmooth: A is not finite!", _state); + ae_assert(ae_isfinite(b, _state), "AutoGKSmooth: B is not finite!", _state); + autogksmoothw(a, b, 0.0, state, _state); +} + + +/************************************************************************* +Integration of a smooth function F(x) on a finite interval [a,b]. + +This subroutine is same as AutoGKSmooth(), but it guarantees that interval +[a,b] is partitioned into subintervals which have width at most XWidth. + +Subroutine can be used when integrating nearly-constant function with +narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth +subroutine can overlook them. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmooth, AutoGKSingular, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksmoothw(double a, + double b, + double xwidth, + autogkstate* state, + ae_state *_state) +{ + + _autogkstate_clear(state); + + ae_assert(ae_isfinite(a, _state), "AutoGKSmoothW: A is not finite!", _state); + ae_assert(ae_isfinite(b, _state), "AutoGKSmoothW: B is not finite!", _state); + ae_assert(ae_isfinite(xwidth, _state), "AutoGKSmoothW: XWidth is not finite!", _state); + state->wrappermode = 0; + state->a = a; + state->b = b; + state->xwidth = xwidth; + state->needf = ae_false; + ae_vector_set_length(&state->rstate.ra, 10+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Integration on a finite interval [A,B]. +Integrand have integrable singularities at A/B. + +F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known +alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates +from below can be used (but these estimates should be greater than -1 too). + +One of alpha/beta variables (or even both alpha/beta) may be equal to 0, +which means than function F(x) is non-singular at A/B. Anyway (singular at +bounds or not), function F(x) is supposed to be continuous on (A,B). + +Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result +is calculated with accuracy close to the machine precision. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + Alpha - power-law coefficient of the F(x) at A, + Alpha>-1 + Beta - power-law coefficient of the F(x) at B, + Beta>-1 + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmooth, AutoGKSmoothW, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksingular(double a, + double b, + double alpha, + double beta, + autogkstate* state, + ae_state *_state) +{ + + _autogkstate_clear(state); + + ae_assert(ae_isfinite(a, _state), "AutoGKSingular: A is not finite!", _state); + ae_assert(ae_isfinite(b, _state), "AutoGKSingular: B is not finite!", _state); + ae_assert(ae_isfinite(alpha, _state), "AutoGKSingular: Alpha is not finite!", _state); + ae_assert(ae_isfinite(beta, _state), "AutoGKSingular: Beta is not finite!", _state); + state->wrappermode = 1; + state->a = a; + state->b = b; + state->alpha = alpha; + state->beta = beta; + state->xwidth = 0.0; + state->needf = ae_false; + ae_vector_set_length(&state->rstate.ra, 10+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 07.05.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool autogkiteration(autogkstate* state, ae_state *_state) +{ + double s; + double tmp; + double eps; + double a; + double b; + double x; + double t; + double alpha; + double beta; + double v1; + double v2; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + s = state->rstate.ra.ptr.p_double[0]; + tmp = state->rstate.ra.ptr.p_double[1]; + eps = state->rstate.ra.ptr.p_double[2]; + a = state->rstate.ra.ptr.p_double[3]; + b = state->rstate.ra.ptr.p_double[4]; + x = state->rstate.ra.ptr.p_double[5]; + t = state->rstate.ra.ptr.p_double[6]; + alpha = state->rstate.ra.ptr.p_double[7]; + beta = state->rstate.ra.ptr.p_double[8]; + v1 = state->rstate.ra.ptr.p_double[9]; + v2 = state->rstate.ra.ptr.p_double[10]; + } + else + { + s = -983; + tmp = -989; + eps = -834; + a = 900; + b = -287; + x = 364; + t = 214; + alpha = -338; + beta = -686; + v1 = 912; + v2 = 585; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + + /* + * Routine body + */ + eps = 0; + a = state->a; + b = state->b; + alpha = state->alpha; + beta = state->beta; + state->terminationtype = -1; + state->nfev = 0; + state->nintervals = 0; + + /* + * smooth function at a finite interval + */ + if( state->wrappermode!=0 ) + { + goto lbl_3; + } + + /* + * special case + */ + if( ae_fp_eq(a,b) ) + { + state->terminationtype = 1; + state->v = 0; + result = ae_false; + return result; + } + + /* + * general case + */ + autogk_autogkinternalprepare(a, b, eps, state->xwidth, &state->internalstate, _state); +lbl_5: + if( !autogk_autogkinternaliteration(&state->internalstate, _state) ) + { + goto lbl_6; + } + x = state->internalstate.x; + state->x = x; + state->xminusa = x-a; + state->bminusx = b-x; + state->needf = ae_true; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->needf = ae_false; + state->nfev = state->nfev+1; + state->internalstate.f = state->f; + goto lbl_5; +lbl_6: + state->v = state->internalstate.r; + state->terminationtype = state->internalstate.info; + state->nintervals = state->internalstate.heapused; + result = ae_false; + return result; +lbl_3: + + /* + * function with power-law singularities at the ends of a finite interval + */ + if( state->wrappermode!=1 ) + { + goto lbl_7; + } + + /* + * test coefficients + */ + if( ae_fp_less_eq(alpha,-1)||ae_fp_less_eq(beta,-1) ) + { + state->terminationtype = -1; + state->v = 0; + result = ae_false; + return result; + } + + /* + * special cases + */ + if( ae_fp_eq(a,b) ) + { + state->terminationtype = 1; + state->v = 0; + result = ae_false; + return result; + } + + /* + * reduction to general form + */ + if( ae_fp_less(a,b) ) + { + s = 1; + } + else + { + s = -1; + tmp = a; + a = b; + b = tmp; + tmp = alpha; + alpha = beta; + beta = tmp; + } + alpha = ae_minreal(alpha, 0, _state); + beta = ae_minreal(beta, 0, _state); + + /* + * first, integrate left half of [a,b]: + * integral(f(x)dx, a, (b+a)/2) = + * = 1/(1+alpha) * integral(t^(-alpha/(1+alpha))*f(a+t^(1/(1+alpha)))dt, 0, (0.5*(b-a))^(1+alpha)) + */ + autogk_autogkinternalprepare(0, ae_pow(0.5*(b-a), 1+alpha, _state), eps, state->xwidth, &state->internalstate, _state); +lbl_9: + if( !autogk_autogkinternaliteration(&state->internalstate, _state) ) + { + goto lbl_10; + } + + /* + * Fill State.X, State.XMinusA, State.BMinusX. + * Latter two are filled correctly even if Binternalstate.x; + t = ae_pow(x, 1/(1+alpha), _state); + state->x = a+t; + if( ae_fp_greater(s,0) ) + { + state->xminusa = t; + state->bminusx = b-(a+t); + } + else + { + state->xminusa = a+t-b; + state->bminusx = -t; + } + state->needf = ae_true; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->needf = ae_false; + if( ae_fp_neq(alpha,0) ) + { + state->internalstate.f = state->f*ae_pow(x, -alpha/(1+alpha), _state)/(1+alpha); + } + else + { + state->internalstate.f = state->f; + } + state->nfev = state->nfev+1; + goto lbl_9; +lbl_10: + v1 = state->internalstate.r; + state->nintervals = state->nintervals+state->internalstate.heapused; + + /* + * then, integrate right half of [a,b]: + * integral(f(x)dx, (b+a)/2, b) = + * = 1/(1+beta) * integral(t^(-beta/(1+beta))*f(b-t^(1/(1+beta)))dt, 0, (0.5*(b-a))^(1+beta)) + */ + autogk_autogkinternalprepare(0, ae_pow(0.5*(b-a), 1+beta, _state), eps, state->xwidth, &state->internalstate, _state); +lbl_11: + if( !autogk_autogkinternaliteration(&state->internalstate, _state) ) + { + goto lbl_12; + } + + /* + * Fill State.X, State.XMinusA, State.BMinusX. + * Latter two are filled correctly (X-A, B-X) even if Binternalstate.x; + t = ae_pow(x, 1/(1+beta), _state); + state->x = b-t; + if( ae_fp_greater(s,0) ) + { + state->xminusa = b-t-a; + state->bminusx = t; + } + else + { + state->xminusa = -t; + state->bminusx = a-(b-t); + } + state->needf = ae_true; + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + state->needf = ae_false; + if( ae_fp_neq(beta,0) ) + { + state->internalstate.f = state->f*ae_pow(x, -beta/(1+beta), _state)/(1+beta); + } + else + { + state->internalstate.f = state->f; + } + state->nfev = state->nfev+1; + goto lbl_11; +lbl_12: + v2 = state->internalstate.r; + state->nintervals = state->nintervals+state->internalstate.heapused; + + /* + * final result + */ + state->v = s*(v1+v2); + state->terminationtype = 1; + result = ae_false; + return result; +lbl_7: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ra.ptr.p_double[0] = s; + state->rstate.ra.ptr.p_double[1] = tmp; + state->rstate.ra.ptr.p_double[2] = eps; + state->rstate.ra.ptr.p_double[3] = a; + state->rstate.ra.ptr.p_double[4] = b; + state->rstate.ra.ptr.p_double[5] = x; + state->rstate.ra.ptr.p_double[6] = t; + state->rstate.ra.ptr.p_double[7] = alpha; + state->rstate.ra.ptr.p_double[8] = beta; + state->rstate.ra.ptr.p_double[9] = v1; + state->rstate.ra.ptr.p_double[10] = v2; + return result; +} + + +/************************************************************************* +Adaptive integration results + +Called after AutoGKIteration returned False. + +Input parameters: + State - algorithm state (used by AutoGKIteration). + +Output parameters: + V - integral(f(x)dx,a,b) + Rep - optimization report (see AutoGKReport description) + + -- ALGLIB -- + Copyright 14.11.2007 by Bochkanov Sergey +*************************************************************************/ +void autogkresults(autogkstate* state, + double* v, + autogkreport* rep, + ae_state *_state) +{ + + *v = 0; + _autogkreport_clear(rep); + + *v = state->v; + rep->terminationtype = state->terminationtype; + rep->nfev = state->nfev; + rep->nintervals = state->nintervals; +} + + +/************************************************************************* +Internal AutoGK subroutine +eps<0 - error +eps=0 - automatic eps selection + +width<0 - error +width=0 - no width requirements +*************************************************************************/ +static void autogk_autogkinternalprepare(double a, + double b, + double eps, + double xwidth, + autogkinternalstate* state, + ae_state *_state) +{ + + + + /* + * Save settings + */ + state->a = a; + state->b = b; + state->eps = eps; + state->xwidth = xwidth; + + /* + * Prepare RComm structure + */ + ae_vector_set_length(&state->rstate.ia, 3+1, _state); + ae_vector_set_length(&state->rstate.ra, 8+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Internal AutoGK subroutine +*************************************************************************/ +static ae_bool autogk_autogkinternaliteration(autogkinternalstate* state, + ae_state *_state) +{ + double c1; + double c2; + ae_int_t i; + ae_int_t j; + double intg; + double intk; + double inta; + double v; + double ta; + double tb; + ae_int_t ns; + double qeps; + ae_int_t info; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + i = state->rstate.ia.ptr.p_int[0]; + j = state->rstate.ia.ptr.p_int[1]; + ns = state->rstate.ia.ptr.p_int[2]; + info = state->rstate.ia.ptr.p_int[3]; + c1 = state->rstate.ra.ptr.p_double[0]; + c2 = state->rstate.ra.ptr.p_double[1]; + intg = state->rstate.ra.ptr.p_double[2]; + intk = state->rstate.ra.ptr.p_double[3]; + inta = state->rstate.ra.ptr.p_double[4]; + v = state->rstate.ra.ptr.p_double[5]; + ta = state->rstate.ra.ptr.p_double[6]; + tb = state->rstate.ra.ptr.p_double[7]; + qeps = state->rstate.ra.ptr.p_double[8]; + } + else + { + i = 497; + j = -271; + ns = -581; + info = 745; + c1 = -533; + c2 = -77; + intg = 678; + intk = -293; + inta = 316; + v = 647; + ta = -756; + tb = 830; + qeps = -871; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + + /* + * Routine body + */ + + /* + * initialize quadratures. + * use 15-point Gauss-Kronrod formula. + */ + state->n = 15; + gkqgenerategausslegendre(state->n, &info, &state->qn, &state->wk, &state->wg, _state); + if( info<0 ) + { + state->info = -5; + state->r = 0; + result = ae_false; + return result; + } + ae_vector_set_length(&state->wr, state->n, _state); + for(i=0; i<=state->n-1; i++) + { + if( i==0 ) + { + state->wr.ptr.p_double[i] = 0.5*ae_fabs(state->qn.ptr.p_double[1]-state->qn.ptr.p_double[0], _state); + continue; + } + if( i==state->n-1 ) + { + state->wr.ptr.p_double[state->n-1] = 0.5*ae_fabs(state->qn.ptr.p_double[state->n-1]-state->qn.ptr.p_double[state->n-2], _state); + continue; + } + state->wr.ptr.p_double[i] = 0.5*ae_fabs(state->qn.ptr.p_double[i-1]-state->qn.ptr.p_double[i+1], _state); + } + + /* + * special case + */ + if( ae_fp_eq(state->a,state->b) ) + { + state->info = 1; + state->r = 0; + result = ae_false; + return result; + } + + /* + * test parameters + */ + if( ae_fp_less(state->eps,0)||ae_fp_less(state->xwidth,0) ) + { + state->info = -1; + state->r = 0; + result = ae_false; + return result; + } + state->info = 1; + if( ae_fp_eq(state->eps,0) ) + { + state->eps = 100000*ae_machineepsilon; + } + + /* + * First, prepare heap + * * column 0 - absolute error + * * column 1 - integral of a F(x) (calculated using Kronrod extension nodes) + * * column 2 - integral of a |F(x)| (calculated using modified rect. method) + * * column 3 - left boundary of a subinterval + * * column 4 - right boundary of a subinterval + */ + if( ae_fp_neq(state->xwidth,0) ) + { + goto lbl_3; + } + + /* + * no maximum width requirements + * start from one big subinterval + */ + state->heapwidth = 5; + state->heapsize = 1; + state->heapused = 1; + ae_matrix_set_length(&state->heap, state->heapsize, state->heapwidth, _state); + c1 = 0.5*(state->b-state->a); + c2 = 0.5*(state->b+state->a); + intg = 0; + intk = 0; + inta = 0; + i = 0; +lbl_5: + if( i>state->n-1 ) + { + goto lbl_7; + } + + /* + * obtain F + */ + state->x = c1*state->qn.ptr.p_double[i]+c2; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + v = state->f; + + /* + * Gauss-Kronrod formula + */ + intk = intk+v*state->wk.ptr.p_double[i]; + if( i%2==1 ) + { + intg = intg+v*state->wg.ptr.p_double[i]; + } + + /* + * Integral |F(x)| + * Use rectangles method + */ + inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i]; + i = i+1; + goto lbl_5; +lbl_7: + intk = intk*(state->b-state->a)*0.5; + intg = intg*(state->b-state->a)*0.5; + inta = inta*(state->b-state->a)*0.5; + state->heap.ptr.pp_double[0][0] = ae_fabs(intg-intk, _state); + state->heap.ptr.pp_double[0][1] = intk; + state->heap.ptr.pp_double[0][2] = inta; + state->heap.ptr.pp_double[0][3] = state->a; + state->heap.ptr.pp_double[0][4] = state->b; + state->sumerr = state->heap.ptr.pp_double[0][0]; + state->sumabs = ae_fabs(inta, _state); + goto lbl_4; +lbl_3: + + /* + * maximum subinterval should be no more than XWidth. + * so we create Ceil((B-A)/XWidth)+1 small subintervals + */ + ns = ae_iceil(ae_fabs(state->b-state->a, _state)/state->xwidth, _state)+1; + state->heapsize = ns; + state->heapused = ns; + state->heapwidth = 5; + ae_matrix_set_length(&state->heap, state->heapsize, state->heapwidth, _state); + state->sumerr = 0; + state->sumabs = 0; + j = 0; +lbl_8: + if( j>ns-1 ) + { + goto lbl_10; + } + ta = state->a+j*(state->b-state->a)/ns; + tb = state->a+(j+1)*(state->b-state->a)/ns; + c1 = 0.5*(tb-ta); + c2 = 0.5*(tb+ta); + intg = 0; + intk = 0; + inta = 0; + i = 0; +lbl_11: + if( i>state->n-1 ) + { + goto lbl_13; + } + + /* + * obtain F + */ + state->x = c1*state->qn.ptr.p_double[i]+c2; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + v = state->f; + + /* + * Gauss-Kronrod formula + */ + intk = intk+v*state->wk.ptr.p_double[i]; + if( i%2==1 ) + { + intg = intg+v*state->wg.ptr.p_double[i]; + } + + /* + * Integral |F(x)| + * Use rectangles method + */ + inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i]; + i = i+1; + goto lbl_11; +lbl_13: + intk = intk*(tb-ta)*0.5; + intg = intg*(tb-ta)*0.5; + inta = inta*(tb-ta)*0.5; + state->heap.ptr.pp_double[j][0] = ae_fabs(intg-intk, _state); + state->heap.ptr.pp_double[j][1] = intk; + state->heap.ptr.pp_double[j][2] = inta; + state->heap.ptr.pp_double[j][3] = ta; + state->heap.ptr.pp_double[j][4] = tb; + state->sumerr = state->sumerr+state->heap.ptr.pp_double[j][0]; + state->sumabs = state->sumabs+ae_fabs(inta, _state); + j = j+1; + goto lbl_8; +lbl_10: +lbl_4: + + /* + * method iterations + */ +lbl_14: + if( ae_false ) + { + goto lbl_15; + } + + /* + * additional memory if needed + */ + if( state->heapused==state->heapsize ) + { + autogk_mheapresize(&state->heap, &state->heapsize, 4*state->heapsize, state->heapwidth, _state); + } + + /* + * TODO: every 20 iterations recalculate errors/sums + */ + if( ae_fp_less_eq(state->sumerr,state->eps*state->sumabs)||state->heapused>=autogk_maxsubintervals ) + { + state->r = 0; + for(j=0; j<=state->heapused-1; j++) + { + state->r = state->r+state->heap.ptr.pp_double[j][1]; + } + result = ae_false; + return result; + } + + /* + * Exclude interval with maximum absolute error + */ + autogk_mheappop(&state->heap, state->heapused, state->heapwidth, _state); + state->sumerr = state->sumerr-state->heap.ptr.pp_double[state->heapused-1][0]; + state->sumabs = state->sumabs-state->heap.ptr.pp_double[state->heapused-1][2]; + + /* + * Divide interval, create subintervals + */ + ta = state->heap.ptr.pp_double[state->heapused-1][3]; + tb = state->heap.ptr.pp_double[state->heapused-1][4]; + state->heap.ptr.pp_double[state->heapused-1][3] = ta; + state->heap.ptr.pp_double[state->heapused-1][4] = 0.5*(ta+tb); + state->heap.ptr.pp_double[state->heapused][3] = 0.5*(ta+tb); + state->heap.ptr.pp_double[state->heapused][4] = tb; + j = state->heapused-1; +lbl_16: + if( j>state->heapused ) + { + goto lbl_18; + } + c1 = 0.5*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3]); + c2 = 0.5*(state->heap.ptr.pp_double[j][4]+state->heap.ptr.pp_double[j][3]); + intg = 0; + intk = 0; + inta = 0; + i = 0; +lbl_19: + if( i>state->n-1 ) + { + goto lbl_21; + } + + /* + * F(x) + */ + state->x = c1*state->qn.ptr.p_double[i]+c2; + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + v = state->f; + + /* + * Gauss-Kronrod formula + */ + intk = intk+v*state->wk.ptr.p_double[i]; + if( i%2==1 ) + { + intg = intg+v*state->wg.ptr.p_double[i]; + } + + /* + * Integral |F(x)| + * Use rectangles method + */ + inta = inta+ae_fabs(v, _state)*state->wr.ptr.p_double[i]; + i = i+1; + goto lbl_19; +lbl_21: + intk = intk*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5; + intg = intg*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5; + inta = inta*(state->heap.ptr.pp_double[j][4]-state->heap.ptr.pp_double[j][3])*0.5; + state->heap.ptr.pp_double[j][0] = ae_fabs(intg-intk, _state); + state->heap.ptr.pp_double[j][1] = intk; + state->heap.ptr.pp_double[j][2] = inta; + state->sumerr = state->sumerr+state->heap.ptr.pp_double[j][0]; + state->sumabs = state->sumabs+state->heap.ptr.pp_double[j][2]; + j = j+1; + goto lbl_16; +lbl_18: + autogk_mheappush(&state->heap, state->heapused-1, state->heapwidth, _state); + autogk_mheappush(&state->heap, state->heapused, state->heapwidth, _state); + state->heapused = state->heapused+1; + goto lbl_14; +lbl_15: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = i; + state->rstate.ia.ptr.p_int[1] = j; + state->rstate.ia.ptr.p_int[2] = ns; + state->rstate.ia.ptr.p_int[3] = info; + state->rstate.ra.ptr.p_double[0] = c1; + state->rstate.ra.ptr.p_double[1] = c2; + state->rstate.ra.ptr.p_double[2] = intg; + state->rstate.ra.ptr.p_double[3] = intk; + state->rstate.ra.ptr.p_double[4] = inta; + state->rstate.ra.ptr.p_double[5] = v; + state->rstate.ra.ptr.p_double[6] = ta; + state->rstate.ra.ptr.p_double[7] = tb; + state->rstate.ra.ptr.p_double[8] = qeps; + return result; +} + + +static void autogk_mheappop(/* Real */ ae_matrix* heap, + ae_int_t heapsize, + ae_int_t heapwidth, + ae_state *_state) +{ + ae_int_t i; + ae_int_t p; + double t; + ae_int_t maxcp; + + + if( heapsize==1 ) + { + return; + } + for(i=0; i<=heapwidth-1; i++) + { + t = heap->ptr.pp_double[heapsize-1][i]; + heap->ptr.pp_double[heapsize-1][i] = heap->ptr.pp_double[0][i]; + heap->ptr.pp_double[0][i] = t; + } + p = 0; + while(2*p+1ptr.pp_double[2*p+2][0],heap->ptr.pp_double[2*p+1][0]) ) + { + maxcp = 2*p+2; + } + } + if( ae_fp_less(heap->ptr.pp_double[p][0],heap->ptr.pp_double[maxcp][0]) ) + { + for(i=0; i<=heapwidth-1; i++) + { + t = heap->ptr.pp_double[p][i]; + heap->ptr.pp_double[p][i] = heap->ptr.pp_double[maxcp][i]; + heap->ptr.pp_double[maxcp][i] = t; + } + p = maxcp; + } + else + { + break; + } + } +} + + +static void autogk_mheappush(/* Real */ ae_matrix* heap, + ae_int_t heapsize, + ae_int_t heapwidth, + ae_state *_state) +{ + ae_int_t i; + ae_int_t p; + double t; + ae_int_t parent; + + + if( heapsize==0 ) + { + return; + } + p = heapsize; + while(p!=0) + { + parent = (p-1)/2; + if( ae_fp_greater(heap->ptr.pp_double[p][0],heap->ptr.pp_double[parent][0]) ) + { + for(i=0; i<=heapwidth-1; i++) + { + t = heap->ptr.pp_double[p][i]; + heap->ptr.pp_double[p][i] = heap->ptr.pp_double[parent][i]; + heap->ptr.pp_double[parent][i] = t; + } + p = parent; + } + else + { + break; + } + } +} + + +static void autogk_mheapresize(/* Real */ ae_matrix* heap, + ae_int_t* heapsize, + ae_int_t newheapsize, + ae_int_t heapwidth, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix tmp; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init(&tmp, 0, 0, DT_REAL, _state, ae_true); + + ae_matrix_set_length(&tmp, *heapsize, heapwidth, _state); + for(i=0; i<=*heapsize-1; i++) + { + ae_v_move(&tmp.ptr.pp_double[i][0], 1, &heap->ptr.pp_double[i][0], 1, ae_v_len(0,heapwidth-1)); + } + ae_matrix_set_length(heap, newheapsize, heapwidth, _state); + for(i=0; i<=*heapsize-1; i++) + { + ae_v_move(&heap->ptr.pp_double[i][0], 1, &tmp.ptr.pp_double[i][0], 1, ae_v_len(0,heapwidth-1)); + } + *heapsize = newheapsize; + ae_frame_leave(_state); +} + + +ae_bool _autogkreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + autogkreport *p = (autogkreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _autogkreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + autogkreport *dst = (autogkreport*)_dst; + autogkreport *src = (autogkreport*)_src; + dst->terminationtype = src->terminationtype; + dst->nfev = src->nfev; + dst->nintervals = src->nintervals; + return ae_true; +} + + +void _autogkreport_clear(void* _p) +{ + autogkreport *p = (autogkreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _autogkreport_destroy(void* _p) +{ + autogkreport *p = (autogkreport*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _autogkinternalstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + autogkinternalstate *p = (autogkinternalstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->heap, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->qn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->wg, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->wk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->wr, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _autogkinternalstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + autogkinternalstate *dst = (autogkinternalstate*)_dst; + autogkinternalstate *src = (autogkinternalstate*)_src; + dst->a = src->a; + dst->b = src->b; + dst->eps = src->eps; + dst->xwidth = src->xwidth; + dst->x = src->x; + dst->f = src->f; + dst->info = src->info; + dst->r = src->r; + if( !ae_matrix_init_copy(&dst->heap, &src->heap, _state, make_automatic) ) + return ae_false; + dst->heapsize = src->heapsize; + dst->heapwidth = src->heapwidth; + dst->heapused = src->heapused; + dst->sumerr = src->sumerr; + dst->sumabs = src->sumabs; + if( !ae_vector_init_copy(&dst->qn, &src->qn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->wg, &src->wg, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->wk, &src->wk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->wr, &src->wr, _state, make_automatic) ) + return ae_false; + dst->n = src->n; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _autogkinternalstate_clear(void* _p) +{ + autogkinternalstate *p = (autogkinternalstate*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->heap); + ae_vector_clear(&p->qn); + ae_vector_clear(&p->wg); + ae_vector_clear(&p->wk); + ae_vector_clear(&p->wr); + _rcommstate_clear(&p->rstate); +} + + +void _autogkinternalstate_destroy(void* _p) +{ + autogkinternalstate *p = (autogkinternalstate*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->heap); + ae_vector_destroy(&p->qn); + ae_vector_destroy(&p->wg); + ae_vector_destroy(&p->wk); + ae_vector_destroy(&p->wr); + _rcommstate_destroy(&p->rstate); +} + + +ae_bool _autogkstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + autogkstate *p = (autogkstate*)_p; + ae_touch_ptr((void*)p); + if( !_autogkinternalstate_init(&p->internalstate, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _autogkstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + autogkstate *dst = (autogkstate*)_dst; + autogkstate *src = (autogkstate*)_src; + dst->a = src->a; + dst->b = src->b; + dst->alpha = src->alpha; + dst->beta = src->beta; + dst->xwidth = src->xwidth; + dst->x = src->x; + dst->xminusa = src->xminusa; + dst->bminusx = src->bminusx; + dst->needf = src->needf; + dst->f = src->f; + dst->wrappermode = src->wrappermode; + if( !_autogkinternalstate_init_copy(&dst->internalstate, &src->internalstate, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + dst->v = src->v; + dst->terminationtype = src->terminationtype; + dst->nfev = src->nfev; + dst->nintervals = src->nintervals; + return ae_true; +} + + +void _autogkstate_clear(void* _p) +{ + autogkstate *p = (autogkstate*)_p; + ae_touch_ptr((void*)p); + _autogkinternalstate_clear(&p->internalstate); + _rcommstate_clear(&p->rstate); +} + + +void _autogkstate_destroy(void* _p) +{ + autogkstate *p = (autogkstate*)_p; + ae_touch_ptr((void*)p); + _autogkinternalstate_destroy(&p->internalstate); + _rcommstate_destroy(&p->rstate); +} + + + +} + diff --git a/psdlag/src/integration.h b/psdlag/src/integration.h new file mode 100644 index 0000000..b0f25c3 --- /dev/null +++ b/psdlag/src/integration.h @@ -0,0 +1,837 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _integration_pkg_h +#define _integration_pkg_h +#include "ap.h" +#include "alglibinternal.h" +#include "linalg.h" +#include "specialfunctions.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + ae_int_t terminationtype; + ae_int_t nfev; + ae_int_t nintervals; +} autogkreport; +typedef struct +{ + double a; + double b; + double eps; + double xwidth; + double x; + double f; + ae_int_t info; + double r; + ae_matrix heap; + ae_int_t heapsize; + ae_int_t heapwidth; + ae_int_t heapused; + double sumerr; + double sumabs; + ae_vector qn; + ae_vector wg; + ae_vector wk; + ae_vector wr; + ae_int_t n; + rcommstate rstate; +} autogkinternalstate; +typedef struct +{ + double a; + double b; + double alpha; + double beta; + double xwidth; + double x; + double xminusa; + double bminusx; + ae_bool needf; + double f; + ae_int_t wrappermode; + autogkinternalstate internalstate; + rcommstate rstate; + double v; + ae_int_t terminationtype; + ae_int_t nfev; + ae_int_t nintervals; +} autogkstate; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + + + + +/************************************************************************* +Integration report: +* TerminationType = completetion code: + * -5 non-convergence of Gauss-Kronrod nodes + calculation subroutine. + * -1 incorrect parameters were specified + * 1 OK +* Rep.NFEV countains number of function calculations +* Rep.NIntervals contains number of intervals [a,b] + was partitioned into. +*************************************************************************/ +class _autogkreport_owner +{ +public: + _autogkreport_owner(); + _autogkreport_owner(const _autogkreport_owner &rhs); + _autogkreport_owner& operator=(const _autogkreport_owner &rhs); + virtual ~_autogkreport_owner(); + alglib_impl::autogkreport* c_ptr(); + alglib_impl::autogkreport* c_ptr() const; +protected: + alglib_impl::autogkreport *p_struct; +}; +class autogkreport : public _autogkreport_owner +{ +public: + autogkreport(); + autogkreport(const autogkreport &rhs); + autogkreport& operator=(const autogkreport &rhs); + virtual ~autogkreport(); + ae_int_t &terminationtype; + ae_int_t &nfev; + ae_int_t &nintervals; + +}; + + +/************************************************************************* +This structure stores state of the integration algorithm. + +Although this class has public fields, they are not intended for external +use. You should use ALGLIB functions to work with this class: +* autogksmooth()/AutoGKSmoothW()/... to create objects +* autogkintegrate() to begin integration +* autogkresults() to get results +*************************************************************************/ +class _autogkstate_owner +{ +public: + _autogkstate_owner(); + _autogkstate_owner(const _autogkstate_owner &rhs); + _autogkstate_owner& operator=(const _autogkstate_owner &rhs); + virtual ~_autogkstate_owner(); + alglib_impl::autogkstate* c_ptr(); + alglib_impl::autogkstate* c_ptr() const; +protected: + alglib_impl::autogkstate *p_struct; +}; +class autogkstate : public _autogkstate_owner +{ +public: + autogkstate(); + autogkstate(const autogkstate &rhs); + autogkstate& operator=(const autogkstate &rhs); + virtual ~autogkstate(); + ae_bool &needf; + double &x; + double &xminusa; + double &bminusx; + double &f; + +}; + +/************************************************************************* +Computation of nodes and weights for a Gauss quadrature formula + +The algorithm generates the N-point Gauss quadrature formula with weight +function given by coefficients alpha and beta of a recurrence relation +which generates a system of orthogonal polynomials: + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-1], alpha coefficients + Beta – array[0..N-1], beta coefficients + Zero-indexed element is not used and may be arbitrary. + Beta[I]>0. + Mu0 – zeroth moment of the weight function. + N – number of nodes of the quadrature formula, N>=1 + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); + + +/************************************************************************* +Computation of nodes and weights for a Gauss-Lobatto quadrature formula + +The algorithm generates the N-point Gauss-Lobatto quadrature formula with +weight function given by coefficients alpha and beta of a recurrence which +generates a system of orthogonal polynomials. + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-2], alpha coefficients + Beta – array[0..N-2], beta coefficients. + Zero-indexed element is not used, may be arbitrary. + Beta[I]>0 + Mu0 – zeroth moment of the weighting function. + A – left boundary of the integration interval. + B – right boundary of the integration interval. + N – number of nodes of the quadrature formula, N>=3 + (including the left and right boundary nodes). + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslobattorec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const double b, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); + + +/************************************************************************* +Computation of nodes and weights for a Gauss-Radau quadrature formula + +The algorithm generates the N-point Gauss-Radau quadrature formula with +weight function given by the coefficients alpha and beta of a recurrence +which generates a system of orthogonal polynomials. + +P-1(x) = 0 +P0(x) = 1 +Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zeroth moment Mu0 + +Mu0 = integral(W(x)dx,a,b) + +INPUT PARAMETERS: + Alpha – array[0..N-2], alpha coefficients. + Beta – array[0..N-1], beta coefficients + Zero-indexed element is not used. + Beta[I]>0 + Mu0 – zeroth moment of the weighting function. + A – left boundary of the integration interval. + N – number of nodes of the quadrature formula, N>=2 + (including the left boundary node). + +OUTPUT PARAMETERS: + Info - error code: + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * 1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 2005-2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategaussradaurec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const double a, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); + + +/************************************************************************* +Returns nodes/weights for Gauss-Legendre quadrature on [-1,1] with N +nodes. + +INPUT PARAMETERS: + N - number of nodes, >=1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); + + +/************************************************************************* +Returns nodes/weights for Gauss-Jacobi quadrature on [-1,1] with weight +function W(x)=Power(1-x,Alpha)*Power(1+x,Beta). + +INPUT PARAMETERS: + N - number of nodes, >=1 + Alpha - power-law coefficient, Alpha>-1 + Beta - power-law coefficient, Beta>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. Alpha or Beta are too close + to -1 to obtain weights/nodes with high enough + accuracy, or, may be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha/Beta was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &w); + + +/************************************************************************* +Returns nodes/weights for Gauss-Laguerre quadrature on [0,+inf) with +weight function W(x)=Power(x,Alpha)*Exp(-x) + +INPUT PARAMETERS: + N - number of nodes, >=1 + Alpha - power-law coefficient, Alpha>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. Alpha is too close to -1 to + obtain weights/nodes with high enough accuracy + or, may be, N is too large. Try to use + multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausslaguerre(const ae_int_t n, const double alpha, ae_int_t &info, real_1d_array &x, real_1d_array &w); + + +/************************************************************************* +Returns nodes/weights for Gauss-Hermite quadrature on (-inf,+inf) with +weight function W(x)=Exp(-x*x) + +INPUT PARAMETERS: + N - number of nodes, >=1 + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. May be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N/Alpha was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + W - array[0..N-1] - array of quadrature weights. + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gqgenerategausshermite(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &w); + +/************************************************************************* +Computation of nodes and weights of a Gauss-Kronrod quadrature formula + +The algorithm generates the N-point Gauss-Kronrod quadrature formula with +weight function given by coefficients alpha and beta of a recurrence +relation which generates a system of orthogonal polynomials: + + P-1(x) = 0 + P0(x) = 1 + Pn+1(x) = (x-alpha(n))*Pn(x) - beta(n)*Pn-1(x) + +and zero moment Mu0 + + Mu0 = integral(W(x)dx,a,b) + + +INPUT PARAMETERS: + Alpha – alpha coefficients, array[0..floor(3*K/2)]. + Beta – beta coefficients, array[0..ceil(3*K/2)]. + Beta[0] is not used and may be arbitrary. + Beta[I]>0. + Mu0 – zeroth moment of the weight function. + N – number of nodes of the Gauss-Kronrod quadrature formula, + N >= 3, + N = 2*K+1. + +OUTPUT PARAMETERS: + Info - error code: + * -5 no real and positive Gauss-Kronrod formula can + be created for such a weight function with a + given number of nodes. + * -4 N is too large, task may be ill conditioned - + x[i]=x[i+1] found. + * -3 internal eigenproblem solver hasn't converged + * -2 Beta[i]<=0 + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, + in ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + -- ALGLIB -- + Copyright 08.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgeneraterec(const real_1d_array &alpha, const real_1d_array &beta, const double mu0, const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss); + + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Legendre +quadrature with N points. + +GKQLegendreCalc (calculation) or GKQLegendreTbl (precomputed table) is +used depending on machine precision and number of nodes. + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgenerategausslegendre(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss); + + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes/weights for Gauss-Jacobi +quadrature on [-1,1] with weight function + + W(x)=Power(1-x,Alpha)*Power(1+x,Beta). + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + Alpha - power-law coefficient, Alpha>-1 + Beta - power-law coefficient, Beta>-1 + +OUTPUT PARAMETERS: + Info - error code: + * -5 no real and positive Gauss-Kronrod formula can + be created for such a weight function with a + given number of nodes. + * -4 an error was detected when calculating + weights/nodes. Alpha or Beta are too close + to -1 to obtain weights/nodes with high enough + accuracy, or, may be, N is too large. Try to + use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + * +2 OK, but quadrature rule have exterior nodes, + x[0]<-1 or x[n-1]>+1 + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqgenerategaussjacobi(const ae_int_t n, const double alpha, const double beta, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss); + + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes for quadrature with N points. + +Reduction to tridiagonal eigenproblem is used. + +INPUT PARAMETERS: + N - number of Kronrod nodes, must be odd number, >=3. + +OUTPUT PARAMETERS: + Info - error code: + * -4 an error was detected when calculating + weights/nodes. N is too large to obtain + weights/nodes with high enough accuracy. + Try to use multiple precision version. + * -3 internal eigenproblem solver hasn't converged + * -1 incorrect N was passed + * +1 OK + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqlegendrecalc(const ae_int_t n, ae_int_t &info, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss); + + +/************************************************************************* +Returns Gauss and Gauss-Kronrod nodes for quadrature with N points using +pre-calculated table. Nodes/weights were computed with accuracy up to +1.0E-32 (if MPFR version of ALGLIB is used). In standard double precision +accuracy reduces to something about 2.0E-16 (depending on your compiler's +handling of long floating point constants). + +INPUT PARAMETERS: + N - number of Kronrod nodes. + N can be 15, 21, 31, 41, 51, 61. + +OUTPUT PARAMETERS: + X - array[0..N-1] - array of quadrature nodes, ordered in + ascending order. + WKronrod - array[0..N-1] - Kronrod weights + WGauss - array[0..N-1] - Gauss weights (interleaved with zeros + corresponding to extended Kronrod nodes). + + + -- ALGLIB -- + Copyright 12.05.2009 by Bochkanov Sergey +*************************************************************************/ +void gkqlegendretbl(const ae_int_t n, real_1d_array &x, real_1d_array &wkronrod, real_1d_array &wgauss, double &eps); + +/************************************************************************* +Integration of a smooth function F(x) on a finite interval [a,b]. + +Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result +is calculated with accuracy close to the machine precision. + +Algorithm works well only with smooth integrands. It may be used with +continuous non-smooth integrands, but with less performance. + +It should never be used with integrands which have integrable singularities +at lower or upper limits - algorithm may crash. Use AutoGKSingular in such +cases. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmoothW, AutoGKSingular, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksmooth(const double a, const double b, autogkstate &state); + + +/************************************************************************* +Integration of a smooth function F(x) on a finite interval [a,b]. + +This subroutine is same as AutoGKSmooth(), but it guarantees that interval +[a,b] is partitioned into subintervals which have width at most XWidth. + +Subroutine can be used when integrating nearly-constant function with +narrow "bumps" (about XWidth wide). If "bumps" are too narrow, AutoGKSmooth +subroutine can overlook them. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmooth, AutoGKSingular, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksmoothw(const double a, const double b, const double xwidth, autogkstate &state); + + +/************************************************************************* +Integration on a finite interval [A,B]. +Integrand have integrable singularities at A/B. + +F(X) must diverge as "(x-A)^alpha" at A, as "(B-x)^beta" at B, with known +alpha/beta (alpha>-1, beta>-1). If alpha/beta are not known, estimates +from below can be used (but these estimates should be greater than -1 too). + +One of alpha/beta variables (or even both alpha/beta) may be equal to 0, +which means than function F(x) is non-singular at A/B. Anyway (singular at +bounds or not), function F(x) is supposed to be continuous on (A,B). + +Fast-convergent algorithm based on a Gauss-Kronrod formula is used. Result +is calculated with accuracy close to the machine precision. + +INPUT PARAMETERS: + A, B - interval boundaries (AB) + Alpha - power-law coefficient of the F(x) at A, + Alpha>-1 + Beta - power-law coefficient of the F(x) at B, + Beta>-1 + +OUTPUT PARAMETERS + State - structure which stores algorithm state + +SEE ALSO + AutoGKSmooth, AutoGKSmoothW, AutoGKResults. + + + -- ALGLIB -- + Copyright 06.05.2009 by Bochkanov Sergey +*************************************************************************/ +void autogksingular(const double a, const double b, const double alpha, const double beta, autogkstate &state); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool autogkiteration(const autogkstate &state); + + +/************************************************************************* +This function is used to launcn iterations of the 1-dimensional integrator + +It accepts following parameters: + func - callback which calculates f(x) for given x + ptr - optional pointer which is passed to func; can be NULL + + + -- ALGLIB -- + Copyright 07.05.2009 by Bochkanov Sergey + +*************************************************************************/ +void autogkintegrate(autogkstate &state, + void (*func)(double x, double xminusa, double bminusx, double &y, void *ptr), + void *ptr = NULL); + + +/************************************************************************* +Adaptive integration results + +Called after AutoGKIteration returned False. + +Input parameters: + State - algorithm state (used by AutoGKIteration). + +Output parameters: + V - integral(f(x)dx,a,b) + Rep - optimization report (see AutoGKReport description) + + -- ALGLIB -- + Copyright 14.11.2007 by Bochkanov Sergey +*************************************************************************/ +void autogkresults(const autogkstate &state, double &v, autogkreport &rep); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void gqgeneraterec(/* Real */ ae_vector* alpha, + /* Real */ ae_vector* beta, + double mu0, + ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state); +void gqgenerategausslobattorec(/* Real */ ae_vector* alpha, + /* Real */ ae_vector* beta, + double mu0, + double a, + double b, + ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state); +void gqgenerategaussradaurec(/* Real */ ae_vector* alpha, + /* Real */ ae_vector* beta, + double mu0, + double a, + ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state); +void gqgenerategausslegendre(ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state); +void gqgenerategaussjacobi(ae_int_t n, + double alpha, + double beta, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state); +void gqgenerategausslaguerre(ae_int_t n, + double alpha, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state); +void gqgenerategausshermite(ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* w, + ae_state *_state); +void gkqgeneraterec(/* Real */ ae_vector* alpha, + /* Real */ ae_vector* beta, + double mu0, + ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + ae_state *_state); +void gkqgenerategausslegendre(ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + ae_state *_state); +void gkqgenerategaussjacobi(ae_int_t n, + double alpha, + double beta, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + ae_state *_state); +void gkqlegendrecalc(ae_int_t n, + ae_int_t* info, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + ae_state *_state); +void gkqlegendretbl(ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* wkronrod, + /* Real */ ae_vector* wgauss, + double* eps, + ae_state *_state); +void autogksmooth(double a, + double b, + autogkstate* state, + ae_state *_state); +void autogksmoothw(double a, + double b, + double xwidth, + autogkstate* state, + ae_state *_state); +void autogksingular(double a, + double b, + double alpha, + double beta, + autogkstate* state, + ae_state *_state); +ae_bool autogkiteration(autogkstate* state, ae_state *_state); +void autogkresults(autogkstate* state, + double* v, + autogkreport* rep, + ae_state *_state); +ae_bool _autogkreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _autogkreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _autogkreport_clear(void* _p); +void _autogkreport_destroy(void* _p); +ae_bool _autogkinternalstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _autogkinternalstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _autogkinternalstate_clear(void* _p); +void _autogkinternalstate_destroy(void* _p); +ae_bool _autogkstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _autogkstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _autogkstate_clear(void* _p); +void _autogkstate_destroy(void* _p); + +} +#endif + diff --git a/psdlag/src/interpolation.cpp b/psdlag/src/interpolation.cpp new file mode 100644 index 0000000..08ed432 --- /dev/null +++ b/psdlag/src/interpolation.cpp @@ -0,0 +1,30715 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "interpolation.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +IDW interpolant. +*************************************************************************/ +_idwinterpolant_owner::_idwinterpolant_owner() +{ + p_struct = (alglib_impl::idwinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::idwinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_idwinterpolant_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_idwinterpolant_owner::_idwinterpolant_owner(const _idwinterpolant_owner &rhs) +{ + p_struct = (alglib_impl::idwinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::idwinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_idwinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_idwinterpolant_owner& _idwinterpolant_owner::operator=(const _idwinterpolant_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_idwinterpolant_clear(p_struct); + if( !alglib_impl::_idwinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_idwinterpolant_owner::~_idwinterpolant_owner() +{ + alglib_impl::_idwinterpolant_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::idwinterpolant* _idwinterpolant_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::idwinterpolant* _idwinterpolant_owner::c_ptr() const +{ + return const_cast(p_struct); +} +idwinterpolant::idwinterpolant() : _idwinterpolant_owner() +{ +} + +idwinterpolant::idwinterpolant(const idwinterpolant &rhs):_idwinterpolant_owner(rhs) +{ +} + +idwinterpolant& idwinterpolant::operator=(const idwinterpolant &rhs) +{ + if( this==&rhs ) + return *this; + _idwinterpolant_owner::operator=(rhs); + return *this; +} + +idwinterpolant::~idwinterpolant() +{ +} + +/************************************************************************* +IDW interpolation + +INPUT PARAMETERS: + Z - IDW interpolant built with one of model building + subroutines. + X - array[0..NX-1], interpolation point + +Result: + IDW interpolant Z(X) + + -- ALGLIB -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +double idwcalc(const idwinterpolant &z, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::idwcalc(const_cast(z.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +IDW interpolant using modified Shepard method for uniform point +distributions. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + D - nodal function type, either: + * 0 constant model. Just for demonstration only, worst + model ever. + * 1 linear model, least squares fitting. Simpe model for + datasets too small for quadratic models + * 2 quadratic model, least squares fitting. Best model + available (if your dataset is large enough). + * -1 "fast" linear model, use with caution!!! It is + significantly faster than linear/quadratic and better + than constant model. But it is less robust (especially + in the presence of noise). + NQ - number of points used to calculate nodal functions (ignored + for constant models). NQ should be LARGER than: + * max(1.5*(1+NX),2^NX+1) for linear model, + * max(3/4*(NX+2)*(NX+1),2^NX+1) for quadratic model. + Values less than this threshold will be silently increased. + NW - number of points used to calculate weights and to interpolate. + Required: >=2^NX+1, values less than this threshold will be + silently increased. + Recommended value: about 2*NQ + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: + * best results are obtained with quadratic models, worst - with constant + models + * when N is large, NQ and NW must be significantly smaller than N both + to obtain optimal performance and to obtain optimal accuracy. In 2 or + 3-dimensional tasks NQ=15 and NW=25 are good values to start with. + * NQ and NW may be greater than N. In such cases they will be + automatically decreased. + * this subroutine is always succeeds (as long as correct parameters are + passed). + * see 'Multivariate Interpolation of Large Sets of Scattered Data' by + Robert J. Renka for more information on this algorithm. + * this subroutine assumes that point distribution is uniform at the small + scales. If it isn't - for example, points are concentrated along + "lines", but "lines" distribution is uniform at the larger scale - then + you should use IDWBuildModifiedShepardR() + + + -- ALGLIB PROJECT -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildmodifiedshepard(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t d, const ae_int_t nq, const ae_int_t nw, idwinterpolant &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::idwbuildmodifiedshepard(const_cast(xy.c_ptr()), n, nx, d, nq, nw, const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +IDW interpolant using modified Shepard method for non-uniform datasets. + +This type of model uses constant nodal functions and interpolates using +all nodes which are closer than user-specified radius R. It may be used +when points distribution is non-uniform at the small scale, but it is at +the distances as large as R. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + R - radius, R>0 + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: +* if there is less than IDWKMin points within R-ball, algorithm selects + IDWKMin closest ones, so that continuity properties of interpolant are + preserved even far from points. + + -- ALGLIB PROJECT -- + Copyright 11.04.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildmodifiedshepardr(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const double r, idwinterpolant &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::idwbuildmodifiedshepardr(const_cast(xy.c_ptr()), n, nx, r, const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +IDW model for noisy data. + +This subroutine may be used to handle noisy data, i.e. data with noise in +OUTPUT values. It differs from IDWBuildModifiedShepard() in the following +aspects: +* nodal functions are not constrained to pass through nodes: Qi(xi)<>yi, + i.e. we have fitting instead of interpolation. +* weights which are used during least squares fitting stage are all equal + to 1.0 (independently of distance) +* "fast"-linear or constant nodal functions are not supported (either not + robust enough or too rigid) + +This problem require far more complex tuning than interpolation problems. +Below you can find some recommendations regarding this problem: +* focus on tuning NQ; it controls noise reduction. As for NW, you can just + make it equal to 2*NQ. +* you can use cross-validation to determine optimal NQ. +* optimal NQ is a result of complex tradeoff between noise level (more + noise = larger NQ required) and underlying function complexity (given + fixed N, larger NQ means smoothing of compex features in the data). For + example, NQ=N will reduce noise to the minimum level possible, but you + will end up with just constant/linear/quadratic (depending on D) least + squares model for the whole dataset. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + D - nodal function degree, either: + * 1 linear model, least squares fitting. Simpe model for + datasets too small for quadratic models (or for very + noisy problems). + * 2 quadratic model, least squares fitting. Best model + available (if your dataset is large enough). + NQ - number of points used to calculate nodal functions. NQ should + be significantly larger than 1.5 times the number of + coefficients in a nodal function to overcome effects of noise: + * larger than 1.5*(1+NX) for linear model, + * larger than 3/4*(NX+2)*(NX+1) for quadratic model. + Values less than this threshold will be silently increased. + NW - number of points used to calculate weights and to interpolate. + Required: >=2^NX+1, values less than this threshold will be + silently increased. + Recommended value: about 2*NQ or larger + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: + * best results are obtained with quadratic models, linear models are not + recommended to use unless you are pretty sure that it is what you want + * this subroutine is always succeeds (as long as correct parameters are + passed). + * see 'Multivariate Interpolation of Large Sets of Scattered Data' by + Robert J. Renka for more information on this algorithm. + + + -- ALGLIB PROJECT -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildnoisy(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t d, const ae_int_t nq, const ae_int_t nw, idwinterpolant &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::idwbuildnoisy(const_cast(xy.c_ptr()), n, nx, d, nq, nw, const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Barycentric interpolant. +*************************************************************************/ +_barycentricinterpolant_owner::_barycentricinterpolant_owner() +{ + p_struct = (alglib_impl::barycentricinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::barycentricinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_barycentricinterpolant_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_barycentricinterpolant_owner::_barycentricinterpolant_owner(const _barycentricinterpolant_owner &rhs) +{ + p_struct = (alglib_impl::barycentricinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::barycentricinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_barycentricinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_barycentricinterpolant_owner& _barycentricinterpolant_owner::operator=(const _barycentricinterpolant_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_barycentricinterpolant_clear(p_struct); + if( !alglib_impl::_barycentricinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_barycentricinterpolant_owner::~_barycentricinterpolant_owner() +{ + alglib_impl::_barycentricinterpolant_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::barycentricinterpolant* _barycentricinterpolant_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::barycentricinterpolant* _barycentricinterpolant_owner::c_ptr() const +{ + return const_cast(p_struct); +} +barycentricinterpolant::barycentricinterpolant() : _barycentricinterpolant_owner() +{ +} + +barycentricinterpolant::barycentricinterpolant(const barycentricinterpolant &rhs):_barycentricinterpolant_owner(rhs) +{ +} + +barycentricinterpolant& barycentricinterpolant::operator=(const barycentricinterpolant &rhs) +{ + if( this==&rhs ) + return *this; + _barycentricinterpolant_owner::operator=(rhs); + return *this; +} + +barycentricinterpolant::~barycentricinterpolant() +{ +} + +/************************************************************************* +Rational interpolation using barycentric formula + +F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) + +Input parameters: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +Result: + barycentric interpolant F(t) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +double barycentriccalc(const barycentricinterpolant &b, const double t) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::barycentriccalc(const_cast(b.c_ptr()), t, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Differentiation of barycentric interpolant: first derivative. + +Algorithm used in this subroutine is very robust and should not fail until +provided with values too close to MaxRealNumber (usually MaxRealNumber/N +or greater will overflow). + +INPUT PARAMETERS: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +OUTPUT PARAMETERS: + F - barycentric interpolant at T + DF - first derivative + +NOTE + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricdiff1(const barycentricinterpolant &b, const double t, double &f, double &df) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentricdiff1(const_cast(b.c_ptr()), t, &f, &df, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Differentiation of barycentric interpolant: first/second derivatives. + +INPUT PARAMETERS: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +OUTPUT PARAMETERS: + F - barycentric interpolant at T + DF - first derivative + D2F - second derivative + +NOTE: this algorithm may fail due to overflow/underflor if used on data +whose values are close to MaxRealNumber or MinRealNumber. Use more robust +BarycentricDiff1() subroutine in such cases. + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricdiff2(const barycentricinterpolant &b, const double t, double &f, double &df, double &d2f) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentricdiff2(const_cast(b.c_ptr()), t, &f, &df, &d2f, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine performs linear transformation of the argument. + +INPUT PARAMETERS: + B - rational interpolant in barycentric form + CA, CB - transformation coefficients: x = CA*t + CB + +OUTPUT PARAMETERS: + B - transformed interpolant with X replaced by T + + -- ALGLIB PROJECT -- + Copyright 19.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentriclintransx(const barycentricinterpolant &b, const double ca, const double cb) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentriclintransx(const_cast(b.c_ptr()), ca, cb, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine performs linear transformation of the barycentric +interpolant. + +INPUT PARAMETERS: + B - rational interpolant in barycentric form + CA, CB - transformation coefficients: B2(x) = CA*B(x) + CB + +OUTPUT PARAMETERS: + B - transformed interpolant + + -- ALGLIB PROJECT -- + Copyright 19.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentriclintransy(const barycentricinterpolant &b, const double ca, const double cb) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentriclintransy(const_cast(b.c_ptr()), ca, cb, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Extracts X/Y/W arrays from rational interpolant + +INPUT PARAMETERS: + B - barycentric interpolant + +OUTPUT PARAMETERS: + N - nodes count, N>0 + X - interpolation nodes, array[0..N-1] + F - function values, array[0..N-1] + W - barycentric weights, array[0..N-1] + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricunpack(const barycentricinterpolant &b, ae_int_t &n, real_1d_array &x, real_1d_array &y, real_1d_array &w) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentricunpack(const_cast(b.c_ptr()), &n, const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Rational interpolant from X/Y/W arrays + +F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) + +INPUT PARAMETERS: + X - interpolation nodes, array[0..N-1] + F - function values, array[0..N-1] + W - barycentric weights, array[0..N-1] + N - nodes count, N>0 + +OUTPUT PARAMETERS: + B - barycentric interpolant built from (X, Y, W) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricbuildxyw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, barycentricinterpolant &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentricbuildxyw(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Rational interpolant without poles + +The subroutine constructs the rational interpolating function without real +poles (see 'Barycentric rational interpolation with no poles and high +rates of approximation', Michael S. Floater. and Kai Hormann, for more +information on this subject). + +Input parameters: + X - interpolation nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of nodes, N>0. + D - order of the interpolation scheme, 0 <= D <= N-1. + D<0 will cause an error. + D>=N it will be replaced with D=N-1. + if you don't know what D to choose, use small value about 3-5. + +Output parameters: + B - barycentric interpolant. + +Note: + this algorithm always succeeds and calculates the weights with close + to machine precision. + + -- ALGLIB PROJECT -- + Copyright 17.06.2007 by Bochkanov Sergey +*************************************************************************/ +void barycentricbuildfloaterhormann(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t d, barycentricinterpolant &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentricbuildfloaterhormann(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, d, const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conversion from barycentric representation to Chebyshev basis. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + P - polynomial in barycentric form + A,B - base interval for Chebyshev polynomials (see below) + A<>B + +OUTPUT PARAMETERS + T - coefficients of Chebyshev representation; + P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N-1 }, + where Ti - I-th Chebyshev polynomial. + +NOTES: + barycentric interpolant passed as P may be either polynomial obtained + from polynomial interpolation/ fitting or rational function which is + NOT polynomial. We can't distinguish between these two cases, and this + algorithm just tries to work assuming that P IS a polynomial. If not, + algorithm will return results, but they won't have any meaning. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialbar2cheb(const barycentricinterpolant &p, const double a, const double b, real_1d_array &t) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbar2cheb(const_cast(p.c_ptr()), a, b, const_cast(t.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conversion from Chebyshev basis to barycentric representation. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + T - coefficients of Chebyshev representation; + P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N }, + where Ti - I-th Chebyshev polynomial. + N - number of coefficients: + * if given, only leading N elements of T are used + * if not given, automatically determined from size of T + A,B - base interval for Chebyshev polynomials (see above) + A(t.c_ptr()), n, a, b, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conversion from Chebyshev basis to barycentric representation. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + T - coefficients of Chebyshev representation; + P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N }, + where Ti - I-th Chebyshev polynomial. + N - number of coefficients: + * if given, only leading N elements of T are used + * if not given, automatically determined from size of T + A,B - base interval for Chebyshev polynomials (see above) + A(t.c_ptr()), n, a, b, const_cast(p.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conversion from barycentric representation to power basis. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + P - polynomial in barycentric form + C - offset (see below); 0.0 is used as default value. + S - scale (see below); 1.0 is used as default value. S<>0. + +OUTPUT PARAMETERS + A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } + N - number of coefficients (polynomial degree plus 1) + +NOTES: +1. this function accepts offset and scale, which can be set to improve + numerical properties of polynomial. For example, if P was obtained as + result of interpolation on [-1,+1], you can set C=0 and S=1 and + represent P as sum of 1, x, x^2, x^3 and so on. In most cases you it + is exactly what you need. + + However, if your interpolation model was built on [999,1001], you will + see significant growth of numerical errors when using {1, x, x^2, x^3} + as basis. Representing P as sum of 1, (x-1000), (x-1000)^2, (x-1000)^3 + will be better option. Such representation can be obtained by using + 1000.0 as offset C and 1.0 as scale S. + +2. power basis is ill-conditioned and tricks described above can't solve + this problem completely. This function will return coefficients in + any case, but for N>8 they will become unreliable. However, N's + less than 5 are pretty safe. + +3. barycentric interpolant passed as P may be either polynomial obtained + from polynomial interpolation/ fitting or rational function which is + NOT polynomial. We can't distinguish between these two cases, and this + algorithm just tries to work assuming that P IS a polynomial. If not, + algorithm will return results, but they won't have any meaning. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialbar2pow(const barycentricinterpolant &p, const double c, const double s, real_1d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbar2pow(const_cast(p.c_ptr()), c, s, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conversion from barycentric representation to power basis. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + P - polynomial in barycentric form + C - offset (see below); 0.0 is used as default value. + S - scale (see below); 1.0 is used as default value. S<>0. + +OUTPUT PARAMETERS + A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } + N - number of coefficients (polynomial degree plus 1) + +NOTES: +1. this function accepts offset and scale, which can be set to improve + numerical properties of polynomial. For example, if P was obtained as + result of interpolation on [-1,+1], you can set C=0 and S=1 and + represent P as sum of 1, x, x^2, x^3 and so on. In most cases you it + is exactly what you need. + + However, if your interpolation model was built on [999,1001], you will + see significant growth of numerical errors when using {1, x, x^2, x^3} + as basis. Representing P as sum of 1, (x-1000), (x-1000)^2, (x-1000)^3 + will be better option. Such representation can be obtained by using + 1000.0 as offset C and 1.0 as scale S. + +2. power basis is ill-conditioned and tricks described above can't solve + this problem completely. This function will return coefficients in + any case, but for N>8 they will become unreliable. However, N's + less than 5 are pretty safe. + +3. barycentric interpolant passed as P may be either polynomial obtained + from polynomial interpolation/ fitting or rational function which is + NOT polynomial. We can't distinguish between these two cases, and this + algorithm just tries to work assuming that P IS a polynomial. If not, + algorithm will return results, but they won't have any meaning. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialbar2pow(const barycentricinterpolant &p, real_1d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + double c; + double s; + + c = 0; + s = 1; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbar2pow(const_cast(p.c_ptr()), c, s, const_cast(a.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conversion from power basis to barycentric representation. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } + N - number of coefficients (polynomial degree plus 1) + * if given, only leading N elements of A are used + * if not given, automatically determined from size of A + C - offset (see below); 0.0 is used as default value. + S - scale (see below); 1.0 is used as default value. S<>0. + +OUTPUT PARAMETERS + P - polynomial in barycentric form + + +NOTES: +1. this function accepts offset and scale, which can be set to improve + numerical properties of polynomial. For example, if you interpolate on + [-1,+1], you can set C=0 and S=1 and convert from sum of 1, x, x^2, + x^3 and so on. In most cases you it is exactly what you need. + + However, if your interpolation model was built on [999,1001], you will + see significant growth of numerical errors when using {1, x, x^2, x^3} + as input basis. Converting from sum of 1, (x-1000), (x-1000)^2, + (x-1000)^3 will be better option (you have to specify 1000.0 as offset + C and 1.0 as scale S). + +2. power basis is ill-conditioned and tricks described above can't solve + this problem completely. This function will return barycentric model + in any case, but for N>8 accuracy well degrade. However, N's less than + 5 are pretty safe. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialpow2bar(const real_1d_array &a, const ae_int_t n, const double c, const double s, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialpow2bar(const_cast(a.c_ptr()), n, c, s, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conversion from power basis to barycentric representation. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } + N - number of coefficients (polynomial degree plus 1) + * if given, only leading N elements of A are used + * if not given, automatically determined from size of A + C - offset (see below); 0.0 is used as default value. + S - scale (see below); 1.0 is used as default value. S<>0. + +OUTPUT PARAMETERS + P - polynomial in barycentric form + + +NOTES: +1. this function accepts offset and scale, which can be set to improve + numerical properties of polynomial. For example, if you interpolate on + [-1,+1], you can set C=0 and S=1 and convert from sum of 1, x, x^2, + x^3 and so on. In most cases you it is exactly what you need. + + However, if your interpolation model was built on [999,1001], you will + see significant growth of numerical errors when using {1, x, x^2, x^3} + as input basis. Converting from sum of 1, (x-1000), (x-1000)^2, + (x-1000)^3 will be better option (you have to specify 1000.0 as offset + C and 1.0 as scale S). + +2. power basis is ill-conditioned and tricks described above can't solve + this problem completely. This function will return barycentric model + in any case, but for N>8 accuracy well degrade. However, N's less than + 5 are pretty safe. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialpow2bar(const real_1d_array &a, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + double c; + double s; + + n = a.length(); + c = 0; + s = 1; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialpow2bar(const_cast(a.c_ptr()), n, c, s, const_cast(p.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Lagrange intepolant: generation of the model on the general grid. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + X - abscissas, array[0..N-1] + Y - function values, array[0..N-1] + N - number of points, N>=1 + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuild(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbuild(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Lagrange intepolant: generation of the model on the general grid. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + X - abscissas, array[0..N-1] + Y - function values, array[0..N-1] + N - number of points, N>=1 + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuild(const real_1d_array &x, const real_1d_array &y, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'polynomialbuild': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbuild(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Lagrange intepolant: generation of the model on equidistant grid. +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1] + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildeqdist(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbuildeqdist(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Lagrange intepolant: generation of the model on equidistant grid. +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1] + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildeqdist(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = y.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbuildeqdist(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Lagrange intepolant on Chebyshev grid (first kind). +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1], + Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n))) + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildcheb1(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbuildcheb1(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Lagrange intepolant on Chebyshev grid (first kind). +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1], + Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n))) + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildcheb1(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = y.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbuildcheb1(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Lagrange intepolant on Chebyshev grid (second kind). +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1], + Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1))) + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildcheb2(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbuildcheb2(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Lagrange intepolant on Chebyshev grid (second kind). +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1], + Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1))) + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildcheb2(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = y.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialbuildcheb2(a, b, const_cast(y.c_ptr()), n, const_cast(p.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Fast equidistant polynomial interpolation function with O(N) complexity + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on equidistant grid, N>=1 + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolynomialBuildEqDist()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalceqdist(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::polynomialcalceqdist(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Fast equidistant polynomial interpolation function with O(N) complexity + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on equidistant grid, N>=1 + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolynomialBuildEqDist()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalceqdist(const double a, const double b, const real_1d_array &f, const double t) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = f.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::polynomialcalceqdist(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Fast polynomial interpolation function on Chebyshev points (first kind) +with O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on Chebyshev grid (first kind), + X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n)) + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolIntBuildCheb1()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalccheb1(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::polynomialcalccheb1(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Fast polynomial interpolation function on Chebyshev points (first kind) +with O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on Chebyshev grid (first kind), + X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n)) + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolIntBuildCheb1()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalccheb1(const double a, const double b, const real_1d_array &f, const double t) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = f.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::polynomialcalccheb1(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Fast polynomial interpolation function on Chebyshev points (second kind) +with O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on Chebyshev grid (second kind), + X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1)) + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolIntBuildCheb2()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalccheb2(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::polynomialcalccheb2(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Fast polynomial interpolation function on Chebyshev points (second kind) +with O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on Chebyshev grid (second kind), + X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1)) + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolIntBuildCheb2()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalccheb2(const double a, const double b, const real_1d_array &f, const double t) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = f.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::polynomialcalccheb2(a, b, const_cast(f.c_ptr()), n, t, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +1-dimensional spline interpolant +*************************************************************************/ +_spline1dinterpolant_owner::_spline1dinterpolant_owner() +{ + p_struct = (alglib_impl::spline1dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline1dinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_spline1dinterpolant_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_spline1dinterpolant_owner::_spline1dinterpolant_owner(const _spline1dinterpolant_owner &rhs) +{ + p_struct = (alglib_impl::spline1dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline1dinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_spline1dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_spline1dinterpolant_owner& _spline1dinterpolant_owner::operator=(const _spline1dinterpolant_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_spline1dinterpolant_clear(p_struct); + if( !alglib_impl::_spline1dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_spline1dinterpolant_owner::~_spline1dinterpolant_owner() +{ + alglib_impl::_spline1dinterpolant_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::spline1dinterpolant* _spline1dinterpolant_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::spline1dinterpolant* _spline1dinterpolant_owner::c_ptr() const +{ + return const_cast(p_struct); +} +spline1dinterpolant::spline1dinterpolant() : _spline1dinterpolant_owner() +{ +} + +spline1dinterpolant::spline1dinterpolant(const spline1dinterpolant &rhs):_spline1dinterpolant_owner(rhs) +{ +} + +spline1dinterpolant& spline1dinterpolant::operator=(const spline1dinterpolant &rhs) +{ + if( this==&rhs ) + return *this; + _spline1dinterpolant_owner::operator=(rhs); + return *this; +} + +spline1dinterpolant::~spline1dinterpolant() +{ +} + +/************************************************************************* +This subroutine builds linear spline interpolant + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildlinear(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildlinear(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds linear spline interpolant + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildlinear(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dbuildlinear': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildlinear(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds cubic spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + C - spline interpolant + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds cubic spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + C - spline interpolant + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildcubic(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t boundltype; + double boundl; + ae_int_t boundrtype; + double boundr; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dbuildcubic': looks like one of arguments has wrong size"); + n = x.length(); + boundltype = 0; + boundl = 0; + boundrtype = 0; + boundr = 0; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at nodes x[], it calculates and returns table of function derivatives d[] +(calculated at the same nodes x[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - spline nodes + Y - function values + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + D - derivative values at X[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Derivative values are correctly reordered on return, so D[I] is always +equal to S'(X[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dgriddiffcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, real_1d_array &d) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dgriddiffcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(d.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at nodes x[], it calculates and returns table of function derivatives d[] +(calculated at the same nodes x[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - spline nodes + Y - function values + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + D - derivative values at X[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Derivative values are correctly reordered on return, so D[I] is always +equal to S'(X[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dgriddiffcubic(const real_1d_array &x, const real_1d_array &y, real_1d_array &d) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t boundltype; + double boundl; + ae_int_t boundrtype; + double boundr; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dgriddiffcubic': looks like one of arguments has wrong size"); + n = x.length(); + boundltype = 0; + boundl = 0; + boundrtype = 0; + boundr = 0; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dgriddiffcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(d.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at nodes x[], it calculates and returns tables of first and second +function derivatives d1[] and d2[] (calculated at the same nodes x[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - spline nodes + Y - function values + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + D1 - S' values at X[] + D2 - S'' values at X[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Derivative values are correctly reordered on return, so D[I] is always +equal to S'(X[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dgriddiff2cubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, real_1d_array &d1, real_1d_array &d2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dgriddiff2cubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(d1.c_ptr()), const_cast(d2.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at nodes x[], it calculates and returns tables of first and second +function derivatives d1[] and d2[] (calculated at the same nodes x[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - spline nodes + Y - function values + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + D1 - S' values at X[] + D2 - S'' values at X[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Derivative values are correctly reordered on return, so D[I] is always +equal to S'(X[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dgriddiff2cubic(const real_1d_array &x, const real_1d_array &y, real_1d_array &d1, real_1d_array &d2) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t boundltype; + double boundl; + ae_int_t boundrtype; + double boundr; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dgriddiff2cubic': looks like one of arguments has wrong size"); + n = x.length(); + boundltype = 0; + boundl = 0; + boundrtype = 0; + boundr = 0; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dgriddiff2cubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(d1.c_ptr()), const_cast(d2.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[] (calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dconvcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[] (calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvcubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t boundltype; + double boundl; + ae_int_t boundrtype; + double boundr; + ae_int_t n2; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dconvcubic': looks like one of arguments has wrong size"); + n = x.length(); + boundltype = 0; + boundl = 0; + boundrtype = 0; + boundr = 0; + n2 = x2.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dconvcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[] and derivatives d2[] (calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + D2 - first derivatives at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiffcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2, real_1d_array &d2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dconvdiffcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), const_cast(d2.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[] and derivatives d2[] (calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + D2 - first derivatives at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiffcubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2, real_1d_array &d2) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t boundltype; + double boundl; + ae_int_t boundrtype; + double boundr; + ae_int_t n2; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dconvdiffcubic': looks like one of arguments has wrong size"); + n = x.length(); + boundltype = 0; + boundl = 0; + boundrtype = 0; + boundr = 0; + n2 = x2.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dconvdiffcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), const_cast(d2.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[], first and second derivatives d2[] and dd2[] +(calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + D2 - first derivatives at X2[] + DD2 - second derivatives at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiff2cubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2, real_1d_array &d2, real_1d_array &dd2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dconvdiff2cubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), const_cast(d2.c_ptr()), const_cast(dd2.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[], first and second derivatives d2[] and dd2[] +(calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + D2 - first derivatives at X2[] + DD2 - second derivatives at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiff2cubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2, real_1d_array &d2, real_1d_array &dd2) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t boundltype; + double boundl; + ae_int_t boundrtype; + double boundr; + ae_int_t n2; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dconvdiff2cubic': looks like one of arguments has wrong size"); + n = x.length(); + boundltype = 0; + boundl = 0; + boundrtype = 0; + boundr = 0; + n2 = x2.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dconvdiff2cubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, boundltype, boundl, boundrtype, boundr, const_cast(x2.c_ptr()), n2, const_cast(y2.c_ptr()), const_cast(d2.c_ptr()), const_cast(dd2.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds Catmull-Rom spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundType - boundary condition type: + * -1 for periodic boundary condition + * 0 for parabolically terminated spline (default) + Tension - tension parameter: + * tension=0 corresponds to classic Catmull-Rom spline (default) + * 0(x.c_ptr()), const_cast(y.c_ptr()), n, boundtype, tension, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds Catmull-Rom spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundType - boundary condition type: + * -1 for periodic boundary condition + * 0 for parabolically terminated spline (default) + Tension - tension parameter: + * tension=0 corresponds to classic Catmull-Rom spline (default) + * 0(x.c_ptr()), const_cast(y.c_ptr()), n, boundtype, tension, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds Hermite spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + D - derivatives, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant. + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildhermite(const real_1d_array &x, const real_1d_array &y, const real_1d_array &d, const ae_int_t n, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildhermite(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(d.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds Hermite spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + D - derivatives, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant. + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildhermite(const real_1d_array &x, const real_1d_array &y, const real_1d_array &d, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length()) || (x.length()!=d.length())) + throw ap_error("Error while calling 'spline1dbuildhermite': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildhermite(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(d.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds Akima spline interpolant + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildakima(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildakima(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds Akima spline interpolant + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildakima(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dbuildakima': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildakima(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine calculates the value of the spline at the given point X. + +INPUT PARAMETERS: + C - spline interpolant + X - point + +Result: + S(x) + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +double spline1dcalc(const spline1dinterpolant &c, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spline1dcalc(const_cast(c.c_ptr()), x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine differentiates the spline. + +INPUT PARAMETERS: + C - spline interpolant. + X - point + +Result: + S - S(x) + DS - S'(x) + D2S - S''(x) + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1ddiff(const spline1dinterpolant &c, const double x, double &s, double &ds, double &d2s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1ddiff(const_cast(c.c_ptr()), x, &s, &ds, &d2s, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine unpacks the spline into the coefficients table. + +INPUT PARAMETERS: + C - spline interpolant. + X - point + +OUTPUT PARAMETERS: + Tbl - coefficients table, unpacked format, array[0..N-2, 0..5]. + For I = 0...N-2: + Tbl[I,0] = X[i] + Tbl[I,1] = X[i+1] + Tbl[I,2] = C0 + Tbl[I,3] = C1 + Tbl[I,4] = C2 + Tbl[I,5] = C3 + On [x[i], x[i+1]] spline is equals to: + S(x) = C0 + C1*t + C2*t^2 + C3*t^3 + t = x-x[i] + +NOTE: + You can rebuild spline with Spline1DBuildHermite() function, which + accepts as inputs function values and derivatives at nodes, which are + easy to calculate when you have coefficients. + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dunpack(const spline1dinterpolant &c, ae_int_t &n, real_2d_array &tbl) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dunpack(const_cast(c.c_ptr()), &n, const_cast(tbl.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: x = A*t + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dlintransx(const spline1dinterpolant &c, const double a, const double b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dlintransx(const_cast(c.c_ptr()), a, b, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: S2(x) = A*S(x) + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dlintransy(const spline1dinterpolant &c, const double a, const double b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dlintransy(const_cast(c.c_ptr()), a, b, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine integrates the spline. + +INPUT PARAMETERS: + C - spline interpolant. + X - right bound of the integration interval [a, x], + here 'a' denotes min(x[]) +Result: + integral(S(t)dt,a,x) + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +double spline1dintegrate(const spline1dinterpolant &c, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spline1dintegrate(const_cast(c.c_ptr()), x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function builds monotone cubic Hermite interpolant. This interpolant +is monotonic in [x(0),x(n-1)] and is constant outside of this interval. + +In case y[] form non-monotonic sequence, interpolant is piecewise +monotonic. Say, for x=(0,1,2,3,4) and y=(0,1,2,1,0) interpolant will +monotonically grow at [0..2] and monotonically decrease at [2..4]. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. Subroutine automatically + sorts points, so caller may pass unsorted array. + Y - function values, array[0..N-1] + N - the number of points(N>=2). + +OUTPUT PARAMETERS: + C - spline interpolant. + + -- ALGLIB PROJECT -- + Copyright 21.06.2012 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildmonotone(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildmonotone(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function builds monotone cubic Hermite interpolant. This interpolant +is monotonic in [x(0),x(n-1)] and is constant outside of this interval. + +In case y[] form non-monotonic sequence, interpolant is piecewise +monotonic. Say, for x=(0,1,2,3,4) and y=(0,1,2,1,0) interpolant will +monotonically grow at [0..2] and monotonically decrease at [2..4]. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. Subroutine automatically + sorts points, so caller may pass unsorted array. + Y - function values, array[0..N-1] + N - the number of points(N>=2). + +OUTPUT PARAMETERS: + C - spline interpolant. + + -- ALGLIB PROJECT -- + Copyright 21.06.2012 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildmonotone(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dbuildmonotone': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dbuildmonotone(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Polynomial fitting report: + TaskRCond reciprocal of task's condition number + RMSError RMS error + AvgError average error + AvgRelError average relative error (for non-zero Y[I]) + MaxError maximum error +*************************************************************************/ +_polynomialfitreport_owner::_polynomialfitreport_owner() +{ + p_struct = (alglib_impl::polynomialfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::polynomialfitreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_polynomialfitreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_polynomialfitreport_owner::_polynomialfitreport_owner(const _polynomialfitreport_owner &rhs) +{ + p_struct = (alglib_impl::polynomialfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::polynomialfitreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_polynomialfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_polynomialfitreport_owner& _polynomialfitreport_owner::operator=(const _polynomialfitreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_polynomialfitreport_clear(p_struct); + if( !alglib_impl::_polynomialfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_polynomialfitreport_owner::~_polynomialfitreport_owner() +{ + alglib_impl::_polynomialfitreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::polynomialfitreport* _polynomialfitreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::polynomialfitreport* _polynomialfitreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +polynomialfitreport::polynomialfitreport() : _polynomialfitreport_owner() ,taskrcond(p_struct->taskrcond),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) +{ +} + +polynomialfitreport::polynomialfitreport(const polynomialfitreport &rhs):_polynomialfitreport_owner(rhs) ,taskrcond(p_struct->taskrcond),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) +{ +} + +polynomialfitreport& polynomialfitreport::operator=(const polynomialfitreport &rhs) +{ + if( this==&rhs ) + return *this; + _polynomialfitreport_owner::operator=(rhs); + return *this; +} + +polynomialfitreport::~polynomialfitreport() +{ +} + + +/************************************************************************* +Barycentric fitting report: + RMSError RMS error + AvgError average error + AvgRelError average relative error (for non-zero Y[I]) + MaxError maximum error + TaskRCond reciprocal of task's condition number +*************************************************************************/ +_barycentricfitreport_owner::_barycentricfitreport_owner() +{ + p_struct = (alglib_impl::barycentricfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::barycentricfitreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_barycentricfitreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_barycentricfitreport_owner::_barycentricfitreport_owner(const _barycentricfitreport_owner &rhs) +{ + p_struct = (alglib_impl::barycentricfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::barycentricfitreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_barycentricfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_barycentricfitreport_owner& _barycentricfitreport_owner::operator=(const _barycentricfitreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_barycentricfitreport_clear(p_struct); + if( !alglib_impl::_barycentricfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_barycentricfitreport_owner::~_barycentricfitreport_owner() +{ + alglib_impl::_barycentricfitreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::barycentricfitreport* _barycentricfitreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::barycentricfitreport* _barycentricfitreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +barycentricfitreport::barycentricfitreport() : _barycentricfitreport_owner() ,taskrcond(p_struct->taskrcond),dbest(p_struct->dbest),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) +{ +} + +barycentricfitreport::barycentricfitreport(const barycentricfitreport &rhs):_barycentricfitreport_owner(rhs) ,taskrcond(p_struct->taskrcond),dbest(p_struct->dbest),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) +{ +} + +barycentricfitreport& barycentricfitreport::operator=(const barycentricfitreport &rhs) +{ + if( this==&rhs ) + return *this; + _barycentricfitreport_owner::operator=(rhs); + return *this; +} + +barycentricfitreport::~barycentricfitreport() +{ +} + + +/************************************************************************* +Spline fitting report: + RMSError RMS error + AvgError average error + AvgRelError average relative error (for non-zero Y[I]) + MaxError maximum error + +Fields below are filled by obsolete functions (Spline1DFitCubic, +Spline1DFitHermite). Modern fitting functions do NOT fill these fields: + TaskRCond reciprocal of task's condition number +*************************************************************************/ +_spline1dfitreport_owner::_spline1dfitreport_owner() +{ + p_struct = (alglib_impl::spline1dfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline1dfitreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_spline1dfitreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_spline1dfitreport_owner::_spline1dfitreport_owner(const _spline1dfitreport_owner &rhs) +{ + p_struct = (alglib_impl::spline1dfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline1dfitreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_spline1dfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_spline1dfitreport_owner& _spline1dfitreport_owner::operator=(const _spline1dfitreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_spline1dfitreport_clear(p_struct); + if( !alglib_impl::_spline1dfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_spline1dfitreport_owner::~_spline1dfitreport_owner() +{ + alglib_impl::_spline1dfitreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::spline1dfitreport* _spline1dfitreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::spline1dfitreport* _spline1dfitreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +spline1dfitreport::spline1dfitreport() : _spline1dfitreport_owner() ,taskrcond(p_struct->taskrcond),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) +{ +} + +spline1dfitreport::spline1dfitreport(const spline1dfitreport &rhs):_spline1dfitreport_owner(rhs) ,taskrcond(p_struct->taskrcond),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror) +{ +} + +spline1dfitreport& spline1dfitreport::operator=(const spline1dfitreport &rhs) +{ + if( this==&rhs ) + return *this; + _spline1dfitreport_owner::operator=(rhs); + return *this; +} + +spline1dfitreport::~spline1dfitreport() +{ +} + + +/************************************************************************* +Least squares fitting report. This structure contains informational fields +which are set by fitting functions provided by this unit. + +Different functions initialize different sets of fields, so you should +read documentation on specific function you used in order to know which +fields are initialized. + + TaskRCond reciprocal of task's condition number + IterationsCount number of internal iterations + + VarIdx if user-supplied gradient contains errors which were + detected by nonlinear fitter, this field is set to + index of the first component of gradient which is + suspected to be spoiled by bugs. + + RMSError RMS error + AvgError average error + AvgRelError average relative error (for non-zero Y[I]) + MaxError maximum error + + WRMSError weighted RMS error + + CovPar covariance matrix for parameters, filled by some solvers + ErrPar vector of errors in parameters, filled by some solvers + ErrCurve vector of fit errors - variability of the best-fit + curve, filled by some solvers. + Noise vector of per-point noise estimates, filled by + some solvers. + R2 coefficient of determination (non-weighted, non-adjusted), + filled by some solvers. +*************************************************************************/ +_lsfitreport_owner::_lsfitreport_owner() +{ + p_struct = (alglib_impl::lsfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lsfitreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lsfitreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lsfitreport_owner::_lsfitreport_owner(const _lsfitreport_owner &rhs) +{ + p_struct = (alglib_impl::lsfitreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lsfitreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lsfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lsfitreport_owner& _lsfitreport_owner::operator=(const _lsfitreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_lsfitreport_clear(p_struct); + if( !alglib_impl::_lsfitreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_lsfitreport_owner::~_lsfitreport_owner() +{ + alglib_impl::_lsfitreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::lsfitreport* _lsfitreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::lsfitreport* _lsfitreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +lsfitreport::lsfitreport() : _lsfitreport_owner() ,taskrcond(p_struct->taskrcond),iterationscount(p_struct->iterationscount),varidx(p_struct->varidx),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror),wrmserror(p_struct->wrmserror),covpar(&p_struct->covpar),errpar(&p_struct->errpar),errcurve(&p_struct->errcurve),noise(&p_struct->noise),r2(p_struct->r2) +{ +} + +lsfitreport::lsfitreport(const lsfitreport &rhs):_lsfitreport_owner(rhs) ,taskrcond(p_struct->taskrcond),iterationscount(p_struct->iterationscount),varidx(p_struct->varidx),rmserror(p_struct->rmserror),avgerror(p_struct->avgerror),avgrelerror(p_struct->avgrelerror),maxerror(p_struct->maxerror),wrmserror(p_struct->wrmserror),covpar(&p_struct->covpar),errpar(&p_struct->errpar),errcurve(&p_struct->errcurve),noise(&p_struct->noise),r2(p_struct->r2) +{ +} + +lsfitreport& lsfitreport::operator=(const lsfitreport &rhs) +{ + if( this==&rhs ) + return *this; + _lsfitreport_owner::operator=(rhs); + return *this; +} + +lsfitreport::~lsfitreport() +{ +} + + +/************************************************************************* +Nonlinear fitter. + +You should use ALGLIB functions to work with fitter. +Never try to access its fields directly! +*************************************************************************/ +_lsfitstate_owner::_lsfitstate_owner() +{ + p_struct = (alglib_impl::lsfitstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::lsfitstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lsfitstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lsfitstate_owner::_lsfitstate_owner(const _lsfitstate_owner &rhs) +{ + p_struct = (alglib_impl::lsfitstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::lsfitstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lsfitstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lsfitstate_owner& _lsfitstate_owner::operator=(const _lsfitstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_lsfitstate_clear(p_struct); + if( !alglib_impl::_lsfitstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_lsfitstate_owner::~_lsfitstate_owner() +{ + alglib_impl::_lsfitstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::lsfitstate* _lsfitstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::lsfitstate* _lsfitstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +lsfitstate::lsfitstate() : _lsfitstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),needfgh(p_struct->needfgh),xupdated(p_struct->xupdated),c(&p_struct->c),f(p_struct->f),g(&p_struct->g),h(&p_struct->h),x(&p_struct->x) +{ +} + +lsfitstate::lsfitstate(const lsfitstate &rhs):_lsfitstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),needfgh(p_struct->needfgh),xupdated(p_struct->xupdated),c(&p_struct->c),f(p_struct->f),g(&p_struct->g),h(&p_struct->h),x(&p_struct->x) +{ +} + +lsfitstate& lsfitstate::operator=(const lsfitstate &rhs) +{ + if( this==&rhs ) + return *this; + _lsfitstate_owner::operator=(rhs); + return *this; +} + +lsfitstate::~lsfitstate() +{ +} + +/************************************************************************* +Fitting by polynomials in barycentric form. This function provides simple +unterface for unconstrained unweighted fitting. See PolynomialFitWC() if +you need constrained fitting. + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO: + PolynomialFitWC() + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0 + * if given, only leading N elements of X/Y are used + * if not given, automatically determined from sizes of X/Y + M - number of basis functions (= polynomial_degree + 1), M>=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + P - interpolant in barycentric form. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +NOTES: + you can convert P from barycentric form to the power or Chebyshev + basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from + POLINT subpackage. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialfit(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialfit(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Fitting by polynomials in barycentric form. This function provides simple +unterface for unconstrained unweighted fitting. See PolynomialFitWC() if +you need constrained fitting. + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO: + PolynomialFitWC() + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0 + * if given, only leading N elements of X/Y are used + * if not given, automatically determined from sizes of X/Y + M - number of basis functions (= polynomial_degree + 1), M>=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + P - interpolant in barycentric form. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +NOTES: + you can convert P from barycentric form to the power or Chebyshev + basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from + POLINT subpackage. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialfit(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'polynomialfit': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialfit(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted fitting by polynomials in barycentric form, with constraints on +function values or first derivatives. + +Small regularizing term is used when solving constrained tasks (to improve +stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO: + PolynomialFit() + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points, N>0. + * if given, only leading N elements of X/Y/W are used + * if not given, automatically determined from sizes of X/Y/W + XC - points where polynomial values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that P(XC[i])=YC[i] + * DC[i]=1 means that P'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints, 0<=K=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + P - interpolant in barycentric form. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +NOTES: + you can convert P from barycentric form to the power or Chebyshev + basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from + POLINT subpackage. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* even simple constraints can be inconsistent, see Wikipedia article on + this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints is NOT GUARANTEED. +* in the one special cases, however, we can guarantee consistency. This + case is: M>1 and constraints on the function values (NOT DERIVATIVES) + +Our final recommendation is to use constraints WHEN AND ONLY when you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialfitwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialfitwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted fitting by polynomials in barycentric form, with constraints on +function values or first derivatives. + +Small regularizing term is used when solving constrained tasks (to improve +stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO: + PolynomialFit() + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points, N>0. + * if given, only leading N elements of X/Y/W are used + * if not given, automatically determined from sizes of X/Y/W + XC - points where polynomial values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that P(XC[i])=YC[i] + * DC[i]=1 means that P'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints, 0<=K=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + P - interpolant in barycentric form. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +NOTES: + you can convert P from barycentric form to the power or Chebyshev + basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from + POLINT subpackage. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* even simple constraints can be inconsistent, see Wikipedia article on + this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints is NOT GUARANTEED. +* in the one special cases, however, we can guarantee consistency. This + case is: M>1 and constraints on the function values (NOT DERIVATIVES) + +Our final recommendation is to use constraints WHEN AND ONLY when you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialfitwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t k; + if( (x.length()!=y.length()) || (x.length()!=w.length())) + throw ap_error("Error while calling 'polynomialfitwc': looks like one of arguments has wrong size"); + if( (xc.length()!=yc.length()) || (xc.length()!=dc.length())) + throw ap_error("Error while calling 'polynomialfitwc': looks like one of arguments has wrong size"); + n = x.length(); + k = xc.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::polynomialfitwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(p.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weghted rational least squares fitting using Floater-Hormann rational +functions with optimal D chosen from [0,9], with constraints and +individual weights. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least WEIGHTED root +mean square error) is chosen. Task is linear, so linear least squares +solver is used. Complexity of this computational scheme is O(N*M^2) +(mostly dominated by the least squares solver). + +SEE ALSO +* BarycentricFitFloaterHormann(), "lightweight" fitting without invididual + weights and constraints. + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points, N>0. + XC - points where function values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints, 0<=K=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + -1 means another errors in parameters passed + (N<=0, for example) + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroutine doesn't calculate task's condition number for K<>0. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained barycentric interpolants: +* excessive constraints can be inconsistent. Floater-Hormann basis + functions aren't as flexible as splines (although they are very smooth). +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints IS NOT GUARANTEED. +* in the several special cases, however, we CAN guarantee consistency. +* one of this cases is constraints on the function VALUES at the interval + boundaries. Note that consustency of the constraints on the function + DERIVATIVES is NOT guaranteed (you can use in such cases cubic splines + which are more flexible). +* another special case is ONE constraint on the function value (OR, but + not AND, derivative) anywhere in the interval + +Our final recommendation is to use constraints WHEN AND ONLY WHEN you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricfitfloaterhormannwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, barycentricinterpolant &b, barycentricfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentricfitfloaterhormannwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(b.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Rational least squares fitting using Floater-Hormann rational functions +with optimal D chosen from [0,9]. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least root mean +square error) is chosen. Task is linear, so linear least squares solver +is used. Complexity of this computational scheme is O(N*M^2) (mostly +dominated by the least squares solver). + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0. + M - number of basis functions ( = number_of_nodes), M>=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricfitfloaterhormann(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, barycentricinterpolant &b, barycentricfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::barycentricfitfloaterhormann(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(b.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Rational least squares fitting using Floater-Hormann rational functions +with optimal D chosen from [0,9]. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least root mean +square error) is chosen. Task is linear, so linear least squares solver +is used. Complexity of this computational scheme is O(N*M^2) (mostly +dominated by the least squares solver). + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0. + M - number of basis functions ( = number_of_nodes), M>=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitpenalized(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfitpenalized(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, rho, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Rational least squares fitting using Floater-Hormann rational functions +with optimal D chosen from [0,9]. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least root mean +square error) is chosen. Task is linear, so linear least squares solver +is used. Complexity of this computational scheme is O(N*M^2) (mostly +dominated by the least squares solver). + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0. + M - number of basis functions ( = number_of_nodes), M>=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitpenalized(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dfitpenalized': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfitpenalized(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, rho, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted fitting by penalized cubic spline. + +Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are cubic splines with natural boundary +conditions. Problem is regularized by adding non-linearity penalty to the +usual least squares penalty function: + + S(x) = arg min { LS + P }, where + LS = SUM { w[i]^2*(y[i] - S(x[i]))^2 } - least squares penalty + P = C*10^rho*integral{ S''(x)^2*dx } - non-linearity penalty + rho - tunable constant given by user + C - automatically determined scale parameter, + makes penalty invariant with respect to scaling of X, Y, W. + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + problem. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + M - number of basis functions ( = number_of_nodes), M>=4. + Rho - regularization constant passed by user. It penalizes + nonlinearity in the regression spline. It is logarithmically + scaled, i.e. actual value of regularization constant is + calculated as 10^Rho. It is automatically scaled so that: + * Rho=2.0 corresponds to moderate amount of nonlinearity + * generally, it should be somewhere in the [-8.0,+8.0] + If you do not want to penalize nonlineary, + pass small Rho. Values as low as -15 should work. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD or + Cholesky decomposition; problem may be + too ill-conditioned (very rare) + S - spline interpolant. + Rep - Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +NOTE 1: additional nodes are added to the spline outside of the fitting +interval to force linearity when xmax(x,xc). It is done +for consistency - we penalize non-linearity at [min(x,xc),max(x,xc)], so +it is natural to force linearity outside of this interval. + +NOTE 2: function automatically sorts points, so caller may pass unsorted +array. + + -- ALGLIB PROJECT -- + Copyright 19.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitpenalizedw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfitpenalizedw(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, m, rho, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted fitting by penalized cubic spline. + +Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are cubic splines with natural boundary +conditions. Problem is regularized by adding non-linearity penalty to the +usual least squares penalty function: + + S(x) = arg min { LS + P }, where + LS = SUM { w[i]^2*(y[i] - S(x[i]))^2 } - least squares penalty + P = C*10^rho*integral{ S''(x)^2*dx } - non-linearity penalty + rho - tunable constant given by user + C - automatically determined scale parameter, + makes penalty invariant with respect to scaling of X, Y, W. + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + problem. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + M - number of basis functions ( = number_of_nodes), M>=4. + Rho - regularization constant passed by user. It penalizes + nonlinearity in the regression spline. It is logarithmically + scaled, i.e. actual value of regularization constant is + calculated as 10^Rho. It is automatically scaled so that: + * Rho=2.0 corresponds to moderate amount of nonlinearity + * generally, it should be somewhere in the [-8.0,+8.0] + If you do not want to penalize nonlineary, + pass small Rho. Values as low as -15 should work. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD or + Cholesky decomposition; problem may be + too ill-conditioned (very rare) + S - spline interpolant. + Rep - Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +NOTE 1: additional nodes are added to the spline outside of the fitting +interval to force linearity when xmax(x,xc). It is done +for consistency - we penalize non-linearity at [min(x,xc),max(x,xc)], so +it is natural to force linearity outside of this interval. + +NOTE 2: function automatically sorts points, so caller may pass unsorted +array. + + -- ALGLIB PROJECT -- + Copyright 19.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitpenalizedw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length()) || (x.length()!=w.length())) + throw ap_error("Error while calling 'spline1dfitpenalizedw': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfitpenalizedw(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, m, rho, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted fitting by cubic spline, with constraints on function values or +derivatives. + +Equidistant grid with M-2 nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are cubic splines with continuous second +derivatives and non-fixed first derivatives at interval ends. Small +regularizing term is used when solving constrained tasks (to improve +stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO + Spline1DFitHermiteWC() - fitting by Hermite splines (more flexible, + less smooth) + Spline1DFitCubic() - "lightweight" fitting by cubic splines, + without invididual weights and constraints + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + XC - points where spline values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints (optional): + * 0<=K=4. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + S - spline interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* excessive constraints can be inconsistent. Splines are piecewise cubic + functions, and it is easy to create an example, where large number of + constraints concentrated in small area will result in inconsistency. + Just because spline is not flexible enough to satisfy all of them. And + same constraints spread across the [min(x),max(x)] will be perfectly + consistent. +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints IS NOT GUARANTEED. +* in the several special cases, however, we CAN guarantee consistency. +* one of this cases is constraints on the function values AND/OR its + derivatives at the interval boundaries. +* another special case is ONE constraint on the function value (OR, but + not AND, derivative) anywhere in the interval + +Our final recommendation is to use constraints WHEN AND ONLY WHEN you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitcubicwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfitcubicwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted fitting by cubic spline, with constraints on function values or +derivatives. + +Equidistant grid with M-2 nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are cubic splines with continuous second +derivatives and non-fixed first derivatives at interval ends. Small +regularizing term is used when solving constrained tasks (to improve +stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO + Spline1DFitHermiteWC() - fitting by Hermite splines (more flexible, + less smooth) + Spline1DFitCubic() - "lightweight" fitting by cubic splines, + without invididual weights and constraints + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + XC - points where spline values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints (optional): + * 0<=K=4. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + S - spline interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* excessive constraints can be inconsistent. Splines are piecewise cubic + functions, and it is easy to create an example, where large number of + constraints concentrated in small area will result in inconsistency. + Just because spline is not flexible enough to satisfy all of them. And + same constraints spread across the [min(x),max(x)] will be perfectly + consistent. +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints IS NOT GUARANTEED. +* in the several special cases, however, we CAN guarantee consistency. +* one of this cases is constraints on the function values AND/OR its + derivatives at the interval boundaries. +* another special case is ONE constraint on the function value (OR, but + not AND, derivative) anywhere in the interval + +Our final recommendation is to use constraints WHEN AND ONLY WHEN you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitcubicwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t k; + if( (x.length()!=y.length()) || (x.length()!=w.length())) + throw ap_error("Error while calling 'spline1dfitcubicwc': looks like one of arguments has wrong size"); + if( (xc.length()!=yc.length()) || (xc.length()!=dc.length())) + throw ap_error("Error while calling 'spline1dfitcubicwc': looks like one of arguments has wrong size"); + n = x.length(); + k = xc.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfitcubicwc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted fitting by Hermite spline, with constraints on function values +or first derivatives. + +Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are Hermite splines. Small regularizing +term is used when solving constrained tasks (to improve stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO + Spline1DFitCubicWC() - fitting by Cubic splines (less flexible, + more smooth) + Spline1DFitHermite() - "lightweight" Hermite fitting, without + invididual weights and constraints + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + XC - points where spline values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints (optional): + * 0<=K=4, + M IS EVEN! + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + -2 means odd M was passed (which is not supported) + -1 means another errors in parameters passed + (N<=0, for example) + S - spline interpolant. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +IMPORTANT: + this subroitine supports only even M's + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* excessive constraints can be inconsistent. Splines are piecewise cubic + functions, and it is easy to create an example, where large number of + constraints concentrated in small area will result in inconsistency. + Just because spline is not flexible enough to satisfy all of them. And + same constraints spread across the [min(x),max(x)] will be perfectly + consistent. +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints is NOT GUARANTEED. +* in the several special cases, however, we can guarantee consistency. +* one of this cases is M>=4 and constraints on the function value + (AND/OR its derivative) at the interval boundaries. +* another special case is M>=4 and ONE constraint on the function value + (OR, BUT NOT AND, derivative) anywhere in [min(x),max(x)] + +Our final recommendation is to use constraints WHEN AND ONLY when you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfithermitewc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfithermitewc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted fitting by Hermite spline, with constraints on function values +or first derivatives. + +Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are Hermite splines. Small regularizing +term is used when solving constrained tasks (to improve stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO + Spline1DFitCubicWC() - fitting by Cubic splines (less flexible, + more smooth) + Spline1DFitHermite() - "lightweight" Hermite fitting, without + invididual weights and constraints + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + XC - points where spline values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints (optional): + * 0<=K=4, + M IS EVEN! + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + -2 means odd M was passed (which is not supported) + -1 means another errors in parameters passed + (N<=0, for example) + S - spline interpolant. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +IMPORTANT: + this subroitine supports only even M's + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* excessive constraints can be inconsistent. Splines are piecewise cubic + functions, and it is easy to create an example, where large number of + constraints concentrated in small area will result in inconsistency. + Just because spline is not flexible enough to satisfy all of them. And + same constraints spread across the [min(x),max(x)] will be perfectly + consistent. +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints is NOT GUARANTEED. +* in the several special cases, however, we can guarantee consistency. +* one of this cases is M>=4 and constraints on the function value + (AND/OR its derivative) at the interval boundaries. +* another special case is M>=4 and ONE constraint on the function value + (OR, BUT NOT AND, derivative) anywhere in [min(x),max(x)] + +Our final recommendation is to use constraints WHEN AND ONLY when you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfithermitewc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t k; + if( (x.length()!=y.length()) || (x.length()!=w.length())) + throw ap_error("Error while calling 'spline1dfithermitewc': looks like one of arguments has wrong size"); + if( (xc.length()!=yc.length()) || (xc.length()!=dc.length())) + throw ap_error("Error while calling 'spline1dfithermitewc': looks like one of arguments has wrong size"); + n = x.length(); + k = xc.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfithermitewc(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), n, const_cast(xc.c_ptr()), const_cast(yc.c_ptr()), const_cast(dc.c_ptr()), k, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Least squares fitting by cubic spline. + +This subroutine is "lightweight" alternative for more complex and feature- +rich Spline1DFitCubicWC(). See Spline1DFitCubicWC() for more information +about subroutine parameters (we don't duplicate it here because of length) + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfitcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Least squares fitting by cubic spline. + +This subroutine is "lightweight" alternative for more complex and feature- +rich Spline1DFitCubicWC(). See Spline1DFitCubicWC() for more information +about subroutine parameters (we don't duplicate it here because of length) + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dfitcubic': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfitcubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Least squares fitting by Hermite spline. + +This subroutine is "lightweight" alternative for more complex and feature- +rich Spline1DFitHermiteWC(). See Spline1DFitHermiteWC() description for +more information about subroutine parameters (we don't duplicate it here +because of length). + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfithermite(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfithermite(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Least squares fitting by Hermite spline. + +This subroutine is "lightweight" alternative for more complex and feature- +rich Spline1DFitHermiteWC(). See Spline1DFitHermiteWC() description for +more information about subroutine parameters (we don't duplicate it here +because of length). + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfithermite(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spline1dfithermite': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline1dfithermite(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m, &info, const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted linear least squares fitting. + +QR decomposition is used to reduce task to MxM, then triangular solver or +SVD-based solver is used depending on condition number of the system. It +allows to maximize speed and retain decent accuracy. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + W - array[0..N-1] Weights corresponding to function values. + Each summand in square sum of approximation deviations + from given values is multiplied by the square of + corresponding weight. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I, J] - value of J-th basis function in I-th point. + N - number of points used. N>=1. + M - number of basis functions, M>=1. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -1 incorrect N/M were specified + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * Rep.TaskRCond reciprocal of condition number + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearw(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const ae_int_t n, const ae_int_t m, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitlinearw(const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(fmatrix.c_ptr()), n, m, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted linear least squares fitting. + +QR decomposition is used to reduce task to MxM, then triangular solver or +SVD-based solver is used depending on condition number of the system. It +allows to maximize speed and retain decent accuracy. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + W - array[0..N-1] Weights corresponding to function values. + Each summand in square sum of approximation deviations + from given values is multiplied by the square of + corresponding weight. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I, J] - value of J-th basis function in I-th point. + N - number of points used. N>=1. + M - number of basis functions, M>=1. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -1 incorrect N/M were specified + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * Rep.TaskRCond reciprocal of condition number + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearw(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + if( (y.length()!=w.length()) || (y.length()!=fmatrix.rows())) + throw ap_error("Error while calling 'lsfitlinearw': looks like one of arguments has wrong size"); + n = y.length(); + m = fmatrix.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitlinearw(const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(fmatrix.c_ptr()), n, m, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted constained linear least squares fitting. + +This is variation of LSFitLinearW(), which searchs for min|A*x=b| given +that K additional constaints C*x=bc are satisfied. It reduces original +task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinearW() +is called. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + W - array[0..N-1] Weights corresponding to function values. + Each summand in square sum of approximation deviations + from given values is multiplied by the square of + corresponding weight. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I,J] - value of J-th basis function in I-th point. + CMatrix - a table of constaints, array[0..K-1,0..M]. + I-th row of CMatrix corresponds to I-th linear constraint: + CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] + N - number of points used. N>=1. + M - number of basis functions, M>=1. + K - number of constraints, 0 <= K < M + K=0 corresponds to absence of constraints. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -3 either too many constraints (M or more), + degenerate constraints (some constraints are + repetead twice) or inconsistent constraints were + specified. + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 07.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearwc(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const real_2d_array &cmatrix, const ae_int_t n, const ae_int_t m, const ae_int_t k, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitlinearwc(const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(fmatrix.c_ptr()), const_cast(cmatrix.c_ptr()), n, m, k, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted constained linear least squares fitting. + +This is variation of LSFitLinearW(), which searchs for min|A*x=b| given +that K additional constaints C*x=bc are satisfied. It reduces original +task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinearW() +is called. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + W - array[0..N-1] Weights corresponding to function values. + Each summand in square sum of approximation deviations + from given values is multiplied by the square of + corresponding weight. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I,J] - value of J-th basis function in I-th point. + CMatrix - a table of constaints, array[0..K-1,0..M]. + I-th row of CMatrix corresponds to I-th linear constraint: + CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] + N - number of points used. N>=1. + M - number of basis functions, M>=1. + K - number of constraints, 0 <= K < M + K=0 corresponds to absence of constraints. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -3 either too many constraints (M or more), + degenerate constraints (some constraints are + repetead twice) or inconsistent constraints were + specified. + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 07.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearwc(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const real_2d_array &cmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + ae_int_t k; + if( (y.length()!=w.length()) || (y.length()!=fmatrix.rows())) + throw ap_error("Error while calling 'lsfitlinearwc': looks like one of arguments has wrong size"); + if( (fmatrix.cols()!=cmatrix.cols()-1)) + throw ap_error("Error while calling 'lsfitlinearwc': looks like one of arguments has wrong size"); + n = y.length(); + m = fmatrix.cols(); + k = cmatrix.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitlinearwc(const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(fmatrix.c_ptr()), const_cast(cmatrix.c_ptr()), n, m, k, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Linear least squares fitting. + +QR decomposition is used to reduce task to MxM, then triangular solver or +SVD-based solver is used depending on condition number of the system. It +allows to maximize speed and retain decent accuracy. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I, J] - value of J-th basis function in I-th point. + N - number of points used. N>=1. + M - number of basis functions, M>=1. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * Rep.TaskRCond reciprocal of condition number + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinear(const real_1d_array &y, const real_2d_array &fmatrix, const ae_int_t n, const ae_int_t m, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitlinear(const_cast(y.c_ptr()), const_cast(fmatrix.c_ptr()), n, m, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Linear least squares fitting. + +QR decomposition is used to reduce task to MxM, then triangular solver or +SVD-based solver is used depending on condition number of the system. It +allows to maximize speed and retain decent accuracy. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I, J] - value of J-th basis function in I-th point. + N - number of points used. N>=1. + M - number of basis functions, M>=1. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * Rep.TaskRCond reciprocal of condition number + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinear(const real_1d_array &y, const real_2d_array &fmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + if( (y.length()!=fmatrix.rows())) + throw ap_error("Error while calling 'lsfitlinear': looks like one of arguments has wrong size"); + n = y.length(); + m = fmatrix.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitlinear(const_cast(y.c_ptr()), const_cast(fmatrix.c_ptr()), n, m, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Constained linear least squares fitting. + +This is variation of LSFitLinear(), which searchs for min|A*x=b| given +that K additional constaints C*x=bc are satisfied. It reduces original +task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinear() +is called. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I,J] - value of J-th basis function in I-th point. + CMatrix - a table of constaints, array[0..K-1,0..M]. + I-th row of CMatrix corresponds to I-th linear constraint: + CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] + N - number of points used. N>=1. + M - number of basis functions, M>=1. + K - number of constraints, 0 <= K < M + K=0 corresponds to absence of constraints. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -3 either too many constraints (M or more), + degenerate constraints (some constraints are + repetead twice) or inconsistent constraints were + specified. + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 07.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearc(const real_1d_array &y, const real_2d_array &fmatrix, const real_2d_array &cmatrix, const ae_int_t n, const ae_int_t m, const ae_int_t k, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitlinearc(const_cast(y.c_ptr()), const_cast(fmatrix.c_ptr()), const_cast(cmatrix.c_ptr()), n, m, k, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Constained linear least squares fitting. + +This is variation of LSFitLinear(), which searchs for min|A*x=b| given +that K additional constaints C*x=bc are satisfied. It reduces original +task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinear() +is called. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I,J] - value of J-th basis function in I-th point. + CMatrix - a table of constaints, array[0..K-1,0..M]. + I-th row of CMatrix corresponds to I-th linear constraint: + CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] + N - number of points used. N>=1. + M - number of basis functions, M>=1. + K - number of constraints, 0 <= K < M + K=0 corresponds to absence of constraints. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -3 either too many constraints (M or more), + degenerate constraints (some constraints are + repetead twice) or inconsistent constraints were + specified. + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 07.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearc(const real_1d_array &y, const real_2d_array &fmatrix, const real_2d_array &cmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + ae_int_t k; + if( (y.length()!=fmatrix.rows())) + throw ap_error("Error while calling 'lsfitlinearc': looks like one of arguments has wrong size"); + if( (fmatrix.cols()!=cmatrix.cols()-1)) + throw ap_error("Error while calling 'lsfitlinearc': looks like one of arguments has wrong size"); + n = y.length(); + m = fmatrix.cols(); + k = cmatrix.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitlinearc(const_cast(y.c_ptr()), const_cast(fmatrix.c_ptr()), const_cast(cmatrix.c_ptr()), n, m, k, &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted nonlinear least squares fitting using function values only. + +Combination of numerical differentiation and secant updates is used to +obtain function Jacobian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]). + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + DiffStep- numerical differentiation step; + should not be very small or large; + large = loss of accuracy + small = growth of round-off errors + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 18.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewf(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const double diffstep, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatewf(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted nonlinear least squares fitting using function values only. + +Combination of numerical differentiation and secant updates is used to +obtain function Jacobian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]). + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + DiffStep- numerical differentiation step; + should not be very small or large; + large = loss of accuracy + small = growth of round-off errors + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 18.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewf(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const double diffstep, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + ae_int_t k; + if( (x.rows()!=y.length()) || (x.rows()!=w.length())) + throw ap_error("Error while calling 'lsfitcreatewf': looks like one of arguments has wrong size"); + n = x.rows(); + m = x.cols(); + k = c.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatewf(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Nonlinear least squares fitting using function values only. + +Combination of numerical differentiation and secant updates is used to +obtain function Jacobian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (f(c,x[0])-y[0])^2 + ... + (f(c,x[n-1])-y[n-1])^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]). + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + DiffStep- numerical differentiation step; + should not be very small or large; + large = loss of accuracy + small = growth of round-off errors + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 18.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatef(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const double diffstep, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatef(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Nonlinear least squares fitting using function values only. + +Combination of numerical differentiation and secant updates is used to +obtain function Jacobian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (f(c,x[0])-y[0])^2 + ... + (f(c,x[n-1])-y[n-1])^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]). + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + DiffStep- numerical differentiation step; + should not be very small or large; + large = loss of accuracy + small = growth of round-off errors + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 18.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatef(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const double diffstep, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + ae_int_t k; + if( (x.rows()!=y.length())) + throw ap_error("Error while calling 'lsfitcreatef': looks like one of arguments has wrong size"); + n = x.rows(); + m = x.cols(); + k = c.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatef(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted nonlinear least squares fitting using gradient only. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]) and its gradient. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + CheapFG - boolean flag, which is: + * True if both function and gradient calculation complexity + are less than O(M^2). An improved algorithm can + be used which corresponds to FGJ scheme from + MINLM unit. + * False otherwise. + Standard Jacibian-bases Levenberg-Marquardt algo + will be used (FJ scheme). + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +See also: + LSFitResults + LSFitCreateFG (fitting without weights) + LSFitCreateWFGH (fitting using Hessian) + LSFitCreateFGH (fitting using Hessian, without weights) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewfg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const bool cheapfg, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatewfg(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, cheapfg, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted nonlinear least squares fitting using gradient only. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]) and its gradient. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + CheapFG - boolean flag, which is: + * True if both function and gradient calculation complexity + are less than O(M^2). An improved algorithm can + be used which corresponds to FGJ scheme from + MINLM unit. + * False otherwise. + Standard Jacibian-bases Levenberg-Marquardt algo + will be used (FJ scheme). + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +See also: + LSFitResults + LSFitCreateFG (fitting without weights) + LSFitCreateWFGH (fitting using Hessian) + LSFitCreateFGH (fitting using Hessian, without weights) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewfg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const bool cheapfg, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + ae_int_t k; + if( (x.rows()!=y.length()) || (x.rows()!=w.length())) + throw ap_error("Error while calling 'lsfitcreatewfg': looks like one of arguments has wrong size"); + n = x.rows(); + m = x.cols(); + k = c.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatewfg(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, cheapfg, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Nonlinear least squares fitting using gradient only, without individual +weights. + +Nonlinear task min(F(c)) is solved, where + + F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]) and its gradient. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + CheapFG - boolean flag, which is: + * True if both function and gradient calculation complexity + are less than O(M^2). An improved algorithm can + be used which corresponds to FGJ scheme from + MINLM unit. + * False otherwise. + Standard Jacibian-bases Levenberg-Marquardt algo + will be used (FJ scheme). + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatefg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const bool cheapfg, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatefg(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, cheapfg, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Nonlinear least squares fitting using gradient only, without individual +weights. + +Nonlinear task min(F(c)) is solved, where + + F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]) and its gradient. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + CheapFG - boolean flag, which is: + * True if both function and gradient calculation complexity + are less than O(M^2). An improved algorithm can + be used which corresponds to FGJ scheme from + MINLM unit. + * False otherwise. + Standard Jacibian-bases Levenberg-Marquardt algo + will be used (FJ scheme). + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatefg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const bool cheapfg, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + ae_int_t k; + if( (x.rows()!=y.length())) + throw ap_error("Error while calling 'lsfitcreatefg': looks like one of arguments has wrong size"); + n = x.rows(); + m = x.cols(); + k = c.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatefg(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, cheapfg, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted nonlinear least squares fitting using gradient/Hessian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses f(c,x[i]), its gradient and its Hessian. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewfgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatewfgh(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Weighted nonlinear least squares fitting using gradient/Hessian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses f(c,x[i]), its gradient and its Hessian. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewfgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + ae_int_t k; + if( (x.rows()!=y.length()) || (x.rows()!=w.length())) + throw ap_error("Error while calling 'lsfitcreatewfgh': looks like one of arguments has wrong size"); + n = x.rows(); + m = x.cols(); + k = c.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatewfgh(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(w.c_ptr()), const_cast(c.c_ptr()), n, m, k, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Nonlinear least squares fitting using gradient/Hessian, without individial +weights. + +Nonlinear task min(F(c)) is solved, where + + F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses f(c,x[i]), its gradient and its Hessian. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatefgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatefgh(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Nonlinear least squares fitting using gradient/Hessian, without individial +weights. + +Nonlinear task min(F(c)) is solved, where + + F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses f(c,x[i]), its gradient and its Hessian. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatefgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + ae_int_t k; + if( (x.rows()!=y.length())) + throw ap_error("Error while calling 'lsfitcreatefgh': looks like one of arguments has wrong size"); + n = x.rows(); + m = x.cols(); + k = c.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitcreatefgh(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(c.c_ptr()), n, m, k, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Stopping conditions for nonlinear least squares fitting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsF - stopping criterion. Algorithm stops if + |F(k+1)-F(k)| <= EpsF*max{|F(k)|, |F(k+1)|, 1} + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by LSFitSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. Only Levenberg-Marquardt + iterations are counted (L-BFGS/CG iterations are NOT + counted because their cost is very low compared to that of + LM). + +NOTE + +Passing EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to automatic +stopping criterion selection (according to the scheme used by MINLM unit). + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetcond(const lsfitstate &state, const double epsf, const double epsx, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitsetcond(const_cast(state.c_ptr()), epsf, epsx, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + +NOTE: non-zero StpMax leads to moderate performance degradation because +intermediate step of preconditioned L-BFGS optimization is incompatible +with limits on step size. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetstpmax(const lsfitstate &state, const double stpmax) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +When reports are needed, State.C (current parameters) and State.F (current +value of fitting function) are reported. + + + -- ALGLIB -- + Copyright 15.08.2010 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetxrep(const lsfitstate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets scaling coefficients for underlying optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Generally, scale is NOT considered to be a form of preconditioner. But LM +optimizer is unique in that it uses scaling matrix both in the stopping +condition tests and as Marquardt damping factor. + +Proper scaling is very important for the algorithm performance. It is less +important for the quality of results, but still has some influence (it is +easier to converge when variables are properly scaled, so premature +stopping is possible when very badly scalled variables are combined with +relaxed stopping conditions). + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetscale(const lsfitstate &state, const real_1d_array &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets boundary constraints for underlying optimizer + +Boundary constraints are inactive by default (after initial creation). +They are preserved until explicitly turned off with another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[K]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[K]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + +NOTE 2: unlike other constrained optimization algorithms, this solver has +following useful properties: +* bound constraints are always satisfied exactly +* function is evaluated only INSIDE area specified by bound constraints + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetbc(const lsfitstate &state, const real_1d_array &bndl, const real_1d_array &bndu) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitsetbc(const_cast(state.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool lsfititeration(const lsfitstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::lsfititeration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void lsfitfit(lsfitstate &state, + void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), + void (*rep)(const real_1d_array &c, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'lsfitfit()' (func is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::lsfititeration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.c, state.x, state.f, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.c, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'lsfitfit' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void lsfitfit(lsfitstate &state, + void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), + void (*grad)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &c, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'lsfitfit()' (func is NULL)"); + if( grad==NULL ) + throw ap_error("ALGLIB: error in 'lsfitfit()' (grad is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::lsfititeration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.c, state.x, state.f, ptr); + continue; + } + if( state.needfg ) + { + grad(state.c, state.x, state.f, state.g, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.c, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'lsfitfit' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void lsfitfit(lsfitstate &state, + void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), + void (*grad)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*hess)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, real_2d_array &hess, void *ptr), + void (*rep)(const real_1d_array &c, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'lsfitfit()' (func is NULL)"); + if( grad==NULL ) + throw ap_error("ALGLIB: error in 'lsfitfit()' (grad is NULL)"); + if( hess==NULL ) + throw ap_error("ALGLIB: error in 'lsfitfit()' (hess is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::lsfititeration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.c, state.x, state.f, ptr); + continue; + } + if( state.needfg ) + { + grad(state.c, state.x, state.f, state.g, ptr); + continue; + } + if( state.needfgh ) + { + hess(state.c, state.x, state.f, state.g, state.h, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.c, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'lsfitfit' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +Nonlinear least squares fitting results. + +Called after return from LSFitFit(). + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + Info - completion code: + * -7 gradient verification failed. + See LSFitSetGradientCheck() for more information. + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + C - array[0..K-1], solution + Rep - optimization report. On success following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + * WRMSError weighted rms error on the (X,Y). + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(J*CovPar*J')), + where J is Jacobian matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitresults(const lsfitstate &state, ae_int_t &info, real_1d_array &c, lsfitreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitresults(const_cast(state.c_ptr()), &info, const_cast(c.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before fitting begins +* LSFitFit() is called +* prior to actual fitting, for each point in data set X_i and each + component of parameters being fited C_j algorithm performs following + steps: + * two trial steps are made to C_j-TestStep*S[j] and C_j+TestStep*S[j], + where C_j is j-th parameter and S[j] is a scale of j-th parameter + * if needed, steps are bounded with respect to constraints on C[] + * F(X_i|C) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N*K (points count * parameters count) gradient + evaluations. It is very costly and you should use it only for low + dimensional problems, when you want to be sure that you've + correctly calculated analytic derivatives. You should not use it + in the production code (unless you want to check derivatives + provided by some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with LSFitSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +NOTE 4: this function works only for optimizers created with LSFitCreateWFG() + or LSFitCreateFG() constructors. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetgradientcheck(const lsfitstate &state, const double teststep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lsfitsetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Parametric spline inteprolant: 2-dimensional curve. + +You should not try to access its members directly - use PSpline2XXXXXXXX() +functions instead. +*************************************************************************/ +_pspline2interpolant_owner::_pspline2interpolant_owner() +{ + p_struct = (alglib_impl::pspline2interpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::pspline2interpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_pspline2interpolant_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_pspline2interpolant_owner::_pspline2interpolant_owner(const _pspline2interpolant_owner &rhs) +{ + p_struct = (alglib_impl::pspline2interpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::pspline2interpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_pspline2interpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_pspline2interpolant_owner& _pspline2interpolant_owner::operator=(const _pspline2interpolant_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_pspline2interpolant_clear(p_struct); + if( !alglib_impl::_pspline2interpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_pspline2interpolant_owner::~_pspline2interpolant_owner() +{ + alglib_impl::_pspline2interpolant_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::pspline2interpolant* _pspline2interpolant_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::pspline2interpolant* _pspline2interpolant_owner::c_ptr() const +{ + return const_cast(p_struct); +} +pspline2interpolant::pspline2interpolant() : _pspline2interpolant_owner() +{ +} + +pspline2interpolant::pspline2interpolant(const pspline2interpolant &rhs):_pspline2interpolant_owner(rhs) +{ +} + +pspline2interpolant& pspline2interpolant::operator=(const pspline2interpolant &rhs) +{ + if( this==&rhs ) + return *this; + _pspline2interpolant_owner::operator=(rhs); + return *this; +} + +pspline2interpolant::~pspline2interpolant() +{ +} + + +/************************************************************************* +Parametric spline inteprolant: 3-dimensional curve. + +You should not try to access its members directly - use PSpline3XXXXXXXX() +functions instead. +*************************************************************************/ +_pspline3interpolant_owner::_pspline3interpolant_owner() +{ + p_struct = (alglib_impl::pspline3interpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::pspline3interpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_pspline3interpolant_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_pspline3interpolant_owner::_pspline3interpolant_owner(const _pspline3interpolant_owner &rhs) +{ + p_struct = (alglib_impl::pspline3interpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::pspline3interpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_pspline3interpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_pspline3interpolant_owner& _pspline3interpolant_owner::operator=(const _pspline3interpolant_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_pspline3interpolant_clear(p_struct); + if( !alglib_impl::_pspline3interpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_pspline3interpolant_owner::~_pspline3interpolant_owner() +{ + alglib_impl::_pspline3interpolant_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::pspline3interpolant* _pspline3interpolant_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::pspline3interpolant* _pspline3interpolant_owner::c_ptr() const +{ + return const_cast(p_struct); +} +pspline3interpolant::pspline3interpolant() : _pspline3interpolant_owner() +{ +} + +pspline3interpolant::pspline3interpolant(const pspline3interpolant &rhs):_pspline3interpolant_owner(rhs) +{ +} + +pspline3interpolant& pspline3interpolant::operator=(const pspline3interpolant &rhs) +{ + if( this==&rhs ) + return *this; + _pspline3interpolant_owner::operator=(rhs); + return *this; +} + +pspline3interpolant::~pspline3interpolant() +{ +} + +/************************************************************************* +This function builds non-periodic 2-dimensional parametric spline which +starts at (X[0],Y[0]) and ends at (X[N-1],Y[N-1]). + +INPUT PARAMETERS: + XY - points, array[0..N-1,0..1]. + XY[I,0:1] corresponds to the Ith point. + Order of points is important! + N - points count, N>=5 for Akima splines, N>=2 for other types of + splines. + ST - spline type: + * 0 Akima spline + * 1 parabolically terminated Catmull-Rom spline (Tension=0) + * 2 parabolically terminated cubic spline + PT - parameterization type: + * 0 uniform + * 1 chord length + * 2 centripetal + +OUTPUT PARAMETERS: + P - parametric spline interpolant + + +NOTES: +* this function assumes that there all consequent points are distinct. + I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. + However, non-consequent points may coincide, i.e. we can have (x0,y0)= + =(x2,y2). + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2build(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline2interpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline2build(const_cast(xy.c_ptr()), n, st, pt, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function builds non-periodic 3-dimensional parametric spline which +starts at (X[0],Y[0],Z[0]) and ends at (X[N-1],Y[N-1],Z[N-1]). + +Same as PSpline2Build() function, but for 3D, so we won't duplicate its +description here. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3build(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline3interpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline3build(const_cast(xy.c_ptr()), n, st, pt, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function builds periodic 2-dimensional parametric spline which +starts at (X[0],Y[0]), goes through all points to (X[N-1],Y[N-1]) and then +back to (X[0],Y[0]). + +INPUT PARAMETERS: + XY - points, array[0..N-1,0..1]. + XY[I,0:1] corresponds to the Ith point. + XY[N-1,0:1] must be different from XY[0,0:1]. + Order of points is important! + N - points count, N>=3 for other types of splines. + ST - spline type: + * 1 Catmull-Rom spline (Tension=0) with cyclic boundary conditions + * 2 cubic spline with cyclic boundary conditions + PT - parameterization type: + * 0 uniform + * 1 chord length + * 2 centripetal + +OUTPUT PARAMETERS: + P - parametric spline interpolant + + +NOTES: +* this function assumes that there all consequent points are distinct. + I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. + However, non-consequent points may coincide, i.e. we can have (x0,y0)= + =(x2,y2). +* last point of sequence is NOT equal to the first point. You shouldn't + make curve "explicitly periodic" by making them equal. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2buildperiodic(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline2interpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline2buildperiodic(const_cast(xy.c_ptr()), n, st, pt, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function builds periodic 3-dimensional parametric spline which +starts at (X[0],Y[0],Z[0]), goes through all points to (X[N-1],Y[N-1],Z[N-1]) +and then back to (X[0],Y[0],Z[0]). + +Same as PSpline2Build() function, but for 3D, so we won't duplicate its +description here. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3buildperiodic(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline3interpolant &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline3buildperiodic(const_cast(xy.c_ptr()), n, st, pt, const_cast(p.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns vector of parameter values correspoding to points. + +I.e. for P created from (X[0],Y[0])...(X[N-1],Y[N-1]) and U=TValues(P) we +have + (X[0],Y[0]) = PSpline2Calc(P,U[0]), + (X[1],Y[1]) = PSpline2Calc(P,U[1]), + (X[2],Y[2]) = PSpline2Calc(P,U[2]), + ... + +INPUT PARAMETERS: + P - parametric spline interpolant + +OUTPUT PARAMETERS: + N - array size + T - array[0..N-1] + + +NOTES: +* for non-periodic splines U[0]=0, U[0](p.c_ptr()), &n, const_cast(t.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns vector of parameter values correspoding to points. + +Same as PSpline2ParameterValues(), but for 3D. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3parametervalues(const pspline3interpolant &p, ae_int_t &n, real_1d_array &t) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline3parametervalues(const_cast(p.c_ptr()), &n, const_cast(t.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates the value of the parametric spline for a given +value of parameter T + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-position + Y - Y-position + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2calc(const pspline2interpolant &p, const double t, double &x, double &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline2calc(const_cast(p.c_ptr()), t, &x, &y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates the value of the parametric spline for a given +value of parameter T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-position + Y - Y-position + Z - Z-position + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3calc(const pspline3interpolant &p, const double t, double &x, double &y, double &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline3calc(const_cast(p.c_ptr()), t, &x, &y, &z, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates tangent vector for a given value of parameter T + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-component of tangent vector (normalized) + Y - Y-component of tangent vector (normalized) + +NOTE: + X^2+Y^2 is either 1 (for non-zero tangent vector) or 0. + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2tangent(const pspline2interpolant &p, const double t, double &x, double &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline2tangent(const_cast(p.c_ptr()), t, &x, &y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates tangent vector for a given value of parameter T + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-component of tangent vector (normalized) + Y - Y-component of tangent vector (normalized) + Z - Z-component of tangent vector (normalized) + +NOTE: + X^2+Y^2+Z^2 is either 1 (for non-zero tangent vector) or 0. + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3tangent(const pspline3interpolant &p, const double t, double &x, double &y, double &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline3tangent(const_cast(p.c_ptr()), t, &x, &y, &z, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates derivative, i.e. it returns (dX/dT,dY/dT). + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - X-derivative + Y - Y-value + DY - Y-derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2diff(const pspline2interpolant &p, const double t, double &x, double &dx, double &y, double &dy) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline2diff(const_cast(p.c_ptr()), t, &x, &dx, &y, &dy, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates derivative, i.e. it returns (dX/dT,dY/dT,dZ/dT). + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - X-derivative + Y - Y-value + DY - Y-derivative + Z - Z-value + DZ - Z-derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3diff(const pspline3interpolant &p, const double t, double &x, double &dx, double &y, double &dy, double &z, double &dz) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline3diff(const_cast(p.c_ptr()), t, &x, &dx, &y, &dy, &z, &dz, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates first and second derivative with respect to T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - derivative + D2X - second derivative + Y - Y-value + DY - derivative + D2Y - second derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2diff2(const pspline2interpolant &p, const double t, double &x, double &dx, double &d2x, double &y, double &dy, double &d2y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline2diff2(const_cast(p.c_ptr()), t, &x, &dx, &d2x, &y, &dy, &d2y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates first and second derivative with respect to T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - derivative + D2X - second derivative + Y - Y-value + DY - derivative + D2Y - second derivative + Z - Z-value + DZ - derivative + D2Z - second derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3diff2(const pspline3interpolant &p, const double t, double &x, double &dx, double &d2x, double &y, double &dy, double &d2y, double &z, double &dz, double &d2z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pspline3diff2(const_cast(p.c_ptr()), t, &x, &dx, &d2x, &y, &dy, &d2y, &z, &dz, &d2z, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates arc length, i.e. length of curve between t=a +and t=b. + +INPUT PARAMETERS: + P - parametric spline interpolant + A,B - parameter values corresponding to arc ends: + * B>A will result in positive length returned + * B(p.c_ptr()), a, b, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates arc length, i.e. length of curve between t=a +and t=b. + +INPUT PARAMETERS: + P - parametric spline interpolant + A,B - parameter values corresponding to arc ends: + * B>A will result in positive length returned + * B(p.c_ptr()), a, b, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +RBF model. + +Never try to directly work with fields of this object - always use ALGLIB +functions to use this object. +*************************************************************************/ +_rbfmodel_owner::_rbfmodel_owner() +{ + p_struct = (alglib_impl::rbfmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::rbfmodel), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_rbfmodel_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_rbfmodel_owner::_rbfmodel_owner(const _rbfmodel_owner &rhs) +{ + p_struct = (alglib_impl::rbfmodel*)alglib_impl::ae_malloc(sizeof(alglib_impl::rbfmodel), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_rbfmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_rbfmodel_owner& _rbfmodel_owner::operator=(const _rbfmodel_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_rbfmodel_clear(p_struct); + if( !alglib_impl::_rbfmodel_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_rbfmodel_owner::~_rbfmodel_owner() +{ + alglib_impl::_rbfmodel_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::rbfmodel* _rbfmodel_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::rbfmodel* _rbfmodel_owner::c_ptr() const +{ + return const_cast(p_struct); +} +rbfmodel::rbfmodel() : _rbfmodel_owner() +{ +} + +rbfmodel::rbfmodel(const rbfmodel &rhs):_rbfmodel_owner(rhs) +{ +} + +rbfmodel& rbfmodel::operator=(const rbfmodel &rhs) +{ + if( this==&rhs ) + return *this; + _rbfmodel_owner::operator=(rhs); + return *this; +} + +rbfmodel::~rbfmodel() +{ +} + + +/************************************************************************* +RBF solution report: +* TerminationType - termination type, positive values - success, + non-positive - failure. +*************************************************************************/ +_rbfreport_owner::_rbfreport_owner() +{ + p_struct = (alglib_impl::rbfreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::rbfreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_rbfreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_rbfreport_owner::_rbfreport_owner(const _rbfreport_owner &rhs) +{ + p_struct = (alglib_impl::rbfreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::rbfreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_rbfreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_rbfreport_owner& _rbfreport_owner::operator=(const _rbfreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_rbfreport_clear(p_struct); + if( !alglib_impl::_rbfreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_rbfreport_owner::~_rbfreport_owner() +{ + alglib_impl::_rbfreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::rbfreport* _rbfreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::rbfreport* _rbfreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +rbfreport::rbfreport() : _rbfreport_owner() ,arows(p_struct->arows),acols(p_struct->acols),annz(p_struct->annz),iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype) +{ +} + +rbfreport::rbfreport(const rbfreport &rhs):_rbfreport_owner(rhs) ,arows(p_struct->arows),acols(p_struct->acols),annz(p_struct->annz),iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype) +{ +} + +rbfreport& rbfreport::operator=(const rbfreport &rhs) +{ + if( this==&rhs ) + return *this; + _rbfreport_owner::operator=(rhs); + return *this; +} + +rbfreport::~rbfreport() +{ +} + + +/************************************************************************* +This function serializes data structure to string. + +Important properties of s_out: +* it contains alphanumeric characters, dots, underscores, minus signs +* these symbols are grouped into words, which are separated by spaces + and Windows-style (CR+LF) newlines +* although serializer uses spaces and CR+LF as separators, you can + replace any separator character by arbitrary combination of spaces, + tabs, Windows or Unix newlines. It allows flexible reformatting of + the string in case you want to include it into text or XML file. + But you should not insert separators into the middle of the "words" + nor you should change case of letters. +* s_out can be freely moved between 32-bit and 64-bit systems, little + and big endian machines, and so on. You can serialize structure on + 32-bit machine and unserialize it on 64-bit one (or vice versa), or + serialize it on SPARC and unserialize on x86. You can also + serialize it in C++ version of ALGLIB and unserialize in C# one, + and vice versa. +*************************************************************************/ +void rbfserialize(rbfmodel &obj, std::string &s_out) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + alglib_impl::ae_int_t ssize; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_alloc_start(&serializer); + alglib_impl::rbfalloc(&serializer, obj.c_ptr(), &state); + ssize = alglib_impl::ae_serializer_get_alloc_size(&serializer); + s_out.clear(); + s_out.reserve((size_t)(ssize+1)); + alglib_impl::ae_serializer_sstart_str(&serializer, &s_out); + alglib_impl::rbfserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + if( s_out.length()>(size_t)ssize ) + throw ap_error("ALGLIB: serialization integrity error"); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} +/************************************************************************* +This function unserializes data structure from string. +*************************************************************************/ +void rbfunserialize(std::string &s_in, rbfmodel &obj) +{ + alglib_impl::ae_state state; + alglib_impl::ae_serializer serializer; + + alglib_impl::ae_state_init(&state); + try + { + alglib_impl::ae_serializer_init(&serializer); + alglib_impl::ae_serializer_ustart_str(&serializer, &s_in); + alglib_impl::rbfunserialize(&serializer, obj.c_ptr(), &state); + alglib_impl::ae_serializer_stop(&serializer); + alglib_impl::ae_serializer_clear(&serializer); + alglib_impl::ae_state_clear(&state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(state.error_msg); + } +} + +/************************************************************************* +This function creates RBF model for a scalar (NY=1) or vector (NY>1) +function in a NX-dimensional space (NX=2 or NX=3). + +Newly created model is empty. It can be used for interpolation right after +creation, but it just returns zeros. You have to add points to the model, +tune interpolation settings, and then call model construction function +RBFBuildModel() which will update model according to your specification. + +USAGE: +1. User creates model with RBFCreate() +2. User adds dataset with RBFSetPoints() (points do NOT have to be on a + regular grid) +3. (OPTIONAL) User chooses polynomial term by calling: + * RBFLinTerm() to set linear term + * RBFConstTerm() to set constant term + * RBFZeroTerm() to set zero term + By default, linear term is used. +4. User chooses specific RBF algorithm to use: either QNN (RBFSetAlgoQNN) + or ML (RBFSetAlgoMultiLayer). +5. User calls RBFBuildModel() function which rebuilds model according to + the specification +6. User may call RBFCalc() to calculate model value at the specified point, + RBFGridCalc() to calculate model values at the points of the regular + grid. User may extract model coefficients with RBFUnpack() call. + +INPUT PARAMETERS: + NX - dimension of the space, NX=2 or NX=3 + NY - function dimension, NY>=1 + +OUTPUT PARAMETERS: + S - RBF model (initially equals to zero) + +NOTE 1: memory requirements. RBF models require amount of memory which is + proportional to the number of data points. Memory is allocated + during model construction, but most of this memory is freed after + model coefficients are calculated. + + Some approximate estimates for N centers with default settings are + given below: + * about 250*N*(sizeof(double)+2*sizeof(int)) bytes of memory is + needed during model construction stage. + * about 15*N*sizeof(double) bytes is needed after model is built. + For example, for N=100000 we may need 0.6 GB of memory to build + model, but just about 0.012 GB to store it. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcreate(const ae_int_t nx, const ae_int_t ny, rbfmodel &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfcreate(nx, ny, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function adds dataset. + +This function overrides results of the previous calls, i.e. multiple calls +of this function will result in only the last set being added. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call. + XY - points, array[N,NX+NY]. One row corresponds to one point + in the dataset. First NX elements are coordinates, next + NY elements are function values. Array may be larger than + specific, in this case only leading [N,NX+NY] elements + will be used. + N - number of points in the dataset + +After you've added dataset and (optionally) tuned algorithm settings you +should call RBFBuildModel() in order to build a model for you. + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetpoints(const rbfmodel &s, const real_2d_array &xy, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetpoints(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function adds dataset. + +This function overrides results of the previous calls, i.e. multiple calls +of this function will result in only the last set being added. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call. + XY - points, array[N,NX+NY]. One row corresponds to one point + in the dataset. First NX elements are coordinates, next + NY elements are function values. Array may be larger than + specific, in this case only leading [N,NX+NY] elements + will be used. + N - number of points in the dataset + +After you've added dataset and (optionally) tuned algorithm settings you +should call RBFBuildModel() in order to build a model for you. + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetpoints(const rbfmodel &s, const real_2d_array &xy) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = xy.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetpoints(const_cast(s.c_ptr()), const_cast(xy.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets RBF interpolation algorithm. ALGLIB supports several +RBF algorithms with different properties. + +This algorithm is called RBF-QNN and it is good for point sets with +following properties: +a) all points are distinct +b) all points are well separated. +c) points distribution is approximately uniform. There is no "contour + lines", clusters of points, or other small-scale structures. + +Algorithm description: +1) interpolation centers are allocated to data points +2) interpolation radii are calculated as distances to the nearest centers + times Q coefficient (where Q is a value from [0.75,1.50]). +3) after performing (2) radii are transformed in order to avoid situation + when single outlier has very large radius and influences many points + across all dataset. Transformation has following form: + new_r[i] = min(r[i],Z*median(r[])) + where r[i] is I-th radius, median() is a median radius across entire + dataset, Z is user-specified value which controls amount of deviation + from median radius. + +When (a) is violated, we will be unable to build RBF model. When (b) or +(c) are violated, model will be built, but interpolation quality will be +low. See http://www.alglib.net/interpolation/ for more information on this +subject. + +This algorithm is used by default. + +Additional Q parameter controls smoothness properties of the RBF basis: +* Q<0.75 will give perfectly conditioned basis, but terrible smoothness + properties (RBF interpolant will have sharp peaks around function values) +* Q around 1.0 gives good balance between smoothness and condition number +* Q>1.5 will lead to badly conditioned systems and slow convergence of the + underlying linear solver (although smoothness will be very good) +* Q>2.0 will effectively make optimizer useless because it won't converge + within reasonable amount of iterations. It is possible to set such large + Q, but it is advised not to do so. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + Q - Q parameter, Q>0, recommended value - 1.0 + Z - Z parameter, Z>0, recommended value - 5.0 + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetalgoqnn(const rbfmodel &s, const double q, const double z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetalgoqnn(const_cast(s.c_ptr()), q, z, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets RBF interpolation algorithm. ALGLIB supports several +RBF algorithms with different properties. + +This algorithm is called RBF-QNN and it is good for point sets with +following properties: +a) all points are distinct +b) all points are well separated. +c) points distribution is approximately uniform. There is no "contour + lines", clusters of points, or other small-scale structures. + +Algorithm description: +1) interpolation centers are allocated to data points +2) interpolation radii are calculated as distances to the nearest centers + times Q coefficient (where Q is a value from [0.75,1.50]). +3) after performing (2) radii are transformed in order to avoid situation + when single outlier has very large radius and influences many points + across all dataset. Transformation has following form: + new_r[i] = min(r[i],Z*median(r[])) + where r[i] is I-th radius, median() is a median radius across entire + dataset, Z is user-specified value which controls amount of deviation + from median radius. + +When (a) is violated, we will be unable to build RBF model. When (b) or +(c) are violated, model will be built, but interpolation quality will be +low. See http://www.alglib.net/interpolation/ for more information on this +subject. + +This algorithm is used by default. + +Additional Q parameter controls smoothness properties of the RBF basis: +* Q<0.75 will give perfectly conditioned basis, but terrible smoothness + properties (RBF interpolant will have sharp peaks around function values) +* Q around 1.0 gives good balance between smoothness and condition number +* Q>1.5 will lead to badly conditioned systems and slow convergence of the + underlying linear solver (although smoothness will be very good) +* Q>2.0 will effectively make optimizer useless because it won't converge + within reasonable amount of iterations. It is possible to set such large + Q, but it is advised not to do so. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + Q - Q parameter, Q>0, recommended value - 1.0 + Z - Z parameter, Z>0, recommended value - 5.0 + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetalgoqnn(const rbfmodel &s) +{ + alglib_impl::ae_state _alglib_env_state; + double q; + double z; + + q = 1.0; + z = 5.0; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetalgoqnn(const_cast(s.c_ptr()), q, z, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets RBF interpolation algorithm. ALGLIB supports several +RBF algorithms with different properties. + +This algorithm is called RBF-ML. It builds multilayer RBF model, i.e. +model with subsequently decreasing radii, which allows us to combine +smoothness (due to large radii of the first layers) with exactness (due +to small radii of the last layers) and fast convergence. + +Internally RBF-ML uses many different means of acceleration, from sparse +matrices to KD-trees, which results in algorithm whose working time is +roughly proportional to N*log(N)*Density*RBase^2*NLayers, where N is a +number of points, Density is an average density if points per unit of the +interpolation space, RBase is an initial radius, NLayers is a number of +layers. + +RBF-ML is good for following kinds of interpolation problems: +1. "exact" problems (perfect fit) with well separated points +2. least squares problems with arbitrary distribution of points (algorithm + gives perfect fit where it is possible, and resorts to least squares + fit in the hard areas). +3. noisy problems where we want to apply some controlled amount of + smoothing. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + RBase - RBase parameter, RBase>0 + NLayers - NLayers parameter, NLayers>0, recommended value to start + with - about 5. + LambdaV - regularization value, can be useful when solving problem + in the least squares sense. Optimal lambda is problem- + dependent and require trial and error. In our experience, + good lambda can be as large as 0.1, and you can use 0.001 + as initial guess. + Default value - 0.01, which is used when LambdaV is not + given. You can specify zero value, but it is not + recommended to do so. + +TUNING ALGORITHM + +In order to use this algorithm you have to choose three parameters: +* initial radius RBase +* number of layers in the model NLayers +* regularization coefficient LambdaV + +Initial radius is easy to choose - you can pick any number several times +larger than the average distance between points. Algorithm won't break +down if you choose radius which is too large (model construction time will +increase, but model will be built correctly). + +Choose such number of layers that RLast=RBase/2^(NLayers-1) (radius used +by the last layer) will be smaller than the typical distance between +points. In case model error is too large, you can increase number of +layers. Having more layers will make model construction and evaluation +proportionally slower, but it will allow you to have model which precisely +fits your data. From the other side, if you want to suppress noise, you +can DECREASE number of layers to make your model less flexible. + +Regularization coefficient LambdaV controls smoothness of the individual +models built for each layer. We recommend you to use default value in case +you don't want to tune this parameter, because having non-zero LambdaV +accelerates and stabilizes internal iterative algorithm. In case you want +to suppress noise you can use LambdaV as additional parameter (larger +value = more smoothness) to tune. + +TYPICAL ERRORS + +1. Using initial radius which is too large. Memory requirements of the + RBF-ML are roughly proportional to N*Density*RBase^2 (where Density is + an average density of points per unit of the interpolation space). In + the extreme case of the very large RBase we will need O(N^2) units of + memory - and many layers in order to decrease radius to some reasonably + small value. + +2. Using too small number of layers - RBF models with large radius are not + flexible enough to reproduce small variations in the target function. + You need many layers with different radii, from large to small, in + order to have good model. + +3. Using initial radius which is too small. You will get model with + "holes" in the areas which are too far away from interpolation centers. + However, algorithm will work correctly (and quickly) in this case. + +4. Using too many layers - you will get too large and too slow model. This + model will perfectly reproduce your function, but maybe you will be + able to achieve similar results with less layers (and less memory). + + -- ALGLIB -- + Copyright 02.03.2012 by Bochkanov Sergey +*************************************************************************/ +void rbfsetalgomultilayer(const rbfmodel &s, const double rbase, const ae_int_t nlayers, const double lambdav) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetalgomultilayer(const_cast(s.c_ptr()), rbase, nlayers, lambdav, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets RBF interpolation algorithm. ALGLIB supports several +RBF algorithms with different properties. + +This algorithm is called RBF-ML. It builds multilayer RBF model, i.e. +model with subsequently decreasing radii, which allows us to combine +smoothness (due to large radii of the first layers) with exactness (due +to small radii of the last layers) and fast convergence. + +Internally RBF-ML uses many different means of acceleration, from sparse +matrices to KD-trees, which results in algorithm whose working time is +roughly proportional to N*log(N)*Density*RBase^2*NLayers, where N is a +number of points, Density is an average density if points per unit of the +interpolation space, RBase is an initial radius, NLayers is a number of +layers. + +RBF-ML is good for following kinds of interpolation problems: +1. "exact" problems (perfect fit) with well separated points +2. least squares problems with arbitrary distribution of points (algorithm + gives perfect fit where it is possible, and resorts to least squares + fit in the hard areas). +3. noisy problems where we want to apply some controlled amount of + smoothing. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + RBase - RBase parameter, RBase>0 + NLayers - NLayers parameter, NLayers>0, recommended value to start + with - about 5. + LambdaV - regularization value, can be useful when solving problem + in the least squares sense. Optimal lambda is problem- + dependent and require trial and error. In our experience, + good lambda can be as large as 0.1, and you can use 0.001 + as initial guess. + Default value - 0.01, which is used when LambdaV is not + given. You can specify zero value, but it is not + recommended to do so. + +TUNING ALGORITHM + +In order to use this algorithm you have to choose three parameters: +* initial radius RBase +* number of layers in the model NLayers +* regularization coefficient LambdaV + +Initial radius is easy to choose - you can pick any number several times +larger than the average distance between points. Algorithm won't break +down if you choose radius which is too large (model construction time will +increase, but model will be built correctly). + +Choose such number of layers that RLast=RBase/2^(NLayers-1) (radius used +by the last layer) will be smaller than the typical distance between +points. In case model error is too large, you can increase number of +layers. Having more layers will make model construction and evaluation +proportionally slower, but it will allow you to have model which precisely +fits your data. From the other side, if you want to suppress noise, you +can DECREASE number of layers to make your model less flexible. + +Regularization coefficient LambdaV controls smoothness of the individual +models built for each layer. We recommend you to use default value in case +you don't want to tune this parameter, because having non-zero LambdaV +accelerates and stabilizes internal iterative algorithm. In case you want +to suppress noise you can use LambdaV as additional parameter (larger +value = more smoothness) to tune. + +TYPICAL ERRORS + +1. Using initial radius which is too large. Memory requirements of the + RBF-ML are roughly proportional to N*Density*RBase^2 (where Density is + an average density of points per unit of the interpolation space). In + the extreme case of the very large RBase we will need O(N^2) units of + memory - and many layers in order to decrease radius to some reasonably + small value. + +2. Using too small number of layers - RBF models with large radius are not + flexible enough to reproduce small variations in the target function. + You need many layers with different radii, from large to small, in + order to have good model. + +3. Using initial radius which is too small. You will get model with + "holes" in the areas which are too far away from interpolation centers. + However, algorithm will work correctly (and quickly) in this case. + +4. Using too many layers - you will get too large and too slow model. This + model will perfectly reproduce your function, but maybe you will be + able to achieve similar results with less layers (and less memory). + + -- ALGLIB -- + Copyright 02.03.2012 by Bochkanov Sergey +*************************************************************************/ +void rbfsetalgomultilayer(const rbfmodel &s, const double rbase, const ae_int_t nlayers) +{ + alglib_impl::ae_state _alglib_env_state; + double lambdav; + + lambdav = 0.01; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetalgomultilayer(const_cast(s.c_ptr()), rbase, nlayers, lambdav, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets linear term (model is a sum of radial basis functions +plus linear polynomial). This function won't have effect until next call +to RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetlinterm(const rbfmodel &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetlinterm(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets constant term (model is a sum of radial basis functions +plus constant). This function won't have effect until next call to +RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetconstterm(const rbfmodel &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetconstterm(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets zero term (model is a sum of radial basis functions +without polynomial term). This function won't have effect until next call +to RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetzeroterm(const rbfmodel &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfsetzeroterm(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function builds RBF model and returns report (contains some +information which can be used for evaluation of the algorithm properties). + +Call to this function modifies RBF model by calculating its centers/radii/ +weights and saving them into RBFModel structure. Initially RBFModel +contain zero coefficients, but after call to this function we will have +coefficients which were calculated in order to fit our dataset. + +After you called this function you can call RBFCalc(), RBFGridCalc() and +other model calculation functions. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + Rep - report: + * Rep.TerminationType: + * -5 - non-distinct basis function centers were detected, + interpolation aborted + * -4 - nonconvergence of the internal SVD solver + * 1 - successful termination + Fields are used for debugging purposes: + * Rep.IterationsCount - iterations count of the LSQR solver + * Rep.NMV - number of matrix-vector products + * Rep.ARows - rows count for the system matrix + * Rep.ACols - columns count for the system matrix + * Rep.ANNZ - number of significantly non-zero elements + (elements above some algorithm-determined threshold) + +NOTE: failure to build model will leave current state of the structure +unchanged. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfbuildmodel(const rbfmodel &s, rbfreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfbuildmodel(const_cast(s.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates values of the RBF model in the given point. + +This function should be used when we have NY=1 (scalar function) and NX=2 +(2-dimensional space). If you have 3-dimensional space, use RBFCalc3(). If +you have general situation (NX-dimensional space, NY-dimensional function) +you should use general, less efficient implementation RBFCalc(). + +If you want to calculate function values many times, consider using +RBFGridCalc2(), which is far more efficient than many subsequent calls to +RBFCalc2(). + +This function returns 0.0 when: +* model is not initialized +* NX<>2 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - first coordinate, finite number + X1 - second coordinate, finite number + +RESULT: + value of the model or 0.0 (as defined above) + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +double rbfcalc2(const rbfmodel &s, const double x0, const double x1) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rbfcalc2(const_cast(s.c_ptr()), x0, x1, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates values of the RBF model in the given point. + +This function should be used when we have NY=1 (scalar function) and NX=3 +(3-dimensional space). If you have 2-dimensional space, use RBFCalc2(). If +you have general situation (NX-dimensional space, NY-dimensional function) +you should use general, less efficient implementation RBFCalc(). + +This function returns 0.0 when: +* model is not initialized +* NX<>3 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - first coordinate, finite number + X1 - second coordinate, finite number + X2 - third coordinate, finite number + +RESULT: + value of the model or 0.0 (as defined above) + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +double rbfcalc3(const rbfmodel &s, const double x0, const double x1, const double x2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rbfcalc3(const_cast(s.c_ptr()), x0, x1, x2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates values of the RBF model at the given point. + +This is general function which can be used for arbitrary NX (dimension of +the space of arguments) and NY (dimension of the function itself). However +when you have NY=1 you may find more convenient to use RBFCalc2() or +RBFCalc3(). + +This function returns 0.0 when model is not initialized. + +INPUT PARAMETERS: + S - RBF model + X - coordinates, array[NX]. + X may have more than NX elements, in this case only + leading NX will be used. + +OUTPUT PARAMETERS: + Y - function value, array[NY]. Y is out-parameter and + reallocated after call to this function. In case you want + to reuse previously allocated Y, you may use RBFCalcBuf(), + which reallocates Y only when it is too small. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcalc(const rbfmodel &s, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfcalc(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates values of the RBF model at the given point. + +Same as RBFCalc(), but does not reallocate Y when in is large enough to +store function values. + +INPUT PARAMETERS: + S - RBF model + X - coordinates, array[NX]. + X may have more than NX elements, in this case only + leading NX will be used. + Y - possibly preallocated array + +OUTPUT PARAMETERS: + Y - function value, array[NY]. Y is not reallocated when it + is larger than NY. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcalcbuf(const rbfmodel &s, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfcalcbuf(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates values of the RBF model at the regular grid. + +Grid have N0*N1 points, with Point[I,J] = (X0[I], X1[J]) + +This function returns 0.0 when: +* model is not initialized +* NX<>2 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - array of grid nodes, first coordinates, array[N0] + N0 - grid size (number of nodes) in the first dimension + X1 - array of grid nodes, second coordinates, array[N1] + N1 - grid size (number of nodes) in the second dimension + +OUTPUT PARAMETERS: + Y - function values, array[N0,N1]. Y is out-variable and + is reallocated by this function. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfgridcalc2(const rbfmodel &s, const real_1d_array &x0, const ae_int_t n0, const real_1d_array &x1, const ae_int_t n1, real_2d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfgridcalc2(const_cast(s.c_ptr()), const_cast(x0.c_ptr()), n0, const_cast(x1.c_ptr()), n1, const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function "unpacks" RBF model by extracting its coefficients. + +INPUT PARAMETERS: + S - RBF model + +OUTPUT PARAMETERS: + NX - dimensionality of argument + NY - dimensionality of the target function + XWR - model information, array[NC,NX+NY+1]. + One row of the array corresponds to one basis function: + * first NX columns - coordinates of the center + * next NY columns - weights, one per dimension of the + function being modelled + * last column - radius, same for all dimensions of + the function being modelled + NC - number of the centers + V - polynomial term , array[NY,NX+1]. One row per one + dimension of the function being modelled. First NX + elements are linear coefficients, V[NX] is equal to the + constant part. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfunpack(const rbfmodel &s, ae_int_t &nx, ae_int_t &ny, real_2d_array &xwr, ae_int_t &nc, real_2d_array &v) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rbfunpack(const_cast(s.c_ptr()), &nx, &ny, const_cast(xwr.c_ptr()), &nc, const_cast(v.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +2-dimensional spline inteprolant +*************************************************************************/ +_spline2dinterpolant_owner::_spline2dinterpolant_owner() +{ + p_struct = (alglib_impl::spline2dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline2dinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_spline2dinterpolant_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_spline2dinterpolant_owner::_spline2dinterpolant_owner(const _spline2dinterpolant_owner &rhs) +{ + p_struct = (alglib_impl::spline2dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline2dinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_spline2dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_spline2dinterpolant_owner& _spline2dinterpolant_owner::operator=(const _spline2dinterpolant_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_spline2dinterpolant_clear(p_struct); + if( !alglib_impl::_spline2dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_spline2dinterpolant_owner::~_spline2dinterpolant_owner() +{ + alglib_impl::_spline2dinterpolant_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::spline2dinterpolant* _spline2dinterpolant_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::spline2dinterpolant* _spline2dinterpolant_owner::c_ptr() const +{ + return const_cast(p_struct); +} +spline2dinterpolant::spline2dinterpolant() : _spline2dinterpolant_owner() +{ +} + +spline2dinterpolant::spline2dinterpolant(const spline2dinterpolant &rhs):_spline2dinterpolant_owner(rhs) +{ +} + +spline2dinterpolant& spline2dinterpolant::operator=(const spline2dinterpolant &rhs) +{ + if( this==&rhs ) + return *this; + _spline2dinterpolant_owner::operator=(rhs); + return *this; +} + +spline2dinterpolant::~spline2dinterpolant() +{ +} + +/************************************************************************* +This subroutine calculates the value of the bilinear or bicubic spline at +the given point X. + +Input parameters: + C - coefficients table. + Built by BuildBilinearSpline or BuildBicubicSpline. + X, Y- point + +Result: + S(x,y) + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +double spline2dcalc(const spline2dinterpolant &c, const double x, const double y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spline2dcalc(const_cast(c.c_ptr()), x, y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine calculates the value of the bilinear or bicubic spline at +the given point X and its derivatives. + +Input parameters: + C - spline interpolant. + X, Y- point + +Output parameters: + F - S(x,y) + FX - dS(x,y)/dX + FY - dS(x,y)/dY + FXY - d2S(x,y)/dXdY + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2ddiff(const spline2dinterpolant &c, const double x, const double y, double &f, double &fx, double &fy, double &fxy) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2ddiff(const_cast(c.c_ptr()), x, y, &f, &fx, &fy, &fxy, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +Input parameters: + C - spline interpolant + AX, BX - transformation coefficients: x = A*t + B + AY, BY - transformation coefficients: y = A*u + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dlintransxy(const spline2dinterpolant &c, const double ax, const double bx, const double ay, const double by) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dlintransxy(const_cast(c.c_ptr()), ax, bx, ay, by, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +Input parameters: + C - spline interpolant. + A, B- transformation coefficients: S2(x,y) = A*S(x,y) + B + +Output parameters: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dlintransf(const spline2dinterpolant &c, const double a, const double b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dlintransf(const_cast(c.c_ptr()), a, b, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine makes the copy of the spline model. + +Input parameters: + C - spline interpolant + +Output parameters: + CC - spline copy + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dcopy(const spline2dinterpolant &c, spline2dinterpolant &cc) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dcopy(const_cast(c.c_ptr()), const_cast(cc.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Bicubic spline resampling + +Input parameters: + A - function values at the old grid, + array[0..OldHeight-1, 0..OldWidth-1] + OldHeight - old grid height, OldHeight>1 + OldWidth - old grid width, OldWidth>1 + NewHeight - new grid height, NewHeight>1 + NewWidth - new grid width, NewWidth>1 + +Output parameters: + B - function values at the new grid, + array[0..NewHeight-1, 0..NewWidth-1] + + -- ALGLIB routine -- + 15 May, 2007 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline2dresamplebicubic(const real_2d_array &a, const ae_int_t oldheight, const ae_int_t oldwidth, real_2d_array &b, const ae_int_t newheight, const ae_int_t newwidth) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dresamplebicubic(const_cast(a.c_ptr()), oldheight, oldwidth, const_cast(b.c_ptr()), newheight, newwidth, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Bilinear spline resampling + +Input parameters: + A - function values at the old grid, + array[0..OldHeight-1, 0..OldWidth-1] + OldHeight - old grid height, OldHeight>1 + OldWidth - old grid width, OldWidth>1 + NewHeight - new grid height, NewHeight>1 + NewWidth - new grid width, NewWidth>1 + +Output parameters: + B - function values at the new grid, + array[0..NewHeight-1, 0..NewWidth-1] + + -- ALGLIB routine -- + 09.07.2007 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline2dresamplebilinear(const real_2d_array &a, const ae_int_t oldheight, const ae_int_t oldwidth, real_2d_array &b, const ae_int_t newheight, const ae_int_t newwidth) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dresamplebilinear(const_cast(a.c_ptr()), oldheight, oldwidth, const_cast(b.c_ptr()), newheight, newwidth, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds bilinear vector-valued spline. + +Input parameters: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + F - function values, array[0..M*N*D-1]: + * first D elements store D values at (X[0],Y[0]) + * next D elements store D values at (X[1],Y[0]) + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(J*N+I)...D*(J*N+I)+D-1]. + M,N - grid size, M>=2, N>=2 + D - vector dimension, D>=1 + +Output parameters: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbilinearv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &f, const ae_int_t d, spline2dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dbuildbilinearv(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, const_cast(f.c_ptr()), d, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds bicubic vector-valued spline. + +Input parameters: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + F - function values, array[0..M*N*D-1]: + * first D elements store D values at (X[0],Y[0]) + * next D elements store D values at (X[1],Y[0]) + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(J*N+I)...D*(J*N+I)+D-1]. + M,N - grid size, M>=2, N>=2 + D - vector dimension, D>=1 + +Output parameters: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbicubicv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &f, const ae_int_t d, spline2dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dbuildbicubicv(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, const_cast(f.c_ptr()), d, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y- point + F - output buffer, possibly preallocated array. In case array size + is large enough to store result, it is not reallocated. Array + which is too short will be reallocated + +OUTPUT PARAMETERS: + F - array[D] (or larger) which stores function values + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dcalcvbuf(const spline2dinterpolant &c, const double x, const double y, real_1d_array &f) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dcalcvbuf(const_cast(c.c_ptr()), x, y, const_cast(f.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y- point + +OUTPUT PARAMETERS: + F - array[D] which stores function values. F is out-parameter and + it is reallocated after call to this function. In case you + want to reuse previously allocated F, you may use + Spline2DCalcVBuf(), which reallocates F only when it is too + small. + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dcalcv(const spline2dinterpolant &c, const double x, const double y, real_1d_array &f) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dcalcv(const_cast(c.c_ptr()), x, y, const_cast(f.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine unpacks two-dimensional spline into the coefficients table + +Input parameters: + C - spline interpolant. + +Result: + M, N- grid size (x-axis and y-axis) + D - number of components + Tbl - coefficients table, unpacked format, + D - components: [0..(N-1)*(M-1)*D-1, 0..19]. + For T=0..D-1 (component index), I = 0...N-2 (x index), + J=0..M-2 (y index): + K := T + I*D + J*D*(N-1) + + K-th row stores decomposition for T-th component of the + vector-valued function + + Tbl[K,0] = X[i] + Tbl[K,1] = X[i+1] + Tbl[K,2] = Y[j] + Tbl[K,3] = Y[j+1] + Tbl[K,4] = C00 + Tbl[K,5] = C01 + Tbl[K,6] = C02 + Tbl[K,7] = C03 + Tbl[K,8] = C10 + Tbl[K,9] = C11 + ... + Tbl[K,19] = C33 + On each grid square spline is equals to: + S(x) = SUM(c[i,j]*(t^i)*(u^j), i=0..3, j=0..3) + t = x-x[j] + u = y-y[i] + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dunpackv(const spline2dinterpolant &c, ae_int_t &m, ae_int_t &n, ae_int_t &d, real_2d_array &tbl) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dunpackv(const_cast(c.c_ptr()), &m, &n, &d, const_cast(tbl.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DBuildBilinearV(), which is more +flexible and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbilinear(const real_1d_array &x, const real_1d_array &y, const real_2d_array &f, const ae_int_t m, const ae_int_t n, spline2dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dbuildbilinear(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(f.c_ptr()), m, n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DBuildBicubicV(), which is more +flexible and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbicubic(const real_1d_array &x, const real_1d_array &y, const real_2d_array &f, const ae_int_t m, const ae_int_t n, spline2dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dbuildbicubic(const_cast(x.c_ptr()), const_cast(y.c_ptr()), const_cast(f.c_ptr()), m, n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DUnpackV(), which is more flexible +and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dunpack(const spline2dinterpolant &c, ae_int_t &m, ae_int_t &n, real_2d_array &tbl) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline2dunpack(const_cast(c.c_ptr()), &m, &n, const_cast(tbl.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +3-dimensional spline inteprolant +*************************************************************************/ +_spline3dinterpolant_owner::_spline3dinterpolant_owner() +{ + p_struct = (alglib_impl::spline3dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline3dinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_spline3dinterpolant_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_spline3dinterpolant_owner::_spline3dinterpolant_owner(const _spline3dinterpolant_owner &rhs) +{ + p_struct = (alglib_impl::spline3dinterpolant*)alglib_impl::ae_malloc(sizeof(alglib_impl::spline3dinterpolant), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_spline3dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_spline3dinterpolant_owner& _spline3dinterpolant_owner::operator=(const _spline3dinterpolant_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_spline3dinterpolant_clear(p_struct); + if( !alglib_impl::_spline3dinterpolant_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_spline3dinterpolant_owner::~_spline3dinterpolant_owner() +{ + alglib_impl::_spline3dinterpolant_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::spline3dinterpolant* _spline3dinterpolant_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::spline3dinterpolant* _spline3dinterpolant_owner::c_ptr() const +{ + return const_cast(p_struct); +} +spline3dinterpolant::spline3dinterpolant() : _spline3dinterpolant_owner() +{ +} + +spline3dinterpolant::spline3dinterpolant(const spline3dinterpolant &rhs):_spline3dinterpolant_owner(rhs) +{ +} + +spline3dinterpolant& spline3dinterpolant::operator=(const spline3dinterpolant &rhs) +{ + if( this==&rhs ) + return *this; + _spline3dinterpolant_owner::operator=(rhs); + return *this; +} + +spline3dinterpolant::~spline3dinterpolant() +{ +} + +/************************************************************************* +This subroutine calculates the value of the trilinear or tricubic spline at +the given point (X,Y,Z). + +INPUT PARAMETERS: + C - coefficients table. + Built by BuildBilinearSpline or BuildBicubicSpline. + X, Y, + Z - point + +Result: + S(x,y,z) + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +double spline3dcalc(const spline3dinterpolant &c, const double x, const double y, const double z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spline3dcalc(const_cast(c.c_ptr()), x, y, z, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +INPUT PARAMETERS: + C - spline interpolant + AX, BX - transformation coefficients: x = A*u + B + AY, BY - transformation coefficients: y = A*v + B + AZ, BZ - transformation coefficients: z = A*w + B + +OUTPUT PARAMETERS: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dlintransxyz(const spline3dinterpolant &c, const double ax, const double bx, const double ay, const double by, const double az, const double bz) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline3dlintransxyz(const_cast(c.c_ptr()), ax, bx, ay, by, az, bz, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: S2(x,y) = A*S(x,y,z) + B + +OUTPUT PARAMETERS: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dlintransf(const spline3dinterpolant &c, const double a, const double b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline3dlintransf(const_cast(c.c_ptr()), a, b, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Trilinear spline resampling + +INPUT PARAMETERS: + A - array[0..OldXCount*OldYCount*OldZCount-1], function + values at the old grid, : + A[0] x=0,y=0,z=0 + A[1] x=1,y=0,z=0 + A[..] ... + A[..] x=oldxcount-1,y=0,z=0 + A[..] x=0,y=1,z=0 + A[..] ... + ... + OldZCount - old Z-count, OldZCount>1 + OldYCount - old Y-count, OldYCount>1 + OldXCount - old X-count, OldXCount>1 + NewZCount - new Z-count, NewZCount>1 + NewYCount - new Y-count, NewYCount>1 + NewXCount - new X-count, NewXCount>1 + +OUTPUT PARAMETERS: + B - array[0..NewXCount*NewYCount*NewZCount-1], function + values at the new grid: + B[0] x=0,y=0,z=0 + B[1] x=1,y=0,z=0 + B[..] ... + B[..] x=newxcount-1,y=0,z=0 + B[..] x=0,y=1,z=0 + B[..] ... + ... + + -- ALGLIB routine -- + 26.04.2012 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline3dresampletrilinear(const real_1d_array &a, const ae_int_t oldzcount, const ae_int_t oldycount, const ae_int_t oldxcount, const ae_int_t newzcount, const ae_int_t newycount, const ae_int_t newxcount, real_1d_array &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline3dresampletrilinear(const_cast(a.c_ptr()), oldzcount, oldycount, oldxcount, newzcount, newycount, newxcount, const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine builds trilinear vector-valued spline. + +INPUT PARAMETERS: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + Z - spline applicates, array[0..L-1] + F - function values, array[0..M*N*L*D-1]: + * first D elements store D values at (X[0],Y[0],Z[0]) + * next D elements store D values at (X[1],Y[0],Z[0]) + * next D elements store D values at (X[2],Y[0],Z[0]) + * ... + * next D elements store D values at (X[0],Y[1],Z[0]) + * next D elements store D values at (X[1],Y[1],Z[0]) + * next D elements store D values at (X[2],Y[1],Z[0]) + * ... + * next D elements store D values at (X[0],Y[0],Z[1]) + * next D elements store D values at (X[1],Y[0],Z[1]) + * next D elements store D values at (X[2],Y[0],Z[1]) + * ... + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(N*(M*K+J)+I)...D*(N*(M*K+J)+I)+D-1]. + M,N, + L - grid size, M>=2, N>=2, L>=2 + D - vector dimension, D>=1 + +OUTPUT PARAMETERS: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dbuildtrilinearv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &z, const ae_int_t l, const real_1d_array &f, const ae_int_t d, spline3dinterpolant &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline3dbuildtrilinearv(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, const_cast(z.c_ptr()), l, const_cast(f.c_ptr()), d, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y,Z). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y, + Z - point + F - output buffer, possibly preallocated array. In case array size + is large enough to store result, it is not reallocated. Array + which is too short will be reallocated + +OUTPUT PARAMETERS: + F - array[D] (or larger) which stores function values + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dcalcvbuf(const spline3dinterpolant &c, const double x, const double y, const double z, real_1d_array &f) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline3dcalcvbuf(const_cast(c.c_ptr()), x, y, z, const_cast(f.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine calculates trilinear or tricubic vector-valued spline at the +given point (X,Y,Z). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y, + Z - point + +OUTPUT PARAMETERS: + F - array[D] which stores function values. F is out-parameter and + it is reallocated after call to this function. In case you + want to reuse previously allocated F, you may use + Spline2DCalcVBuf(), which reallocates F only when it is too + small. + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dcalcv(const spline3dinterpolant &c, const double x, const double y, const double z, real_1d_array &f) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline3dcalcv(const_cast(c.c_ptr()), x, y, z, const_cast(f.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine unpacks tri-dimensional spline into the coefficients table + +INPUT PARAMETERS: + C - spline interpolant. + +Result: + N - grid size (X) + M - grid size (Y) + L - grid size (Z) + D - number of components + SType- spline type. Currently, only one spline type is supported: + trilinear spline, as indicated by SType=1. + Tbl - spline coefficients: [0..(N-1)*(M-1)*(L-1)*D-1, 0..13]. + For T=0..D-1 (component index), I = 0...N-2 (x index), + J=0..M-2 (y index), K=0..L-2 (z index): + Q := T + I*D + J*D*(N-1) + K*D*(N-1)*(M-1), + + Q-th row stores decomposition for T-th component of the + vector-valued function + + Tbl[Q,0] = X[i] + Tbl[Q,1] = X[i+1] + Tbl[Q,2] = Y[j] + Tbl[Q,3] = Y[j+1] + Tbl[Q,4] = Z[k] + Tbl[Q,5] = Z[k+1] + + Tbl[Q,6] = C000 + Tbl[Q,7] = C100 + Tbl[Q,8] = C010 + Tbl[Q,9] = C110 + Tbl[Q,10]= C001 + Tbl[Q,11]= C101 + Tbl[Q,12]= C011 + Tbl[Q,13]= C111 + On each grid square spline is equals to: + S(x) = SUM(c[i,j,k]*(x^i)*(y^j)*(z^k), i=0..1, j=0..1, k=0..1) + t = x-x[j] + u = y-y[i] + v = z-z[k] + + NOTE: format of Tbl is given for SType=1. Future versions of + ALGLIB can use different formats for different values of + SType. + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dunpackv(const spline3dinterpolant &c, ae_int_t &n, ae_int_t &m, ae_int_t &l, ae_int_t &d, ae_int_t &stype, real_2d_array &tbl) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spline3dunpackv(const_cast(c.c_ptr()), &n, &m, &l, &d, &stype, const_cast(tbl.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +static double idwint_idwqfactor = 1.5; +static ae_int_t idwint_idwkmin = 5; +static double idwint_idwcalcq(idwinterpolant* z, + /* Real */ ae_vector* x, + ae_int_t k, + ae_state *_state); +static void idwint_idwinit1(ae_int_t n, + ae_int_t nx, + ae_int_t d, + ae_int_t nq, + ae_int_t nw, + idwinterpolant* z, + ae_state *_state); +static void idwint_idwinternalsolver(/* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* fmatrix, + /* Real */ ae_vector* temp, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* x, + double* taskrcond, + ae_state *_state); + + +static void ratint_barycentricnormalize(barycentricinterpolant* b, + ae_state *_state); + + + + +static void spline1d_spline1dgriddiffcubicinternal(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* d, + /* Real */ ae_vector* a1, + /* Real */ ae_vector* a2, + /* Real */ ae_vector* a3, + /* Real */ ae_vector* b, + /* Real */ ae_vector* dt, + ae_state *_state); +static void spline1d_heapsortpoints(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state); +static void spline1d_heapsortppoints(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Integer */ ae_vector* p, + ae_int_t n, + ae_state *_state); +static void spline1d_solvetridiagonal(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* c, + /* Real */ ae_vector* d, + ae_int_t n, + /* Real */ ae_vector* x, + ae_state *_state); +static void spline1d_solvecyclictridiagonal(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* c, + /* Real */ ae_vector* d, + ae_int_t n, + /* Real */ ae_vector* x, + ae_state *_state); +static double spline1d_diffthreepoint(double t, + double x0, + double f0, + double x1, + double f1, + double x2, + double f2, + ae_state *_state); +static void spline1d_hermitecalc(double p0, + double m0, + double p1, + double m1, + double t, + double* s, + double* ds, + ae_state *_state); +static double spline1d_rescaleval(double a0, + double b0, + double a1, + double b1, + double t, + ae_state *_state); + + +static void lsfit_spline1dfitinternal(ae_int_t st, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state); +static void lsfit_lsfitlinearinternal(/* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* fmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state); +static void lsfit_lsfitclearrequestfields(lsfitstate* state, + ae_state *_state); +static void lsfit_barycentriccalcbasis(barycentricinterpolant* b, + double t, + /* Real */ ae_vector* y, + ae_state *_state); +static void lsfit_internalchebyshevfit(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state); +static void lsfit_barycentricfitwcfixedd(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t d, + ae_int_t* info, + barycentricinterpolant* b, + barycentricfitreport* rep, + ae_state *_state); +static void lsfit_clearreport(lsfitreport* rep, ae_state *_state); +static void lsfit_estimateerrors(/* Real */ ae_matrix* f1, + /* Real */ ae_vector* f0, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_vector* x, + /* Real */ ae_vector* s, + ae_int_t n, + ae_int_t k, + lsfitreport* rep, + /* Real */ ae_matrix* z, + ae_int_t zkind, + ae_state *_state); + + +static void pspline_pspline2par(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t pt, + /* Real */ ae_vector* p, + ae_state *_state); +static void pspline_pspline3par(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t pt, + /* Real */ ae_vector* p, + ae_state *_state); + + +static double rbf_eps = 1.0E-6; +static ae_int_t rbf_mxnx = 3; +static double rbf_rbffarradius = 6; +static double rbf_rbfnearradius = 2.1; +static double rbf_rbfmlradius = 3; +static ae_int_t rbf_rbffirstversion = 0; +static void rbf_rbfgridpoints(rbfmodel* s, ae_state *_state); +static void rbf_rbfradnn(rbfmodel* s, + double q, + double z, + ae_state *_state); +static ae_bool rbf_buildlinearmodel(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t ny, + ae_int_t modeltype, + /* Real */ ae_matrix* v, + ae_state *_state); +static void rbf_buildrbfmodellsqr(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + /* Real */ ae_matrix* xc, + /* Real */ ae_vector* r, + ae_int_t n, + ae_int_t nc, + ae_int_t ny, + kdtree* pointstree, + kdtree* centerstree, + double epsort, + double epserr, + ae_int_t maxits, + ae_int_t* gnnz, + ae_int_t* snnz, + /* Real */ ae_matrix* w, + ae_int_t* info, + ae_int_t* iterationscount, + ae_int_t* nmv, + ae_state *_state); +static void rbf_buildrbfmlayersmodellsqr(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + /* Real */ ae_matrix* xc, + double rval, + /* Real */ ae_vector* r, + ae_int_t n, + ae_int_t* nc, + ae_int_t ny, + ae_int_t nlayers, + kdtree* centerstree, + double epsort, + double epserr, + ae_int_t maxits, + double lambdav, + ae_int_t* annz, + /* Real */ ae_matrix* w, + ae_int_t* info, + ae_int_t* iterationscount, + ae_int_t* nmv, + ae_state *_state); + + +static void spline2d_bicubiccalcderivatives(/* Real */ ae_matrix* a, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* dx, + /* Real */ ae_matrix* dy, + /* Real */ ae_matrix* dxy, + ae_state *_state); + + +static void spline3d_spline3ddiff(spline3dinterpolant* c, + double x, + double y, + double z, + double* f, + double* fx, + double* fy, + double* fxy, + ae_state *_state); + + + + + +/************************************************************************* +IDW interpolation + +INPUT PARAMETERS: + Z - IDW interpolant built with one of model building + subroutines. + X - array[0..NX-1], interpolation point + +Result: + IDW interpolant Z(X) + + -- ALGLIB -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +double idwcalc(idwinterpolant* z, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + double r; + double s; + double w; + double v1; + double v2; + double d0; + double di; + double result; + + + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + k = 0; + + /* + * Query + */ + if( z->modeltype==0 ) + { + + /* + * NQ/NW-based model + */ + k = kdtreequeryknn(&z->tree, x, z->nw, ae_true, _state); + kdtreequeryresultsdistances(&z->tree, &z->rbuf, _state); + kdtreequeryresultstags(&z->tree, &z->tbuf, _state); + } + if( z->modeltype==1 ) + { + + /* + * R-based model + */ + k = kdtreequeryrnn(&z->tree, x, z->r, ae_true, _state); + kdtreequeryresultsdistances(&z->tree, &z->rbuf, _state); + kdtreequeryresultstags(&z->tree, &z->tbuf, _state); + if( ktree, x, idwint_idwkmin, ae_true, _state); + kdtreequeryresultsdistances(&z->tree, &z->rbuf, _state); + kdtreequeryresultstags(&z->tree, &z->tbuf, _state); + } + } + + /* + * initialize weights for linear/quadratic members calculation. + * + * NOTE 1: weights are calculated using NORMALIZED modified + * Shepard's formula. Original formula gives w(i) = sqr((R-di)/(R*di)), + * where di is i-th distance, R is max(di). Modified formula have + * following form: + * w_mod(i) = 1, if di=d0 + * w_mod(i) = w(i)/w(0), if di<>d0 + * + * NOTE 2: self-match is USED for this query + * + * NOTE 3: last point almost always gain zero weight, but it MUST + * be used for fitting because sometimes it will gain NON-ZERO + * weight - for example, when all distances are equal. + */ + r = z->rbuf.ptr.p_double[k-1]; + d0 = z->rbuf.ptr.p_double[0]; + result = 0; + s = 0; + for(i=0; i<=k-1; i++) + { + di = z->rbuf.ptr.p_double[i]; + if( ae_fp_eq(di,d0) ) + { + + /* + * distance is equal to shortest, set it 1.0 + * without explicitly calculating (which would give + * us same result, but 'll expose us to the risk of + * division by zero). + */ + w = 1; + } + else + { + + /* + * use normalized formula + */ + v1 = (r-di)/(r-d0); + v2 = d0/di; + w = ae_sqr(v1*v2, _state); + } + result = result+w*idwint_idwcalcq(z, x, z->tbuf.ptr.p_int[i], _state); + s = s+w; + } + result = result/s; + return result; +} + + +/************************************************************************* +IDW interpolant using modified Shepard method for uniform point +distributions. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + D - nodal function type, either: + * 0 constant model. Just for demonstration only, worst + model ever. + * 1 linear model, least squares fitting. Simpe model for + datasets too small for quadratic models + * 2 quadratic model, least squares fitting. Best model + available (if your dataset is large enough). + * -1 "fast" linear model, use with caution!!! It is + significantly faster than linear/quadratic and better + than constant model. But it is less robust (especially + in the presence of noise). + NQ - number of points used to calculate nodal functions (ignored + for constant models). NQ should be LARGER than: + * max(1.5*(1+NX),2^NX+1) for linear model, + * max(3/4*(NX+2)*(NX+1),2^NX+1) for quadratic model. + Values less than this threshold will be silently increased. + NW - number of points used to calculate weights and to interpolate. + Required: >=2^NX+1, values less than this threshold will be + silently increased. + Recommended value: about 2*NQ + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: + * best results are obtained with quadratic models, worst - with constant + models + * when N is large, NQ and NW must be significantly smaller than N both + to obtain optimal performance and to obtain optimal accuracy. In 2 or + 3-dimensional tasks NQ=15 and NW=25 are good values to start with. + * NQ and NW may be greater than N. In such cases they will be + automatically decreased. + * this subroutine is always succeeds (as long as correct parameters are + passed). + * see 'Multivariate Interpolation of Large Sets of Scattered Data' by + Robert J. Renka for more information on this algorithm. + * this subroutine assumes that point distribution is uniform at the small + scales. If it isn't - for example, points are concentrated along + "lines", but "lines" distribution is uniform at the larger scale - then + you should use IDWBuildModifiedShepardR() + + + -- ALGLIB PROJECT -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildmodifiedshepard(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t nx, + ae_int_t d, + ae_int_t nq, + ae_int_t nw, + idwinterpolant* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t j2; + ae_int_t j3; + double v; + double r; + double s; + double d0; + double di; + double v1; + double v2; + ae_int_t nc; + ae_int_t offs; + ae_vector x; + ae_vector qrbuf; + ae_matrix qxybuf; + ae_vector y; + ae_matrix fmatrix; + ae_vector w; + ae_vector qsol; + ae_vector temp; + ae_vector tags; + ae_int_t info; + double taskrcond; + + ae_frame_make(_state, &_frame_block); + _idwinterpolant_clear(z); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&qrbuf, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&qxybuf, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&qsol, 0, DT_REAL, _state, ae_true); + ae_vector_init(&temp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tags, 0, DT_INT, _state, ae_true); + + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + nc = 0; + + /* + * assertions + */ + ae_assert(n>0, "IDWBuildModifiedShepard: N<=0!", _state); + ae_assert(nx>=1, "IDWBuildModifiedShepard: NX<1!", _state); + ae_assert(d>=-1&&d<=2, "IDWBuildModifiedShepard: D<>-1 and D<>0 and D<>1 and D<>2!", _state); + + /* + * Correct parameters if needed + */ + if( d==1 ) + { + nq = ae_maxint(nq, ae_iceil(idwint_idwqfactor*(1+nx), _state)+1, _state); + nq = ae_maxint(nq, ae_round(ae_pow(2, nx, _state), _state)+1, _state); + } + if( d==2 ) + { + nq = ae_maxint(nq, ae_iceil(idwint_idwqfactor*(nx+2)*(nx+1)/2, _state)+1, _state); + nq = ae_maxint(nq, ae_round(ae_pow(2, nx, _state), _state)+1, _state); + } + nw = ae_maxint(nw, ae_round(ae_pow(2, nx, _state), _state)+1, _state); + nq = ae_minint(nq, n, _state); + nw = ae_minint(nw, n, _state); + + /* + * primary initialization of Z + */ + idwint_idwinit1(n, nx, d, nq, nw, z, _state); + z->modeltype = 0; + + /* + * Create KD-tree + */ + ae_vector_set_length(&tags, n, _state); + for(i=0; i<=n-1; i++) + { + tags.ptr.p_int[i] = i; + } + kdtreebuildtagged(xy, &tags, n, nx, 1, 2, &z->tree, _state); + + /* + * build nodal functions + */ + ae_vector_set_length(&temp, nq+1, _state); + ae_vector_set_length(&x, nx, _state); + ae_vector_set_length(&qrbuf, nq, _state); + ae_matrix_set_length(&qxybuf, nq, nx+1, _state); + if( d==-1 ) + { + ae_vector_set_length(&w, nq, _state); + } + if( d==1 ) + { + ae_vector_set_length(&y, nq, _state); + ae_vector_set_length(&w, nq, _state); + ae_vector_set_length(&qsol, nx, _state); + + /* + * NX for linear members, + * 1 for temporary storage + */ + ae_matrix_set_length(&fmatrix, nq, nx+1, _state); + } + if( d==2 ) + { + ae_vector_set_length(&y, nq, _state); + ae_vector_set_length(&w, nq, _state); + ae_vector_set_length(&qsol, nx+ae_round(nx*(nx+1)*0.5, _state), _state); + + /* + * NX for linear members, + * Round(NX*(NX+1)*0.5) for quadratic model, + * 1 for temporary storage + */ + ae_matrix_set_length(&fmatrix, nq, nx+ae_round(nx*(nx+1)*0.5, _state)+1, _state); + } + for(i=0; i<=n-1; i++) + { + + /* + * Initialize center and function value. + * If D=0 it is all what we need + */ + ae_v_move(&z->q.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx)); + if( d==0 ) + { + continue; + } + + /* + * calculate weights for linear/quadratic members calculation. + * + * NOTE 1: weights are calculated using NORMALIZED modified + * Shepard's formula. Original formula is w(i) = sqr((R-di)/(R*di)), + * where di is i-th distance, R is max(di). Modified formula have + * following form: + * w_mod(i) = 1, if di=d0 + * w_mod(i) = w(i)/w(0), if di<>d0 + * + * NOTE 2: self-match is NOT used for this query + * + * NOTE 3: last point almost always gain zero weight, but it MUST + * be used for fitting because sometimes it will gain NON-ZERO + * weight - for example, when all distances are equal. + */ + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx-1)); + k = kdtreequeryknn(&z->tree, &x, nq, ae_false, _state); + kdtreequeryresultsxy(&z->tree, &qxybuf, _state); + kdtreequeryresultsdistances(&z->tree, &qrbuf, _state); + r = qrbuf.ptr.p_double[k-1]; + d0 = qrbuf.ptr.p_double[0]; + for(j=0; j<=k-1; j++) + { + di = qrbuf.ptr.p_double[j]; + if( ae_fp_eq(di,d0) ) + { + + /* + * distance is equal to shortest, set it 1.0 + * without explicitly calculating (which would give + * us same result, but 'll expose us to the risk of + * division by zero). + */ + w.ptr.p_double[j] = 1; + } + else + { + + /* + * use normalized formula + */ + v1 = (r-di)/(r-d0); + v2 = d0/di; + w.ptr.p_double[j] = ae_sqr(v1*v2, _state); + } + } + + /* + * calculate linear/quadratic members + */ + if( d==-1 ) + { + + /* + * "Fast" linear nodal function calculated using + * inverse distance weighting + */ + for(j=0; j<=nx-1; j++) + { + x.ptr.p_double[j] = 0; + } + s = 0; + for(j=0; j<=k-1; j++) + { + + /* + * calculate J-th inverse distance weighted gradient: + * grad_k = (y_j-y_k)*(x_j-x_k)/sqr(norm(x_j-x_k)) + * grad = sum(wk*grad_k)/sum(w_k) + */ + v = 0; + for(j2=0; j2<=nx-1; j2++) + { + v = v+ae_sqr(qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2], _state); + } + + /* + * Although x_j<>x_k, sqr(norm(x_j-x_k)) may be zero due to + * underflow. If it is, we assume than J-th gradient is zero + * (i.e. don't add anything) + */ + if( ae_fp_neq(v,0) ) + { + for(j2=0; j2<=nx-1; j2++) + { + x.ptr.p_double[j2] = x.ptr.p_double[j2]+w.ptr.p_double[j]*(qxybuf.ptr.pp_double[j][nx]-xy->ptr.pp_double[i][nx])*(qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2])/v; + } + } + s = s+w.ptr.p_double[j]; + } + for(j=0; j<=nx-1; j++) + { + z->q.ptr.pp_double[i][nx+1+j] = x.ptr.p_double[j]/s; + } + } + else + { + + /* + * Least squares models: build + */ + if( d==1 ) + { + + /* + * Linear nodal function calculated using + * least squares fitting to its neighbors + */ + for(j=0; j<=k-1; j++) + { + for(j2=0; j2<=nx-1; j2++) + { + fmatrix.ptr.pp_double[j][j2] = qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2]; + } + y.ptr.p_double[j] = qxybuf.ptr.pp_double[j][nx]-xy->ptr.pp_double[i][nx]; + } + nc = nx; + } + if( d==2 ) + { + + /* + * Quadratic nodal function calculated using + * least squares fitting to its neighbors + */ + for(j=0; j<=k-1; j++) + { + offs = 0; + for(j2=0; j2<=nx-1; j2++) + { + fmatrix.ptr.pp_double[j][offs] = qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2]; + offs = offs+1; + } + for(j2=0; j2<=nx-1; j2++) + { + for(j3=j2; j3<=nx-1; j3++) + { + fmatrix.ptr.pp_double[j][offs] = (qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2])*(qxybuf.ptr.pp_double[j][j3]-xy->ptr.pp_double[i][j3]); + offs = offs+1; + } + } + y.ptr.p_double[j] = qxybuf.ptr.pp_double[j][nx]-xy->ptr.pp_double[i][nx]; + } + nc = nx+ae_round(nx*(nx+1)*0.5, _state); + } + idwint_idwinternalsolver(&y, &w, &fmatrix, &temp, k, nc, &info, &qsol, &taskrcond, _state); + + /* + * Least squares models: copy results + */ + if( info>0 ) + { + + /* + * LLS task is solved, copy results + */ + z->debugworstrcond = ae_minreal(z->debugworstrcond, taskrcond, _state); + z->debugbestrcond = ae_maxreal(z->debugbestrcond, taskrcond, _state); + for(j=0; j<=nc-1; j++) + { + z->q.ptr.pp_double[i][nx+1+j] = qsol.ptr.p_double[j]; + } + } + else + { + + /* + * Solver failure, very strange, but we will use + * zero values to handle it. + */ + z->debugsolverfailures = z->debugsolverfailures+1; + for(j=0; j<=nc-1; j++) + { + z->q.ptr.pp_double[i][nx+1+j] = 0; + } + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +IDW interpolant using modified Shepard method for non-uniform datasets. + +This type of model uses constant nodal functions and interpolates using +all nodes which are closer than user-specified radius R. It may be used +when points distribution is non-uniform at the small scale, but it is at +the distances as large as R. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + R - radius, R>0 + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: +* if there is less than IDWKMin points within R-ball, algorithm selects + IDWKMin closest ones, so that continuity properties of interpolant are + preserved even far from points. + + -- ALGLIB PROJECT -- + Copyright 11.04.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildmodifiedshepardr(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t nx, + double r, + idwinterpolant* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector tags; + + ae_frame_make(_state, &_frame_block); + _idwinterpolant_clear(z); + ae_vector_init(&tags, 0, DT_INT, _state, ae_true); + + + /* + * assertions + */ + ae_assert(n>0, "IDWBuildModifiedShepardR: N<=0!", _state); + ae_assert(nx>=1, "IDWBuildModifiedShepardR: NX<1!", _state); + ae_assert(ae_fp_greater(r,0), "IDWBuildModifiedShepardR: R<=0!", _state); + + /* + * primary initialization of Z + */ + idwint_idwinit1(n, nx, 0, 0, n, z, _state); + z->modeltype = 1; + z->r = r; + + /* + * Create KD-tree + */ + ae_vector_set_length(&tags, n, _state); + for(i=0; i<=n-1; i++) + { + tags.ptr.p_int[i] = i; + } + kdtreebuildtagged(xy, &tags, n, nx, 1, 2, &z->tree, _state); + + /* + * build nodal functions + */ + for(i=0; i<=n-1; i++) + { + ae_v_move(&z->q.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx)); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +IDW model for noisy data. + +This subroutine may be used to handle noisy data, i.e. data with noise in +OUTPUT values. It differs from IDWBuildModifiedShepard() in the following +aspects: +* nodal functions are not constrained to pass through nodes: Qi(xi)<>yi, + i.e. we have fitting instead of interpolation. +* weights which are used during least squares fitting stage are all equal + to 1.0 (independently of distance) +* "fast"-linear or constant nodal functions are not supported (either not + robust enough or too rigid) + +This problem require far more complex tuning than interpolation problems. +Below you can find some recommendations regarding this problem: +* focus on tuning NQ; it controls noise reduction. As for NW, you can just + make it equal to 2*NQ. +* you can use cross-validation to determine optimal NQ. +* optimal NQ is a result of complex tradeoff between noise level (more + noise = larger NQ required) and underlying function complexity (given + fixed N, larger NQ means smoothing of compex features in the data). For + example, NQ=N will reduce noise to the minimum level possible, but you + will end up with just constant/linear/quadratic (depending on D) least + squares model for the whole dataset. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + D - nodal function degree, either: + * 1 linear model, least squares fitting. Simpe model for + datasets too small for quadratic models (or for very + noisy problems). + * 2 quadratic model, least squares fitting. Best model + available (if your dataset is large enough). + NQ - number of points used to calculate nodal functions. NQ should + be significantly larger than 1.5 times the number of + coefficients in a nodal function to overcome effects of noise: + * larger than 1.5*(1+NX) for linear model, + * larger than 3/4*(NX+2)*(NX+1) for quadratic model. + Values less than this threshold will be silently increased. + NW - number of points used to calculate weights and to interpolate. + Required: >=2^NX+1, values less than this threshold will be + silently increased. + Recommended value: about 2*NQ or larger + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: + * best results are obtained with quadratic models, linear models are not + recommended to use unless you are pretty sure that it is what you want + * this subroutine is always succeeds (as long as correct parameters are + passed). + * see 'Multivariate Interpolation of Large Sets of Scattered Data' by + Robert J. Renka for more information on this algorithm. + + + -- ALGLIB PROJECT -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildnoisy(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t nx, + ae_int_t d, + ae_int_t nq, + ae_int_t nw, + idwinterpolant* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t j2; + ae_int_t j3; + double v; + ae_int_t nc; + ae_int_t offs; + double taskrcond; + ae_vector x; + ae_vector qrbuf; + ae_matrix qxybuf; + ae_vector y; + ae_vector w; + ae_matrix fmatrix; + ae_vector qsol; + ae_vector tags; + ae_vector temp; + ae_int_t info; + + ae_frame_make(_state, &_frame_block); + _idwinterpolant_clear(z); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&qrbuf, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&qxybuf, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&qsol, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tags, 0, DT_INT, _state, ae_true); + ae_vector_init(&temp, 0, DT_REAL, _state, ae_true); + + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + nc = 0; + + /* + * assertions + */ + ae_assert(n>0, "IDWBuildNoisy: N<=0!", _state); + ae_assert(nx>=1, "IDWBuildNoisy: NX<1!", _state); + ae_assert(d>=1&&d<=2, "IDWBuildNoisy: D<>1 and D<>2!", _state); + + /* + * Correct parameters if needed + */ + if( d==1 ) + { + nq = ae_maxint(nq, ae_iceil(idwint_idwqfactor*(1+nx), _state)+1, _state); + } + if( d==2 ) + { + nq = ae_maxint(nq, ae_iceil(idwint_idwqfactor*(nx+2)*(nx+1)/2, _state)+1, _state); + } + nw = ae_maxint(nw, ae_round(ae_pow(2, nx, _state), _state)+1, _state); + nq = ae_minint(nq, n, _state); + nw = ae_minint(nw, n, _state); + + /* + * primary initialization of Z + */ + idwint_idwinit1(n, nx, d, nq, nw, z, _state); + z->modeltype = 0; + + /* + * Create KD-tree + */ + ae_vector_set_length(&tags, n, _state); + for(i=0; i<=n-1; i++) + { + tags.ptr.p_int[i] = i; + } + kdtreebuildtagged(xy, &tags, n, nx, 1, 2, &z->tree, _state); + + /* + * build nodal functions + * (special algorithm for noisy data is used) + */ + ae_vector_set_length(&temp, nq+1, _state); + ae_vector_set_length(&x, nx, _state); + ae_vector_set_length(&qrbuf, nq, _state); + ae_matrix_set_length(&qxybuf, nq, nx+1, _state); + if( d==1 ) + { + ae_vector_set_length(&y, nq, _state); + ae_vector_set_length(&w, nq, _state); + ae_vector_set_length(&qsol, 1+nx, _state); + + /* + * 1 for constant member, + * NX for linear members, + * 1 for temporary storage + */ + ae_matrix_set_length(&fmatrix, nq, 1+nx+1, _state); + } + if( d==2 ) + { + ae_vector_set_length(&y, nq, _state); + ae_vector_set_length(&w, nq, _state); + ae_vector_set_length(&qsol, 1+nx+ae_round(nx*(nx+1)*0.5, _state), _state); + + /* + * 1 for constant member, + * NX for linear members, + * Round(NX*(NX+1)*0.5) for quadratic model, + * 1 for temporary storage + */ + ae_matrix_set_length(&fmatrix, nq, 1+nx+ae_round(nx*(nx+1)*0.5, _state)+1, _state); + } + for(i=0; i<=n-1; i++) + { + + /* + * Initialize center. + */ + ae_v_move(&z->q.ptr.pp_double[i][0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx-1)); + + /* + * Calculate linear/quadratic members + * using least squares fit + * NOTE 1: all weight are equal to 1.0 + * NOTE 2: self-match is USED for this query + */ + ae_v_move(&x.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nx-1)); + k = kdtreequeryknn(&z->tree, &x, nq, ae_true, _state); + kdtreequeryresultsxy(&z->tree, &qxybuf, _state); + kdtreequeryresultsdistances(&z->tree, &qrbuf, _state); + if( d==1 ) + { + + /* + * Linear nodal function calculated using + * least squares fitting to its neighbors + */ + for(j=0; j<=k-1; j++) + { + fmatrix.ptr.pp_double[j][0] = 1.0; + for(j2=0; j2<=nx-1; j2++) + { + fmatrix.ptr.pp_double[j][1+j2] = qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2]; + } + y.ptr.p_double[j] = qxybuf.ptr.pp_double[j][nx]; + w.ptr.p_double[j] = 1; + } + nc = 1+nx; + } + if( d==2 ) + { + + /* + * Quadratic nodal function calculated using + * least squares fitting to its neighbors + */ + for(j=0; j<=k-1; j++) + { + fmatrix.ptr.pp_double[j][0] = 1; + offs = 1; + for(j2=0; j2<=nx-1; j2++) + { + fmatrix.ptr.pp_double[j][offs] = qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2]; + offs = offs+1; + } + for(j2=0; j2<=nx-1; j2++) + { + for(j3=j2; j3<=nx-1; j3++) + { + fmatrix.ptr.pp_double[j][offs] = (qxybuf.ptr.pp_double[j][j2]-xy->ptr.pp_double[i][j2])*(qxybuf.ptr.pp_double[j][j3]-xy->ptr.pp_double[i][j3]); + offs = offs+1; + } + } + y.ptr.p_double[j] = qxybuf.ptr.pp_double[j][nx]; + w.ptr.p_double[j] = 1; + } + nc = 1+nx+ae_round(nx*(nx+1)*0.5, _state); + } + idwint_idwinternalsolver(&y, &w, &fmatrix, &temp, k, nc, &info, &qsol, &taskrcond, _state); + + /* + * Least squares models: copy results + */ + if( info>0 ) + { + + /* + * LLS task is solved, copy results + */ + z->debugworstrcond = ae_minreal(z->debugworstrcond, taskrcond, _state); + z->debugbestrcond = ae_maxreal(z->debugbestrcond, taskrcond, _state); + for(j=0; j<=nc-1; j++) + { + z->q.ptr.pp_double[i][nx+j] = qsol.ptr.p_double[j]; + } + } + else + { + + /* + * Solver failure, very strange, but we will use + * zero values to handle it. + */ + z->debugsolverfailures = z->debugsolverfailures+1; + v = 0; + for(j=0; j<=k-1; j++) + { + v = v+qxybuf.ptr.pp_double[j][nx]; + } + z->q.ptr.pp_double[i][nx] = v/k; + for(j=0; j<=nc-2; j++) + { + z->q.ptr.pp_double[i][nx+1+j] = 0; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine: K-th nodal function calculation + + -- ALGLIB -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +static double idwint_idwcalcq(idwinterpolant* z, + /* Real */ ae_vector* x, + ae_int_t k, + ae_state *_state) +{ + ae_int_t nx; + ae_int_t i; + ae_int_t j; + ae_int_t offs; + double result; + + + nx = z->nx; + + /* + * constant member + */ + result = z->q.ptr.pp_double[k][nx]; + + /* + * linear members + */ + if( z->d>=1 ) + { + for(i=0; i<=nx-1; i++) + { + result = result+z->q.ptr.pp_double[k][nx+1+i]*(x->ptr.p_double[i]-z->q.ptr.pp_double[k][i]); + } + } + + /* + * quadratic members + */ + if( z->d>=2 ) + { + offs = nx+1+nx; + for(i=0; i<=nx-1; i++) + { + for(j=i; j<=nx-1; j++) + { + result = result+z->q.ptr.pp_double[k][offs]*(x->ptr.p_double[i]-z->q.ptr.pp_double[k][i])*(x->ptr.p_double[j]-z->q.ptr.pp_double[k][j]); + offs = offs+1; + } + } + } + return result; +} + + +/************************************************************************* +Initialization of internal structures. + +It assumes correctness of all parameters. + + -- ALGLIB -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +static void idwint_idwinit1(ae_int_t n, + ae_int_t nx, + ae_int_t d, + ae_int_t nq, + ae_int_t nw, + idwinterpolant* z, + ae_state *_state) +{ + + + z->debugsolverfailures = 0; + z->debugworstrcond = 1.0; + z->debugbestrcond = 0; + z->n = n; + z->nx = nx; + z->d = 0; + if( d==1 ) + { + z->d = 1; + } + if( d==2 ) + { + z->d = 2; + } + if( d==-1 ) + { + z->d = 1; + } + z->nw = nw; + if( d==-1 ) + { + ae_matrix_set_length(&z->q, n, nx+1+nx, _state); + } + if( d==0 ) + { + ae_matrix_set_length(&z->q, n, nx+1, _state); + } + if( d==1 ) + { + ae_matrix_set_length(&z->q, n, nx+1+nx, _state); + } + if( d==2 ) + { + ae_matrix_set_length(&z->q, n, nx+1+nx+ae_round(nx*(nx+1)*0.5, _state), _state); + } + ae_vector_set_length(&z->tbuf, nw, _state); + ae_vector_set_length(&z->rbuf, nw, _state); + ae_matrix_set_length(&z->xybuf, nw, nx+1, _state); + ae_vector_set_length(&z->xbuf, nx, _state); +} + + +/************************************************************************* +Linear least squares solver for small tasks. + +Works faster than standard ALGLIB solver in non-degenerate cases (due to +absense of internal allocations and optimized row/colums). In degenerate +cases it calls standard solver, which results in small performance penalty +associated with preliminary steps. + +INPUT PARAMETERS: + Y array[0..N-1] + W array[0..N-1] + FMatrix array[0..N-1,0..M], have additional column for temporary + values + Temp array[0..N] +*************************************************************************/ +static void idwint_idwinternalsolver(/* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* fmatrix, + /* Real */ ae_vector* temp, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* x, + double* taskrcond, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double v; + double tau; + ae_vector b; + densesolverlsreport srep; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + _densesolverlsreport_init(&srep, _state, ae_true); + + + /* + * set up info + */ + *info = 1; + + /* + * prepare matrix + */ + for(i=0; i<=n-1; i++) + { + fmatrix->ptr.pp_double[i][m] = y->ptr.p_double[i]; + v = w->ptr.p_double[i]; + ae_v_muld(&fmatrix->ptr.pp_double[i][0], 1, ae_v_len(0,m), v); + } + + /* + * use either fast algorithm or general algorithm + */ + if( m<=n ) + { + + /* + * QR decomposition + * We assume that M<=N (we would have called LSFit() otherwise) + */ + for(i=0; i<=m-1; i++) + { + if( iptr.p_double[1], 1, &fmatrix->ptr.pp_double[i][i], fmatrix->stride, ae_v_len(1,n-i)); + generatereflection(temp, n-i, &tau, _state); + fmatrix->ptr.pp_double[i][i] = temp->ptr.p_double[1]; + temp->ptr.p_double[1] = 1; + for(j=i+1; j<=m; j++) + { + v = ae_v_dotproduct(&fmatrix->ptr.pp_double[i][j], fmatrix->stride, &temp->ptr.p_double[1], 1, ae_v_len(i,n-1)); + v = tau*v; + ae_v_subd(&fmatrix->ptr.pp_double[i][j], fmatrix->stride, &temp->ptr.p_double[1], 1, ae_v_len(i,n-1), v); + } + } + } + + /* + * Check condition number + */ + *taskrcond = rmatrixtrrcondinf(fmatrix, m, ae_true, ae_false, _state); + + /* + * use either fast algorithm for non-degenerate cases + * or slow algorithm for degenerate cases + */ + if( ae_fp_greater(*taskrcond,10000*n*ae_machineepsilon) ) + { + + /* + * solve triangular system R*x = FMatrix[0:M-1,M] + * using fast algorithm, then exit + */ + x->ptr.p_double[m-1] = fmatrix->ptr.pp_double[m-1][m]/fmatrix->ptr.pp_double[m-1][m-1]; + for(i=m-2; i>=0; i--) + { + v = ae_v_dotproduct(&fmatrix->ptr.pp_double[i][i+1], 1, &x->ptr.p_double[i+1], 1, ae_v_len(i+1,m-1)); + x->ptr.p_double[i] = (fmatrix->ptr.pp_double[i][m]-v)/fmatrix->ptr.pp_double[i][i]; + } + } + else + { + + /* + * use more general algorithm + */ + ae_vector_set_length(&b, m, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=i-1; j++) + { + fmatrix->ptr.pp_double[i][j] = 0.0; + } + b.ptr.p_double[i] = fmatrix->ptr.pp_double[i][m]; + } + rmatrixsolvels(fmatrix, m, m, &b, 10000*ae_machineepsilon, info, &srep, x, _state); + } + } + else + { + + /* + * use more general algorithm + */ + ae_vector_set_length(&b, n, _state); + for(i=0; i<=n-1; i++) + { + b.ptr.p_double[i] = fmatrix->ptr.pp_double[i][m]; + } + rmatrixsolvels(fmatrix, n, m, &b, 10000*ae_machineepsilon, info, &srep, x, _state); + *taskrcond = srep.r2; + } + ae_frame_leave(_state); +} + + +ae_bool _idwinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + idwinterpolant *p = (idwinterpolant*)_p; + ae_touch_ptr((void*)p); + if( !_kdtree_init(&p->tree, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->q, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tbuf, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->xybuf, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _idwinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + idwinterpolant *dst = (idwinterpolant*)_dst; + idwinterpolant *src = (idwinterpolant*)_src; + dst->n = src->n; + dst->nx = src->nx; + dst->d = src->d; + dst->r = src->r; + dst->nw = src->nw; + if( !_kdtree_init_copy(&dst->tree, &src->tree, _state, make_automatic) ) + return ae_false; + dst->modeltype = src->modeltype; + if( !ae_matrix_init_copy(&dst->q, &src->q, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xbuf, &src->xbuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tbuf, &src->tbuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rbuf, &src->rbuf, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->xybuf, &src->xybuf, _state, make_automatic) ) + return ae_false; + dst->debugsolverfailures = src->debugsolverfailures; + dst->debugworstrcond = src->debugworstrcond; + dst->debugbestrcond = src->debugbestrcond; + return ae_true; +} + + +void _idwinterpolant_clear(void* _p) +{ + idwinterpolant *p = (idwinterpolant*)_p; + ae_touch_ptr((void*)p); + _kdtree_clear(&p->tree); + ae_matrix_clear(&p->q); + ae_vector_clear(&p->xbuf); + ae_vector_clear(&p->tbuf); + ae_vector_clear(&p->rbuf); + ae_matrix_clear(&p->xybuf); +} + + +void _idwinterpolant_destroy(void* _p) +{ + idwinterpolant *p = (idwinterpolant*)_p; + ae_touch_ptr((void*)p); + _kdtree_destroy(&p->tree); + ae_matrix_destroy(&p->q); + ae_vector_destroy(&p->xbuf); + ae_vector_destroy(&p->tbuf); + ae_vector_destroy(&p->rbuf); + ae_matrix_destroy(&p->xybuf); +} + + + + +/************************************************************************* +Rational interpolation using barycentric formula + +F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) + +Input parameters: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +Result: + barycentric interpolant F(t) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +double barycentriccalc(barycentricinterpolant* b, + double t, + ae_state *_state) +{ + double s1; + double s2; + double s; + double v; + ae_int_t i; + double result; + + + ae_assert(!ae_isinf(t, _state), "BarycentricCalc: infinite T!", _state); + + /* + * special case: NaN + */ + if( ae_isnan(t, _state) ) + { + result = _state->v_nan; + return result; + } + + /* + * special case: N=1 + */ + if( b->n==1 ) + { + result = b->sy*b->y.ptr.p_double[0]; + return result; + } + + /* + * Here we assume that task is normalized, i.e.: + * 1. abs(Y[i])<=1 + * 2. abs(W[i])<=1 + * 3. X[] is ordered + */ + s = ae_fabs(t-b->x.ptr.p_double[0], _state); + for(i=0; i<=b->n-1; i++) + { + v = b->x.ptr.p_double[i]; + if( ae_fp_eq(v,t) ) + { + result = b->sy*b->y.ptr.p_double[i]; + return result; + } + v = ae_fabs(t-v, _state); + if( ae_fp_less(v,s) ) + { + s = v; + } + } + s1 = 0; + s2 = 0; + for(i=0; i<=b->n-1; i++) + { + v = s/(t-b->x.ptr.p_double[i]); + v = v*b->w.ptr.p_double[i]; + s1 = s1+v*b->y.ptr.p_double[i]; + s2 = s2+v; + } + result = b->sy*s1/s2; + return result; +} + + +/************************************************************************* +Differentiation of barycentric interpolant: first derivative. + +Algorithm used in this subroutine is very robust and should not fail until +provided with values too close to MaxRealNumber (usually MaxRealNumber/N +or greater will overflow). + +INPUT PARAMETERS: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +OUTPUT PARAMETERS: + F - barycentric interpolant at T + DF - first derivative + +NOTE + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricdiff1(barycentricinterpolant* b, + double t, + double* f, + double* df, + ae_state *_state) +{ + double v; + double vv; + ae_int_t i; + ae_int_t k; + double n0; + double n1; + double d0; + double d1; + double s0; + double s1; + double xk; + double xi; + double xmin; + double xmax; + double xscale1; + double xoffs1; + double xscale2; + double xoffs2; + double xprev; + + *f = 0; + *df = 0; + + ae_assert(!ae_isinf(t, _state), "BarycentricDiff1: infinite T!", _state); + + /* + * special case: NaN + */ + if( ae_isnan(t, _state) ) + { + *f = _state->v_nan; + *df = _state->v_nan; + return; + } + + /* + * special case: N=1 + */ + if( b->n==1 ) + { + *f = b->sy*b->y.ptr.p_double[0]; + *df = 0; + return; + } + if( ae_fp_eq(b->sy,0) ) + { + *f = 0; + *df = 0; + return; + } + ae_assert(ae_fp_greater(b->sy,0), "BarycentricDiff1: internal error", _state); + + /* + * We assume than N>1 and B.SY>0. Find: + * 1. pivot point (X[i] closest to T) + * 2. width of interval containing X[i] + */ + v = ae_fabs(b->x.ptr.p_double[0]-t, _state); + k = 0; + xmin = b->x.ptr.p_double[0]; + xmax = b->x.ptr.p_double[0]; + for(i=1; i<=b->n-1; i++) + { + vv = b->x.ptr.p_double[i]; + if( ae_fp_less(ae_fabs(vv-t, _state),v) ) + { + v = ae_fabs(vv-t, _state); + k = i; + } + xmin = ae_minreal(xmin, vv, _state); + xmax = ae_maxreal(xmax, vv, _state); + } + + /* + * pivot point found, calculate dNumerator and dDenominator + */ + xscale1 = 1/(xmax-xmin); + xoffs1 = -xmin/(xmax-xmin)+1; + xscale2 = 2; + xoffs2 = -3; + t = t*xscale1+xoffs1; + t = t*xscale2+xoffs2; + xk = b->x.ptr.p_double[k]; + xk = xk*xscale1+xoffs1; + xk = xk*xscale2+xoffs2; + v = t-xk; + n0 = 0; + n1 = 0; + d0 = 0; + d1 = 0; + xprev = -2; + for(i=0; i<=b->n-1; i++) + { + xi = b->x.ptr.p_double[i]; + xi = xi*xscale1+xoffs1; + xi = xi*xscale2+xoffs2; + ae_assert(ae_fp_greater(xi,xprev), "BarycentricDiff1: points are too close!", _state); + xprev = xi; + if( i!=k ) + { + vv = ae_sqr(t-xi, _state); + s0 = (t-xk)/(t-xi); + s1 = (xk-xi)/vv; + } + else + { + s0 = 1; + s1 = 0; + } + vv = b->w.ptr.p_double[i]*b->y.ptr.p_double[i]; + n0 = n0+s0*vv; + n1 = n1+s1*vv; + vv = b->w.ptr.p_double[i]; + d0 = d0+s0*vv; + d1 = d1+s1*vv; + } + *f = b->sy*n0/d0; + *df = (n1*d0-n0*d1)/ae_sqr(d0, _state); + if( ae_fp_neq(*df,0) ) + { + *df = ae_sign(*df, _state)*ae_exp(ae_log(ae_fabs(*df, _state), _state)+ae_log(b->sy, _state)+ae_log(xscale1, _state)+ae_log(xscale2, _state), _state); + } +} + + +/************************************************************************* +Differentiation of barycentric interpolant: first/second derivatives. + +INPUT PARAMETERS: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +OUTPUT PARAMETERS: + F - barycentric interpolant at T + DF - first derivative + D2F - second derivative + +NOTE: this algorithm may fail due to overflow/underflor if used on data +whose values are close to MaxRealNumber or MinRealNumber. Use more robust +BarycentricDiff1() subroutine in such cases. + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricdiff2(barycentricinterpolant* b, + double t, + double* f, + double* df, + double* d2f, + ae_state *_state) +{ + double v; + double vv; + ae_int_t i; + ae_int_t k; + double n0; + double n1; + double n2; + double d0; + double d1; + double d2; + double s0; + double s1; + double s2; + double xk; + double xi; + + *f = 0; + *df = 0; + *d2f = 0; + + ae_assert(!ae_isinf(t, _state), "BarycentricDiff1: infinite T!", _state); + + /* + * special case: NaN + */ + if( ae_isnan(t, _state) ) + { + *f = _state->v_nan; + *df = _state->v_nan; + *d2f = _state->v_nan; + return; + } + + /* + * special case: N=1 + */ + if( b->n==1 ) + { + *f = b->sy*b->y.ptr.p_double[0]; + *df = 0; + *d2f = 0; + return; + } + if( ae_fp_eq(b->sy,0) ) + { + *f = 0; + *df = 0; + *d2f = 0; + return; + } + + /* + * We assume than N>1 and B.SY>0. Find: + * 1. pivot point (X[i] closest to T) + * 2. width of interval containing X[i] + */ + ae_assert(ae_fp_greater(b->sy,0), "BarycentricDiff: internal error", _state); + *f = 0; + *df = 0; + *d2f = 0; + v = ae_fabs(b->x.ptr.p_double[0]-t, _state); + k = 0; + for(i=1; i<=b->n-1; i++) + { + vv = b->x.ptr.p_double[i]; + if( ae_fp_less(ae_fabs(vv-t, _state),v) ) + { + v = ae_fabs(vv-t, _state); + k = i; + } + } + + /* + * pivot point found, calculate dNumerator and dDenominator + */ + xk = b->x.ptr.p_double[k]; + v = t-xk; + n0 = 0; + n1 = 0; + n2 = 0; + d0 = 0; + d1 = 0; + d2 = 0; + for(i=0; i<=b->n-1; i++) + { + if( i!=k ) + { + xi = b->x.ptr.p_double[i]; + vv = ae_sqr(t-xi, _state); + s0 = (t-xk)/(t-xi); + s1 = (xk-xi)/vv; + s2 = -2*(xk-xi)/(vv*(t-xi)); + } + else + { + s0 = 1; + s1 = 0; + s2 = 0; + } + vv = b->w.ptr.p_double[i]*b->y.ptr.p_double[i]; + n0 = n0+s0*vv; + n1 = n1+s1*vv; + n2 = n2+s2*vv; + vv = b->w.ptr.p_double[i]; + d0 = d0+s0*vv; + d1 = d1+s1*vv; + d2 = d2+s2*vv; + } + *f = b->sy*n0/d0; + *df = b->sy*(n1*d0-n0*d1)/ae_sqr(d0, _state); + *d2f = b->sy*((n2*d0-n0*d2)*ae_sqr(d0, _state)-(n1*d0-n0*d1)*2*d0*d1)/ae_sqr(ae_sqr(d0, _state), _state); +} + + +/************************************************************************* +This subroutine performs linear transformation of the argument. + +INPUT PARAMETERS: + B - rational interpolant in barycentric form + CA, CB - transformation coefficients: x = CA*t + CB + +OUTPUT PARAMETERS: + B - transformed interpolant with X replaced by T + + -- ALGLIB PROJECT -- + Copyright 19.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentriclintransx(barycentricinterpolant* b, + double ca, + double cb, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double v; + + + + /* + * special case, replace by constant F(CB) + */ + if( ae_fp_eq(ca,0) ) + { + b->sy = barycentriccalc(b, cb, _state); + v = 1; + for(i=0; i<=b->n-1; i++) + { + b->y.ptr.p_double[i] = 1; + b->w.ptr.p_double[i] = v; + v = -v; + } + return; + } + + /* + * general case: CA<>0 + */ + for(i=0; i<=b->n-1; i++) + { + b->x.ptr.p_double[i] = (b->x.ptr.p_double[i]-cb)/ca; + } + if( ae_fp_less(ca,0) ) + { + for(i=0; i<=b->n-1; i++) + { + if( in-1-i ) + { + j = b->n-1-i; + v = b->x.ptr.p_double[i]; + b->x.ptr.p_double[i] = b->x.ptr.p_double[j]; + b->x.ptr.p_double[j] = v; + v = b->y.ptr.p_double[i]; + b->y.ptr.p_double[i] = b->y.ptr.p_double[j]; + b->y.ptr.p_double[j] = v; + v = b->w.ptr.p_double[i]; + b->w.ptr.p_double[i] = b->w.ptr.p_double[j]; + b->w.ptr.p_double[j] = v; + } + else + { + break; + } + } + } +} + + +/************************************************************************* +This subroutine performs linear transformation of the barycentric +interpolant. + +INPUT PARAMETERS: + B - rational interpolant in barycentric form + CA, CB - transformation coefficients: B2(x) = CA*B(x) + CB + +OUTPUT PARAMETERS: + B - transformed interpolant + + -- ALGLIB PROJECT -- + Copyright 19.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentriclintransy(barycentricinterpolant* b, + double ca, + double cb, + ae_state *_state) +{ + ae_int_t i; + double v; + + + for(i=0; i<=b->n-1; i++) + { + b->y.ptr.p_double[i] = ca*b->sy*b->y.ptr.p_double[i]+cb; + } + b->sy = 0; + for(i=0; i<=b->n-1; i++) + { + b->sy = ae_maxreal(b->sy, ae_fabs(b->y.ptr.p_double[i], _state), _state); + } + if( ae_fp_greater(b->sy,0) ) + { + v = 1/b->sy; + ae_v_muld(&b->y.ptr.p_double[0], 1, ae_v_len(0,b->n-1), v); + } +} + + +/************************************************************************* +Extracts X/Y/W arrays from rational interpolant + +INPUT PARAMETERS: + B - barycentric interpolant + +OUTPUT PARAMETERS: + N - nodes count, N>0 + X - interpolation nodes, array[0..N-1] + F - function values, array[0..N-1] + W - barycentric weights, array[0..N-1] + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricunpack(barycentricinterpolant* b, + ae_int_t* n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_state *_state) +{ + double v; + + *n = 0; + ae_vector_clear(x); + ae_vector_clear(y); + ae_vector_clear(w); + + *n = b->n; + ae_vector_set_length(x, *n, _state); + ae_vector_set_length(y, *n, _state); + ae_vector_set_length(w, *n, _state); + v = b->sy; + ae_v_move(&x->ptr.p_double[0], 1, &b->x.ptr.p_double[0], 1, ae_v_len(0,*n-1)); + ae_v_moved(&y->ptr.p_double[0], 1, &b->y.ptr.p_double[0], 1, ae_v_len(0,*n-1), v); + ae_v_move(&w->ptr.p_double[0], 1, &b->w.ptr.p_double[0], 1, ae_v_len(0,*n-1)); +} + + +/************************************************************************* +Rational interpolant from X/Y/W arrays + +F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) + +INPUT PARAMETERS: + X - interpolation nodes, array[0..N-1] + F - function values, array[0..N-1] + W - barycentric weights, array[0..N-1] + N - nodes count, N>0 + +OUTPUT PARAMETERS: + B - barycentric interpolant built from (X, Y, W) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricbuildxyw(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + barycentricinterpolant* b, + ae_state *_state) +{ + + _barycentricinterpolant_clear(b); + + ae_assert(n>0, "BarycentricBuildXYW: incorrect N!", _state); + + /* + * fill X/Y/W + */ + ae_vector_set_length(&b->x, n, _state); + ae_vector_set_length(&b->y, n, _state); + ae_vector_set_length(&b->w, n, _state); + ae_v_move(&b->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&b->y.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&b->w.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); + b->n = n; + + /* + * Normalize + */ + ratint_barycentricnormalize(b, _state); +} + + +/************************************************************************* +Rational interpolant without poles + +The subroutine constructs the rational interpolating function without real +poles (see 'Barycentric rational interpolation with no poles and high +rates of approximation', Michael S. Floater. and Kai Hormann, for more +information on this subject). + +Input parameters: + X - interpolation nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of nodes, N>0. + D - order of the interpolation scheme, 0 <= D <= N-1. + D<0 will cause an error. + D>=N it will be replaced with D=N-1. + if you don't know what D to choose, use small value about 3-5. + +Output parameters: + B - barycentric interpolant. + +Note: + this algorithm always succeeds and calculates the weights with close + to machine precision. + + -- ALGLIB PROJECT -- + Copyright 17.06.2007 by Bochkanov Sergey +*************************************************************************/ +void barycentricbuildfloaterhormann(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t d, + barycentricinterpolant* b, + ae_state *_state) +{ + ae_frame _frame_block; + double s0; + double s; + double v; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_vector perm; + ae_vector wtemp; + ae_vector sortrbuf; + ae_vector sortrbuf2; + + ae_frame_make(_state, &_frame_block); + _barycentricinterpolant_clear(b); + ae_vector_init(&perm, 0, DT_INT, _state, ae_true); + ae_vector_init(&wtemp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sortrbuf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sortrbuf2, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "BarycentricFloaterHormann: N<=0!", _state); + ae_assert(d>=0, "BarycentricFloaterHormann: incorrect D!", _state); + + /* + * Prepare + */ + if( d>n-1 ) + { + d = n-1; + } + b->n = n; + + /* + * special case: N=1 + */ + if( n==1 ) + { + ae_vector_set_length(&b->x, n, _state); + ae_vector_set_length(&b->y, n, _state); + ae_vector_set_length(&b->w, n, _state); + b->x.ptr.p_double[0] = x->ptr.p_double[0]; + b->y.ptr.p_double[0] = y->ptr.p_double[0]; + b->w.ptr.p_double[0] = 1; + ratint_barycentricnormalize(b, _state); + ae_frame_leave(_state); + return; + } + + /* + * Fill X/Y + */ + ae_vector_set_length(&b->x, n, _state); + ae_vector_set_length(&b->y, n, _state); + ae_v_move(&b->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&b->y.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); + tagsortfastr(&b->x, &b->y, &sortrbuf, &sortrbuf2, n, _state); + + /* + * Calculate Wk + */ + ae_vector_set_length(&b->w, n, _state); + s0 = 1; + for(k=1; k<=d; k++) + { + s0 = -s0; + } + for(k=0; k<=n-1; k++) + { + + /* + * Wk + */ + s = 0; + for(i=ae_maxint(k-d, 0, _state); i<=ae_minint(k, n-1-d, _state); i++) + { + v = 1; + for(j=i; j<=i+d; j++) + { + if( j!=k ) + { + v = v/ae_fabs(b->x.ptr.p_double[k]-b->x.ptr.p_double[j], _state); + } + } + s = s+v; + } + b->w.ptr.p_double[k] = s0*s; + + /* + * Next S0 + */ + s0 = -s0; + } + + /* + * Normalize + */ + ratint_barycentricnormalize(b, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Copying of the barycentric interpolant (for internal use only) + +INPUT PARAMETERS: + B - barycentric interpolant + +OUTPUT PARAMETERS: + B2 - copy(B1) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentriccopy(barycentricinterpolant* b, + barycentricinterpolant* b2, + ae_state *_state) +{ + + _barycentricinterpolant_clear(b2); + + b2->n = b->n; + b2->sy = b->sy; + ae_vector_set_length(&b2->x, b2->n, _state); + ae_vector_set_length(&b2->y, b2->n, _state); + ae_vector_set_length(&b2->w, b2->n, _state); + ae_v_move(&b2->x.ptr.p_double[0], 1, &b->x.ptr.p_double[0], 1, ae_v_len(0,b2->n-1)); + ae_v_move(&b2->y.ptr.p_double[0], 1, &b->y.ptr.p_double[0], 1, ae_v_len(0,b2->n-1)); + ae_v_move(&b2->w.ptr.p_double[0], 1, &b->w.ptr.p_double[0], 1, ae_v_len(0,b2->n-1)); +} + + +/************************************************************************* +Normalization of barycentric interpolant: +* B.N, B.X, B.Y and B.W are initialized +* B.SY is NOT initialized +* Y[] is normalized, scaling coefficient is stored in B.SY +* W[] is normalized, no scaling coefficient is stored +* X[] is sorted + +Internal subroutine. +*************************************************************************/ +static void ratint_barycentricnormalize(barycentricinterpolant* b, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector p1; + ae_vector p2; + ae_int_t i; + ae_int_t j; + ae_int_t j2; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&p1, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + + + /* + * Normalize task: |Y|<=1, |W|<=1, sort X[] + */ + b->sy = 0; + for(i=0; i<=b->n-1; i++) + { + b->sy = ae_maxreal(b->sy, ae_fabs(b->y.ptr.p_double[i], _state), _state); + } + if( ae_fp_greater(b->sy,0)&&ae_fp_greater(ae_fabs(b->sy-1, _state),10*ae_machineepsilon) ) + { + v = 1/b->sy; + ae_v_muld(&b->y.ptr.p_double[0], 1, ae_v_len(0,b->n-1), v); + } + v = 0; + for(i=0; i<=b->n-1; i++) + { + v = ae_maxreal(v, ae_fabs(b->w.ptr.p_double[i], _state), _state); + } + if( ae_fp_greater(v,0)&&ae_fp_greater(ae_fabs(v-1, _state),10*ae_machineepsilon) ) + { + v = 1/v; + ae_v_muld(&b->w.ptr.p_double[0], 1, ae_v_len(0,b->n-1), v); + } + for(i=0; i<=b->n-2; i++) + { + if( ae_fp_less(b->x.ptr.p_double[i+1],b->x.ptr.p_double[i]) ) + { + tagsort(&b->x, b->n, &p1, &p2, _state); + for(j=0; j<=b->n-1; j++) + { + j2 = p2.ptr.p_int[j]; + v = b->y.ptr.p_double[j]; + b->y.ptr.p_double[j] = b->y.ptr.p_double[j2]; + b->y.ptr.p_double[j2] = v; + v = b->w.ptr.p_double[j]; + b->w.ptr.p_double[j] = b->w.ptr.p_double[j2]; + b->w.ptr.p_double[j2] = v; + } + break; + } + } + ae_frame_leave(_state); +} + + +ae_bool _barycentricinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + barycentricinterpolant *p = (barycentricinterpolant*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->w, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _barycentricinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + barycentricinterpolant *dst = (barycentricinterpolant*)_dst; + barycentricinterpolant *src = (barycentricinterpolant*)_src; + dst->n = src->n; + dst->sy = src->sy; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->w, &src->w, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _barycentricinterpolant_clear(void* _p) +{ + barycentricinterpolant *p = (barycentricinterpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x); + ae_vector_clear(&p->y); + ae_vector_clear(&p->w); +} + + +void _barycentricinterpolant_destroy(void* _p) +{ + barycentricinterpolant *p = (barycentricinterpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->y); + ae_vector_destroy(&p->w); +} + + + + +/************************************************************************* +Conversion from barycentric representation to Chebyshev basis. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + P - polynomial in barycentric form + A,B - base interval for Chebyshev polynomials (see below) + A<>B + +OUTPUT PARAMETERS + T - coefficients of Chebyshev representation; + P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N-1 }, + where Ti - I-th Chebyshev polynomial. + +NOTES: + barycentric interpolant passed as P may be either polynomial obtained + from polynomial interpolation/ fitting or rational function which is + NOT polynomial. We can't distinguish between these two cases, and this + algorithm just tries to work assuming that P IS a polynomial. If not, + algorithm will return results, but they won't have any meaning. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialbar2cheb(barycentricinterpolant* p, + double a, + double b, + /* Real */ ae_vector* t, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t k; + ae_vector vp; + ae_vector vx; + ae_vector tk; + ae_vector tk1; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(t); + ae_vector_init(&vp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&vx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tk, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tk1, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_isfinite(a, _state), "PolynomialBar2Cheb: A is not finite!", _state); + ae_assert(ae_isfinite(b, _state), "PolynomialBar2Cheb: B is not finite!", _state); + ae_assert(ae_fp_neq(a,b), "PolynomialBar2Cheb: A=B!", _state); + ae_assert(p->n>0, "PolynomialBar2Cheb: P is not correctly initialized barycentric interpolant!", _state); + + /* + * Calculate function values on a Chebyshev grid + */ + ae_vector_set_length(&vp, p->n, _state); + ae_vector_set_length(&vx, p->n, _state); + for(i=0; i<=p->n-1; i++) + { + vx.ptr.p_double[i] = ae_cos(ae_pi*(i+0.5)/p->n, _state); + vp.ptr.p_double[i] = barycentriccalc(p, 0.5*(vx.ptr.p_double[i]+1)*(b-a)+a, _state); + } + + /* + * T[0] + */ + ae_vector_set_length(t, p->n, _state); + v = 0; + for(i=0; i<=p->n-1; i++) + { + v = v+vp.ptr.p_double[i]; + } + t->ptr.p_double[0] = v/p->n; + + /* + * other T's. + * + * NOTES: + * 1. TK stores T{k} on VX, TK1 stores T{k-1} on VX + * 2. we can do same calculations with fast DCT, but it + * * adds dependencies + * * still leaves us with O(N^2) algorithm because + * preparation of function values is O(N^2) process + */ + if( p->n>1 ) + { + ae_vector_set_length(&tk, p->n, _state); + ae_vector_set_length(&tk1, p->n, _state); + for(i=0; i<=p->n-1; i++) + { + tk.ptr.p_double[i] = vx.ptr.p_double[i]; + tk1.ptr.p_double[i] = 1; + } + for(k=1; k<=p->n-1; k++) + { + + /* + * calculate discrete product of function vector and TK + */ + v = ae_v_dotproduct(&tk.ptr.p_double[0], 1, &vp.ptr.p_double[0], 1, ae_v_len(0,p->n-1)); + t->ptr.p_double[k] = v/(0.5*p->n); + + /* + * Update TK and TK1 + */ + for(i=0; i<=p->n-1; i++) + { + v = 2*vx.ptr.p_double[i]*tk.ptr.p_double[i]-tk1.ptr.p_double[i]; + tk1.ptr.p_double[i] = tk.ptr.p_double[i]; + tk.ptr.p_double[i] = v; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Conversion from Chebyshev basis to barycentric representation. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + T - coefficients of Chebyshev representation; + P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N }, + where Ti - I-th Chebyshev polynomial. + N - number of coefficients: + * if given, only leading N elements of T are used + * if not given, automatically determined from size of T + A,B - base interval for Chebyshev polynomials (see above) + A=1, "PolynomialBar2Cheb: N<1", _state); + ae_assert(t->cnt>=n, "PolynomialBar2Cheb: Length(T)ptr.p_double[0]; + tk1 = 1; + tk = vx; + for(k=1; k<=n-1; k++) + { + vy = vy+t->ptr.p_double[k]*tk; + v = 2*vx*tk-tk1; + tk1 = tk; + tk = v; + } + y.ptr.p_double[i] = vy; + } + + /* + * Build barycentric interpolant, map grid from [-1,+1] to [A,B] + */ + polynomialbuildcheb1(a, b, &y, n, p, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Conversion from barycentric representation to power basis. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + P - polynomial in barycentric form + C - offset (see below); 0.0 is used as default value. + S - scale (see below); 1.0 is used as default value. S<>0. + +OUTPUT PARAMETERS + A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } + N - number of coefficients (polynomial degree plus 1) + +NOTES: +1. this function accepts offset and scale, which can be set to improve + numerical properties of polynomial. For example, if P was obtained as + result of interpolation on [-1,+1], you can set C=0 and S=1 and + represent P as sum of 1, x, x^2, x^3 and so on. In most cases you it + is exactly what you need. + + However, if your interpolation model was built on [999,1001], you will + see significant growth of numerical errors when using {1, x, x^2, x^3} + as basis. Representing P as sum of 1, (x-1000), (x-1000)^2, (x-1000)^3 + will be better option. Such representation can be obtained by using + 1000.0 as offset C and 1.0 as scale S. + +2. power basis is ill-conditioned and tricks described above can't solve + this problem completely. This function will return coefficients in + any case, but for N>8 they will become unreliable. However, N's + less than 5 are pretty safe. + +3. barycentric interpolant passed as P may be either polynomial obtained + from polynomial interpolation/ fitting or rational function which is + NOT polynomial. We can't distinguish between these two cases, and this + algorithm just tries to work assuming that P IS a polynomial. If not, + algorithm will return results, but they won't have any meaning. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialbar2pow(barycentricinterpolant* p, + double c, + double s, + /* Real */ ae_vector* a, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t k; + double e; + double d; + ae_vector vp; + ae_vector vx; + ae_vector tk; + ae_vector tk1; + ae_vector t; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(a); + ae_vector_init(&vp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&vx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tk, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tk1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_isfinite(c, _state), "PolynomialBar2Pow: C is not finite!", _state); + ae_assert(ae_isfinite(s, _state), "PolynomialBar2Pow: S is not finite!", _state); + ae_assert(ae_fp_neq(s,0), "PolynomialBar2Pow: S=0!", _state); + ae_assert(p->n>0, "PolynomialBar2Pow: P is not correctly initialized barycentric interpolant!", _state); + + /* + * Calculate function values on a Chebyshev grid + */ + ae_vector_set_length(&vp, p->n, _state); + ae_vector_set_length(&vx, p->n, _state); + for(i=0; i<=p->n-1; i++) + { + vx.ptr.p_double[i] = ae_cos(ae_pi*(i+0.5)/p->n, _state); + vp.ptr.p_double[i] = barycentriccalc(p, s*vx.ptr.p_double[i]+c, _state); + } + + /* + * T[0] + */ + ae_vector_set_length(&t, p->n, _state); + v = 0; + for(i=0; i<=p->n-1; i++) + { + v = v+vp.ptr.p_double[i]; + } + t.ptr.p_double[0] = v/p->n; + + /* + * other T's. + * + * NOTES: + * 1. TK stores T{k} on VX, TK1 stores T{k-1} on VX + * 2. we can do same calculations with fast DCT, but it + * * adds dependencies + * * still leaves us with O(N^2) algorithm because + * preparation of function values is O(N^2) process + */ + if( p->n>1 ) + { + ae_vector_set_length(&tk, p->n, _state); + ae_vector_set_length(&tk1, p->n, _state); + for(i=0; i<=p->n-1; i++) + { + tk.ptr.p_double[i] = vx.ptr.p_double[i]; + tk1.ptr.p_double[i] = 1; + } + for(k=1; k<=p->n-1; k++) + { + + /* + * calculate discrete product of function vector and TK + */ + v = ae_v_dotproduct(&tk.ptr.p_double[0], 1, &vp.ptr.p_double[0], 1, ae_v_len(0,p->n-1)); + t.ptr.p_double[k] = v/(0.5*p->n); + + /* + * Update TK and TK1 + */ + for(i=0; i<=p->n-1; i++) + { + v = 2*vx.ptr.p_double[i]*tk.ptr.p_double[i]-tk1.ptr.p_double[i]; + tk1.ptr.p_double[i] = tk.ptr.p_double[i]; + tk.ptr.p_double[i] = v; + } + } + } + + /* + * Convert from Chebyshev basis to power basis + */ + ae_vector_set_length(a, p->n, _state); + for(i=0; i<=p->n-1; i++) + { + a->ptr.p_double[i] = 0; + } + d = 0; + for(i=0; i<=p->n-1; i++) + { + for(k=i; k<=p->n-1; k++) + { + e = a->ptr.p_double[k]; + a->ptr.p_double[k] = 0; + if( i<=1&&k==i ) + { + a->ptr.p_double[k] = 1; + } + else + { + if( i!=0 ) + { + a->ptr.p_double[k] = 2*d; + } + if( k>i+1 ) + { + a->ptr.p_double[k] = a->ptr.p_double[k]-a->ptr.p_double[k-2]; + } + } + d = e; + } + d = a->ptr.p_double[i]; + e = 0; + k = i; + while(k<=p->n-1) + { + e = e+a->ptr.p_double[k]*t.ptr.p_double[k]; + k = k+2; + } + a->ptr.p_double[i] = e; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Conversion from power basis to barycentric representation. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } + N - number of coefficients (polynomial degree plus 1) + * if given, only leading N elements of A are used + * if not given, automatically determined from size of A + C - offset (see below); 0.0 is used as default value. + S - scale (see below); 1.0 is used as default value. S<>0. + +OUTPUT PARAMETERS + P - polynomial in barycentric form + + +NOTES: +1. this function accepts offset and scale, which can be set to improve + numerical properties of polynomial. For example, if you interpolate on + [-1,+1], you can set C=0 and S=1 and convert from sum of 1, x, x^2, + x^3 and so on. In most cases you it is exactly what you need. + + However, if your interpolation model was built on [999,1001], you will + see significant growth of numerical errors when using {1, x, x^2, x^3} + as input basis. Converting from sum of 1, (x-1000), (x-1000)^2, + (x-1000)^3 will be better option (you have to specify 1000.0 as offset + C and 1.0 as scale S). + +2. power basis is ill-conditioned and tricks described above can't solve + this problem completely. This function will return barycentric model + in any case, but for N>8 accuracy well degrade. However, N's less than + 5 are pretty safe. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialpow2bar(/* Real */ ae_vector* a, + ae_int_t n, + double c, + double s, + barycentricinterpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t k; + ae_vector y; + double vx; + double vy; + double px; + + ae_frame_make(_state, &_frame_block); + _barycentricinterpolant_clear(p); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_isfinite(c, _state), "PolynomialPow2Bar: C is not finite!", _state); + ae_assert(ae_isfinite(s, _state), "PolynomialPow2Bar: S is not finite!", _state); + ae_assert(ae_fp_neq(s,0), "PolynomialPow2Bar: S is zero!", _state); + ae_assert(n>=1, "PolynomialPow2Bar: N<1", _state); + ae_assert(a->cnt>=n, "PolynomialPow2Bar: Length(A)ptr.p_double[0]; + px = vx; + for(k=1; k<=n-1; k++) + { + vy = vy+px*a->ptr.p_double[k]; + px = px*vx; + } + y.ptr.p_double[i] = vy; + } + + /* + * Build barycentric interpolant, map grid from [-1,+1] to [A,B] + */ + polynomialbuildcheb1(c-s, c+s, &y, n, p, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Lagrange intepolant: generation of the model on the general grid. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + X - abscissas, array[0..N-1] + Y - function values, array[0..N-1] + N - number of points, N>=1 + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuild(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + barycentricinterpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_int_t j; + ae_int_t k; + ae_vector w; + double b; + double a; + double v; + double mx; + ae_vector sortrbuf; + ae_vector sortrbuf2; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + _barycentricinterpolant_clear(p); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sortrbuf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sortrbuf2, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "PolynomialBuild: N<=0!", _state); + ae_assert(x->cnt>=n, "PolynomialBuild: Length(X)cnt>=n, "PolynomialBuild: Length(Y)ptr.p_double[0]; + b = x->ptr.p_double[0]; + for(j=0; j<=n-1; j++) + { + w.ptr.p_double[j] = 1; + a = ae_minreal(a, x->ptr.p_double[j], _state); + b = ae_maxreal(b, x->ptr.p_double[j], _state); + } + for(k=0; k<=n-1; k++) + { + + /* + * W[K] is used instead of 0.0 because + * cycle on J does not touch K-th element + * and we MUST get maximum from ALL elements + */ + mx = ae_fabs(w.ptr.p_double[k], _state); + for(j=0; j<=n-1; j++) + { + if( j!=k ) + { + v = (b-a)/(x->ptr.p_double[j]-x->ptr.p_double[k]); + w.ptr.p_double[j] = w.ptr.p_double[j]*v; + mx = ae_maxreal(mx, ae_fabs(w.ptr.p_double[j], _state), _state); + } + } + if( k%5==0 ) + { + + /* + * every 5-th run we renormalize W[] + */ + v = 1/mx; + ae_v_muld(&w.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + } + } + barycentricbuildxyw(x, y, &w, n, p, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Lagrange intepolant: generation of the model on equidistant grid. +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1] + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildeqdist(double a, + double b, + /* Real */ ae_vector* y, + ae_int_t n, + barycentricinterpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector w; + ae_vector x; + double v; + + ae_frame_make(_state, &_frame_block); + _barycentricinterpolant_clear(p); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "PolynomialBuildEqDist: N<=0!", _state); + ae_assert(y->cnt>=n, "PolynomialBuildEqDist: Length(Y)=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildcheb1(double a, + double b, + /* Real */ ae_vector* y, + ae_int_t n, + barycentricinterpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector w; + ae_vector x; + double v; + double t; + + ae_frame_make(_state, &_frame_block); + _barycentricinterpolant_clear(p); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "PolynomialBuildCheb1: N<=0!", _state); + ae_assert(y->cnt>=n, "PolynomialBuildCheb1: Length(Y)=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildcheb2(double a, + double b, + /* Real */ ae_vector* y, + ae_int_t n, + barycentricinterpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector w; + ae_vector x; + double v; + + ae_frame_make(_state, &_frame_block); + _barycentricinterpolant_clear(p); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "PolynomialBuildCheb2: N<=0!", _state); + ae_assert(y->cnt>=n, "PolynomialBuildCheb2: Length(Y)=1 + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolynomialBuildEqDist()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalceqdist(double a, + double b, + /* Real */ ae_vector* f, + ae_int_t n, + double t, + ae_state *_state) +{ + double s1; + double s2; + double v; + double threshold; + double s; + double h; + ae_int_t i; + ae_int_t j; + double w; + double x; + double result; + + + ae_assert(n>0, "PolynomialCalcEqDist: N<=0!", _state); + ae_assert(f->cnt>=n, "PolynomialCalcEqDist: Length(F)v_nan; + return result; + } + + /* + * Special case: N=1 + */ + if( n==1 ) + { + result = f->ptr.p_double[0]; + return result; + } + + /* + * First, decide: should we use "safe" formula (guarded + * against overflow) or fast one? + */ + threshold = ae_sqrt(ae_minrealnumber, _state); + j = 0; + s = t-a; + for(i=1; i<=n-1; i++) + { + x = a+(double)i/(double)(n-1)*(b-a); + if( ae_fp_less(ae_fabs(t-x, _state),ae_fabs(s, _state)) ) + { + s = t-x; + j = i; + } + } + if( ae_fp_eq(s,0) ) + { + result = f->ptr.p_double[j]; + return result; + } + if( ae_fp_greater(ae_fabs(s, _state),threshold) ) + { + + /* + * use fast formula + */ + j = -1; + s = 1.0; + } + + /* + * Calculate using safe or fast barycentric formula + */ + s1 = 0; + s2 = 0; + w = 1.0; + h = (b-a)/(n-1); + for(i=0; i<=n-1; i++) + { + if( i!=j ) + { + v = s*w/(t-(a+i*h)); + s1 = s1+v*f->ptr.p_double[i]; + s2 = s2+v; + } + else + { + v = w; + s1 = s1+v*f->ptr.p_double[i]; + s2 = s2+v; + } + w = -w*(n-1-i); + w = w/(i+1); + } + result = s1/s2; + return result; +} + + +/************************************************************************* +Fast polynomial interpolation function on Chebyshev points (first kind) +with O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on Chebyshev grid (first kind), + X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n)) + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolIntBuildCheb1()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalccheb1(double a, + double b, + /* Real */ ae_vector* f, + ae_int_t n, + double t, + ae_state *_state) +{ + double s1; + double s2; + double v; + double threshold; + double s; + ae_int_t i; + ae_int_t j; + double a0; + double delta; + double alpha; + double beta; + double ca; + double sa; + double tempc; + double temps; + double x; + double w; + double p1; + double result; + + + ae_assert(n>0, "PolynomialCalcCheb1: N<=0!", _state); + ae_assert(f->cnt>=n, "PolynomialCalcCheb1: Length(F)v_nan; + return result; + } + + /* + * Special case: N=1 + */ + if( n==1 ) + { + result = f->ptr.p_double[0]; + return result; + } + + /* + * Prepare information for the recurrence formula + * used to calculate sin(pi*(2j+1)/(2n+2)) and + * cos(pi*(2j+1)/(2n+2)): + * + * A0 = pi/(2n+2) + * Delta = pi/(n+1) + * Alpha = 2 sin^2 (Delta/2) + * Beta = sin(Delta) + * + * so that sin(..) = sin(A0+j*delta) and cos(..) = cos(A0+j*delta). + * Then we use + * + * sin(x+delta) = sin(x) - (alpha*sin(x) - beta*cos(x)) + * cos(x+delta) = cos(x) - (alpha*cos(x) - beta*sin(x)) + * + * to repeatedly calculate sin(..) and cos(..). + */ + threshold = ae_sqrt(ae_minrealnumber, _state); + t = (t-0.5*(a+b))/(0.5*(b-a)); + a0 = ae_pi/(2*(n-1)+2); + delta = 2*ae_pi/(2*(n-1)+2); + alpha = 2*ae_sqr(ae_sin(delta/2, _state), _state); + beta = ae_sin(delta, _state); + + /* + * First, decide: should we use "safe" formula (guarded + * against overflow) or fast one? + */ + ca = ae_cos(a0, _state); + sa = ae_sin(a0, _state); + j = 0; + x = ca; + s = t-x; + for(i=1; i<=n-1; i++) + { + + /* + * Next X[i] + */ + temps = sa-(alpha*sa-beta*ca); + tempc = ca-(alpha*ca+beta*sa); + sa = temps; + ca = tempc; + x = ca; + + /* + * Use X[i] + */ + if( ae_fp_less(ae_fabs(t-x, _state),ae_fabs(s, _state)) ) + { + s = t-x; + j = i; + } + } + if( ae_fp_eq(s,0) ) + { + result = f->ptr.p_double[j]; + return result; + } + if( ae_fp_greater(ae_fabs(s, _state),threshold) ) + { + + /* + * use fast formula + */ + j = -1; + s = 1.0; + } + + /* + * Calculate using safe or fast barycentric formula + */ + s1 = 0; + s2 = 0; + ca = ae_cos(a0, _state); + sa = ae_sin(a0, _state); + p1 = 1.0; + for(i=0; i<=n-1; i++) + { + + /* + * Calculate X[i], W[i] + */ + x = ca; + w = p1*sa; + + /* + * Proceed + */ + if( i!=j ) + { + v = s*w/(t-x); + s1 = s1+v*f->ptr.p_double[i]; + s2 = s2+v; + } + else + { + v = w; + s1 = s1+v*f->ptr.p_double[i]; + s2 = s2+v; + } + + /* + * Next CA, SA, P1 + */ + temps = sa-(alpha*sa-beta*ca); + tempc = ca-(alpha*ca+beta*sa); + sa = temps; + ca = tempc; + p1 = -p1; + } + result = s1/s2; + return result; +} + + +/************************************************************************* +Fast polynomial interpolation function on Chebyshev points (second kind) +with O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on Chebyshev grid (second kind), + X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1)) + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolIntBuildCheb2()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalccheb2(double a, + double b, + /* Real */ ae_vector* f, + ae_int_t n, + double t, + ae_state *_state) +{ + double s1; + double s2; + double v; + double threshold; + double s; + ae_int_t i; + ae_int_t j; + double a0; + double delta; + double alpha; + double beta; + double ca; + double sa; + double tempc; + double temps; + double x; + double w; + double p1; + double result; + + + ae_assert(n>0, "PolynomialCalcCheb2: N<=0!", _state); + ae_assert(f->cnt>=n, "PolynomialCalcCheb2: Length(F)v_nan; + return result; + } + + /* + * Special case: N=1 + */ + if( n==1 ) + { + result = f->ptr.p_double[0]; + return result; + } + + /* + * Prepare information for the recurrence formula + * used to calculate sin(pi*i/n) and + * cos(pi*i/n): + * + * A0 = 0 + * Delta = pi/n + * Alpha = 2 sin^2 (Delta/2) + * Beta = sin(Delta) + * + * so that sin(..) = sin(A0+j*delta) and cos(..) = cos(A0+j*delta). + * Then we use + * + * sin(x+delta) = sin(x) - (alpha*sin(x) - beta*cos(x)) + * cos(x+delta) = cos(x) - (alpha*cos(x) - beta*sin(x)) + * + * to repeatedly calculate sin(..) and cos(..). + */ + threshold = ae_sqrt(ae_minrealnumber, _state); + t = (t-0.5*(a+b))/(0.5*(b-a)); + a0 = 0.0; + delta = ae_pi/(n-1); + alpha = 2*ae_sqr(ae_sin(delta/2, _state), _state); + beta = ae_sin(delta, _state); + + /* + * First, decide: should we use "safe" formula (guarded + * against overflow) or fast one? + */ + ca = ae_cos(a0, _state); + sa = ae_sin(a0, _state); + j = 0; + x = ca; + s = t-x; + for(i=1; i<=n-1; i++) + { + + /* + * Next X[i] + */ + temps = sa-(alpha*sa-beta*ca); + tempc = ca-(alpha*ca+beta*sa); + sa = temps; + ca = tempc; + x = ca; + + /* + * Use X[i] + */ + if( ae_fp_less(ae_fabs(t-x, _state),ae_fabs(s, _state)) ) + { + s = t-x; + j = i; + } + } + if( ae_fp_eq(s,0) ) + { + result = f->ptr.p_double[j]; + return result; + } + if( ae_fp_greater(ae_fabs(s, _state),threshold) ) + { + + /* + * use fast formula + */ + j = -1; + s = 1.0; + } + + /* + * Calculate using safe or fast barycentric formula + */ + s1 = 0; + s2 = 0; + ca = ae_cos(a0, _state); + sa = ae_sin(a0, _state); + p1 = 1.0; + for(i=0; i<=n-1; i++) + { + + /* + * Calculate X[i], W[i] + */ + x = ca; + if( i==0||i==n-1 ) + { + w = 0.5*p1; + } + else + { + w = 1.0*p1; + } + + /* + * Proceed + */ + if( i!=j ) + { + v = s*w/(t-x); + s1 = s1+v*f->ptr.p_double[i]; + s2 = s2+v; + } + else + { + v = w; + s1 = s1+v*f->ptr.p_double[i]; + s2 = s2+v; + } + + /* + * Next CA, SA, P1 + */ + temps = sa-(alpha*sa-beta*ca); + tempc = ca-(alpha*ca+beta*sa); + sa = temps; + ca = tempc; + p1 = -p1; + } + result = s1/s2; + return result; +} + + + + +/************************************************************************* +This subroutine builds linear spline interpolant + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildlinear(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + spline1dinterpolant* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + _spline1dinterpolant_clear(c); + + ae_assert(n>1, "Spline1DBuildLinear: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DBuildLinear: Length(X)cnt>=n, "Spline1DBuildLinear: Length(Y)periodic = ae_false; + c->n = n; + c->k = 3; + c->continuity = 0; + ae_vector_set_length(&c->x, n, _state); + ae_vector_set_length(&c->c, 4*(n-1)+2, _state); + for(i=0; i<=n-1; i++) + { + c->x.ptr.p_double[i] = x->ptr.p_double[i]; + } + for(i=0; i<=n-2; i++) + { + c->c.ptr.p_double[4*i+0] = y->ptr.p_double[i]; + c->c.ptr.p_double[4*i+1] = (y->ptr.p_double[i+1]-y->ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i]); + c->c.ptr.p_double[4*i+2] = 0; + c->c.ptr.p_double[4*i+3] = 0; + } + c->c.ptr.p_double[4*(n-1)+0] = y->ptr.p_double[n-1]; + c->c.ptr.p_double[4*(n-1)+1] = c->c.ptr.p_double[4*(n-2)+1]; + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine builds cubic spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + C - spline interpolant + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + spline1dinterpolant* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector a1; + ae_vector a2; + ae_vector a3; + ae_vector b; + ae_vector dt; + ae_vector d; + ae_vector p; + ae_int_t ylen; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + _spline1dinterpolant_clear(c); + ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + + + /* + * check correctness of boundary conditions + */ + ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DBuildCubic: incorrect BoundLType!", _state); + ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DBuildCubic: incorrect BoundRType!", _state); + ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DBuildCubic: incorrect BoundLType/BoundRType!", _state); + if( boundltype==1||boundltype==2 ) + { + ae_assert(ae_isfinite(boundl, _state), "Spline1DBuildCubic: BoundL is infinite or NAN!", _state); + } + if( boundrtype==1||boundrtype==2 ) + { + ae_assert(ae_isfinite(boundr, _state), "Spline1DBuildCubic: BoundR is infinite or NAN!", _state); + } + + /* + * check lengths of arguments + */ + ae_assert(n>=2, "Spline1DBuildCubic: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DBuildCubic: Length(X)cnt>=n, "Spline1DBuildCubic: Length(Y)ptr.p_double[n-1] = y->ptr.p_double[0]; + } + spline1d_spline1dgriddiffcubicinternal(x, y, n, boundltype, boundl, boundrtype, boundr, &d, &a1, &a2, &a3, &b, &dt, _state); + spline1dbuildhermite(x, y, &d, n, c, _state); + c->periodic = boundltype==-1||boundrtype==-1; + c->continuity = 2; + ae_frame_leave(_state); +} + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at nodes x[], it calculates and returns table of function derivatives d[] +(calculated at the same nodes x[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - spline nodes + Y - function values + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + D - derivative values at X[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Derivative values are correctly reordered on return, so D[I] is always +equal to S'(X[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dgriddiffcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector a1; + ae_vector a2; + ae_vector a3; + ae_vector b; + ae_vector dt; + ae_vector p; + ae_int_t i; + ae_int_t ylen; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_clear(d); + ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + + + /* + * check correctness of boundary conditions + */ + ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DGridDiffCubic: incorrect BoundLType!", _state); + ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DGridDiffCubic: incorrect BoundRType!", _state); + ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DGridDiffCubic: incorrect BoundLType/BoundRType!", _state); + if( boundltype==1||boundltype==2 ) + { + ae_assert(ae_isfinite(boundl, _state), "Spline1DGridDiffCubic: BoundL is infinite or NAN!", _state); + } + if( boundrtype==1||boundrtype==2 ) + { + ae_assert(ae_isfinite(boundr, _state), "Spline1DGridDiffCubic: BoundR is infinite or NAN!", _state); + } + + /* + * check lengths of arguments + */ + ae_assert(n>=2, "Spline1DGridDiffCubic: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DGridDiffCubic: Length(X)cnt>=n, "Spline1DGridDiffCubic: Length(Y)ptr.p_double[i]; + } + ae_v_move(&d->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at nodes x[], it calculates and returns tables of first and second +function derivatives d1[] and d2[] (calculated at the same nodes x[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - spline nodes + Y - function values + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + D1 - S' values at X[] + D2 - S'' values at X[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Derivative values are correctly reordered on return, so D[I] is always +equal to S'(X[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dgriddiff2cubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* d1, + /* Real */ ae_vector* d2, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector a1; + ae_vector a2; + ae_vector a3; + ae_vector b; + ae_vector dt; + ae_vector p; + ae_int_t i; + ae_int_t ylen; + double delta; + double delta2; + double delta3; + double s2; + double s3; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_clear(d1); + ae_vector_clear(d2); + ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + + + /* + * check correctness of boundary conditions + */ + ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DGridDiff2Cubic: incorrect BoundLType!", _state); + ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DGridDiff2Cubic: incorrect BoundRType!", _state); + ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DGridDiff2Cubic: incorrect BoundLType/BoundRType!", _state); + if( boundltype==1||boundltype==2 ) + { + ae_assert(ae_isfinite(boundl, _state), "Spline1DGridDiff2Cubic: BoundL is infinite or NAN!", _state); + } + if( boundrtype==1||boundrtype==2 ) + { + ae_assert(ae_isfinite(boundr, _state), "Spline1DGridDiff2Cubic: BoundR is infinite or NAN!", _state); + } + + /* + * check lengths of arguments + */ + ae_assert(n>=2, "Spline1DGridDiff2Cubic: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DGridDiff2Cubic: Length(X)cnt>=n, "Spline1DGridDiff2Cubic: Length(Y)ptr.p_double[i+1]-x->ptr.p_double[i]; + delta2 = ae_sqr(delta, _state); + delta3 = delta*delta2; + s2 = (3*(y->ptr.p_double[i+1]-y->ptr.p_double[i])-2*d1->ptr.p_double[i]*delta-d1->ptr.p_double[i+1]*delta)/delta2; + s3 = (2*(y->ptr.p_double[i]-y->ptr.p_double[i+1])+d1->ptr.p_double[i]*delta+d1->ptr.p_double[i+1]*delta)/delta3; + d2->ptr.p_double[i] = 2*s2; + } + d2->ptr.p_double[n-1] = 2*s2+6*s3*delta; + + /* + * Remember that HeapSortPPoints() call? + * Now we have to reorder them back. + */ + if( dt.cntptr.p_double[i]; + } + ae_v_move(&d1->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + dt.ptr.p_double[p.ptr.p_int[i]] = d2->ptr.p_double[i]; + } + ae_v_move(&d2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[] (calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* x2, + ae_int_t n2, + /* Real */ ae_vector* y2, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector _x2; + ae_vector a1; + ae_vector a2; + ae_vector a3; + ae_vector b; + ae_vector d; + ae_vector dt; + ae_vector d1; + ae_vector d2; + ae_vector p; + ae_vector p2; + ae_int_t i; + ae_int_t ylen; + double t; + double t2; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_init_copy(&_x2, x2, _state, ae_true); + x2 = &_x2; + ae_vector_clear(y2); + ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + + + /* + * check correctness of boundary conditions + */ + ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DConvCubic: incorrect BoundLType!", _state); + ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DConvCubic: incorrect BoundRType!", _state); + ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DConvCubic: incorrect BoundLType/BoundRType!", _state); + if( boundltype==1||boundltype==2 ) + { + ae_assert(ae_isfinite(boundl, _state), "Spline1DConvCubic: BoundL is infinite or NAN!", _state); + } + if( boundrtype==1||boundrtype==2 ) + { + ae_assert(ae_isfinite(boundr, _state), "Spline1DConvCubic: BoundR is infinite or NAN!", _state); + } + + /* + * check lengths of arguments + */ + ae_assert(n>=2, "Spline1DConvCubic: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DConvCubic: Length(X)cnt>=n, "Spline1DConvCubic: Length(Y)=2, "Spline1DConvCubic: N2<2!", _state); + ae_assert(x2->cnt>=n2, "Spline1DConvCubic: Length(X2)ptr.p_double[i]; + apperiodicmap(&t, x->ptr.p_double[0], x->ptr.p_double[n-1], &t2, _state); + x2->ptr.p_double[i] = t; + } + } + spline1d_heapsortppoints(x2, &dt, &p2, n2, _state); + + /* + * Now we've checked and preordered everything, so we: + * * call internal GridDiff() function to get Hermite form of spline + * * convert using internal Conv() function + * * convert Y2 back to original order + */ + spline1d_spline1dgriddiffcubicinternal(x, y, n, boundltype, boundl, boundrtype, boundr, &d, &a1, &a2, &a3, &b, &dt, _state); + spline1dconvdiffinternal(x, y, &d, n, x2, n2, y2, ae_true, &d1, ae_false, &d2, ae_false, _state); + ae_assert(dt.cnt>=n2, "Spline1DConvCubic: internal error!", _state); + for(i=0; i<=n2-1; i++) + { + dt.ptr.p_double[p2.ptr.p_int[i]] = y2->ptr.p_double[i]; + } + ae_v_move(&y2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[] and derivatives d2[] (calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + D2 - first derivatives at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiffcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* x2, + ae_int_t n2, + /* Real */ ae_vector* y2, + /* Real */ ae_vector* d2, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector _x2; + ae_vector a1; + ae_vector a2; + ae_vector a3; + ae_vector b; + ae_vector d; + ae_vector dt; + ae_vector rt1; + ae_vector p; + ae_vector p2; + ae_int_t i; + ae_int_t ylen; + double t; + double t2; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_init_copy(&_x2, x2, _state, ae_true); + x2 = &_x2; + ae_vector_clear(y2); + ae_vector_clear(d2); + ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); + ae_vector_init(&rt1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + + + /* + * check correctness of boundary conditions + */ + ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DConvDiffCubic: incorrect BoundLType!", _state); + ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DConvDiffCubic: incorrect BoundRType!", _state); + ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DConvDiffCubic: incorrect BoundLType/BoundRType!", _state); + if( boundltype==1||boundltype==2 ) + { + ae_assert(ae_isfinite(boundl, _state), "Spline1DConvDiffCubic: BoundL is infinite or NAN!", _state); + } + if( boundrtype==1||boundrtype==2 ) + { + ae_assert(ae_isfinite(boundr, _state), "Spline1DConvDiffCubic: BoundR is infinite or NAN!", _state); + } + + /* + * check lengths of arguments + */ + ae_assert(n>=2, "Spline1DConvDiffCubic: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DConvDiffCubic: Length(X)cnt>=n, "Spline1DConvDiffCubic: Length(Y)=2, "Spline1DConvDiffCubic: N2<2!", _state); + ae_assert(x2->cnt>=n2, "Spline1DConvDiffCubic: Length(X2)ptr.p_double[i]; + apperiodicmap(&t, x->ptr.p_double[0], x->ptr.p_double[n-1], &t2, _state); + x2->ptr.p_double[i] = t; + } + } + spline1d_heapsortppoints(x2, &dt, &p2, n2, _state); + + /* + * Now we've checked and preordered everything, so we: + * * call internal GridDiff() function to get Hermite form of spline + * * convert using internal Conv() function + * * convert Y2 back to original order + */ + spline1d_spline1dgriddiffcubicinternal(x, y, n, boundltype, boundl, boundrtype, boundr, &d, &a1, &a2, &a3, &b, &dt, _state); + spline1dconvdiffinternal(x, y, &d, n, x2, n2, y2, ae_true, d2, ae_true, &rt1, ae_false, _state); + ae_assert(dt.cnt>=n2, "Spline1DConvDiffCubic: internal error!", _state); + for(i=0; i<=n2-1; i++) + { + dt.ptr.p_double[p2.ptr.p_int[i]] = y2->ptr.p_double[i]; + } + ae_v_move(&y2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); + for(i=0; i<=n2-1; i++) + { + dt.ptr.p_double[p2.ptr.p_int[i]] = d2->ptr.p_double[i]; + } + ae_v_move(&d2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[], first and second derivatives d2[] and dd2[] +(calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + D2 - first derivatives at X2[] + DD2 - second derivatives at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiff2cubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* x2, + ae_int_t n2, + /* Real */ ae_vector* y2, + /* Real */ ae_vector* d2, + /* Real */ ae_vector* dd2, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector _x2; + ae_vector a1; + ae_vector a2; + ae_vector a3; + ae_vector b; + ae_vector d; + ae_vector dt; + ae_vector p; + ae_vector p2; + ae_int_t i; + ae_int_t ylen; + double t; + double t2; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_init_copy(&_x2, x2, _state, ae_true); + x2 = &_x2; + ae_vector_clear(y2); + ae_vector_clear(d2); + ae_vector_clear(dd2); + ae_vector_init(&a1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&a3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dt, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + + + /* + * check correctness of boundary conditions + */ + ae_assert(((boundltype==-1||boundltype==0)||boundltype==1)||boundltype==2, "Spline1DConvDiff2Cubic: incorrect BoundLType!", _state); + ae_assert(((boundrtype==-1||boundrtype==0)||boundrtype==1)||boundrtype==2, "Spline1DConvDiff2Cubic: incorrect BoundRType!", _state); + ae_assert((boundrtype==-1&&boundltype==-1)||(boundrtype!=-1&&boundltype!=-1), "Spline1DConvDiff2Cubic: incorrect BoundLType/BoundRType!", _state); + if( boundltype==1||boundltype==2 ) + { + ae_assert(ae_isfinite(boundl, _state), "Spline1DConvDiff2Cubic: BoundL is infinite or NAN!", _state); + } + if( boundrtype==1||boundrtype==2 ) + { + ae_assert(ae_isfinite(boundr, _state), "Spline1DConvDiff2Cubic: BoundR is infinite or NAN!", _state); + } + + /* + * check lengths of arguments + */ + ae_assert(n>=2, "Spline1DConvDiff2Cubic: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DConvDiff2Cubic: Length(X)cnt>=n, "Spline1DConvDiff2Cubic: Length(Y)=2, "Spline1DConvDiff2Cubic: N2<2!", _state); + ae_assert(x2->cnt>=n2, "Spline1DConvDiff2Cubic: Length(X2)ptr.p_double[i]; + apperiodicmap(&t, x->ptr.p_double[0], x->ptr.p_double[n-1], &t2, _state); + x2->ptr.p_double[i] = t; + } + } + spline1d_heapsortppoints(x2, &dt, &p2, n2, _state); + + /* + * Now we've checked and preordered everything, so we: + * * call internal GridDiff() function to get Hermite form of spline + * * convert using internal Conv() function + * * convert Y2 back to original order + */ + spline1d_spline1dgriddiffcubicinternal(x, y, n, boundltype, boundl, boundrtype, boundr, &d, &a1, &a2, &a3, &b, &dt, _state); + spline1dconvdiffinternal(x, y, &d, n, x2, n2, y2, ae_true, d2, ae_true, dd2, ae_true, _state); + ae_assert(dt.cnt>=n2, "Spline1DConvDiff2Cubic: internal error!", _state); + for(i=0; i<=n2-1; i++) + { + dt.ptr.p_double[p2.ptr.p_int[i]] = y2->ptr.p_double[i]; + } + ae_v_move(&y2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); + for(i=0; i<=n2-1; i++) + { + dt.ptr.p_double[p2.ptr.p_int[i]] = d2->ptr.p_double[i]; + } + ae_v_move(&d2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); + for(i=0; i<=n2-1; i++) + { + dt.ptr.p_double[p2.ptr.p_int[i]] = dd2->ptr.p_double[i]; + } + ae_v_move(&dd2->ptr.p_double[0], 1, &dt.ptr.p_double[0], 1, ae_v_len(0,n2-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine builds Catmull-Rom spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundType - boundary condition type: + * -1 for periodic boundary condition + * 0 for parabolically terminated spline (default) + Tension - tension parameter: + * tension=0 corresponds to classic Catmull-Rom spline (default) + * 0=2, "Spline1DBuildCatmullRom: N<2!", _state); + ae_assert(boundtype==-1||boundtype==0, "Spline1DBuildCatmullRom: incorrect BoundType!", _state); + ae_assert(ae_fp_greater_eq(tension,0), "Spline1DBuildCatmullRom: Tension<0!", _state); + ae_assert(ae_fp_less_eq(tension,1), "Spline1DBuildCatmullRom: Tension>1!", _state); + ae_assert(x->cnt>=n, "Spline1DBuildCatmullRom: Length(X)cnt>=n, "Spline1DBuildCatmullRom: Length(Y)ptr.p_double[n-1] = y->ptr.p_double[0]; + ae_vector_set_length(&d, n, _state); + d.ptr.p_double[0] = (y->ptr.p_double[1]-y->ptr.p_double[n-2])/(2*(x->ptr.p_double[1]-x->ptr.p_double[0]+x->ptr.p_double[n-1]-x->ptr.p_double[n-2])); + for(i=1; i<=n-2; i++) + { + d.ptr.p_double[i] = (1-tension)*(y->ptr.p_double[i+1]-y->ptr.p_double[i-1])/(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); + } + d.ptr.p_double[n-1] = d.ptr.p_double[0]; + + /* + * Now problem is reduced to the cubic Hermite spline + */ + spline1dbuildhermite(x, y, &d, n, c, _state); + c->periodic = ae_true; + } + else + { + + /* + * Non-periodic boundary conditions + */ + ae_vector_set_length(&d, n, _state); + for(i=1; i<=n-2; i++) + { + d.ptr.p_double[i] = (1-tension)*(y->ptr.p_double[i+1]-y->ptr.p_double[i-1])/(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); + } + d.ptr.p_double[0] = 2*(y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0])-d.ptr.p_double[1]; + d.ptr.p_double[n-1] = 2*(y->ptr.p_double[n-1]-y->ptr.p_double[n-2])/(x->ptr.p_double[n-1]-x->ptr.p_double[n-2])-d.ptr.p_double[n-2]; + + /* + * Now problem is reduced to the cubic Hermite spline + */ + spline1dbuildhermite(x, y, &d, n, c, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine builds Hermite spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + D - derivatives, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant. + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildhermite(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* d, + ae_int_t n, + spline1dinterpolant* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector _d; + ae_int_t i; + double delta; + double delta2; + double delta3; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_init_copy(&_d, d, _state, ae_true); + d = &_d; + _spline1dinterpolant_clear(c); + + ae_assert(n>=2, "Spline1DBuildHermite: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DBuildHermite: Length(X)cnt>=n, "Spline1DBuildHermite: Length(Y)cnt>=n, "Spline1DBuildHermite: Length(D)x, n, _state); + ae_vector_set_length(&c->c, 4*(n-1)+2, _state); + c->periodic = ae_false; + c->k = 3; + c->n = n; + c->continuity = 1; + for(i=0; i<=n-1; i++) + { + c->x.ptr.p_double[i] = x->ptr.p_double[i]; + } + for(i=0; i<=n-2; i++) + { + delta = x->ptr.p_double[i+1]-x->ptr.p_double[i]; + delta2 = ae_sqr(delta, _state); + delta3 = delta*delta2; + c->c.ptr.p_double[4*i+0] = y->ptr.p_double[i]; + c->c.ptr.p_double[4*i+1] = d->ptr.p_double[i]; + c->c.ptr.p_double[4*i+2] = (3*(y->ptr.p_double[i+1]-y->ptr.p_double[i])-2*d->ptr.p_double[i]*delta-d->ptr.p_double[i+1]*delta)/delta2; + c->c.ptr.p_double[4*i+3] = (2*(y->ptr.p_double[i]-y->ptr.p_double[i+1])+d->ptr.p_double[i]*delta+d->ptr.p_double[i+1]*delta)/delta3; + } + c->c.ptr.p_double[4*(n-1)+0] = y->ptr.p_double[n-1]; + c->c.ptr.p_double[4*(n-1)+1] = d->ptr.p_double[n-1]; + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine builds Akima spline interpolant + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildakima(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + spline1dinterpolant* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_int_t i; + ae_vector d; + ae_vector w; + ae_vector diff; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + _spline1dinterpolant_clear(c); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&diff, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=2, "Spline1DBuildAkima: N<2!", _state); + ae_assert(x->cnt>=n, "Spline1DBuildAkima: Length(X)cnt>=n, "Spline1DBuildAkima: Length(Y)ptr.p_double[i+1]-y->ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i]); + } + for(i=1; i<=n-2; i++) + { + w.ptr.p_double[i] = ae_fabs(diff.ptr.p_double[i]-diff.ptr.p_double[i-1], _state); + } + + /* + * Prepare Hermite interpolation scheme + */ + ae_vector_set_length(&d, n, _state); + for(i=2; i<=n-3; i++) + { + if( ae_fp_neq(ae_fabs(w.ptr.p_double[i-1], _state)+ae_fabs(w.ptr.p_double[i+1], _state),0) ) + { + d.ptr.p_double[i] = (w.ptr.p_double[i+1]*diff.ptr.p_double[i-1]+w.ptr.p_double[i-1]*diff.ptr.p_double[i])/(w.ptr.p_double[i+1]+w.ptr.p_double[i-1]); + } + else + { + d.ptr.p_double[i] = ((x->ptr.p_double[i+1]-x->ptr.p_double[i])*diff.ptr.p_double[i-1]+(x->ptr.p_double[i]-x->ptr.p_double[i-1])*diff.ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); + } + } + d.ptr.p_double[0] = spline1d_diffthreepoint(x->ptr.p_double[0], x->ptr.p_double[0], y->ptr.p_double[0], x->ptr.p_double[1], y->ptr.p_double[1], x->ptr.p_double[2], y->ptr.p_double[2], _state); + d.ptr.p_double[1] = spline1d_diffthreepoint(x->ptr.p_double[1], x->ptr.p_double[0], y->ptr.p_double[0], x->ptr.p_double[1], y->ptr.p_double[1], x->ptr.p_double[2], y->ptr.p_double[2], _state); + d.ptr.p_double[n-2] = spline1d_diffthreepoint(x->ptr.p_double[n-2], x->ptr.p_double[n-3], y->ptr.p_double[n-3], x->ptr.p_double[n-2], y->ptr.p_double[n-2], x->ptr.p_double[n-1], y->ptr.p_double[n-1], _state); + d.ptr.p_double[n-1] = spline1d_diffthreepoint(x->ptr.p_double[n-1], x->ptr.p_double[n-3], y->ptr.p_double[n-3], x->ptr.p_double[n-2], y->ptr.p_double[n-2], x->ptr.p_double[n-1], y->ptr.p_double[n-1], _state); + + /* + * Build Akima spline using Hermite interpolation scheme + */ + spline1dbuildhermite(x, y, &d, n, c, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine calculates the value of the spline at the given point X. + +INPUT PARAMETERS: + C - spline interpolant + X - point + +Result: + S(x) + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +double spline1dcalc(spline1dinterpolant* c, double x, ae_state *_state) +{ + ae_int_t l; + ae_int_t r; + ae_int_t m; + double t; + double result; + + + ae_assert(c->k==3, "Spline1DCalc: internal error", _state); + ae_assert(!ae_isinf(x, _state), "Spline1DCalc: infinite X!", _state); + + /* + * special case: NaN + */ + if( ae_isnan(x, _state) ) + { + result = _state->v_nan; + return result; + } + + /* + * correct if periodic + */ + if( c->periodic ) + { + apperiodicmap(&x, c->x.ptr.p_double[0], c->x.ptr.p_double[c->n-1], &t, _state); + } + + /* + * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) + */ + l = 0; + r = c->n-2+1; + while(l!=r-1) + { + m = (l+r)/2; + if( c->x.ptr.p_double[m]>=x ) + { + r = m; + } + else + { + l = m; + } + } + + /* + * Interpolation + */ + x = x-c->x.ptr.p_double[l]; + m = 4*l; + result = c->c.ptr.p_double[m]+x*(c->c.ptr.p_double[m+1]+x*(c->c.ptr.p_double[m+2]+x*c->c.ptr.p_double[m+3])); + return result; +} + + +/************************************************************************* +This subroutine differentiates the spline. + +INPUT PARAMETERS: + C - spline interpolant. + X - point + +Result: + S - S(x) + DS - S'(x) + D2S - S''(x) + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1ddiff(spline1dinterpolant* c, + double x, + double* s, + double* ds, + double* d2s, + ae_state *_state) +{ + ae_int_t l; + ae_int_t r; + ae_int_t m; + double t; + + *s = 0; + *ds = 0; + *d2s = 0; + + ae_assert(c->k==3, "Spline1DDiff: internal error", _state); + ae_assert(!ae_isinf(x, _state), "Spline1DDiff: infinite X!", _state); + + /* + * special case: NaN + */ + if( ae_isnan(x, _state) ) + { + *s = _state->v_nan; + *ds = _state->v_nan; + *d2s = _state->v_nan; + return; + } + + /* + * correct if periodic + */ + if( c->periodic ) + { + apperiodicmap(&x, c->x.ptr.p_double[0], c->x.ptr.p_double[c->n-1], &t, _state); + } + + /* + * Binary search + */ + l = 0; + r = c->n-2+1; + while(l!=r-1) + { + m = (l+r)/2; + if( c->x.ptr.p_double[m]>=x ) + { + r = m; + } + else + { + l = m; + } + } + + /* + * Differentiation + */ + x = x-c->x.ptr.p_double[l]; + m = 4*l; + *s = c->c.ptr.p_double[m]+x*(c->c.ptr.p_double[m+1]+x*(c->c.ptr.p_double[m+2]+x*c->c.ptr.p_double[m+3])); + *ds = c->c.ptr.p_double[m+1]+2*x*c->c.ptr.p_double[m+2]+3*ae_sqr(x, _state)*c->c.ptr.p_double[m+3]; + *d2s = 2*c->c.ptr.p_double[m+2]+6*x*c->c.ptr.p_double[m+3]; +} + + +/************************************************************************* +This subroutine makes the copy of the spline. + +INPUT PARAMETERS: + C - spline interpolant. + +Result: + CC - spline copy + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dcopy(spline1dinterpolant* c, + spline1dinterpolant* cc, + ae_state *_state) +{ + ae_int_t s; + + _spline1dinterpolant_clear(cc); + + cc->periodic = c->periodic; + cc->n = c->n; + cc->k = c->k; + cc->continuity = c->continuity; + ae_vector_set_length(&cc->x, cc->n, _state); + ae_v_move(&cc->x.ptr.p_double[0], 1, &c->x.ptr.p_double[0], 1, ae_v_len(0,cc->n-1)); + s = c->c.cnt; + ae_vector_set_length(&cc->c, s, _state); + ae_v_move(&cc->c.ptr.p_double[0], 1, &c->c.ptr.p_double[0], 1, ae_v_len(0,s-1)); +} + + +/************************************************************************* +This subroutine unpacks the spline into the coefficients table. + +INPUT PARAMETERS: + C - spline interpolant. + X - point + +OUTPUT PARAMETERS: + Tbl - coefficients table, unpacked format, array[0..N-2, 0..5]. + For I = 0...N-2: + Tbl[I,0] = X[i] + Tbl[I,1] = X[i+1] + Tbl[I,2] = C0 + Tbl[I,3] = C1 + Tbl[I,4] = C2 + Tbl[I,5] = C3 + On [x[i], x[i+1]] spline is equals to: + S(x) = C0 + C1*t + C2*t^2 + C3*t^3 + t = x-x[i] + +NOTE: + You can rebuild spline with Spline1DBuildHermite() function, which + accepts as inputs function values and derivatives at nodes, which are + easy to calculate when you have coefficients. + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dunpack(spline1dinterpolant* c, + ae_int_t* n, + /* Real */ ae_matrix* tbl, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + *n = 0; + ae_matrix_clear(tbl); + + ae_matrix_set_length(tbl, c->n-2+1, 2+c->k+1, _state); + *n = c->n; + + /* + * Fill + */ + for(i=0; i<=*n-2; i++) + { + tbl->ptr.pp_double[i][0] = c->x.ptr.p_double[i]; + tbl->ptr.pp_double[i][1] = c->x.ptr.p_double[i+1]; + for(j=0; j<=c->k; j++) + { + tbl->ptr.pp_double[i][2+j] = c->c.ptr.p_double[(c->k+1)*i+j]; + } + } +} + + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: x = A*t + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dlintransx(spline1dinterpolant* c, + double a, + double b, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t n; + double v; + double dv; + double d2v; + ae_vector x; + ae_vector y; + ae_vector d; + ae_bool isperiodic; + ae_int_t contval; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + + ae_assert(c->k==3, "Spline1DLinTransX: internal error", _state); + n = c->n; + ae_vector_set_length(&x, n, _state); + ae_vector_set_length(&y, n, _state); + ae_vector_set_length(&d, n, _state); + + /* + * Unpack, X, Y, dY/dX. + * Scale and pack with Spline1DBuildHermite again. + */ + if( ae_fp_eq(a,0) ) + { + + /* + * Special case: A=0 + */ + v = spline1dcalc(c, b, _state); + for(i=0; i<=n-1; i++) + { + x.ptr.p_double[i] = c->x.ptr.p_double[i]; + y.ptr.p_double[i] = v; + d.ptr.p_double[i] = 0.0; + } + } + else + { + + /* + * General case, A<>0 + */ + for(i=0; i<=n-1; i++) + { + x.ptr.p_double[i] = c->x.ptr.p_double[i]; + spline1ddiff(c, x.ptr.p_double[i], &v, &dv, &d2v, _state); + x.ptr.p_double[i] = (x.ptr.p_double[i]-b)/a; + y.ptr.p_double[i] = v; + d.ptr.p_double[i] = a*dv; + } + } + isperiodic = c->periodic; + contval = c->continuity; + if( contval>0 ) + { + spline1dbuildhermite(&x, &y, &d, n, c, _state); + } + else + { + spline1dbuildlinear(&x, &y, n, c, _state); + } + c->periodic = isperiodic; + c->continuity = contval; + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: S2(x) = A*S(x) + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dlintransy(spline1dinterpolant* c, + double a, + double b, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n; + + + ae_assert(c->k==3, "Spline1DLinTransX: internal error", _state); + n = c->n; + for(i=0; i<=n-2; i++) + { + c->c.ptr.p_double[4*i] = a*c->c.ptr.p_double[4*i]+b; + for(j=1; j<=3; j++) + { + c->c.ptr.p_double[4*i+j] = a*c->c.ptr.p_double[4*i+j]; + } + } + c->c.ptr.p_double[4*(n-1)+0] = a*c->c.ptr.p_double[4*(n-1)+0]+b; + c->c.ptr.p_double[4*(n-1)+1] = a*c->c.ptr.p_double[4*(n-1)+1]; +} + + +/************************************************************************* +This subroutine integrates the spline. + +INPUT PARAMETERS: + C - spline interpolant. + X - right bound of the integration interval [a, x], + here 'a' denotes min(x[]) +Result: + integral(S(t)dt,a,x) + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +double spline1dintegrate(spline1dinterpolant* c, + double x, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + ae_int_t l; + ae_int_t r; + ae_int_t m; + double w; + double v; + double t; + double intab; + double additionalterm; + double result; + + + n = c->n; + + /* + * Periodic splines require special treatment. We make + * following transformation: + * + * integral(S(t)dt,A,X) = integral(S(t)dt,A,Z)+AdditionalTerm + * + * here X may lie outside of [A,B], Z lies strictly in [A,B], + * AdditionalTerm is equals to integral(S(t)dt,A,B) times some + * integer number (may be zero). + */ + if( c->periodic&&(ae_fp_less(x,c->x.ptr.p_double[0])||ae_fp_greater(x,c->x.ptr.p_double[c->n-1])) ) + { + + /* + * compute integral(S(x)dx,A,B) + */ + intab = 0; + for(i=0; i<=c->n-2; i++) + { + w = c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i]; + m = (c->k+1)*i; + intab = intab+c->c.ptr.p_double[m]*w; + v = w; + for(j=1; j<=c->k; j++) + { + v = v*w; + intab = intab+c->c.ptr.p_double[m+j]*v/(j+1); + } + } + + /* + * map X into [A,B] + */ + apperiodicmap(&x, c->x.ptr.p_double[0], c->x.ptr.p_double[c->n-1], &t, _state); + additionalterm = t*intab; + } + else + { + additionalterm = 0; + } + + /* + * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) + */ + l = 0; + r = n-2+1; + while(l!=r-1) + { + m = (l+r)/2; + if( ae_fp_greater_eq(c->x.ptr.p_double[m],x) ) + { + r = m; + } + else + { + l = m; + } + } + + /* + * Integration + */ + result = 0; + for(i=0; i<=l-1; i++) + { + w = c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i]; + m = (c->k+1)*i; + result = result+c->c.ptr.p_double[m]*w; + v = w; + for(j=1; j<=c->k; j++) + { + v = v*w; + result = result+c->c.ptr.p_double[m+j]*v/(j+1); + } + } + w = x-c->x.ptr.p_double[l]; + m = (c->k+1)*l; + v = w; + result = result+c->c.ptr.p_double[m]*w; + for(j=1; j<=c->k; j++) + { + v = v*w; + result = result+c->c.ptr.p_double[m+j]*v/(j+1); + } + result = result+additionalterm; + return result; +} + + +/************************************************************************* +Internal version of Spline1DConvDiff + +Converts from Hermite spline given by grid XOld to new grid X2 + +INPUT PARAMETERS: + XOld - old grid + YOld - values at old grid + DOld - first derivative at old grid + N - grid size + X2 - new grid + N2 - new grid size + Y - possibly preallocated output array + (reallocate if too small) + NeedY - do we need Y? + D1 - possibly preallocated output array + (reallocate if too small) + NeedD1 - do we need D1? + D2 - possibly preallocated output array + (reallocate if too small) + NeedD2 - do we need D1? + +OUTPUT ARRAYS: + Y - values, if needed + D1 - first derivative, if needed + D2 - second derivative, if needed + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiffinternal(/* Real */ ae_vector* xold, + /* Real */ ae_vector* yold, + /* Real */ ae_vector* dold, + ae_int_t n, + /* Real */ ae_vector* x2, + ae_int_t n2, + /* Real */ ae_vector* y, + ae_bool needy, + /* Real */ ae_vector* d1, + ae_bool needd1, + /* Real */ ae_vector* d2, + ae_bool needd2, + ae_state *_state) +{ + ae_int_t intervalindex; + ae_int_t pointindex; + ae_bool havetoadvance; + double c0; + double c1; + double c2; + double c3; + double a; + double b; + double w; + double w2; + double w3; + double fa; + double fb; + double da; + double db; + double t; + + + + /* + * Prepare space + */ + if( needy&&y->cntcntcnt=n2 ) + { + break; + } + t = x2->ptr.p_double[pointindex]; + + /* + * do we need to advance interval? + */ + havetoadvance = ae_false; + if( intervalindex==-1 ) + { + havetoadvance = ae_true; + } + else + { + if( intervalindexptr.p_double[intervalindex]; + b = xold->ptr.p_double[intervalindex+1]; + w = b-a; + w2 = w*w; + w3 = w*w2; + fa = yold->ptr.p_double[intervalindex]; + fb = yold->ptr.p_double[intervalindex+1]; + da = dold->ptr.p_double[intervalindex]; + db = dold->ptr.p_double[intervalindex+1]; + c0 = fa; + c1 = da; + c2 = (3*(fb-fa)-2*da*w-db*w)/w2; + c3 = (2*(fa-fb)+da*w+db*w)/w3; + continue; + } + + /* + * Calculate spline and its derivatives using power basis + */ + t = t-a; + if( needy ) + { + y->ptr.p_double[pointindex] = c0+t*(c1+t*(c2+t*c3)); + } + if( needd1 ) + { + d1->ptr.p_double[pointindex] = c1+2*t*c2+3*t*t*c3; + } + if( needd2 ) + { + d2->ptr.p_double[pointindex] = 2*c2+6*t*c3; + } + pointindex = pointindex+1; + } +} + + +/************************************************************************* +This function finds all roots and extrema of the spline S(x) defined at +[A,B] (interval which contains spline nodes). + +It does not extrapolates function, so roots and extrema located outside +of [A,B] will not be found. It returns all isolated (including multiple) +roots and extrema. + +INPUT PARAMETERS + C - spline interpolant + +OUTPUT PARAMETERS + R - array[NR], contains roots of the spline. + In case there is no roots, this array has zero length. + NR - number of roots, >=0 + DR - is set to True in case there is at least one interval + where spline is just a zero constant. Such degenerate + cases are not reported in the R/NR + E - array[NE], contains extrema (maximums/minimums) of + the spline. In case there is no extrema, this array + has zero length. + ET - array[NE], extrema types: + * ET[i]>0 in case I-th extrema is a minimum + * ET[i]<0 in case I-th extrema is a maximum + NE - number of extrema, >=0 + DE - is set to True in case there is at least one interval + where spline is a constant. Such degenerate cases are + not reported in the E/NE. + +NOTES: + +1. This function does NOT report following kinds of roots: + * intervals where function is constantly zero + * roots which are outside of [A,B] (note: it CAN return A or B) + +2. This function does NOT report following kinds of extrema: + * intervals where function is a constant + * extrema which are outside of (A,B) (note: it WON'T return A or B) + + -- ALGLIB PROJECT -- + Copyright 26.09.2011 by Bochkanov Sergey +*************************************************************************/ +void spline1drootsandextrema(spline1dinterpolant* c, + /* Real */ ae_vector* r, + ae_int_t* nr, + ae_bool* dr, + /* Real */ ae_vector* e, + /* Integer */ ae_vector* et, + ae_int_t* ne, + ae_bool* de, + ae_state *_state) +{ + ae_frame _frame_block; + double pl; + double ml; + double pll; + double pr; + double mr; + ae_vector tr; + ae_vector tmpr; + ae_vector tmpe; + ae_vector tmpet; + ae_vector tmpc; + double x0; + double x1; + double x2; + double ex0; + double ex1; + ae_int_t tne; + ae_int_t tnr; + ae_int_t i; + ae_int_t j; + ae_bool nstep; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(r); + *nr = 0; + *dr = ae_false; + ae_vector_clear(e); + ae_vector_clear(et); + *ne = 0; + *de = ae_false; + ae_vector_init(&tr, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpr, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpe, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpet, 0, DT_INT, _state, ae_true); + ae_vector_init(&tmpc, 0, DT_REAL, _state, ae_true); + + + /* + *exception handling + */ + ae_assert(c->k==3, "Spline1DRootsAndExtrema : incorrect parameter C.K!", _state); + ae_assert(c->continuity>=0, "Spline1DRootsAndExtrema : parameter C.Continuity must not be less than 0!", _state); + + /* + *initialization of variable + */ + *nr = 0; + *ne = 0; + *dr = ae_false; + *de = ae_false; + nstep = ae_true; + + /* + *consider case, when C.Continuty=0 + */ + if( c->continuity==0 ) + { + + /* + *allocation for auxiliary arrays + *'TmpR ' - it stores a time value for roots + *'TmpE ' - it stores a time value for extremums + *'TmpET '- it stores a time value for extremums type + */ + rvectorsetlengthatleast(&tmpr, 3*(c->n-1), _state); + rvectorsetlengthatleast(&tmpe, 2*(c->n-1), _state); + ivectorsetlengthatleast(&tmpet, 2*(c->n-1), _state); + + /* + *start calculating + */ + for(i=0; i<=c->n-2; i++) + { + + /* + *initialization pL, mL, pR, mR + */ + pl = c->c.ptr.p_double[4*i]; + ml = c->c.ptr.p_double[4*i+1]; + pr = c->c.ptr.p_double[4*(i+1)]; + mr = c->c.ptr.p_double[4*i+1]+2*c->c.ptr.p_double[4*i+2]*(c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i])+3*c->c.ptr.p_double[4*i+3]*(c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i])*(c->x.ptr.p_double[i+1]-c->x.ptr.p_double[i]); + + /* + *pre-searching roots and extremums + */ + solvecubicpolinom(pl, ml, pr, mr, c->x.ptr.p_double[i], c->x.ptr.p_double[i+1], &x0, &x1, &x2, &ex0, &ex1, &tnr, &tne, &tr, _state); + *dr = *dr||tnr==-1; + *de = *de||tne==-1; + + /* + *searching of roots + */ + if( tnr==1&&nstep ) + { + + /* + *is there roots? + */ + if( *nr>0 ) + { + + /* + *is a next root equal a previous root? + *if is't, then write new root + */ + if( ae_fp_neq(x0,tmpr.ptr.p_double[*nr-1]) ) + { + tmpr.ptr.p_double[*nr] = x0; + *nr = *nr+1; + } + } + else + { + + /* + *write a first root + */ + tmpr.ptr.p_double[*nr] = x0; + *nr = *nr+1; + } + } + else + { + + /* + *case when function at a segment identically to zero + *then we have to clear a root, if the one located on a + *constant segment + */ + if( tnr==-1 ) + { + + /* + *safe state variable as constant + */ + if( nstep ) + { + nstep = ae_false; + } + + /* + *clear the root, if there is + */ + if( *nr>0 ) + { + if( ae_fp_eq(c->x.ptr.p_double[i],tmpr.ptr.p_double[*nr-1]) ) + { + *nr = *nr-1; + } + } + + /* + *change state for 'DR' + */ + if( !*dr ) + { + *dr = ae_true; + } + } + else + { + nstep = ae_true; + } + } + + /* + *searching of extremums + */ + if( i>0 ) + { + pll = c->c.ptr.p_double[4*(i-1)]; + + /* + *if pL=pLL or pL=pR then + */ + if( tne==-1 ) + { + if( !*de ) + { + *de = ae_true; + } + } + else + { + if( ae_fp_greater(pl,pll)&&ae_fp_greater(pl,pr) ) + { + + /* + *maximum + */ + tmpet.ptr.p_int[*ne] = -1; + tmpe.ptr.p_double[*ne] = c->x.ptr.p_double[i]; + *ne = *ne+1; + } + else + { + if( ae_fp_less(pl,pll)&&ae_fp_less(pl,pr) ) + { + + /* + *minimum + */ + tmpet.ptr.p_int[*ne] = 1; + tmpe.ptr.p_double[*ne] = c->x.ptr.p_double[i]; + *ne = *ne+1; + } + } + } + } + } + + /* + *write final result + */ + rvectorsetlengthatleast(r, *nr, _state); + rvectorsetlengthatleast(e, *ne, _state); + ivectorsetlengthatleast(et, *ne, _state); + + /* + *write roots + */ + for(i=0; i<=*nr-1; i++) + { + r->ptr.p_double[i] = tmpr.ptr.p_double[i]; + } + + /* + *write extremums and their types + */ + for(i=0; i<=*ne-1; i++) + { + e->ptr.p_double[i] = tmpe.ptr.p_double[i]; + et->ptr.p_int[i] = tmpet.ptr.p_int[i]; + } + } + else + { + + /* + *case, when C.Continuity>=1 + *'TmpR ' - it stores a time value for roots + *'TmpC' - it stores a time value for extremums and + *their function value (TmpC={EX0,F(EX0), EX1,F(EX1), ..., EXn,F(EXn)};) + *'TmpE' - it stores a time value for extremums only + *'TmpET'- it stores a time value for extremums type + */ + rvectorsetlengthatleast(&tmpr, 2*c->n-1, _state); + rvectorsetlengthatleast(&tmpc, 4*c->n, _state); + rvectorsetlengthatleast(&tmpe, 2*c->n, _state); + ivectorsetlengthatleast(&tmpet, 2*c->n, _state); + + /* + *start calculating + */ + for(i=0; i<=c->n-2; i++) + { + + /* + *we calculate pL,mL, pR,mR as Fi+1(F'i+1) at left border + */ + pl = c->c.ptr.p_double[4*i]; + ml = c->c.ptr.p_double[4*i+1]; + pr = c->c.ptr.p_double[4*(i+1)]; + mr = c->c.ptr.p_double[4*(i+1)+1]; + + /* + *calculating roots and extremums at [X[i],X[i+1]] + */ + solvecubicpolinom(pl, ml, pr, mr, c->x.ptr.p_double[i], c->x.ptr.p_double[i+1], &x0, &x1, &x2, &ex0, &ex1, &tnr, &tne, &tr, _state); + + /* + *searching roots + */ + if( tnr>0 ) + { + + /* + *re-init tR + */ + if( tnr>=1 ) + { + tr.ptr.p_double[0] = x0; + } + if( tnr>=2 ) + { + tr.ptr.p_double[1] = x1; + } + if( tnr==3 ) + { + tr.ptr.p_double[2] = x2; + } + + /* + *start root selection + */ + if( *nr>0 ) + { + if( ae_fp_neq(tmpr.ptr.p_double[*nr-1],x0) ) + { + + /* + *previous segment was't constant identical zero + */ + if( nstep ) + { + for(j=0; j<=tnr-1; j++) + { + tmpr.ptr.p_double[*nr+j] = tr.ptr.p_double[j]; + } + *nr = *nr+tnr; + } + else + { + + /* + *previous segment was constant identical zero + *and we must ignore [NR+j-1] root + */ + for(j=1; j<=tnr-1; j++) + { + tmpr.ptr.p_double[*nr+j-1] = tr.ptr.p_double[j]; + } + *nr = *nr+tnr-1; + nstep = ae_true; + } + } + else + { + for(j=1; j<=tnr-1; j++) + { + tmpr.ptr.p_double[*nr+j-1] = tr.ptr.p_double[j]; + } + *nr = *nr+tnr-1; + } + } + else + { + + /* + *write first root + */ + for(j=0; j<=tnr-1; j++) + { + tmpr.ptr.p_double[*nr+j] = tr.ptr.p_double[j]; + } + *nr = *nr+tnr; + } + } + else + { + if( tnr==-1 ) + { + + /* + *decrement 'NR' if at previous step was writen a root + *(previous segment identical zero) + */ + if( *nr>0&&nstep ) + { + *nr = *nr-1; + } + + /* + *previous segment is't constant + */ + if( nstep ) + { + nstep = ae_false; + } + + /* + *rewrite 'DR' + */ + if( !*dr ) + { + *dr = ae_true; + } + } + } + + /* + *searching extremums + *write all term like extremums + */ + if( tne==1 ) + { + if( *ne>0 ) + { + + /* + *just ignore identical extremums + *because he must be one + */ + if( ae_fp_neq(tmpc.ptr.p_double[*ne-2],ex0) ) + { + tmpc.ptr.p_double[*ne] = ex0; + tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i]); + *ne = *ne+2; + } + } + else + { + + /* + *write first extremum and it function value + */ + tmpc.ptr.p_double[*ne] = ex0; + tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i]); + *ne = *ne+2; + } + } + else + { + if( tne==2 ) + { + if( *ne>0 ) + { + + /* + *ignore identical extremum + */ + if( ae_fp_neq(tmpc.ptr.p_double[*ne-2],ex0) ) + { + tmpc.ptr.p_double[*ne] = ex0; + tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i]); + *ne = *ne+2; + } + } + else + { + + /* + *write first extremum + */ + tmpc.ptr.p_double[*ne] = ex0; + tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i])*(ex0-c->x.ptr.p_double[i]); + *ne = *ne+2; + } + + /* + *write second extremum + */ + tmpc.ptr.p_double[*ne] = ex1; + tmpc.ptr.p_double[*ne+1] = c->c.ptr.p_double[4*i]+c->c.ptr.p_double[4*i+1]*(ex1-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+2]*(ex1-c->x.ptr.p_double[i])*(ex1-c->x.ptr.p_double[i])+c->c.ptr.p_double[4*i+3]*(ex1-c->x.ptr.p_double[i])*(ex1-c->x.ptr.p_double[i])*(ex1-c->x.ptr.p_double[i]); + *ne = *ne+2; + } + else + { + if( tne==-1 ) + { + if( !*de ) + { + *de = ae_true; + } + } + } + } + } + + /* + *checking of arrays + *get number of extremums (tNe=NE/2) + *initialize pL as value F0(X[0]) and + *initialize pR as value Fn-1(X[N]) + */ + tne = *ne/2; + *ne = 0; + pl = c->c.ptr.p_double[0]; + pr = c->c.ptr.p_double[4*(c->n-1)]; + for(i=0; i<=tne-1; i++) + { + if( i>0&&ix.ptr.p_double[0]) ) + { + if( ae_fp_greater(tmpc.ptr.p_double[2*i+1],pl)&&ae_fp_greater(tmpc.ptr.p_double[2*i+1],tmpc.ptr.p_double[2*(i+1)+1]) ) + { + + /* + *maximum + */ + tmpe.ptr.p_double[*ne] = tmpc.ptr.p_double[2*i]; + tmpet.ptr.p_int[*ne] = -1; + *ne = *ne+1; + } + else + { + if( ae_fp_less(tmpc.ptr.p_double[2*i+1],pl)&&ae_fp_less(tmpc.ptr.p_double[2*i+1],tmpc.ptr.p_double[2*(i+1)+1]) ) + { + + /* + *minimum + */ + tmpe.ptr.p_double[*ne] = tmpc.ptr.p_double[2*i]; + tmpet.ptr.p_int[*ne] = 1; + *ne = *ne+1; + } + } + } + } + else + { + if( i==tne-1 ) + { + if( ae_fp_neq(tmpc.ptr.p_double[2*i],c->x.ptr.p_double[c->n-1]) ) + { + if( ae_fp_greater(tmpc.ptr.p_double[2*i+1],tmpc.ptr.p_double[2*(i-1)+1])&&ae_fp_greater(tmpc.ptr.p_double[2*i+1],pr) ) + { + + /* + *maximum + */ + tmpe.ptr.p_double[*ne] = tmpc.ptr.p_double[2*i]; + tmpet.ptr.p_int[*ne] = -1; + *ne = *ne+1; + } + else + { + if( ae_fp_less(tmpc.ptr.p_double[2*i+1],tmpc.ptr.p_double[2*(i-1)+1])&&ae_fp_less(tmpc.ptr.p_double[2*i+1],pr) ) + { + + /* + *minimum + */ + tmpe.ptr.p_double[*ne] = tmpc.ptr.p_double[2*i]; + tmpet.ptr.p_int[*ne] = 1; + *ne = *ne+1; + } + } + } + } + } + } + } + + /* + *final results + *allocate R, E, ET + */ + rvectorsetlengthatleast(r, *nr, _state); + rvectorsetlengthatleast(e, *ne, _state); + ivectorsetlengthatleast(et, *ne, _state); + + /* + *write result for extremus and their types + */ + for(i=0; i<=*ne-1; i++) + { + e->ptr.p_double[i] = tmpe.ptr.p_double[i]; + et->ptr.p_int[i] = tmpet.ptr.p_int[i]; + } + + /* + *write result for roots + */ + for(i=0; i<=*nr-1; i++) + { + r->ptr.p_double[i] = tmpr.ptr.p_double[i]; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. Heap sort. +*************************************************************************/ +void heapsortdpoints(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* d, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector rbuf; + ae_vector ibuf; + ae_vector rbuf2; + ae_vector ibuf2; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&rbuf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ibuf, 0, DT_INT, _state, ae_true); + ae_vector_init(&rbuf2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ibuf2, 0, DT_INT, _state, ae_true); + + ae_vector_set_length(&ibuf, n, _state); + ae_vector_set_length(&rbuf, n, _state); + for(i=0; i<=n-1; i++) + { + ibuf.ptr.p_int[i] = i; + } + tagsortfasti(x, &ibuf, &rbuf2, &ibuf2, n, _state); + for(i=0; i<=n-1; i++) + { + rbuf.ptr.p_double[i] = y->ptr.p_double[ibuf.ptr.p_int[i]]; + } + ae_v_move(&y->ptr.p_double[0], 1, &rbuf.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + rbuf.ptr.p_double[i] = d->ptr.p_double[ibuf.ptr.p_int[i]]; + } + ae_v_move(&d->ptr.p_double[0], 1, &rbuf.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +This procedure search roots of an quadratic equation inside [0;1] and it number of roots. + +INPUT PARAMETERS: + P0 - value of a function at 0 + M0 - value of a derivative at 0 + P1 - value of a function at 1 + M1 - value of a derivative at 1 + +OUTPUT PARAMETERS: + X0 - first root of an equation + X1 - second root of an equation + NR - number of roots + +RESTRICTIONS OF PARAMETERS: + +Parameters for this procedure has't to be zero simultaneously. Is expected, +that input polinom is't degenerate or constant identicaly ZERO. + + +REMARK: + +The procedure always fill value for X1 and X2, even if it is't belongs to [0;1]. +But first true root(even if existing one) is in X1. +Number of roots is NR. + + -- ALGLIB PROJECT -- + Copyright 26.09.2011 by Bochkanov Sergey +*************************************************************************/ +void solvepolinom2(double p0, + double m0, + double p1, + double m1, + double* x0, + double* x1, + ae_int_t* nr, + ae_state *_state) +{ + double a; + double b; + double c; + double dd; + double tmp; + double exf; + double extr; + + *x0 = 0; + *x1 = 0; + *nr = 0; + + + /* + *calculate parameters for equation: A, B and C + */ + a = 6*p0+3*m0-6*p1+3*m1; + b = -6*p0-4*m0+6*p1-2*m1; + c = m0; + + /* + *check case, when A=0 + *we are considering the linear equation + */ + if( ae_fp_eq(a,0) ) + { + + /* + *B<>0 and root inside [0;1] + *one root + */ + if( (ae_fp_neq(b,0)&&ae_sign(c, _state)*ae_sign(b, _state)<=0)&&ae_fp_greater_eq(ae_fabs(b, _state),ae_fabs(c, _state)) ) + { + *x0 = -c/b; + *nr = 1; + return; + } + else + { + *nr = 0; + return; + } + } + + /* + *consider case, when extremumu outside (0;1) + *exist one root only + */ + if( ae_fp_less_eq(ae_fabs(2*a, _state),ae_fabs(b, _state))||ae_sign(b, _state)*ae_sign(a, _state)>=0 ) + { + if( ae_sign(m0, _state)*ae_sign(m1, _state)>0 ) + { + *nr = 0; + return; + } + + /* + *consider case, when the one exist + *same sign of derivative + */ + if( ae_sign(m0, _state)*ae_sign(m1, _state)<0 ) + { + *nr = 1; + extr = -b/(2*a); + dd = b*b-4*a*c; + if( ae_fp_less(dd,0) ) + { + return; + } + *x0 = (-b-ae_sqrt(dd, _state))/(2*a); + *x1 = (-b+ae_sqrt(dd, _state))/(2*a); + if( (ae_fp_greater_eq(extr,1)&&ae_fp_less_eq(*x1,extr))||(ae_fp_less_eq(extr,0)&&ae_fp_greater_eq(*x1,extr)) ) + { + *x0 = *x1; + } + return; + } + + /* + *consider case, when the one is 0 + */ + if( ae_fp_eq(m0,0) ) + { + *x0 = 0; + *nr = 1; + return; + } + if( ae_fp_eq(m1,0) ) + { + *x0 = 1; + *nr = 1; + return; + } + } + else + { + + /* + *consider case, when both of derivatives is 0 + */ + if( ae_fp_eq(m0,0)&&ae_fp_eq(m1,0) ) + { + *x0 = 0; + *x1 = 1; + *nr = 2; + return; + } + + /* + *consider case, when derivative at 0 is 0, and derivative at 1 is't 0 + */ + if( ae_fp_eq(m0,0)&&ae_fp_neq(m1,0) ) + { + dd = b*b-4*a*c; + if( ae_fp_less(dd,0) ) + { + *x0 = 0; + *nr = 1; + return; + } + *x0 = (-b-ae_sqrt(dd, _state))/(2*a); + *x1 = (-b+ae_sqrt(dd, _state))/(2*a); + extr = -b/(2*a); + exf = a*extr*extr+b*extr+c; + if( ae_sign(exf, _state)*ae_sign(m1, _state)>0 ) + { + *x0 = 0; + *nr = 1; + return; + } + else + { + if( ae_fp_greater(extr,*x0) ) + { + *x0 = 0; + } + else + { + *x1 = 0; + } + *nr = 2; + + /* + *roots must placed ascending + */ + if( ae_fp_greater(*x0,*x1) ) + { + tmp = *x0; + *x0 = *x1; + *x1 = tmp; + } + return; + } + } + if( ae_fp_eq(m1,0)&&ae_fp_neq(m0,0) ) + { + dd = b*b-4*a*c; + if( ae_fp_less(dd,0) ) + { + *x0 = 1; + *nr = 1; + return; + } + *x0 = (-b-ae_sqrt(dd, _state))/(2*a); + *x1 = (-b+ae_sqrt(dd, _state))/(2*a); + extr = -b/(2*a); + exf = a*extr*extr+b*extr+c; + if( ae_sign(exf, _state)*ae_sign(m0, _state)>0 ) + { + *x0 = 1; + *nr = 1; + return; + } + else + { + if( ae_fp_less(extr,*x0) ) + { + *x0 = 1; + } + else + { + *x1 = 1; + } + *nr = 2; + + /* + *roots must placed ascending + */ + if( ae_fp_greater(*x0,*x1) ) + { + tmp = *x0; + *x0 = *x1; + *x1 = tmp; + } + return; + } + } + else + { + extr = -b/(2*a); + exf = a*extr*extr+b*extr+c; + if( ae_sign(exf, _state)*ae_sign(m0, _state)>0&&ae_sign(exf, _state)*ae_sign(m1, _state)>0 ) + { + *nr = 0; + return; + } + dd = b*b-4*a*c; + if( ae_fp_less(dd,0) ) + { + *nr = 0; + return; + } + *x0 = (-b-ae_sqrt(dd, _state))/(2*a); + *x1 = (-b+ae_sqrt(dd, _state))/(2*a); + + /* + *if EXF and m0, EXF and m1 has different signs, then equation has two roots + */ + if( ae_sign(exf, _state)*ae_sign(m0, _state)<0&&ae_sign(exf, _state)*ae_sign(m1, _state)<0 ) + { + *nr = 2; + + /* + *roots must placed ascending + */ + if( ae_fp_greater(*x0,*x1) ) + { + tmp = *x0; + *x0 = *x1; + *x1 = tmp; + } + return; + } + else + { + *nr = 1; + if( ae_sign(exf, _state)*ae_sign(m0, _state)<0 ) + { + if( ae_fp_less(*x1,extr) ) + { + *x0 = *x1; + } + return; + } + if( ae_sign(exf, _state)*ae_sign(m1, _state)<0 ) + { + if( ae_fp_greater(*x1,extr) ) + { + *x0 = *x1; + } + return; + } + } + } + } +} + + +/************************************************************************* +This procedure search roots of an cubic equation inside [A;B], it number of roots +and number of extremums. + +INPUT PARAMETERS: + pA - value of a function at A + mA - value of a derivative at A + pB - value of a function at B + mB - value of a derivative at B + A0 - left border [A0;B0] + B0 - right border [A0;B0] + +OUTPUT PARAMETERS: + X0 - first root of an equation + X1 - second root of an equation + X2 - third root of an equation + EX0 - first extremum of a function + EX0 - second extremum of a function + NR - number of roots + NR - number of extrmums + +RESTRICTIONS OF PARAMETERS: + +Length of [A;B] must be positive and is't zero, i.e. A<>B and AB + */ + ae_assert(ae_fp_less(a,b), "\nSolveCubicPolinom: incorrect borders for [A;B]!\n", _state); + + /* + *case 1 + *function can be identicaly to ZERO + */ + if( ((ae_fp_eq(ma,0)&&ae_fp_eq(mb,0))&&ae_fp_eq(pa,pb))&&ae_fp_eq(pa,0) ) + { + *nr = -1; + *ne = -1; + return; + } + if( (ae_fp_eq(ma,0)&&ae_fp_eq(mb,0))&&ae_fp_eq(pa,pb) ) + { + *nr = 0; + *ne = -1; + return; + } + tmpma = ma*(b-a); + tmpmb = mb*(b-a); + solvepolinom2(pa, tmpma, pb, tmpmb, ex0, ex1, ne, _state); + *ex0 = spline1d_rescaleval(0, 1, a, b, *ex0, _state); + *ex1 = spline1d_rescaleval(0, 1, a, b, *ex1, _state); + + /* + *case 3.1 + *no extremums at [A;B] + */ + if( *ne==0 ) + { + *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, 1, x0, _state); + if( *nr==1 ) + { + *x0 = spline1d_rescaleval(0, 1, a, b, *x0, _state); + } + return; + } + + /* + *case 3.2 + *one extremum + */ + if( *ne==1 ) + { + if( ae_fp_eq(*ex0,a)||ae_fp_eq(*ex0,b) ) + { + *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, 1, x0, _state); + if( *nr==1 ) + { + *x0 = spline1d_rescaleval(0, 1, a, b, *x0, _state); + } + return; + } + else + { + *nr = 0; + i = 0; + tex0 = spline1d_rescaleval(a, b, 0, 1, *ex0, _state); + *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, tex0, x0, _state)+(*nr); + if( *nr>i ) + { + tempdata->ptr.p_double[i] = spline1d_rescaleval(0, tex0, a, *ex0, *x0, _state); + i = i+1; + } + *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex0, 1, x0, _state)+(*nr); + if( *nr>i ) + { + *x0 = spline1d_rescaleval(tex0, 1, *ex0, b, *x0, _state); + if( i>0 ) + { + if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + else + { + *nr = *nr-1; + } + } + else + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + } + if( *nr>0 ) + { + *x0 = tempdata->ptr.p_double[0]; + if( *nr>1 ) + { + *x1 = tempdata->ptr.p_double[1]; + } + return; + } + } + return; + } + else + { + + /* + *case 3.3 + *two extremums(or more, but it's impossible) + * + * + *case 3.3.0 + *both extremums at the border + */ + if( ae_fp_eq(*ex0,a)&&ae_fp_eq(*ex1,b) ) + { + *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, 1, x0, _state); + if( *nr==1 ) + { + *x0 = spline1d_rescaleval(0, 1, a, b, *x0, _state); + } + return; + } + if( ae_fp_eq(*ex0,a)&&ae_fp_neq(*ex1,b) ) + { + *nr = 0; + i = 0; + tex1 = spline1d_rescaleval(a, b, 0, 1, *ex1, _state); + *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, tex1, x0, _state)+(*nr); + if( *nr>i ) + { + tempdata->ptr.p_double[i] = spline1d_rescaleval(0, tex1, a, *ex1, *x0, _state); + i = i+1; + } + *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex1, 1, x0, _state)+(*nr); + if( *nr>i ) + { + *x0 = spline1d_rescaleval(tex1, 1, *ex1, b, *x0, _state); + if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + else + { + *nr = *nr-1; + } + } + if( *nr>0 ) + { + *x0 = tempdata->ptr.p_double[0]; + if( *nr>1 ) + { + *x1 = tempdata->ptr.p_double[1]; + } + return; + } + } + if( ae_fp_eq(*ex1,b)&&ae_fp_neq(*ex0,a) ) + { + *nr = 0; + i = 0; + tex0 = spline1d_rescaleval(a, b, 0, 1, *ex0, _state); + *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, tex0, x0, _state)+(*nr); + if( *nr>i ) + { + tempdata->ptr.p_double[i] = spline1d_rescaleval(0, tex0, a, *ex0, *x0, _state); + i = i+1; + } + *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex0, 1, x0, _state)+(*nr); + if( *nr>i ) + { + *x0 = spline1d_rescaleval(tex0, 1, *ex0, b, *x0, _state); + if( i>0 ) + { + if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + else + { + *nr = *nr-1; + } + } + else + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + } + if( *nr>0 ) + { + *x0 = tempdata->ptr.p_double[0]; + if( *nr>1 ) + { + *x1 = tempdata->ptr.p_double[1]; + } + return; + } + } + else + { + + /* + *case 3.3.2 + *both extremums inside (0;1) + */ + *nr = 0; + i = 0; + tex0 = spline1d_rescaleval(a, b, 0, 1, *ex0, _state); + tex1 = spline1d_rescaleval(a, b, 0, 1, *ex1, _state); + *nr = bisectmethod(pa, tmpma, pb, tmpmb, 0, tex0, x0, _state)+(*nr); + if( *nr>i ) + { + tempdata->ptr.p_double[i] = spline1d_rescaleval(0, tex0, a, *ex0, *x0, _state); + i = i+1; + } + *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex0, tex1, x0, _state)+(*nr); + if( *nr>i ) + { + *x0 = spline1d_rescaleval(tex0, tex1, *ex0, *ex1, *x0, _state); + if( i>0 ) + { + if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + else + { + *nr = *nr-1; + } + } + else + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + } + *nr = bisectmethod(pa, tmpma, pb, tmpmb, tex1, 1, x0, _state)+(*nr); + if( *nr>i ) + { + *x0 = spline1d_rescaleval(tex1, 1, *ex1, b, *x0, _state); + if( i>0 ) + { + if( ae_fp_neq(*x0,tempdata->ptr.p_double[i-1]) ) + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + else + { + *nr = *nr-1; + } + } + else + { + tempdata->ptr.p_double[i] = *x0; + i = i+1; + } + } + + /* + *write are found roots + */ + if( *nr>0 ) + { + *x0 = tempdata->ptr.p_double[0]; + if( *nr>1 ) + { + *x1 = tempdata->ptr.p_double[1]; + } + if( *nr>2 ) + { + *x2 = tempdata->ptr.p_double[2]; + } + return; + } + } + } +} + + +/************************************************************************* +Function for searching a root at [A;B] by bisection method and return number of roots +(0 or 1) + +INPUT PARAMETERS: + pA - value of a function at A + mA - value of a derivative at A + pB - value of a function at B + mB - value of a derivative at B + A0 - left border [A0;B0] + B0 - right border [A0;B0] + +RESTRICTIONS OF PARAMETERS: + +We assume, that B0>A0. + + +REMARK: + +Assume, that exist one root only at [A;B], else +function may be work incorrectly. +The function dont check value A0,B0! + + -- ALGLIB PROJECT -- + Copyright 26.09.2011 by Bochkanov Sergey +*************************************************************************/ +ae_int_t bisectmethod(double pa, + double ma, + double pb, + double mb, + double a, + double b, + double* x, + ae_state *_state) +{ + double vacuum; + double eps; + double a0; + double b0; + double m; + double lf; + double rf; + double mf; + ae_int_t result; + + *x = 0; + + + /* + *accuracy + */ + eps = 1000*(b-a)*ae_machineepsilon; + + /* + *initialization left and right borders + */ + a0 = a; + b0 = b; + + /* + *initialize function value at 'A' and 'B' + */ + spline1d_hermitecalc(pa, ma, pb, mb, a, &lf, &vacuum, _state); + spline1d_hermitecalc(pa, ma, pb, mb, b, &rf, &vacuum, _state); + + /* + *check, that 'A' and 'B' are't roots, + *and that root exist + */ + if( ae_sign(lf, _state)*ae_sign(rf, _state)>0 ) + { + result = 0; + return result; + } + else + { + if( ae_fp_eq(lf,0) ) + { + *x = a; + result = 1; + return result; + } + else + { + if( ae_fp_eq(rf,0) ) + { + *x = b; + result = 1; + return result; + } + } + } + + /* + *searching a root + */ + do + { + m = (b0+a0)/2; + spline1d_hermitecalc(pa, ma, pb, mb, a0, &lf, &vacuum, _state); + spline1d_hermitecalc(pa, ma, pb, mb, b0, &rf, &vacuum, _state); + spline1d_hermitecalc(pa, ma, pb, mb, m, &mf, &vacuum, _state); + if( ae_sign(mf, _state)*ae_sign(lf, _state)<0 ) + { + b0 = m; + } + else + { + if( ae_sign(mf, _state)*ae_sign(rf, _state)<0 ) + { + a0 = m; + } + else + { + if( ae_fp_eq(lf,0) ) + { + *x = a0; + result = 1; + return result; + } + if( ae_fp_eq(rf,0) ) + { + *x = b0; + result = 1; + return result; + } + if( ae_fp_eq(mf,0) ) + { + *x = m; + result = 1; + return result; + } + } + } + } + while(ae_fp_greater_eq(ae_fabs(b0-a0, _state),eps)); + *x = m; + result = 1; + return result; +} + + +/************************************************************************* +This function builds monotone cubic Hermite interpolant. This interpolant +is monotonic in [x(0),x(n-1)] and is constant outside of this interval. + +In case y[] form non-monotonic sequence, interpolant is piecewise +monotonic. Say, for x=(0,1,2,3,4) and y=(0,1,2,1,0) interpolant will +monotonically grow at [0..2] and monotonically decrease at [2..4]. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. Subroutine automatically + sorts points, so caller may pass unsorted array. + Y - function values, array[0..N-1] + N - the number of points(N>=2). + +OUTPUT PARAMETERS: + C - spline interpolant. + + -- ALGLIB PROJECT -- + Copyright 21.06.2012 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildmonotone(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + spline1dinterpolant* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector d; + ae_vector ex; + ae_vector ey; + ae_vector p; + double delta; + double alpha; + double beta; + ae_int_t tmpn; + ae_int_t sn; + double ca; + double cb; + double epsilon; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + _spline1dinterpolant_clear(c); + ae_vector_init(&d, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ex, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ey, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + + + /* + * Check lengths of arguments + */ + ae_assert(n>=2, "Spline1DBuildMonotone: N<2", _state); + ae_assert(x->cnt>=n, "Spline1DBuildMonotone: Length(X)cnt>=n, "Spline1DBuildMonotone: Length(Y)ptr.p_double[0]-ae_fabs(x->ptr.p_double[1]-x->ptr.p_double[0], _state); + ex.ptr.p_double[n-1] = x->ptr.p_double[n-3]+ae_fabs(x->ptr.p_double[n-3]-x->ptr.p_double[n-4], _state); + ey.ptr.p_double[0] = y->ptr.p_double[0]; + ey.ptr.p_double[n-1] = y->ptr.p_double[n-3]; + for(i=1; i<=n-2; i++) + { + ex.ptr.p_double[i] = x->ptr.p_double[i-1]; + ey.ptr.p_double[i] = y->ptr.p_double[i-1]; + } + + /* + * Init sign of the function for first segment + */ + i = 0; + ca = 0; + do + { + ca = ey.ptr.p_double[i+1]-ey.ptr.p_double[i]; + i = i+1; + } + while(!(ae_fp_neq(ca,0)||i>n-2)); + if( ae_fp_neq(ca,0) ) + { + ca = ca/ae_fabs(ca, _state); + } + i = 0; + while(i=2, "Spline1DBuildMonotone: internal error", _state); + + /* + * Calculate derivatives for current segment + */ + d.ptr.p_double[i] = 0; + d.ptr.p_double[sn-1] = 0; + for(j=i+1; j<=sn-2; j++) + { + d.ptr.p_double[j] = ((ey.ptr.p_double[j]-ey.ptr.p_double[j-1])/(ex.ptr.p_double[j]-ex.ptr.p_double[j-1])+(ey.ptr.p_double[j+1]-ey.ptr.p_double[j])/(ex.ptr.p_double[j+1]-ex.ptr.p_double[j]))/2; + } + for(j=i; j<=sn-2; j++) + { + delta = (ey.ptr.p_double[j+1]-ey.ptr.p_double[j])/(ex.ptr.p_double[j+1]-ex.ptr.p_double[j]); + if( ae_fp_less_eq(ae_fabs(delta, _state),epsilon) ) + { + d.ptr.p_double[j] = 0; + d.ptr.p_double[j+1] = 0; + } + else + { + alpha = d.ptr.p_double[j]/delta; + beta = d.ptr.p_double[j+1]/delta; + if( ae_fp_neq(alpha,0) ) + { + cb = alpha*ae_sqrt(1+ae_sqr(beta/alpha, _state), _state); + } + else + { + if( ae_fp_neq(beta,0) ) + { + cb = beta; + } + else + { + continue; + } + } + if( ae_fp_greater(cb,3) ) + { + d.ptr.p_double[j] = 3*alpha*delta/cb; + d.ptr.p_double[j+1] = 3*beta*delta/cb; + } + } + } + + /* + * Transition to next segment + */ + i = sn-1; + } + spline1dbuildhermite(&ex, &ey, &d, n, c, _state); + c->continuity = 2; + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal version of Spline1DGridDiffCubic. + +Accepts pre-ordered X/Y, temporary arrays (which may be preallocated, if +you want to save time, or not) and output array (which may be preallocated +too). + +Y is passed as var-parameter because we may need to force last element to +be equal to the first one (if periodic boundary conditions are specified). + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +static void spline1d_spline1dgriddiffcubicinternal(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* d, + /* Real */ ae_vector* a1, + /* Real */ ae_vector* a2, + /* Real */ ae_vector* a3, + /* Real */ ae_vector* b, + /* Real */ ae_vector* dt, + ae_state *_state) +{ + ae_int_t i; + + + + /* + * allocate arrays + */ + if( d->cntcntcntcntcntcntptr.p_double[0] = (y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0]); + d->ptr.p_double[1] = d->ptr.p_double[0]; + return; + } + if( (n==2&&boundltype==-1)&&boundrtype==-1 ) + { + d->ptr.p_double[0] = 0; + d->ptr.p_double[1] = 0; + return; + } + + /* + * Periodic and non-periodic boundary conditions are + * two separate classes + */ + if( boundrtype==-1&&boundltype==-1 ) + { + + /* + * Periodic boundary conditions + */ + y->ptr.p_double[n-1] = y->ptr.p_double[0]; + + /* + * Boundary conditions at N-1 points + * (one point less because last point is the same as first point). + */ + a1->ptr.p_double[0] = x->ptr.p_double[1]-x->ptr.p_double[0]; + a2->ptr.p_double[0] = 2*(x->ptr.p_double[1]-x->ptr.p_double[0]+x->ptr.p_double[n-1]-x->ptr.p_double[n-2]); + a3->ptr.p_double[0] = x->ptr.p_double[n-1]-x->ptr.p_double[n-2]; + b->ptr.p_double[0] = 3*(y->ptr.p_double[n-1]-y->ptr.p_double[n-2])/(x->ptr.p_double[n-1]-x->ptr.p_double[n-2])*(x->ptr.p_double[1]-x->ptr.p_double[0])+3*(y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0])*(x->ptr.p_double[n-1]-x->ptr.p_double[n-2]); + for(i=1; i<=n-2; i++) + { + + /* + * Altough last point is [N-2], we use X[N-1] and Y[N-1] + * (because of periodicity) + */ + a1->ptr.p_double[i] = x->ptr.p_double[i+1]-x->ptr.p_double[i]; + a2->ptr.p_double[i] = 2*(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); + a3->ptr.p_double[i] = x->ptr.p_double[i]-x->ptr.p_double[i-1]; + b->ptr.p_double[i] = 3*(y->ptr.p_double[i]-y->ptr.p_double[i-1])/(x->ptr.p_double[i]-x->ptr.p_double[i-1])*(x->ptr.p_double[i+1]-x->ptr.p_double[i])+3*(y->ptr.p_double[i+1]-y->ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i])*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); + } + + /* + * Solve, add last point (with index N-1) + */ + spline1d_solvecyclictridiagonal(a1, a2, a3, b, n-1, dt, _state); + ae_v_move(&d->ptr.p_double[0], 1, &dt->ptr.p_double[0], 1, ae_v_len(0,n-2)); + d->ptr.p_double[n-1] = d->ptr.p_double[0]; + } + else + { + + /* + * Non-periodic boundary condition. + * Left boundary conditions. + */ + if( boundltype==0 ) + { + a1->ptr.p_double[0] = 0; + a2->ptr.p_double[0] = 1; + a3->ptr.p_double[0] = 1; + b->ptr.p_double[0] = 2*(y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0]); + } + if( boundltype==1 ) + { + a1->ptr.p_double[0] = 0; + a2->ptr.p_double[0] = 1; + a3->ptr.p_double[0] = 0; + b->ptr.p_double[0] = boundl; + } + if( boundltype==2 ) + { + a1->ptr.p_double[0] = 0; + a2->ptr.p_double[0] = 2; + a3->ptr.p_double[0] = 1; + b->ptr.p_double[0] = 3*(y->ptr.p_double[1]-y->ptr.p_double[0])/(x->ptr.p_double[1]-x->ptr.p_double[0])-0.5*boundl*(x->ptr.p_double[1]-x->ptr.p_double[0]); + } + + /* + * Central conditions + */ + for(i=1; i<=n-2; i++) + { + a1->ptr.p_double[i] = x->ptr.p_double[i+1]-x->ptr.p_double[i]; + a2->ptr.p_double[i] = 2*(x->ptr.p_double[i+1]-x->ptr.p_double[i-1]); + a3->ptr.p_double[i] = x->ptr.p_double[i]-x->ptr.p_double[i-1]; + b->ptr.p_double[i] = 3*(y->ptr.p_double[i]-y->ptr.p_double[i-1])/(x->ptr.p_double[i]-x->ptr.p_double[i-1])*(x->ptr.p_double[i+1]-x->ptr.p_double[i])+3*(y->ptr.p_double[i+1]-y->ptr.p_double[i])/(x->ptr.p_double[i+1]-x->ptr.p_double[i])*(x->ptr.p_double[i]-x->ptr.p_double[i-1]); + } + + /* + * Right boundary conditions + */ + if( boundrtype==0 ) + { + a1->ptr.p_double[n-1] = 1; + a2->ptr.p_double[n-1] = 1; + a3->ptr.p_double[n-1] = 0; + b->ptr.p_double[n-1] = 2*(y->ptr.p_double[n-1]-y->ptr.p_double[n-2])/(x->ptr.p_double[n-1]-x->ptr.p_double[n-2]); + } + if( boundrtype==1 ) + { + a1->ptr.p_double[n-1] = 0; + a2->ptr.p_double[n-1] = 1; + a3->ptr.p_double[n-1] = 0; + b->ptr.p_double[n-1] = boundr; + } + if( boundrtype==2 ) + { + a1->ptr.p_double[n-1] = 1; + a2->ptr.p_double[n-1] = 2; + a3->ptr.p_double[n-1] = 0; + b->ptr.p_double[n-1] = 3*(y->ptr.p_double[n-1]-y->ptr.p_double[n-2])/(x->ptr.p_double[n-1]-x->ptr.p_double[n-2])+0.5*boundr*(x->ptr.p_double[n-1]-x->ptr.p_double[n-2]); + } + + /* + * Solve + */ + spline1d_solvetridiagonal(a1, a2, a3, b, n, d, _state); + } +} + + +/************************************************************************* +Internal subroutine. Heap sort. +*************************************************************************/ +static void spline1d_heapsortpoints(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector bufx; + ae_vector bufy; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&bufx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bufy, 0, DT_REAL, _state, ae_true); + + tagsortfastr(x, y, &bufx, &bufy, n, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. Heap sort. + +Accepts: + X, Y - points + P - empty or preallocated array + +Returns: + X, Y - sorted by X + P - array of permutations; I-th position of output + arrays X/Y contains (X[P[I]],Y[P[I]]) +*************************************************************************/ +static void spline1d_heapsortppoints(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Integer */ ae_vector* p, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector rbuf; + ae_vector ibuf; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&rbuf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ibuf, 0, DT_INT, _state, ae_true); + + if( p->cntptr.p_int[i] = i; + } + tagsortfasti(x, p, &rbuf, &ibuf, n, _state); + for(i=0; i<=n-1; i++) + { + rbuf.ptr.p_double[i] = y->ptr.p_double[p->ptr.p_int[i]]; + } + ae_v_move(&y->ptr.p_double[0], 1, &rbuf.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. Tridiagonal solver. Solves + +( B[0] C[0] +( A[1] B[1] C[1] ) +( A[2] B[2] C[2] ) +( .......... ) * X = D +( .......... ) +( A[N-2] B[N-2] C[N-2] ) +( A[N-1] B[N-1] ) + +*************************************************************************/ +static void spline1d_solvetridiagonal(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* c, + /* Real */ ae_vector* d, + ae_int_t n, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _b; + ae_vector _d; + ae_int_t k; + double t; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_b, b, _state, ae_true); + b = &_b; + ae_vector_init_copy(&_d, d, _state, ae_true); + d = &_d; + + if( x->cntptr.p_double[k]/b->ptr.p_double[k-1]; + b->ptr.p_double[k] = b->ptr.p_double[k]-t*c->ptr.p_double[k-1]; + d->ptr.p_double[k] = d->ptr.p_double[k]-t*d->ptr.p_double[k-1]; + } + x->ptr.p_double[n-1] = d->ptr.p_double[n-1]/b->ptr.p_double[n-1]; + for(k=n-2; k>=0; k--) + { + x->ptr.p_double[k] = (d->ptr.p_double[k]-c->ptr.p_double[k]*x->ptr.p_double[k+1])/b->ptr.p_double[k]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. Cyclic tridiagonal solver. Solves + +( B[0] C[0] A[0] ) +( A[1] B[1] C[1] ) +( A[2] B[2] C[2] ) +( .......... ) * X = D +( .......... ) +( A[N-2] B[N-2] C[N-2] ) +( C[N-1] A[N-1] B[N-1] ) +*************************************************************************/ +static void spline1d_solvecyclictridiagonal(/* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* c, + /* Real */ ae_vector* d, + ae_int_t n, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _b; + ae_int_t k; + double alpha; + double beta; + double gamma; + ae_vector y; + ae_vector z; + ae_vector u; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_b, b, _state, ae_true); + b = &_b; + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&z, 0, DT_REAL, _state, ae_true); + ae_vector_init(&u, 0, DT_REAL, _state, ae_true); + + if( x->cntptr.p_double[0]; + alpha = c->ptr.p_double[n-1]; + gamma = -b->ptr.p_double[0]; + b->ptr.p_double[0] = 2*b->ptr.p_double[0]; + b->ptr.p_double[n-1] = b->ptr.p_double[n-1]-alpha*beta/gamma; + ae_vector_set_length(&u, n, _state); + for(k=0; k<=n-1; k++) + { + u.ptr.p_double[k] = 0; + } + u.ptr.p_double[0] = gamma; + u.ptr.p_double[n-1] = alpha; + spline1d_solvetridiagonal(a, b, c, d, n, &y, _state); + spline1d_solvetridiagonal(a, b, c, &u, n, &z, _state); + for(k=0; k<=n-1; k++) + { + x->ptr.p_double[k] = y.ptr.p_double[k]-(y.ptr.p_double[0]+beta/gamma*y.ptr.p_double[n-1])/(1+z.ptr.p_double[0]+beta/gamma*z.ptr.p_double[n-1])*z.ptr.p_double[k]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. Three-point differentiation +*************************************************************************/ +static double spline1d_diffthreepoint(double t, + double x0, + double f0, + double x1, + double f1, + double x2, + double f2, + ae_state *_state) +{ + double a; + double b; + double result; + + + t = t-x0; + x1 = x1-x0; + x2 = x2-x0; + a = (f2-f0-x2/x1*(f1-f0))/(ae_sqr(x2, _state)-x1*x2); + b = (f1-f0-a*ae_sqr(x1, _state))/x1; + result = 2*a*t+b; + return result; +} + + +/************************************************************************* +Procedure for calculating value of a function is providet in the form of +Hermite polinom + +INPUT PARAMETERS: + P0 - value of a function at 0 + M0 - value of a derivative at 0 + P1 - value of a function at 1 + M1 - value of a derivative at 1 + T - point inside [0;1] + +OUTPUT PARAMETERS: + S - value of a function at T + B0 - value of a derivative function at T + + -- ALGLIB PROJECT -- + Copyright 26.09.2011 by Bochkanov Sergey +*************************************************************************/ +static void spline1d_hermitecalc(double p0, + double m0, + double p1, + double m1, + double t, + double* s, + double* ds, + ae_state *_state) +{ + + *s = 0; + *ds = 0; + + *s = p0*(1+2*t)*(1-t)*(1-t)+m0*t*(1-t)*(1-t)+p1*(3-2*t)*t*t+m1*t*t*(t-1); + *ds = -p0*6*t*(1-t)+m0*(1-t)*(1-3*t)+p1*6*t*(1-t)+m1*t*(3*t-2); +} + + +/************************************************************************* +Function for mapping from [A0;B0] to [A1;B1] + +INPUT PARAMETERS: + A0 - left border [A0;B0] + B0 - right border [A0;B0] + A1 - left border [A1;B1] + B1 - right border [A1;B1] + T - value inside [A0;B0] + +RESTRICTIONS OF PARAMETERS: + +We assume, that B0>A0 and B1>A1. But we chech, that T is inside [A0;B0], +and if TB0 then T - B1. + +INPUT PARAMETERS: + A0 - left border for segment [A0;B0] from 'T' is converted to [A1;B1] + B0 - right border for segment [A0;B0] from 'T' is converted to [A1;B1] + A1 - left border for segment [A1;B1] to 'T' is converted from [A0;B0] + B1 - right border for segment [A1;B1] to 'T' is converted from [A0;B0] + T - the parameter is mapped from [A0;B0] to [A1;B1] + +Result: + is converted value for 'T' from [A0;B0] to [A1;B1] + +REMARK: + +The function dont check value A0,B0 and A1,B1! + + -- ALGLIB PROJECT -- + Copyright 26.09.2011 by Bochkanov Sergey +*************************************************************************/ +static double spline1d_rescaleval(double a0, + double b0, + double a1, + double b1, + double t, + ae_state *_state) +{ + double result; + + + + /* + *return left border + */ + if( ae_fp_less_eq(t,a0) ) + { + result = a1; + return result; + } + + /* + *return right border + */ + if( ae_fp_greater_eq(t,b0) ) + { + result = b1; + return result; + } + + /* + *return value between left and right borders + */ + result = (b1-a1)*(t-a0)/(b0-a0)+a1; + return result; +} + + +ae_bool _spline1dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + spline1dinterpolant *p = (spline1dinterpolant*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->c, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _spline1dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + spline1dinterpolant *dst = (spline1dinterpolant*)_dst; + spline1dinterpolant *src = (spline1dinterpolant*)_src; + dst->periodic = src->periodic; + dst->n = src->n; + dst->k = src->k; + dst->continuity = src->continuity; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->c, &src->c, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _spline1dinterpolant_clear(void* _p) +{ + spline1dinterpolant *p = (spline1dinterpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x); + ae_vector_clear(&p->c); +} + + +void _spline1dinterpolant_destroy(void* _p) +{ + spline1dinterpolant *p = (spline1dinterpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->c); +} + + + + +/************************************************************************* +Fitting by polynomials in barycentric form. This function provides simple +unterface for unconstrained unweighted fitting. See PolynomialFitWC() if +you need constrained fitting. + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO: + PolynomialFitWC() + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0 + * if given, only leading N elements of X/Y are used + * if not given, automatically determined from sizes of X/Y + M - number of basis functions (= polynomial_degree + 1), M>=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + P - interpolant in barycentric form. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +NOTES: + you can convert P from barycentric form to the power or Chebyshev + basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from + POLINT subpackage. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialfit(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + barycentricinterpolant* p, + polynomialfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector w; + ae_vector xc; + ae_vector yc; + ae_vector dc; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _barycentricinterpolant_clear(p); + _polynomialfitreport_clear(rep); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&yc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dc, 0, DT_INT, _state, ae_true); + + ae_assert(n>0, "PolynomialFit: N<=0!", _state); + ae_assert(m>0, "PolynomialFit: M<=0!", _state); + ae_assert(x->cnt>=n, "PolynomialFit: Length(X)cnt>=n, "PolynomialFit: Length(Y)0. + * if given, only leading N elements of X/Y/W are used + * if not given, automatically determined from sizes of X/Y/W + XC - points where polynomial values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that P(XC[i])=YC[i] + * DC[i]=1 means that P'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints, 0<=K=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + P - interpolant in barycentric form. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +NOTES: + you can convert P from barycentric form to the power or Chebyshev + basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from + POLINT subpackage. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* even simple constraints can be inconsistent, see Wikipedia article on + this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints is NOT GUARANTEED. +* in the one special cases, however, we can guarantee consistency. This + case is: M>1 and constraints on the function values (NOT DERIVATIVES) + +Our final recommendation is to use constraints WHEN AND ONLY when you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialfitwc(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + barycentricinterpolant* p, + polynomialfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector _w; + ae_vector _xc; + ae_vector _yc; + double xa; + double xb; + double sa; + double sb; + ae_vector xoriginal; + ae_vector yoriginal; + ae_vector y2; + ae_vector w2; + ae_vector tmp; + ae_vector tmp2; + ae_vector bx; + ae_vector by; + ae_vector bw; + ae_int_t i; + ae_int_t j; + double u; + double v; + double s; + ae_int_t relcnt; + lsfitreport lrep; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_init_copy(&_w, w, _state, ae_true); + w = &_w; + ae_vector_init_copy(&_xc, xc, _state, ae_true); + xc = &_xc; + ae_vector_init_copy(&_yc, yc, _state, ae_true); + yc = &_yc; + *info = 0; + _barycentricinterpolant_clear(p); + _polynomialfitreport_clear(rep); + ae_vector_init(&xoriginal, 0, DT_REAL, _state, ae_true); + ae_vector_init(&yoriginal, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&by, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bw, 0, DT_REAL, _state, ae_true); + _lsfitreport_init(&lrep, _state, ae_true); + + ae_assert(n>0, "PolynomialFitWC: N<=0!", _state); + ae_assert(m>0, "PolynomialFitWC: M<=0!", _state); + ae_assert(k>=0, "PolynomialFitWC: K<0!", _state); + ae_assert(k=M!", _state); + ae_assert(x->cnt>=n, "PolynomialFitWC: Length(X)cnt>=n, "PolynomialFitWC: Length(Y)cnt>=n, "PolynomialFitWC: Length(W)cnt>=k, "PolynomialFitWC: Length(XC)cnt>=k, "PolynomialFitWC: Length(YC)cnt>=k, "PolynomialFitWC: Length(DC)ptr.p_int[i]==0||dc->ptr.p_int[i]==1, "PolynomialFitWC: one of DC[] is not 0 or 1!", _state); + } + + /* + * Scale X, Y, XC, YC. + * Solve scaled problem using internal Chebyshev fitting function. + */ + lsfitscalexy(x, y, w, n, xc, yc, dc, k, &xa, &xb, &sa, &sb, &xoriginal, &yoriginal, _state); + lsfit_internalchebyshevfit(x, y, w, n, xc, yc, dc, k, m, info, &tmp, &lrep, _state); + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Generate barycentric model and scale it + * * BX, BY store barycentric model nodes + * * FMatrix is reused (remember - it is at least MxM, what we need) + * + * Model intialization is done in O(M^2). In principle, it can be + * done in O(M*log(M)), but before it we solved task with O(N*M^2) + * complexity, so it is only a small amount of total time spent. + */ + ae_vector_set_length(&bx, m, _state); + ae_vector_set_length(&by, m, _state); + ae_vector_set_length(&bw, m, _state); + ae_vector_set_length(&tmp2, m, _state); + s = 1; + for(i=0; i<=m-1; i++) + { + if( m!=1 ) + { + u = ae_cos(ae_pi*i/(m-1), _state); + } + else + { + u = 0; + } + v = 0; + for(j=0; j<=m-1; j++) + { + if( j==0 ) + { + tmp2.ptr.p_double[j] = 1; + } + else + { + if( j==1 ) + { + tmp2.ptr.p_double[j] = u; + } + else + { + tmp2.ptr.p_double[j] = 2*u*tmp2.ptr.p_double[j-1]-tmp2.ptr.p_double[j-2]; + } + } + v = v+tmp.ptr.p_double[j]*tmp2.ptr.p_double[j]; + } + bx.ptr.p_double[i] = u; + by.ptr.p_double[i] = v; + bw.ptr.p_double[i] = s; + if( i==0||i==m-1 ) + { + bw.ptr.p_double[i] = 0.5*bw.ptr.p_double[i]; + } + s = -s; + } + barycentricbuildxyw(&bx, &by, &bw, m, p, _state); + barycentriclintransx(p, 2/(xb-xa), -(xa+xb)/(xb-xa), _state); + barycentriclintransy(p, sb-sa, sa, _state); + + /* + * Scale absolute errors obtained from LSFitLinearW. + * Relative error should be calculated separately + * (because of shifting/scaling of the task) + */ + rep->taskrcond = lrep.taskrcond; + rep->rmserror = lrep.rmserror*(sb-sa); + rep->avgerror = lrep.avgerror*(sb-sa); + rep->maxerror = lrep.maxerror*(sb-sa); + rep->avgrelerror = 0; + relcnt = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(yoriginal.ptr.p_double[i],0) ) + { + rep->avgrelerror = rep->avgrelerror+ae_fabs(barycentriccalc(p, xoriginal.ptr.p_double[i], _state)-yoriginal.ptr.p_double[i], _state)/ae_fabs(yoriginal.ptr.p_double[i], _state); + relcnt = relcnt+1; + } + } + if( relcnt!=0 ) + { + rep->avgrelerror = rep->avgrelerror/relcnt; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Weghted rational least squares fitting using Floater-Hormann rational +functions with optimal D chosen from [0,9], with constraints and +individual weights. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least WEIGHTED root +mean square error) is chosen. Task is linear, so linear least squares +solver is used. Complexity of this computational scheme is O(N*M^2) +(mostly dominated by the least squares solver). + +SEE ALSO +* BarycentricFitFloaterHormann(), "lightweight" fitting without invididual + weights and constraints. + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points, N>0. + XC - points where function values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints, 0<=K=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + -1 means another errors in parameters passed + (N<=0, for example) + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroutine doesn't calculate task's condition number for K<>0. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained barycentric interpolants: +* excessive constraints can be inconsistent. Floater-Hormann basis + functions aren't as flexible as splines (although they are very smooth). +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints IS NOT GUARANTEED. +* in the several special cases, however, we CAN guarantee consistency. +* one of this cases is constraints on the function VALUES at the interval + boundaries. Note that consustency of the constraints on the function + DERIVATIVES is NOT guaranteed (you can use in such cases cubic splines + which are more flexible). +* another special case is ONE constraint on the function value (OR, but + not AND, derivative) anywhere in the interval + +Our final recommendation is to use constraints WHEN AND ONLY WHEN you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricfitfloaterhormannwc(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + barycentricinterpolant* b, + barycentricfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t d; + ae_int_t i; + double wrmscur; + double wrmsbest; + barycentricinterpolant locb; + barycentricfitreport locrep; + ae_int_t locinfo; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _barycentricinterpolant_clear(b); + _barycentricfitreport_clear(rep); + _barycentricinterpolant_init(&locb, _state, ae_true); + _barycentricfitreport_init(&locrep, _state, ae_true); + + ae_assert(n>0, "BarycentricFitFloaterHormannWC: N<=0!", _state); + ae_assert(m>0, "BarycentricFitFloaterHormannWC: M<=0!", _state); + ae_assert(k>=0, "BarycentricFitFloaterHormannWC: K<0!", _state); + ae_assert(k=M!", _state); + ae_assert(x->cnt>=n, "BarycentricFitFloaterHormannWC: Length(X)cnt>=n, "BarycentricFitFloaterHormannWC: Length(Y)cnt>=n, "BarycentricFitFloaterHormannWC: Length(W)cnt>=k, "BarycentricFitFloaterHormannWC: Length(XC)cnt>=k, "BarycentricFitFloaterHormannWC: Length(YC)cnt>=k, "BarycentricFitFloaterHormannWC: Length(DC)ptr.p_int[i]==0||dc->ptr.p_int[i]==1, "BarycentricFitFloaterHormannWC: one of DC[] is not 0 or 1!", _state); + } + + /* + * Find optimal D + * + * Info is -3 by default (degenerate constraints). + * If LocInfo will always be equal to -3, Info will remain equal to -3. + * If at least once LocInfo will be -4, Info will be -4. + */ + wrmsbest = ae_maxrealnumber; + rep->dbest = -1; + *info = -3; + for(d=0; d<=ae_minint(9, n-1, _state); d++) + { + lsfit_barycentricfitwcfixedd(x, y, w, n, xc, yc, dc, k, m, d, &locinfo, &locb, &locrep, _state); + ae_assert((locinfo==-4||locinfo==-3)||locinfo>0, "BarycentricFitFloaterHormannWC: unexpected result from BarycentricFitWCFixedD!", _state); + if( locinfo>0 ) + { + + /* + * Calculate weghted RMS + */ + wrmscur = 0; + for(i=0; i<=n-1; i++) + { + wrmscur = wrmscur+ae_sqr(w->ptr.p_double[i]*(y->ptr.p_double[i]-barycentriccalc(&locb, x->ptr.p_double[i], _state)), _state); + } + wrmscur = ae_sqrt(wrmscur/n, _state); + if( ae_fp_less(wrmscur,wrmsbest)||rep->dbest<0 ) + { + barycentriccopy(&locb, b, _state); + rep->dbest = d; + *info = 1; + rep->rmserror = locrep.rmserror; + rep->avgerror = locrep.avgerror; + rep->avgrelerror = locrep.avgrelerror; + rep->maxerror = locrep.maxerror; + rep->taskrcond = locrep.taskrcond; + wrmsbest = wrmscur; + } + } + else + { + if( locinfo!=-3&&*info<0 ) + { + *info = locinfo; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Rational least squares fitting using Floater-Hormann rational functions +with optimal D chosen from [0,9]. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least root mean +square error) is chosen. Task is linear, so linear least squares solver +is used. Complexity of this computational scheme is O(N*M^2) (mostly +dominated by the least squares solver). + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0. + M - number of basis functions ( = number_of_nodes), M>=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricfitfloaterhormann(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + barycentricinterpolant* b, + barycentricfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector w; + ae_vector xc; + ae_vector yc; + ae_vector dc; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _barycentricinterpolant_clear(b); + _barycentricfitreport_clear(rep); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&yc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dc, 0, DT_INT, _state, ae_true); + + ae_assert(n>0, "BarycentricFitFloaterHormann: N<=0!", _state); + ae_assert(m>0, "BarycentricFitFloaterHormann: M<=0!", _state); + ae_assert(x->cnt>=n, "BarycentricFitFloaterHormann: Length(X)cnt>=n, "BarycentricFitFloaterHormann: Length(Y)0. + M - number of basis functions ( = number_of_nodes), M>=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitpenalized(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + double rho, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector w; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + *info = 0; + _spline1dinterpolant_clear(s); + _spline1dfitreport_clear(rep); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "Spline1DFitPenalized: N<1!", _state); + ae_assert(m>=4, "Spline1DFitPenalized: M<4!", _state); + ae_assert(x->cnt>=n, "Spline1DFitPenalized: Length(X)cnt>=n, "Spline1DFitPenalized: Length(Y)0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + M - number of basis functions ( = number_of_nodes), M>=4. + Rho - regularization constant passed by user. It penalizes + nonlinearity in the regression spline. It is logarithmically + scaled, i.e. actual value of regularization constant is + calculated as 10^Rho. It is automatically scaled so that: + * Rho=2.0 corresponds to moderate amount of nonlinearity + * generally, it should be somewhere in the [-8.0,+8.0] + If you do not want to penalize nonlineary, + pass small Rho. Values as low as -15 should work. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD or + Cholesky decomposition; problem may be + too ill-conditioned (very rare) + S - spline interpolant. + Rep - Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +NOTE 1: additional nodes are added to the spline outside of the fitting +interval to force linearity when xmax(x,xc). It is done +for consistency - we penalize non-linearity at [min(x,xc),max(x,xc)], so +it is natural to force linearity outside of this interval. + +NOTE 2: function automatically sorts points, so caller may pass unsorted +array. + + -- ALGLIB PROJECT -- + Copyright 19.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitpenalizedw(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + ae_int_t m, + double rho, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector _w; + ae_int_t i; + ae_int_t j; + ae_int_t b; + double v; + double relcnt; + double xa; + double xb; + double sa; + double sb; + ae_vector xoriginal; + ae_vector yoriginal; + double pdecay; + double tdecay; + ae_matrix fmatrix; + ae_vector fcolumn; + ae_vector y2; + ae_vector w2; + ae_vector xc; + ae_vector yc; + ae_vector dc; + double fdmax; + double admax; + ae_matrix amatrix; + ae_matrix d2matrix; + double fa; + double ga; + double fb; + double gb; + double lambdav; + ae_vector bx; + ae_vector by; + ae_vector bd1; + ae_vector bd2; + ae_vector tx; + ae_vector ty; + ae_vector td; + spline1dinterpolant bs; + ae_matrix nmatrix; + ae_vector rightpart; + fblslincgstate cgstate; + ae_vector c; + ae_vector tmp0; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_init_copy(&_w, w, _state, ae_true); + w = &_w; + *info = 0; + _spline1dinterpolant_clear(s); + _spline1dfitreport_clear(rep); + ae_vector_init(&xoriginal, 0, DT_REAL, _state, ae_true); + ae_vector_init(&yoriginal, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&fcolumn, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&yc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dc, 0, DT_INT, _state, ae_true); + ae_matrix_init(&amatrix, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&d2matrix, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&by, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bd1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bd2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ty, 0, DT_REAL, _state, ae_true); + ae_vector_init(&td, 0, DT_REAL, _state, ae_true); + _spline1dinterpolant_init(&bs, _state, ae_true); + ae_matrix_init(&nmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&rightpart, 0, DT_REAL, _state, ae_true); + _fblslincgstate_init(&cgstate, _state, ae_true); + ae_vector_init(&c, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp0, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "Spline1DFitPenalizedW: N<1!", _state); + ae_assert(m>=4, "Spline1DFitPenalizedW: M<4!", _state); + ae_assert(x->cnt>=n, "Spline1DFitPenalizedW: Length(X)cnt>=n, "Spline1DFitPenalizedW: Length(Y)cnt>=n, "Spline1DFitPenalizedW: Length(W)ptr.p_double[i]*fcolumn.ptr.p_double[i], _state); + } + fdmax = ae_maxreal(fdmax, v, _state); + + /* + * Fill temporary with second derivatives of basis function + */ + ae_v_move(&d2matrix.ptr.pp_double[b][0], 1, &bd2.ptr.p_double[0], 1, ae_v_len(0,m-1)); + } + + /* + * * calculate penalty matrix A + * * calculate max of diagonal elements of A + * * calculate PDecay - coefficient before penalty matrix + */ + for(i=0; i<=m-1; i++) + { + for(j=i; j<=m-1; j++) + { + + /* + * calculate integral(B_i''*B_j'') where B_i and B_j are + * i-th and j-th basis splines. + * B_i and B_j are piecewise linear functions. + */ + v = 0; + for(b=0; b<=m-2; b++) + { + fa = d2matrix.ptr.pp_double[i][b]; + fb = d2matrix.ptr.pp_double[i][b+1]; + ga = d2matrix.ptr.pp_double[j][b]; + gb = d2matrix.ptr.pp_double[j][b+1]; + v = v+(bx.ptr.p_double[b+1]-bx.ptr.p_double[b])*(fa*ga+(fa*(gb-ga)+ga*(fb-fa))/2+(fb-fa)*(gb-ga)/3); + } + amatrix.ptr.pp_double[i][j] = v; + amatrix.ptr.pp_double[j][i] = v; + } + } + admax = 0; + for(i=0; i<=m-1; i++) + { + admax = ae_maxreal(admax, ae_fabs(amatrix.ptr.pp_double[i][i], _state), _state); + } + pdecay = lambdav*fdmax/admax; + + /* + * Calculate TDecay for Tikhonov regularization + */ + tdecay = fdmax*(1+pdecay)*10*ae_machineepsilon; + + /* + * Prepare system + * + * NOTE: FMatrix is spoiled during this process + */ + for(i=0; i<=n-1; i++) + { + v = w->ptr.p_double[i]; + ae_v_muld(&fmatrix.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); + } + rmatrixgemm(m, m, n, 1.0, &fmatrix, 0, 0, 1, &fmatrix, 0, 0, 0, 0.0, &nmatrix, 0, 0, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=m-1; j++) + { + nmatrix.ptr.pp_double[i][j] = nmatrix.ptr.pp_double[i][j]+pdecay*amatrix.ptr.pp_double[i][j]; + } + } + for(i=0; i<=m-1; i++) + { + nmatrix.ptr.pp_double[i][i] = nmatrix.ptr.pp_double[i][i]+tdecay; + } + for(i=0; i<=m-1; i++) + { + rightpart.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + v = y->ptr.p_double[i]*w->ptr.p_double[i]; + ae_v_addd(&rightpart.ptr.p_double[0], 1, &fmatrix.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); + } + + /* + * Solve system + */ + if( !spdmatrixcholesky(&nmatrix, m, ae_true, _state) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + fblscholeskysolve(&nmatrix, 1.0, m, ae_true, &rightpart, &tmp0, _state); + ae_v_move(&c.ptr.p_double[0], 1, &rightpart.ptr.p_double[0], 1, ae_v_len(0,m-1)); + + /* + * add nodes to force linearity outside of the fitting interval + */ + spline1dgriddiffcubic(&bx, &c, m, 2, 0.0, 2, 0.0, &bd1, _state); + ae_vector_set_length(&tx, m+2, _state); + ae_vector_set_length(&ty, m+2, _state); + ae_vector_set_length(&td, m+2, _state); + ae_v_move(&tx.ptr.p_double[1], 1, &bx.ptr.p_double[0], 1, ae_v_len(1,m)); + ae_v_move(&ty.ptr.p_double[1], 1, &rightpart.ptr.p_double[0], 1, ae_v_len(1,m)); + ae_v_move(&td.ptr.p_double[1], 1, &bd1.ptr.p_double[0], 1, ae_v_len(1,m)); + tx.ptr.p_double[0] = tx.ptr.p_double[1]-(tx.ptr.p_double[2]-tx.ptr.p_double[1]); + ty.ptr.p_double[0] = ty.ptr.p_double[1]-td.ptr.p_double[1]*(tx.ptr.p_double[2]-tx.ptr.p_double[1]); + td.ptr.p_double[0] = td.ptr.p_double[1]; + tx.ptr.p_double[m+1] = tx.ptr.p_double[m]+(tx.ptr.p_double[m]-tx.ptr.p_double[m-1]); + ty.ptr.p_double[m+1] = ty.ptr.p_double[m]+td.ptr.p_double[m]*(tx.ptr.p_double[m]-tx.ptr.p_double[m-1]); + td.ptr.p_double[m+1] = td.ptr.p_double[m]; + spline1dbuildhermite(&tx, &ty, &td, m+2, s, _state); + spline1dlintransx(s, 2/(xb-xa), -(xa+xb)/(xb-xa), _state); + spline1dlintransy(s, sb-sa, sa, _state); + *info = 1; + + /* + * Fill report + */ + rep->rmserror = 0; + rep->avgerror = 0; + rep->avgrelerror = 0; + rep->maxerror = 0; + relcnt = 0; + spline1dconvcubic(&bx, &rightpart, m, 2, 0.0, 2, 0.0, x, n, &fcolumn, _state); + for(i=0; i<=n-1; i++) + { + v = (sb-sa)*fcolumn.ptr.p_double[i]+sa; + rep->rmserror = rep->rmserror+ae_sqr(v-yoriginal.ptr.p_double[i], _state); + rep->avgerror = rep->avgerror+ae_fabs(v-yoriginal.ptr.p_double[i], _state); + if( ae_fp_neq(yoriginal.ptr.p_double[i],0) ) + { + rep->avgrelerror = rep->avgrelerror+ae_fabs(v-yoriginal.ptr.p_double[i], _state)/ae_fabs(yoriginal.ptr.p_double[i], _state); + relcnt = relcnt+1; + } + rep->maxerror = ae_maxreal(rep->maxerror, ae_fabs(v-yoriginal.ptr.p_double[i], _state), _state); + } + rep->rmserror = ae_sqrt(rep->rmserror/n, _state); + rep->avgerror = rep->avgerror/n; + if( ae_fp_neq(relcnt,0) ) + { + rep->avgrelerror = rep->avgrelerror/relcnt; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Weighted fitting by cubic spline, with constraints on function values or +derivatives. + +Equidistant grid with M-2 nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are cubic splines with continuous second +derivatives and non-fixed first derivatives at interval ends. Small +regularizing term is used when solving constrained tasks (to improve +stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO + Spline1DFitHermiteWC() - fitting by Hermite splines (more flexible, + less smooth) + Spline1DFitCubic() - "lightweight" fitting by cubic splines, + without invididual weights and constraints + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + XC - points where spline values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints (optional): + * 0<=K=4. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + S - spline interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* excessive constraints can be inconsistent. Splines are piecewise cubic + functions, and it is easy to create an example, where large number of + constraints concentrated in small area will result in inconsistency. + Just because spline is not flexible enough to satisfy all of them. And + same constraints spread across the [min(x),max(x)] will be perfectly + consistent. +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints IS NOT GUARANTEED. +* in the several special cases, however, we CAN guarantee consistency. +* one of this cases is constraints on the function values AND/OR its + derivatives at the interval boundaries. +* another special case is ONE constraint on the function value (OR, but + not AND, derivative) anywhere in the interval + +Our final recommendation is to use constraints WHEN AND ONLY WHEN you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitcubicwc(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state) +{ + ae_int_t i; + + *info = 0; + _spline1dinterpolant_clear(s); + _spline1dfitreport_clear(rep); + + ae_assert(n>=1, "Spline1DFitCubicWC: N<1!", _state); + ae_assert(m>=4, "Spline1DFitCubicWC: M<4!", _state); + ae_assert(k>=0, "Spline1DFitCubicWC: K<0!", _state); + ae_assert(k=M!", _state); + ae_assert(x->cnt>=n, "Spline1DFitCubicWC: Length(X)cnt>=n, "Spline1DFitCubicWC: Length(Y)cnt>=n, "Spline1DFitCubicWC: Length(W)cnt>=k, "Spline1DFitCubicWC: Length(XC)cnt>=k, "Spline1DFitCubicWC: Length(YC)cnt>=k, "Spline1DFitCubicWC: Length(DC)ptr.p_int[i]==0||dc->ptr.p_int[i]==1, "Spline1DFitCubicWC: DC[i] is neither 0 or 1!", _state); + } + lsfit_spline1dfitinternal(0, x, y, w, n, xc, yc, dc, k, m, info, s, rep, _state); +} + + +/************************************************************************* +Weighted fitting by Hermite spline, with constraints on function values +or first derivatives. + +Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are Hermite splines. Small regularizing +term is used when solving constrained tasks (to improve stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO + Spline1DFitCubicWC() - fitting by Cubic splines (less flexible, + more smooth) + Spline1DFitHermite() - "lightweight" Hermite fitting, without + invididual weights and constraints + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + XC - points where spline values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints (optional): + * 0<=K=4, + M IS EVEN! + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + -2 means odd M was passed (which is not supported) + -1 means another errors in parameters passed + (N<=0, for example) + S - spline interpolant. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +IMPORTANT: + this subroitine supports only even M's + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* excessive constraints can be inconsistent. Splines are piecewise cubic + functions, and it is easy to create an example, where large number of + constraints concentrated in small area will result in inconsistency. + Just because spline is not flexible enough to satisfy all of them. And + same constraints spread across the [min(x),max(x)] will be perfectly + consistent. +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints is NOT GUARANTEED. +* in the several special cases, however, we can guarantee consistency. +* one of this cases is M>=4 and constraints on the function value + (AND/OR its derivative) at the interval boundaries. +* another special case is M>=4 and ONE constraint on the function value + (OR, BUT NOT AND, derivative) anywhere in [min(x),max(x)] + +Our final recommendation is to use constraints WHEN AND ONLY when you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfithermitewc(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state) +{ + ae_int_t i; + + *info = 0; + _spline1dinterpolant_clear(s); + _spline1dfitreport_clear(rep); + + ae_assert(n>=1, "Spline1DFitHermiteWC: N<1!", _state); + ae_assert(m>=4, "Spline1DFitHermiteWC: M<4!", _state); + ae_assert(m%2==0, "Spline1DFitHermiteWC: M is odd!", _state); + ae_assert(k>=0, "Spline1DFitHermiteWC: K<0!", _state); + ae_assert(k=M!", _state); + ae_assert(x->cnt>=n, "Spline1DFitHermiteWC: Length(X)cnt>=n, "Spline1DFitHermiteWC: Length(Y)cnt>=n, "Spline1DFitHermiteWC: Length(W)cnt>=k, "Spline1DFitHermiteWC: Length(XC)cnt>=k, "Spline1DFitHermiteWC: Length(YC)cnt>=k, "Spline1DFitHermiteWC: Length(DC)ptr.p_int[i]==0||dc->ptr.p_int[i]==1, "Spline1DFitHermiteWC: DC[i] is neither 0 or 1!", _state); + } + lsfit_spline1dfitinternal(1, x, y, w, n, xc, yc, dc, k, m, info, s, rep, _state); +} + + +/************************************************************************* +Least squares fitting by cubic spline. + +This subroutine is "lightweight" alternative for more complex and feature- +rich Spline1DFitCubicWC(). See Spline1DFitCubicWC() for more information +about subroutine parameters (we don't duplicate it here because of length) + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector w; + ae_vector xc; + ae_vector yc; + ae_vector dc; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _spline1dinterpolant_clear(s); + _spline1dfitreport_clear(rep); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&yc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dc, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "Spline1DFitCubic: N<1!", _state); + ae_assert(m>=4, "Spline1DFitCubic: M<4!", _state); + ae_assert(x->cnt>=n, "Spline1DFitCubic: Length(X)cnt>=n, "Spline1DFitCubic: Length(Y)=1, "Spline1DFitHermite: N<1!", _state); + ae_assert(m>=4, "Spline1DFitHermite: M<4!", _state); + ae_assert(m%2==0, "Spline1DFitHermite: M is odd!", _state); + ae_assert(x->cnt>=n, "Spline1DFitHermite: Length(X)cnt>=n, "Spline1DFitHermite: Length(Y)=1. + M - number of basis functions, M>=1. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -1 incorrect N/M were specified + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * Rep.TaskRCond reciprocal of condition number + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearw(/* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* fmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state) +{ + + *info = 0; + ae_vector_clear(c); + _lsfitreport_clear(rep); + + ae_assert(n>=1, "LSFitLinearW: N<1!", _state); + ae_assert(m>=1, "LSFitLinearW: M<1!", _state); + ae_assert(y->cnt>=n, "LSFitLinearW: length(Y)cnt>=n, "LSFitLinearW: length(W)rows>=n, "LSFitLinearW: rows(FMatrix)cols>=m, "LSFitLinearW: cols(FMatrix)=1. + M - number of basis functions, M>=1. + K - number of constraints, 0 <= K < M + K=0 corresponds to absence of constraints. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -3 either too many constraints (M or more), + degenerate constraints (some constraints are + repetead twice) or inconsistent constraints were + specified. + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 07.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearwc(/* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* fmatrix, + /* Real */ ae_matrix* cmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t k, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _y; + ae_matrix _cmatrix; + ae_int_t i; + ae_int_t j; + ae_vector tau; + ae_matrix q; + ae_matrix f2; + ae_vector tmp; + ae_vector c0; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_matrix_init_copy(&_cmatrix, cmatrix, _state, ae_true); + cmatrix = &_cmatrix; + *info = 0; + ae_vector_clear(c); + _lsfitreport_clear(rep); + ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&q, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&f2, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&c0, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "LSFitLinearWC: N<1!", _state); + ae_assert(m>=1, "LSFitLinearWC: M<1!", _state); + ae_assert(k>=0, "LSFitLinearWC: K<0!", _state); + ae_assert(y->cnt>=n, "LSFitLinearWC: length(Y)cnt>=n, "LSFitLinearWC: length(W)rows>=n, "LSFitLinearWC: rows(FMatrix)cols>=m, "LSFitLinearWC: cols(FMatrix)rows>=k, "LSFitLinearWC: rows(CMatrix)cols>=m+1||k==0, "LSFitLinearWC: cols(CMatrix)=m ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Solve + */ + if( k==0 ) + { + + /* + * no constraints + */ + lsfit_lsfitlinearinternal(y, w, fmatrix, n, m, info, c, rep, _state); + } + else + { + + /* + * First, find general form solution of constraints system: + * * factorize C = L*Q + * * unpack Q + * * fill upper part of C with zeros (for RCond) + * + * We got C=C0+Q2'*y where Q2 is lower M-K rows of Q. + */ + rmatrixlq(cmatrix, k, m, &tau, _state); + rmatrixlqunpackq(cmatrix, k, m, &tau, m, &q, _state); + for(i=0; i<=k-1; i++) + { + for(j=i+1; j<=m-1; j++) + { + cmatrix->ptr.pp_double[i][j] = 0.0; + } + } + if( ae_fp_less(rmatrixlurcondinf(cmatrix, k, _state),1000*ae_machineepsilon) ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&tmp, k, _state); + for(i=0; i<=k-1; i++) + { + if( i>0 ) + { + v = ae_v_dotproduct(&cmatrix->ptr.pp_double[i][0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,i-1)); + } + else + { + v = 0; + } + tmp.ptr.p_double[i] = (cmatrix->ptr.pp_double[i][m]-v)/cmatrix->ptr.pp_double[i][i]; + } + ae_vector_set_length(&c0, m, _state); + for(i=0; i<=m-1; i++) + { + c0.ptr.p_double[i] = 0; + } + for(i=0; i<=k-1; i++) + { + v = tmp.ptr.p_double[i]; + ae_v_addd(&c0.ptr.p_double[0], 1, &q.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); + } + + /* + * Second, prepare modified matrix F2 = F*Q2' and solve modified task + */ + ae_vector_set_length(&tmp, ae_maxint(n, m, _state)+1, _state); + ae_matrix_set_length(&f2, n, m-k, _state); + matrixvectormultiply(fmatrix, 0, n-1, 0, m-1, ae_false, &c0, 0, m-1, -1.0, y, 0, n-1, 1.0, _state); + matrixmatrixmultiply(fmatrix, 0, n-1, 0, m-1, ae_false, &q, k, m-1, 0, m-1, ae_true, 1.0, &f2, 0, n-1, 0, m-k-1, 0.0, &tmp, _state); + lsfit_lsfitlinearinternal(y, w, &f2, n, m-k, info, &tmp, rep, _state); + rep->taskrcond = -1; + if( *info<=0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * then, convert back to original answer: C = C0 + Q2'*Y0 + */ + ae_vector_set_length(c, m, _state); + ae_v_move(&c->ptr.p_double[0], 1, &c0.ptr.p_double[0], 1, ae_v_len(0,m-1)); + matrixvectormultiply(&q, k, m-1, 0, m-1, ae_true, &tmp, 0, m-k-1, 1.0, c, 0, m-1, 1.0, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Linear least squares fitting. + +QR decomposition is used to reduce task to MxM, then triangular solver or +SVD-based solver is used depending on condition number of the system. It +allows to maximize speed and retain decent accuracy. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I, J] - value of J-th basis function in I-th point. + N - number of points used. N>=1. + M - number of basis functions, M>=1. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * Rep.TaskRCond reciprocal of condition number + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinear(/* Real */ ae_vector* y, + /* Real */ ae_matrix* fmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector w; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(c); + _lsfitreport_clear(rep); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "LSFitLinear: N<1!", _state); + ae_assert(m>=1, "LSFitLinear: M<1!", _state); + ae_assert(y->cnt>=n, "LSFitLinear: length(Y)rows>=n, "LSFitLinear: rows(FMatrix)cols>=m, "LSFitLinear: cols(FMatrix)=1. + M - number of basis functions, M>=1. + K - number of constraints, 0 <= K < M + K=0 corresponds to absence of constraints. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -3 either too many constraints (M or more), + degenerate constraints (some constraints are + repetead twice) or inconsistent constraints were + specified. + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 07.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearc(/* Real */ ae_vector* y, + /* Real */ ae_matrix* fmatrix, + /* Real */ ae_matrix* cmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t k, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _y; + ae_vector w; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + *info = 0; + ae_vector_clear(c); + _lsfitreport_clear(rep); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "LSFitLinearC: N<1!", _state); + ae_assert(m>=1, "LSFitLinearC: M<1!", _state); + ae_assert(k>=0, "LSFitLinearC: K<0!", _state); + ae_assert(y->cnt>=n, "LSFitLinearC: length(Y)rows>=n, "LSFitLinearC: rows(FMatrix)cols>=m, "LSFitLinearC: cols(FMatrix)rows>=k, "LSFitLinearC: rows(CMatrix)cols>=m+1||k==0, "LSFitLinearC: cols(CMatrix)1 + M - dimension of space + K - number of parameters being fitted + DiffStep- numerical differentiation step; + should not be very small or large; + large = loss of accuracy + small = growth of round-off errors + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 18.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewf(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + double diffstep, + lsfitstate* state, + ae_state *_state) +{ + ae_int_t i; + + _lsfitstate_clear(state); + + ae_assert(n>=1, "LSFitCreateWF: N<1!", _state); + ae_assert(m>=1, "LSFitCreateWF: M<1!", _state); + ae_assert(k>=1, "LSFitCreateWF: K<1!", _state); + ae_assert(c->cnt>=k, "LSFitCreateWF: length(C)cnt>=n, "LSFitCreateWF: length(Y)cnt>=n, "LSFitCreateWF: length(W)rows>=n, "LSFitCreateWF: rows(X)cols>=m, "LSFitCreateWF: cols(X)teststep = 0; + state->diffstep = diffstep; + state->npoints = n; + state->nweights = n; + state->wkind = 1; + state->m = m; + state->k = k; + lsfitsetcond(state, 0.0, 0.0, 0, _state); + lsfitsetstpmax(state, 0.0, _state); + lsfitsetxrep(state, ae_false, _state); + ae_matrix_set_length(&state->taskx, n, m, _state); + ae_vector_set_length(&state->tasky, n, _state); + ae_vector_set_length(&state->taskw, n, _state); + ae_vector_set_length(&state->c, k, _state); + ae_vector_set_length(&state->x, m, _state); + ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->taskw.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; + } + ae_vector_set_length(&state->s, k, _state); + ae_vector_set_length(&state->bndl, k, _state); + ae_vector_set_length(&state->bndu, k, _state); + for(i=0; i<=k-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->bndu.ptr.p_double[i] = _state->v_posinf; + } + state->optalgo = 0; + state->prevnpt = -1; + state->prevalgo = -1; + minlmcreatev(k, n, &state->c, diffstep, &state->optstate, _state); + lsfit_lsfitclearrequestfields(state, _state); + ae_vector_set_length(&state->rstate.ia, 6+1, _state); + ae_vector_set_length(&state->rstate.ra, 8+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Nonlinear least squares fitting using function values only. + +Combination of numerical differentiation and secant updates is used to +obtain function Jacobian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (f(c,x[0])-y[0])^2 + ... + (f(c,x[n-1])-y[n-1])^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]). + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + DiffStep- numerical differentiation step; + should not be very small or large; + large = loss of accuracy + small = growth of round-off errors + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 18.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatef(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + double diffstep, + lsfitstate* state, + ae_state *_state) +{ + ae_int_t i; + + _lsfitstate_clear(state); + + ae_assert(n>=1, "LSFitCreateF: N<1!", _state); + ae_assert(m>=1, "LSFitCreateF: M<1!", _state); + ae_assert(k>=1, "LSFitCreateF: K<1!", _state); + ae_assert(c->cnt>=k, "LSFitCreateF: length(C)cnt>=n, "LSFitCreateF: length(Y)rows>=n, "LSFitCreateF: rows(X)cols>=m, "LSFitCreateF: cols(X)rows>=n, "LSFitCreateF: rows(X)cols>=m, "LSFitCreateF: cols(X)teststep = 0; + state->diffstep = diffstep; + state->npoints = n; + state->wkind = 0; + state->m = m; + state->k = k; + lsfitsetcond(state, 0.0, 0.0, 0, _state); + lsfitsetstpmax(state, 0.0, _state); + lsfitsetxrep(state, ae_false, _state); + ae_matrix_set_length(&state->taskx, n, m, _state); + ae_vector_set_length(&state->tasky, n, _state); + ae_vector_set_length(&state->c, k, _state); + ae_vector_set_length(&state->x, m, _state); + ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); + for(i=0; i<=n-1; i++) + { + ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; + } + ae_vector_set_length(&state->s, k, _state); + ae_vector_set_length(&state->bndl, k, _state); + ae_vector_set_length(&state->bndu, k, _state); + for(i=0; i<=k-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->bndu.ptr.p_double[i] = _state->v_posinf; + } + state->optalgo = 0; + state->prevnpt = -1; + state->prevalgo = -1; + minlmcreatev(k, n, &state->c, diffstep, &state->optstate, _state); + lsfit_lsfitclearrequestfields(state, _state); + ae_vector_set_length(&state->rstate.ia, 6+1, _state); + ae_vector_set_length(&state->rstate.ra, 8+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Weighted nonlinear least squares fitting using gradient only. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]) and its gradient. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + CheapFG - boolean flag, which is: + * True if both function and gradient calculation complexity + are less than O(M^2). An improved algorithm can + be used which corresponds to FGJ scheme from + MINLM unit. + * False otherwise. + Standard Jacibian-bases Levenberg-Marquardt algo + will be used (FJ scheme). + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +See also: + LSFitResults + LSFitCreateFG (fitting without weights) + LSFitCreateWFGH (fitting using Hessian) + LSFitCreateFGH (fitting using Hessian, without weights) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewfg(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + ae_bool cheapfg, + lsfitstate* state, + ae_state *_state) +{ + ae_int_t i; + + _lsfitstate_clear(state); + + ae_assert(n>=1, "LSFitCreateWFG: N<1!", _state); + ae_assert(m>=1, "LSFitCreateWFG: M<1!", _state); + ae_assert(k>=1, "LSFitCreateWFG: K<1!", _state); + ae_assert(c->cnt>=k, "LSFitCreateWFG: length(C)cnt>=n, "LSFitCreateWFG: length(Y)cnt>=n, "LSFitCreateWFG: length(W)rows>=n, "LSFitCreateWFG: rows(X)cols>=m, "LSFitCreateWFG: cols(X)teststep = 0; + state->diffstep = 0; + state->npoints = n; + state->nweights = n; + state->wkind = 1; + state->m = m; + state->k = k; + lsfitsetcond(state, 0.0, 0.0, 0, _state); + lsfitsetstpmax(state, 0.0, _state); + lsfitsetxrep(state, ae_false, _state); + ae_matrix_set_length(&state->taskx, n, m, _state); + ae_vector_set_length(&state->tasky, n, _state); + ae_vector_set_length(&state->taskw, n, _state); + ae_vector_set_length(&state->c, k, _state); + ae_vector_set_length(&state->x, m, _state); + ae_vector_set_length(&state->g, k, _state); + ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->taskw.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; + } + ae_vector_set_length(&state->s, k, _state); + ae_vector_set_length(&state->bndl, k, _state); + ae_vector_set_length(&state->bndu, k, _state); + for(i=0; i<=k-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->bndu.ptr.p_double[i] = _state->v_posinf; + } + state->optalgo = 1; + state->prevnpt = -1; + state->prevalgo = -1; + if( cheapfg ) + { + minlmcreatevgj(k, n, &state->c, &state->optstate, _state); + } + else + { + minlmcreatevj(k, n, &state->c, &state->optstate, _state); + } + lsfit_lsfitclearrequestfields(state, _state); + ae_vector_set_length(&state->rstate.ia, 6+1, _state); + ae_vector_set_length(&state->rstate.ra, 8+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Nonlinear least squares fitting using gradient only, without individual +weights. + +Nonlinear task min(F(c)) is solved, where + + F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]) and its gradient. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + CheapFG - boolean flag, which is: + * True if both function and gradient calculation complexity + are less than O(M^2). An improved algorithm can + be used which corresponds to FGJ scheme from + MINLM unit. + * False otherwise. + Standard Jacibian-bases Levenberg-Marquardt algo + will be used (FJ scheme). + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatefg(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + ae_bool cheapfg, + lsfitstate* state, + ae_state *_state) +{ + ae_int_t i; + + _lsfitstate_clear(state); + + ae_assert(n>=1, "LSFitCreateFG: N<1!", _state); + ae_assert(m>=1, "LSFitCreateFG: M<1!", _state); + ae_assert(k>=1, "LSFitCreateFG: K<1!", _state); + ae_assert(c->cnt>=k, "LSFitCreateFG: length(C)cnt>=n, "LSFitCreateFG: length(Y)rows>=n, "LSFitCreateFG: rows(X)cols>=m, "LSFitCreateFG: cols(X)rows>=n, "LSFitCreateFG: rows(X)cols>=m, "LSFitCreateFG: cols(X)teststep = 0; + state->diffstep = 0; + state->npoints = n; + state->wkind = 0; + state->m = m; + state->k = k; + lsfitsetcond(state, 0.0, 0.0, 0, _state); + lsfitsetstpmax(state, 0.0, _state); + lsfitsetxrep(state, ae_false, _state); + ae_matrix_set_length(&state->taskx, n, m, _state); + ae_vector_set_length(&state->tasky, n, _state); + ae_vector_set_length(&state->c, k, _state); + ae_vector_set_length(&state->x, m, _state); + ae_vector_set_length(&state->g, k, _state); + ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); + for(i=0; i<=n-1; i++) + { + ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; + } + ae_vector_set_length(&state->s, k, _state); + ae_vector_set_length(&state->bndl, k, _state); + ae_vector_set_length(&state->bndu, k, _state); + for(i=0; i<=k-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->bndu.ptr.p_double[i] = _state->v_posinf; + } + state->optalgo = 1; + state->prevnpt = -1; + state->prevalgo = -1; + if( cheapfg ) + { + minlmcreatevgj(k, n, &state->c, &state->optstate, _state); + } + else + { + minlmcreatevj(k, n, &state->c, &state->optstate, _state); + } + lsfit_lsfitclearrequestfields(state, _state); + ae_vector_set_length(&state->rstate.ia, 6+1, _state); + ae_vector_set_length(&state->rstate.ra, 8+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Weighted nonlinear least squares fitting using gradient/Hessian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses f(c,x[i]), its gradient and its Hessian. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewfgh(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + lsfitstate* state, + ae_state *_state) +{ + ae_int_t i; + + _lsfitstate_clear(state); + + ae_assert(n>=1, "LSFitCreateWFGH: N<1!", _state); + ae_assert(m>=1, "LSFitCreateWFGH: M<1!", _state); + ae_assert(k>=1, "LSFitCreateWFGH: K<1!", _state); + ae_assert(c->cnt>=k, "LSFitCreateWFGH: length(C)cnt>=n, "LSFitCreateWFGH: length(Y)cnt>=n, "LSFitCreateWFGH: length(W)rows>=n, "LSFitCreateWFGH: rows(X)cols>=m, "LSFitCreateWFGH: cols(X)teststep = 0; + state->diffstep = 0; + state->npoints = n; + state->nweights = n; + state->wkind = 1; + state->m = m; + state->k = k; + lsfitsetcond(state, 0.0, 0.0, 0, _state); + lsfitsetstpmax(state, 0.0, _state); + lsfitsetxrep(state, ae_false, _state); + ae_matrix_set_length(&state->taskx, n, m, _state); + ae_vector_set_length(&state->tasky, n, _state); + ae_vector_set_length(&state->taskw, n, _state); + ae_vector_set_length(&state->c, k, _state); + ae_matrix_set_length(&state->h, k, k, _state); + ae_vector_set_length(&state->x, m, _state); + ae_vector_set_length(&state->g, k, _state); + ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->taskw.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; + } + ae_vector_set_length(&state->s, k, _state); + ae_vector_set_length(&state->bndl, k, _state); + ae_vector_set_length(&state->bndu, k, _state); + for(i=0; i<=k-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->bndu.ptr.p_double[i] = _state->v_posinf; + } + state->optalgo = 2; + state->prevnpt = -1; + state->prevalgo = -1; + minlmcreatefgh(k, &state->c, &state->optstate, _state); + lsfit_lsfitclearrequestfields(state, _state); + ae_vector_set_length(&state->rstate.ia, 6+1, _state); + ae_vector_set_length(&state->rstate.ra, 8+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Nonlinear least squares fitting using gradient/Hessian, without individial +weights. + +Nonlinear task min(F(c)) is solved, where + + F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses f(c,x[i]), its gradient and its Hessian. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatefgh(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + lsfitstate* state, + ae_state *_state) +{ + ae_int_t i; + + _lsfitstate_clear(state); + + ae_assert(n>=1, "LSFitCreateFGH: N<1!", _state); + ae_assert(m>=1, "LSFitCreateFGH: M<1!", _state); + ae_assert(k>=1, "LSFitCreateFGH: K<1!", _state); + ae_assert(c->cnt>=k, "LSFitCreateFGH: length(C)cnt>=n, "LSFitCreateFGH: length(Y)rows>=n, "LSFitCreateFGH: rows(X)cols>=m, "LSFitCreateFGH: cols(X)teststep = 0; + state->diffstep = 0; + state->npoints = n; + state->wkind = 0; + state->m = m; + state->k = k; + lsfitsetcond(state, 0.0, 0.0, 0, _state); + lsfitsetstpmax(state, 0.0, _state); + lsfitsetxrep(state, ae_false, _state); + ae_matrix_set_length(&state->taskx, n, m, _state); + ae_vector_set_length(&state->tasky, n, _state); + ae_vector_set_length(&state->c, k, _state); + ae_matrix_set_length(&state->h, k, k, _state); + ae_vector_set_length(&state->x, m, _state); + ae_vector_set_length(&state->g, k, _state); + ae_v_move(&state->c.ptr.p_double[0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,k-1)); + for(i=0; i<=n-1; i++) + { + ae_v_move(&state->taskx.ptr.pp_double[i][0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->tasky.ptr.p_double[i] = y->ptr.p_double[i]; + } + ae_vector_set_length(&state->s, k, _state); + ae_vector_set_length(&state->bndl, k, _state); + ae_vector_set_length(&state->bndu, k, _state); + for(i=0; i<=k-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->bndu.ptr.p_double[i] = _state->v_posinf; + } + state->optalgo = 2; + state->prevnpt = -1; + state->prevalgo = -1; + minlmcreatefgh(k, &state->c, &state->optstate, _state); + lsfit_lsfitclearrequestfields(state, _state); + ae_vector_set_length(&state->rstate.ia, 6+1, _state); + ae_vector_set_length(&state->rstate.ra, 8+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Stopping conditions for nonlinear least squares fitting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsF - stopping criterion. Algorithm stops if + |F(k+1)-F(k)| <= EpsF*max{|F(k)|, |F(k+1)|, 1} + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by LSFitSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. Only Levenberg-Marquardt + iterations are counted (L-BFGS/CG iterations are NOT + counted because their cost is very low compared to that of + LM). + +NOTE + +Passing EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to automatic +stopping criterion selection (according to the scheme used by MINLM unit). + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetcond(lsfitstate* state, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsf, _state), "LSFitSetCond: EpsF is not finite!", _state); + ae_assert(ae_fp_greater_eq(epsf,0), "LSFitSetCond: negative EpsF!", _state); + ae_assert(ae_isfinite(epsx, _state), "LSFitSetCond: EpsX is not finite!", _state); + ae_assert(ae_fp_greater_eq(epsx,0), "LSFitSetCond: negative EpsX!", _state); + ae_assert(maxits>=0, "LSFitSetCond: negative MaxIts!", _state); + state->epsf = epsf; + state->epsx = epsx; + state->maxits = maxits; +} + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + +NOTE: non-zero StpMax leads to moderate performance degradation because +intermediate step of preconditioned L-BFGS optimization is incompatible +with limits on step size. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetstpmax(lsfitstate* state, double stpmax, ae_state *_state) +{ + + + ae_assert(ae_fp_greater_eq(stpmax,0), "LSFitSetStpMax: StpMax<0!", _state); + state->stpmax = stpmax; +} + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +When reports are needed, State.C (current parameters) and State.F (current +value of fitting function) are reported. + + + -- ALGLIB -- + Copyright 15.08.2010 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetxrep(lsfitstate* state, ae_bool needxrep, ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +This function sets scaling coefficients for underlying optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Generally, scale is NOT considered to be a form of preconditioner. But LM +optimizer is unique in that it uses scaling matrix both in the stopping +condition tests and as Marquardt damping factor. + +Proper scaling is very important for the algorithm performance. It is less +important for the quality of results, but still has some influence (it is +easier to converge when variables are properly scaled, so premature +stopping is possible when very badly scalled variables are combined with +relaxed stopping conditions). + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetscale(lsfitstate* state, + /* Real */ ae_vector* s, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(s->cnt>=state->k, "LSFitSetScale: Length(S)k-1; i++) + { + ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "LSFitSetScale: S contains infinite or NAN elements", _state); + ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "LSFitSetScale: S contains infinite or NAN elements", _state); + state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +This function sets boundary constraints for underlying optimizer + +Boundary constraints are inactive by default (after initial creation). +They are preserved until explicitly turned off with another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[K]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[K]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + +NOTE 2: unlike other constrained optimization algorithms, this solver has +following useful properties: +* bound constraints are always satisfied exactly +* function is evaluated only INSIDE area specified by bound constraints + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetbc(lsfitstate* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + + k = state->k; + ae_assert(bndl->cnt>=k, "LSFitSetBC: Length(BndL)cnt>=k, "LSFitSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "LSFitSetBC: BndL contains NAN or +INF", _state); + ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "LSFitSetBC: BndU contains NAN or -INF", _state); + if( ae_isfinite(bndl->ptr.p_double[i], _state)&&ae_isfinite(bndu->ptr.p_double[i], _state) ) + { + ae_assert(ae_fp_less_eq(bndl->ptr.p_double[i],bndu->ptr.p_double[i]), "LSFitSetBC: BndL[i]>BndU[i]", _state); + } + state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; + state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; + } +} + + +/************************************************************************* +NOTES: + +1. this algorithm is somewhat unusual because it works with parameterized + function f(C,X), where X is a function argument (we have many points + which are characterized by different argument values), and C is a + parameter to fit. + + For example, if we want to do linear fit by f(c0,c1,x) = c0*x+c1, then + x will be argument, and {c0,c1} will be parameters. + + It is important to understand that this algorithm finds minimum in the + space of function PARAMETERS (not arguments), so it needs derivatives + of f() with respect to C, not X. + + In the example above it will need f=c0*x+c1 and {df/dc0,df/dc1} = {x,1} + instead of {df/dx} = {c0}. + +2. Callback functions accept C as the first parameter, and X as the second + +3. If state was created with LSFitCreateFG(), algorithm needs just + function and its gradient, but if state was created with + LSFitCreateFGH(), algorithm will need function, gradient and Hessian. + + According to the said above, there ase several versions of this + function, which accept different sets of callbacks. + + This flexibility opens way to subtle errors - you may create state with + LSFitCreateFGH() (optimization using Hessian), but call function which + does not accept Hessian. So when algorithm will request Hessian, there + will be no callback to call. In this case exception will be thrown. + + Be careful to avoid such errors because there is no way to find them at + compile time - you can see them at runtime only. + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool lsfititeration(lsfitstate* state, ae_state *_state) +{ + double lx; + double lf; + double ld; + double rx; + double rf; + double rd; + ae_int_t n; + ae_int_t m; + ae_int_t k; + double v; + double vv; + double relcnt; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t info; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + m = state->rstate.ia.ptr.p_int[1]; + k = state->rstate.ia.ptr.p_int[2]; + i = state->rstate.ia.ptr.p_int[3]; + j = state->rstate.ia.ptr.p_int[4]; + j1 = state->rstate.ia.ptr.p_int[5]; + info = state->rstate.ia.ptr.p_int[6]; + lx = state->rstate.ra.ptr.p_double[0]; + lf = state->rstate.ra.ptr.p_double[1]; + ld = state->rstate.ra.ptr.p_double[2]; + rx = state->rstate.ra.ptr.p_double[3]; + rf = state->rstate.ra.ptr.p_double[4]; + rd = state->rstate.ra.ptr.p_double[5]; + v = state->rstate.ra.ptr.p_double[6]; + vv = state->rstate.ra.ptr.p_double[7]; + relcnt = state->rstate.ra.ptr.p_double[8]; + } + else + { + n = -983; + m = -989; + k = -834; + i = 900; + j = -287; + j1 = 364; + info = 214; + lx = -338; + lf = -686; + ld = 912; + rx = 585; + rf = 497; + rd = -271; + v = -581; + vv = 745; + relcnt = -533; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + if( state->rstate.stage==5 ) + { + goto lbl_5; + } + if( state->rstate.stage==6 ) + { + goto lbl_6; + } + if( state->rstate.stage==7 ) + { + goto lbl_7; + } + if( state->rstate.stage==8 ) + { + goto lbl_8; + } + if( state->rstate.stage==9 ) + { + goto lbl_9; + } + if( state->rstate.stage==10 ) + { + goto lbl_10; + } + if( state->rstate.stage==11 ) + { + goto lbl_11; + } + if( state->rstate.stage==12 ) + { + goto lbl_12; + } + if( state->rstate.stage==13 ) + { + goto lbl_13; + } + + /* + * Routine body + */ + + /* + * Init + */ + if( state->wkind==1 ) + { + ae_assert(state->npoints==state->nweights, "LSFitFit: number of points is not equal to the number of weights", _state); + } + state->repvaridx = -1; + n = state->npoints; + m = state->m; + k = state->k; + minlmsetcond(&state->optstate, 0.0, state->epsf, state->epsx, state->maxits, _state); + minlmsetstpmax(&state->optstate, state->stpmax, _state); + minlmsetxrep(&state->optstate, state->xrep, _state); + minlmsetscale(&state->optstate, &state->s, _state); + minlmsetbc(&state->optstate, &state->bndl, &state->bndu, _state); + + /* + * Check that user-supplied gradient is correct + */ + lsfit_lsfitclearrequestfields(state, _state); + if( !(ae_fp_greater(state->teststep,0)&&state->optalgo==1) ) + { + goto lbl_14; + } + for(i=0; i<=k-1; i++) + { + if( ae_isfinite(state->bndl.ptr.p_double[i], _state) ) + { + state->c.ptr.p_double[i] = ae_maxreal(state->c.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); + } + if( ae_isfinite(state->bndu.ptr.p_double[i], _state) ) + { + state->c.ptr.p_double[i] = ae_minreal(state->c.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + } + state->needfg = ae_true; + i = 0; +lbl_16: + if( i>k-1 ) + { + goto lbl_18; + } + ae_assert(ae_fp_less_eq(state->bndl.ptr.p_double[i],state->c.ptr.p_double[i])&&ae_fp_less_eq(state->c.ptr.p_double[i],state->bndu.ptr.p_double[i]), "LSFitIteration: internal error(State.C is out of bounds)", _state); + v = state->c.ptr.p_double[i]; + j = 0; +lbl_19: + if( j>n-1 ) + { + goto lbl_21; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[j][0], 1, ae_v_len(0,m-1)); + state->c.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; + if( ae_isfinite(state->bndl.ptr.p_double[i], _state) ) + { + state->c.ptr.p_double[i] = ae_maxreal(state->c.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); + } + lx = state->c.ptr.p_double[i]; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + lf = state->f; + ld = state->g.ptr.p_double[i]; + state->c.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; + if( ae_isfinite(state->bndu.ptr.p_double[i], _state) ) + { + state->c.ptr.p_double[i] = ae_minreal(state->c.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + rx = state->c.ptr.p_double[i]; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + rf = state->f; + rd = state->g.ptr.p_double[i]; + state->c.ptr.p_double[i] = (lx+rx)/2; + if( ae_isfinite(state->bndl.ptr.p_double[i], _state) ) + { + state->c.ptr.p_double[i] = ae_maxreal(state->c.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); + } + if( ae_isfinite(state->bndu.ptr.p_double[i], _state) ) + { + state->c.ptr.p_double[i] = ae_minreal(state->c.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + state->c.ptr.p_double[i] = v; + if( !derivativecheck(lf, ld, rf, rd, state->f, state->g.ptr.p_double[i], rx-lx, _state) ) + { + state->repvaridx = i; + state->repterminationtype = -7; + result = ae_false; + return result; + } + j = j+1; + goto lbl_19; +lbl_21: + i = i+1; + goto lbl_16; +lbl_18: + state->needfg = ae_false; +lbl_14: + + /* + * Fill WCur by weights: + * * for WKind=0 unit weights are chosen + * * for WKind=1 we use user-supplied weights stored in State.TaskW + */ + rvectorsetlengthatleast(&state->wcur, n, _state); + for(i=0; i<=n-1; i++) + { + state->wcur.ptr.p_double[i] = 1.0; + if( state->wkind==1 ) + { + state->wcur.ptr.p_double[i] = state->taskw.ptr.p_double[i]; + } + } + + /* + * Optimize + */ +lbl_22: + if( !minlmiteration(&state->optstate, _state) ) + { + goto lbl_23; + } + if( !state->optstate.needfi ) + { + goto lbl_24; + } + + /* + * calculate f[] = wi*(f(xi,c)-yi) + */ + i = 0; +lbl_26: + if( i>n-1 ) + { + goto lbl_28; + } + ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->pointindex = i; + lsfit_lsfitclearrequestfields(state, _state); + state->needf = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needf = ae_false; + vv = state->wcur.ptr.p_double[i]; + state->optstate.fi.ptr.p_double[i] = vv*(state->f-state->tasky.ptr.p_double[i]); + i = i+1; + goto lbl_26; +lbl_28: + goto lbl_22; +lbl_24: + if( !state->optstate.needf ) + { + goto lbl_29; + } + + /* + * calculate F = sum (wi*(f(xi,c)-yi))^2 + */ + state->optstate.f = 0; + i = 0; +lbl_31: + if( i>n-1 ) + { + goto lbl_33; + } + ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->pointindex = i; + lsfit_lsfitclearrequestfields(state, _state); + state->needf = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->needf = ae_false; + vv = state->wcur.ptr.p_double[i]; + state->optstate.f = state->optstate.f+ae_sqr(vv*(state->f-state->tasky.ptr.p_double[i]), _state); + i = i+1; + goto lbl_31; +lbl_33: + goto lbl_22; +lbl_29: + if( !state->optstate.needfg ) + { + goto lbl_34; + } + + /* + * calculate F/gradF + */ + state->optstate.f = 0; + for(i=0; i<=k-1; i++) + { + state->optstate.g.ptr.p_double[i] = 0; + } + i = 0; +lbl_36: + if( i>n-1 ) + { + goto lbl_38; + } + ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->pointindex = i; + lsfit_lsfitclearrequestfields(state, _state); + state->needfg = ae_true; + state->rstate.stage = 5; + goto lbl_rcomm; +lbl_5: + state->needfg = ae_false; + vv = state->wcur.ptr.p_double[i]; + state->optstate.f = state->optstate.f+ae_sqr(vv*(state->f-state->tasky.ptr.p_double[i]), _state); + v = ae_sqr(vv, _state)*2*(state->f-state->tasky.ptr.p_double[i]); + ae_v_addd(&state->optstate.g.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,k-1), v); + i = i+1; + goto lbl_36; +lbl_38: + goto lbl_22; +lbl_34: + if( !state->optstate.needfij ) + { + goto lbl_39; + } + + /* + * calculate Fi/jac(Fi) + */ + i = 0; +lbl_41: + if( i>n-1 ) + { + goto lbl_43; + } + ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->pointindex = i; + lsfit_lsfitclearrequestfields(state, _state); + state->needfg = ae_true; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->needfg = ae_false; + vv = state->wcur.ptr.p_double[i]; + state->optstate.fi.ptr.p_double[i] = vv*(state->f-state->tasky.ptr.p_double[i]); + ae_v_moved(&state->optstate.j.ptr.pp_double[i][0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,k-1), vv); + i = i+1; + goto lbl_41; +lbl_43: + goto lbl_22; +lbl_39: + if( !state->optstate.needfgh ) + { + goto lbl_44; + } + + /* + * calculate F/grad(F)/hess(F) + */ + state->optstate.f = 0; + for(i=0; i<=k-1; i++) + { + state->optstate.g.ptr.p_double[i] = 0; + } + for(i=0; i<=k-1; i++) + { + for(j=0; j<=k-1; j++) + { + state->optstate.h.ptr.pp_double[i][j] = 0; + } + } + i = 0; +lbl_46: + if( i>n-1 ) + { + goto lbl_48; + } + ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->pointindex = i; + lsfit_lsfitclearrequestfields(state, _state); + state->needfgh = ae_true; + state->rstate.stage = 7; + goto lbl_rcomm; +lbl_7: + state->needfgh = ae_false; + vv = state->wcur.ptr.p_double[i]; + state->optstate.f = state->optstate.f+ae_sqr(vv*(state->f-state->tasky.ptr.p_double[i]), _state); + v = ae_sqr(vv, _state)*2*(state->f-state->tasky.ptr.p_double[i]); + ae_v_addd(&state->optstate.g.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,k-1), v); + for(j=0; j<=k-1; j++) + { + v = 2*ae_sqr(vv, _state)*state->g.ptr.p_double[j]; + ae_v_addd(&state->optstate.h.ptr.pp_double[j][0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,k-1), v); + v = 2*ae_sqr(vv, _state)*(state->f-state->tasky.ptr.p_double[i]); + ae_v_addd(&state->optstate.h.ptr.pp_double[j][0], 1, &state->h.ptr.pp_double[j][0], 1, ae_v_len(0,k-1), v); + } + i = i+1; + goto lbl_46; +lbl_48: + goto lbl_22; +lbl_44: + if( !state->optstate.xupdated ) + { + goto lbl_49; + } + + /* + * Report new iteration + */ + ae_v_move(&state->c.ptr.p_double[0], 1, &state->optstate.x.ptr.p_double[0], 1, ae_v_len(0,k-1)); + state->f = state->optstate.f; + lsfit_lsfitclearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 8; + goto lbl_rcomm; +lbl_8: + state->xupdated = ae_false; + goto lbl_22; +lbl_49: + goto lbl_22; +lbl_23: + minlmresults(&state->optstate, &state->c, &state->optrep, _state); + state->repterminationtype = state->optrep.terminationtype; + state->repiterationscount = state->optrep.iterationscount; + + /* + * calculate errors + */ + if( state->repterminationtype<=0 ) + { + goto lbl_51; + } + + /* + * Calculate RMS/Avg/Max/... errors + */ + state->reprmserror = 0; + state->repwrmserror = 0; + state->repavgerror = 0; + state->repavgrelerror = 0; + state->repmaxerror = 0; + relcnt = 0; + i = 0; +lbl_53: + if( i>n-1 ) + { + goto lbl_55; + } + ae_v_move(&state->c.ptr.p_double[0], 1, &state->c.ptr.p_double[0], 1, ae_v_len(0,k-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->pointindex = i; + lsfit_lsfitclearrequestfields(state, _state); + state->needf = ae_true; + state->rstate.stage = 9; + goto lbl_rcomm; +lbl_9: + state->needf = ae_false; + v = state->f; + vv = state->wcur.ptr.p_double[i]; + state->reprmserror = state->reprmserror+ae_sqr(v-state->tasky.ptr.p_double[i], _state); + state->repwrmserror = state->repwrmserror+ae_sqr(vv*(v-state->tasky.ptr.p_double[i]), _state); + state->repavgerror = state->repavgerror+ae_fabs(v-state->tasky.ptr.p_double[i], _state); + if( ae_fp_neq(state->tasky.ptr.p_double[i],0) ) + { + state->repavgrelerror = state->repavgrelerror+ae_fabs(v-state->tasky.ptr.p_double[i], _state)/ae_fabs(state->tasky.ptr.p_double[i], _state); + relcnt = relcnt+1; + } + state->repmaxerror = ae_maxreal(state->repmaxerror, ae_fabs(v-state->tasky.ptr.p_double[i], _state), _state); + i = i+1; + goto lbl_53; +lbl_55: + state->reprmserror = ae_sqrt(state->reprmserror/n, _state); + state->repwrmserror = ae_sqrt(state->repwrmserror/n, _state); + state->repavgerror = state->repavgerror/n; + if( ae_fp_neq(relcnt,0) ) + { + state->repavgrelerror = state->repavgrelerror/relcnt; + } + + /* + * Calculate covariance matrix + */ + rmatrixsetlengthatleast(&state->tmpjac, n, k, _state); + rvectorsetlengthatleast(&state->tmpf, n, _state); + rvectorsetlengthatleast(&state->tmp, k, _state); + if( ae_fp_less_eq(state->diffstep,0) ) + { + goto lbl_56; + } + + /* + * Compute Jacobian by means of numerical differentiation + */ + lsfit_lsfitclearrequestfields(state, _state); + state->needf = ae_true; + i = 0; +lbl_58: + if( i>n-1 ) + { + goto lbl_60; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->pointindex = i; + state->rstate.stage = 10; + goto lbl_rcomm; +lbl_10: + state->tmpf.ptr.p_double[i] = state->f; + j = 0; +lbl_61: + if( j>k-1 ) + { + goto lbl_63; + } + v = state->c.ptr.p_double[j]; + lx = v-state->diffstep*state->s.ptr.p_double[j]; + state->c.ptr.p_double[j] = lx; + if( ae_isfinite(state->bndl.ptr.p_double[j], _state) ) + { + state->c.ptr.p_double[j] = ae_maxreal(state->c.ptr.p_double[j], state->bndl.ptr.p_double[j], _state); + } + state->rstate.stage = 11; + goto lbl_rcomm; +lbl_11: + lf = state->f; + rx = v+state->diffstep*state->s.ptr.p_double[j]; + state->c.ptr.p_double[j] = rx; + if( ae_isfinite(state->bndu.ptr.p_double[j], _state) ) + { + state->c.ptr.p_double[j] = ae_minreal(state->c.ptr.p_double[j], state->bndu.ptr.p_double[j], _state); + } + state->rstate.stage = 12; + goto lbl_rcomm; +lbl_12: + rf = state->f; + state->c.ptr.p_double[j] = v; + if( ae_fp_neq(rx,lx) ) + { + state->tmpjac.ptr.pp_double[i][j] = (rf-lf)/(rx-lx); + } + else + { + state->tmpjac.ptr.pp_double[i][j] = 0; + } + j = j+1; + goto lbl_61; +lbl_63: + i = i+1; + goto lbl_58; +lbl_60: + state->needf = ae_false; + goto lbl_57; +lbl_56: + + /* + * Jacobian is calculated with user-provided analytic gradient + */ + lsfit_lsfitclearrequestfields(state, _state); + state->needfg = ae_true; + i = 0; +lbl_64: + if( i>n-1 ) + { + goto lbl_66; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->taskx.ptr.pp_double[i][0], 1, ae_v_len(0,m-1)); + state->pointindex = i; + state->rstate.stage = 13; + goto lbl_rcomm; +lbl_13: + state->tmpf.ptr.p_double[i] = state->f; + for(j=0; j<=k-1; j++) + { + state->tmpjac.ptr.pp_double[i][j] = state->g.ptr.p_double[j]; + } + i = i+1; + goto lbl_64; +lbl_66: + state->needfg = ae_false; +lbl_57: + for(i=0; i<=k-1; i++) + { + state->tmp.ptr.p_double[i] = 0.0; + } + lsfit_estimateerrors(&state->tmpjac, &state->tmpf, &state->tasky, &state->wcur, &state->tmp, &state->s, n, k, &state->rep, &state->tmpjacw, 0, _state); +lbl_51: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = m; + state->rstate.ia.ptr.p_int[2] = k; + state->rstate.ia.ptr.p_int[3] = i; + state->rstate.ia.ptr.p_int[4] = j; + state->rstate.ia.ptr.p_int[5] = j1; + state->rstate.ia.ptr.p_int[6] = info; + state->rstate.ra.ptr.p_double[0] = lx; + state->rstate.ra.ptr.p_double[1] = lf; + state->rstate.ra.ptr.p_double[2] = ld; + state->rstate.ra.ptr.p_double[3] = rx; + state->rstate.ra.ptr.p_double[4] = rf; + state->rstate.ra.ptr.p_double[5] = rd; + state->rstate.ra.ptr.p_double[6] = v; + state->rstate.ra.ptr.p_double[7] = vv; + state->rstate.ra.ptr.p_double[8] = relcnt; + return result; +} + + +/************************************************************************* +Nonlinear least squares fitting results. + +Called after return from LSFitFit(). + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + Info - completion code: + * -7 gradient verification failed. + See LSFitSetGradientCheck() for more information. + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + C - array[0..K-1], solution + Rep - optimization report. On success following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + * WRMSError weighted rms error on the (X,Y). + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(J*CovPar*J')), + where J is Jacobian matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitresults(lsfitstate* state, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + *info = 0; + ae_vector_clear(c); + _lsfitreport_clear(rep); + + lsfit_clearreport(rep, _state); + *info = state->repterminationtype; + rep->varidx = state->repvaridx; + if( *info>0 ) + { + ae_vector_set_length(c, state->k, _state); + ae_v_move(&c->ptr.p_double[0], 1, &state->c.ptr.p_double[0], 1, ae_v_len(0,state->k-1)); + rep->rmserror = state->reprmserror; + rep->wrmserror = state->repwrmserror; + rep->avgerror = state->repavgerror; + rep->avgrelerror = state->repavgrelerror; + rep->maxerror = state->repmaxerror; + rep->iterationscount = state->repiterationscount; + ae_matrix_set_length(&rep->covpar, state->k, state->k, _state); + ae_vector_set_length(&rep->errpar, state->k, _state); + ae_vector_set_length(&rep->errcurve, state->npoints, _state); + ae_vector_set_length(&rep->noise, state->npoints, _state); + rep->r2 = state->rep.r2; + for(i=0; i<=state->k-1; i++) + { + for(j=0; j<=state->k-1; j++) + { + rep->covpar.ptr.pp_double[i][j] = state->rep.covpar.ptr.pp_double[i][j]; + } + rep->errpar.ptr.p_double[i] = state->rep.errpar.ptr.p_double[i]; + } + for(i=0; i<=state->npoints-1; i++) + { + rep->errcurve.ptr.p_double[i] = state->rep.errcurve.ptr.p_double[i]; + rep->noise.ptr.p_double[i] = state->rep.noise.ptr.p_double[i]; + } + } +} + + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before fitting begins +* LSFitFit() is called +* prior to actual fitting, for each point in data set X_i and each + component of parameters being fited C_j algorithm performs following + steps: + * two trial steps are made to C_j-TestStep*S[j] and C_j+TestStep*S[j], + where C_j is j-th parameter and S[j] is a scale of j-th parameter + * if needed, steps are bounded with respect to constraints on C[] + * F(X_i|C) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N*K (points count * parameters count) gradient + evaluations. It is very costly and you should use it only for low + dimensional problems, when you want to be sure that you've + correctly calculated analytic derivatives. You should not use it + in the production code (unless you want to check derivatives + provided by some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with LSFitSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +NOTE 4: this function works only for optimizers created with LSFitCreateWFG() + or LSFitCreateFG() constructors. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetgradientcheck(lsfitstate* state, + double teststep, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(teststep, _state), "LSFitSetGradientCheck: TestStep contains NaN or Infinite", _state); + ae_assert(ae_fp_greater_eq(teststep,0), "LSFitSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); + state->teststep = teststep; +} + + +/************************************************************************* +Internal subroutine: automatic scaling for LLS tasks. +NEVER CALL IT DIRECTLY! + +Maps abscissas to [-1,1], standartizes ordinates and correspondingly scales +constraints. It also scales weights so that max(W[i])=1 + +Transformations performed: +* X, XC [XA,XB] => [-1,+1] + transformation makes min(X)=-1, max(X)=+1 + +* Y [SA,SB] => [0,1] + transformation makes mean(Y)=0, stddev(Y)=1 + +* YC transformed accordingly to SA, SB, DC[I] + + -- ALGLIB PROJECT -- + Copyright 08.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitscalexy(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + double* xa, + double* xb, + double* sa, + double* sb, + /* Real */ ae_vector* xoriginal, + /* Real */ ae_vector* yoriginal, + ae_state *_state) +{ + double xmin; + double xmax; + ae_int_t i; + double mx; + + *xa = 0; + *xb = 0; + *sa = 0; + *sb = 0; + ae_vector_clear(xoriginal); + ae_vector_clear(yoriginal); + + ae_assert(n>=1, "LSFitScaleXY: incorrect N", _state); + ae_assert(k>=0, "LSFitScaleXY: incorrect K", _state); + + /* + * Calculate xmin/xmax. + * Force xmin<>xmax. + */ + xmin = x->ptr.p_double[0]; + xmax = x->ptr.p_double[0]; + for(i=1; i<=n-1; i++) + { + xmin = ae_minreal(xmin, x->ptr.p_double[i], _state); + xmax = ae_maxreal(xmax, x->ptr.p_double[i], _state); + } + for(i=0; i<=k-1; i++) + { + xmin = ae_minreal(xmin, xc->ptr.p_double[i], _state); + xmax = ae_maxreal(xmax, xc->ptr.p_double[i], _state); + } + if( ae_fp_eq(xmin,xmax) ) + { + if( ae_fp_eq(xmin,0) ) + { + xmin = -1; + xmax = 1; + } + else + { + if( ae_fp_greater(xmin,0) ) + { + xmin = 0.5*xmin; + } + else + { + xmax = 0.5*xmax; + } + } + } + + /* + * Transform abscissas: map [XA,XB] to [0,1] + * + * Store old X[] in XOriginal[] (it will be used + * to calculate relative error). + */ + ae_vector_set_length(xoriginal, n, _state); + ae_v_move(&xoriginal->ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + *xa = xmin; + *xb = xmax; + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = 2*(x->ptr.p_double[i]-0.5*(*xa+(*xb)))/(*xb-(*xa)); + } + for(i=0; i<=k-1; i++) + { + ae_assert(dc->ptr.p_int[i]>=0, "LSFitScaleXY: internal error!", _state); + xc->ptr.p_double[i] = 2*(xc->ptr.p_double[i]-0.5*(*xa+(*xb)))/(*xb-(*xa)); + yc->ptr.p_double[i] = yc->ptr.p_double[i]*ae_pow(0.5*(*xb-(*xa)), dc->ptr.p_int[i], _state); + } + + /* + * Transform function values: map [SA,SB] to [0,1] + * SA = mean(Y), + * SB = SA+stddev(Y). + * + * Store old Y[] in YOriginal[] (it will be used + * to calculate relative error). + */ + ae_vector_set_length(yoriginal, n, _state); + ae_v_move(&yoriginal->ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); + *sa = 0; + for(i=0; i<=n-1; i++) + { + *sa = *sa+y->ptr.p_double[i]; + } + *sa = *sa/n; + *sb = 0; + for(i=0; i<=n-1; i++) + { + *sb = *sb+ae_sqr(y->ptr.p_double[i]-(*sa), _state); + } + *sb = ae_sqrt(*sb/n, _state)+(*sa); + if( ae_fp_eq(*sb,*sa) ) + { + *sb = 2*(*sa); + } + if( ae_fp_eq(*sb,*sa) ) + { + *sb = *sa+1; + } + for(i=0; i<=n-1; i++) + { + y->ptr.p_double[i] = (y->ptr.p_double[i]-(*sa))/(*sb-(*sa)); + } + for(i=0; i<=k-1; i++) + { + if( dc->ptr.p_int[i]==0 ) + { + yc->ptr.p_double[i] = (yc->ptr.p_double[i]-(*sa))/(*sb-(*sa)); + } + else + { + yc->ptr.p_double[i] = yc->ptr.p_double[i]/(*sb-(*sa)); + } + } + + /* + * Scale weights + */ + mx = 0; + for(i=0; i<=n-1; i++) + { + mx = ae_maxreal(mx, ae_fabs(w->ptr.p_double[i], _state), _state); + } + if( ae_fp_neq(mx,0) ) + { + for(i=0; i<=n-1; i++) + { + w->ptr.p_double[i] = w->ptr.p_double[i]/mx; + } + } +} + + +/************************************************************************* +Internal spline fitting subroutine + + -- ALGLIB PROJECT -- + Copyright 08.09.2009 by Bochkanov Sergey +*************************************************************************/ +static void lsfit_spline1dfitinternal(ae_int_t st, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector _w; + ae_vector _xc; + ae_vector _yc; + ae_matrix fmatrix; + ae_matrix cmatrix; + ae_vector y2; + ae_vector w2; + ae_vector sx; + ae_vector sy; + ae_vector sd; + ae_vector tmp; + ae_vector xoriginal; + ae_vector yoriginal; + lsfitreport lrep; + double v0; + double v1; + double v2; + double mx; + spline1dinterpolant s2; + ae_int_t i; + ae_int_t j; + ae_int_t relcnt; + double xa; + double xb; + double sa; + double sb; + double bl; + double br; + double decay; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_init_copy(&_w, w, _state, ae_true); + w = &_w; + ae_vector_init_copy(&_xc, xc, _state, ae_true); + xc = &_xc; + ae_vector_init_copy(&_yc, yc, _state, ae_true); + yc = &_yc; + *info = 0; + _spline1dinterpolant_clear(s); + _spline1dfitreport_clear(rep); + ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&cmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sy, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sd, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xoriginal, 0, DT_REAL, _state, ae_true); + ae_vector_init(&yoriginal, 0, DT_REAL, _state, ae_true); + _lsfitreport_init(&lrep, _state, ae_true); + _spline1dinterpolant_init(&s2, _state, ae_true); + + ae_assert(st==0||st==1, "Spline1DFit: internal error!", _state); + if( st==0&&m<4 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( st==1&&m<4 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( (n<1||k<0)||k>=m ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=k-1; i++) + { + *info = 0; + if( dc->ptr.p_int[i]<0 ) + { + *info = -1; + } + if( dc->ptr.p_int[i]>1 ) + { + *info = -1; + } + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + } + if( st==1&&m%2!=0 ) + { + + /* + * Hermite fitter must have even number of basis functions + */ + *info = -2; + ae_frame_leave(_state); + return; + } + + /* + * weight decay for correct handling of task which becomes + * degenerate after constraints are applied + */ + decay = 10000*ae_machineepsilon; + + /* + * Scale X, Y, XC, YC + */ + lsfitscalexy(x, y, w, n, xc, yc, dc, k, &xa, &xb, &sa, &sb, &xoriginal, &yoriginal, _state); + + /* + * allocate space, initialize: + * * SX - grid for basis functions + * * SY - values of basis functions at grid points + * * FMatrix- values of basis functions at X[] + * * CMatrix- values (derivatives) of basis functions at XC[] + */ + ae_vector_set_length(&y2, n+m, _state); + ae_vector_set_length(&w2, n+m, _state); + ae_matrix_set_length(&fmatrix, n+m, m, _state); + if( k>0 ) + { + ae_matrix_set_length(&cmatrix, k, m+1, _state); + } + if( st==0 ) + { + + /* + * allocate space for cubic spline + */ + ae_vector_set_length(&sx, m-2, _state); + ae_vector_set_length(&sy, m-2, _state); + for(j=0; j<=m-2-1; j++) + { + sx.ptr.p_double[j] = (double)(2*j)/(double)(m-2-1)-1; + } + } + if( st==1 ) + { + + /* + * allocate space for Hermite spline + */ + ae_vector_set_length(&sx, m/2, _state); + ae_vector_set_length(&sy, m/2, _state); + ae_vector_set_length(&sd, m/2, _state); + for(j=0; j<=m/2-1; j++) + { + sx.ptr.p_double[j] = (double)(2*j)/(double)(m/2-1)-1; + } + } + + /* + * Prepare design and constraints matrices: + * * fill constraints matrix + * * fill first N rows of design matrix with values + * * fill next M rows of design matrix with regularizing term + * * append M zeros to Y + * * append M elements, mean(abs(W)) each, to W + */ + for(j=0; j<=m-1; j++) + { + + /* + * prepare Jth basis function + */ + if( st==0 ) + { + + /* + * cubic spline basis + */ + for(i=0; i<=m-2-1; i++) + { + sy.ptr.p_double[i] = 0; + } + bl = 0; + br = 0; + if( jptr.p_double[i], _state); + } + for(i=0; i<=k-1; i++) + { + ae_assert(dc->ptr.p_int[i]>=0&&dc->ptr.p_int[i]<=2, "Spline1DFit: internal error!", _state); + spline1ddiff(&s2, xc->ptr.p_double[i], &v0, &v1, &v2, _state); + if( dc->ptr.p_int[i]==0 ) + { + cmatrix.ptr.pp_double[i][j] = v0; + } + if( dc->ptr.p_int[i]==1 ) + { + cmatrix.ptr.pp_double[i][j] = v1; + } + if( dc->ptr.p_int[i]==2 ) + { + cmatrix.ptr.pp_double[i][j] = v2; + } + } + } + for(i=0; i<=k-1; i++) + { + cmatrix.ptr.pp_double[i][m] = yc->ptr.p_double[i]; + } + for(i=0; i<=m-1; i++) + { + for(j=0; j<=m-1; j++) + { + if( i==j ) + { + fmatrix.ptr.pp_double[n+i][j] = decay; + } + else + { + fmatrix.ptr.pp_double[n+i][j] = 0; + } + } + } + ae_vector_set_length(&y2, n+m, _state); + ae_vector_set_length(&w2, n+m, _state); + ae_v_move(&y2.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&w2.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); + mx = 0; + for(i=0; i<=n-1; i++) + { + mx = mx+ae_fabs(w->ptr.p_double[i], _state); + } + mx = mx/n; + for(i=0; i<=m-1; i++) + { + y2.ptr.p_double[n+i] = 0; + w2.ptr.p_double[n+i] = mx; + } + + /* + * Solve constrained task + */ + if( k>0 ) + { + + /* + * solve using regularization + */ + lsfitlinearwc(&y2, &w2, &fmatrix, &cmatrix, n+m, m, k, info, &tmp, &lrep, _state); + } + else + { + + /* + * no constraints, no regularization needed + */ + lsfitlinearwc(y, w, &fmatrix, &cmatrix, n, m, k, info, &tmp, &lrep, _state); + } + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Generate spline and scale it + */ + if( st==0 ) + { + + /* + * cubic spline basis + */ + ae_v_move(&sy.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-2-1)); + spline1dbuildcubic(&sx, &sy, m-2, 1, tmp.ptr.p_double[m-2], 1, tmp.ptr.p_double[m-1], s, _state); + } + if( st==1 ) + { + + /* + * Hermite basis + */ + for(i=0; i<=m/2-1; i++) + { + sy.ptr.p_double[i] = tmp.ptr.p_double[2*i]; + sd.ptr.p_double[i] = tmp.ptr.p_double[2*i+1]; + } + spline1dbuildhermite(&sx, &sy, &sd, m/2, s, _state); + } + spline1dlintransx(s, 2/(xb-xa), -(xa+xb)/(xb-xa), _state); + spline1dlintransy(s, sb-sa, sa, _state); + + /* + * Scale absolute errors obtained from LSFitLinearW. + * Relative error should be calculated separately + * (because of shifting/scaling of the task) + */ + rep->taskrcond = lrep.taskrcond; + rep->rmserror = lrep.rmserror*(sb-sa); + rep->avgerror = lrep.avgerror*(sb-sa); + rep->maxerror = lrep.maxerror*(sb-sa); + rep->avgrelerror = 0; + relcnt = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(yoriginal.ptr.p_double[i],0) ) + { + rep->avgrelerror = rep->avgrelerror+ae_fabs(spline1dcalc(s, xoriginal.ptr.p_double[i], _state)-yoriginal.ptr.p_double[i], _state)/ae_fabs(yoriginal.ptr.p_double[i], _state); + relcnt = relcnt+1; + } + } + if( relcnt!=0 ) + { + rep->avgrelerror = rep->avgrelerror/relcnt; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal fitting subroutine +*************************************************************************/ +static void lsfit_lsfitlinearinternal(/* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* fmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + double threshold; + ae_matrix ft; + ae_matrix q; + ae_matrix l; + ae_matrix r; + ae_vector b; + ae_vector wmod; + ae_vector tau; + ae_vector nzeros; + ae_vector s; + ae_int_t i; + ae_int_t j; + double v; + ae_vector sv; + ae_matrix u; + ae_matrix vt; + ae_vector tmp; + ae_vector utb; + ae_vector sutb; + ae_int_t relcnt; + + ae_frame_make(_state, &_frame_block); + *info = 0; + ae_vector_clear(c); + _lsfitreport_clear(rep); + ae_matrix_init(&ft, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&q, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&l, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&r, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&b, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wmod, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); + ae_vector_init(&nzeros, 0, DT_REAL, _state, ae_true); + ae_vector_init(&s, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sv, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&utb, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sutb, 0, DT_REAL, _state, ae_true); + + lsfit_clearreport(rep, _state); + if( n<1||m<1 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + *info = 1; + threshold = ae_sqrt(ae_machineepsilon, _state); + + /* + * Degenerate case, needs special handling + */ + if( nptr.p_double[j]; + ae_v_moved(&ft.ptr.pp_double[j][0], 1, &fmatrix->ptr.pp_double[j][0], 1, ae_v_len(0,m-1), v); + b.ptr.p_double[j] = w->ptr.p_double[j]*y->ptr.p_double[j]; + wmod.ptr.p_double[j] = 1; + } + + /* + * LQ decomposition and reduction to M=N + */ + ae_vector_set_length(c, m, _state); + for(i=0; i<=m-1; i++) + { + c->ptr.p_double[i] = 0; + } + rep->taskrcond = 0; + rmatrixlq(&ft, n, m, &tau, _state); + rmatrixlqunpackq(&ft, n, m, &tau, n, &q, _state); + rmatrixlqunpackl(&ft, n, m, &l, _state); + lsfit_lsfitlinearinternal(&b, &wmod, &l, n, n, info, &tmp, rep, _state); + if( *info<=0 ) + { + ae_frame_leave(_state); + return; + } + for(i=0; i<=n-1; i++) + { + v = tmp.ptr.p_double[i]; + ae_v_addd(&c->ptr.p_double[0], 1, &q.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); + } + ae_frame_leave(_state); + return; + } + + /* + * N>=M. Generate design matrix and reduce to N=M using + * QR decomposition. + */ + ae_matrix_set_length(&ft, n, m, _state); + ae_vector_set_length(&b, n, _state); + for(j=0; j<=n-1; j++) + { + v = w->ptr.p_double[j]; + ae_v_moved(&ft.ptr.pp_double[j][0], 1, &fmatrix->ptr.pp_double[j][0], 1, ae_v_len(0,m-1), v); + b.ptr.p_double[j] = w->ptr.p_double[j]*y->ptr.p_double[j]; + } + rmatrixqr(&ft, n, m, &tau, _state); + rmatrixqrunpackq(&ft, n, m, &tau, m, &q, _state); + rmatrixqrunpackr(&ft, n, m, &r, _state); + ae_vector_set_length(&tmp, m, _state); + for(i=0; i<=m-1; i++) + { + tmp.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + v = b.ptr.p_double[i]; + ae_v_addd(&tmp.ptr.p_double[0], 1, &q.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); + } + ae_vector_set_length(&b, m, _state); + ae_v_move(&b.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-1)); + + /* + * R contains reduced MxM design upper triangular matrix, + * B contains reduced Mx1 right part. + * + * Determine system condition number and decide + * should we use triangular solver (faster) or + * SVD-based solver (more stable). + * + * We can use LU-based RCond estimator for this task. + */ + rep->taskrcond = rmatrixlurcondinf(&r, m, _state); + if( ae_fp_greater(rep->taskrcond,threshold) ) + { + + /* + * use QR-based solver + */ + ae_vector_set_length(c, m, _state); + c->ptr.p_double[m-1] = b.ptr.p_double[m-1]/r.ptr.pp_double[m-1][m-1]; + for(i=m-2; i>=0; i--) + { + v = ae_v_dotproduct(&r.ptr.pp_double[i][i+1], 1, &c->ptr.p_double[i+1], 1, ae_v_len(i+1,m-1)); + c->ptr.p_double[i] = (b.ptr.p_double[i]-v)/r.ptr.pp_double[i][i]; + } + } + else + { + + /* + * use SVD-based solver + */ + if( !rmatrixsvd(&r, m, m, 1, 1, 2, &sv, &u, &vt, _state) ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&utb, m, _state); + ae_vector_set_length(&sutb, m, _state); + for(i=0; i<=m-1; i++) + { + utb.ptr.p_double[i] = 0; + } + for(i=0; i<=m-1; i++) + { + v = b.ptr.p_double[i]; + ae_v_addd(&utb.ptr.p_double[0], 1, &u.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); + } + if( ae_fp_greater(sv.ptr.p_double[0],0) ) + { + rep->taskrcond = sv.ptr.p_double[m-1]/sv.ptr.p_double[0]; + for(i=0; i<=m-1; i++) + { + if( ae_fp_greater(sv.ptr.p_double[i],threshold*sv.ptr.p_double[0]) ) + { + sutb.ptr.p_double[i] = utb.ptr.p_double[i]/sv.ptr.p_double[i]; + } + else + { + sutb.ptr.p_double[i] = 0; + } + } + } + else + { + rep->taskrcond = 0; + for(i=0; i<=m-1; i++) + { + sutb.ptr.p_double[i] = 0; + } + } + ae_vector_set_length(c, m, _state); + for(i=0; i<=m-1; i++) + { + c->ptr.p_double[i] = 0; + } + for(i=0; i<=m-1; i++) + { + v = sutb.ptr.p_double[i]; + ae_v_addd(&c->ptr.p_double[0], 1, &vt.ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); + } + } + + /* + * calculate errors + */ + rep->rmserror = 0; + rep->avgerror = 0; + rep->avgrelerror = 0; + rep->maxerror = 0; + relcnt = 0; + for(i=0; i<=n-1; i++) + { + v = ae_v_dotproduct(&fmatrix->ptr.pp_double[i][0], 1, &c->ptr.p_double[0], 1, ae_v_len(0,m-1)); + rep->rmserror = rep->rmserror+ae_sqr(v-y->ptr.p_double[i], _state); + rep->avgerror = rep->avgerror+ae_fabs(v-y->ptr.p_double[i], _state); + if( ae_fp_neq(y->ptr.p_double[i],0) ) + { + rep->avgrelerror = rep->avgrelerror+ae_fabs(v-y->ptr.p_double[i], _state)/ae_fabs(y->ptr.p_double[i], _state); + relcnt = relcnt+1; + } + rep->maxerror = ae_maxreal(rep->maxerror, ae_fabs(v-y->ptr.p_double[i], _state), _state); + } + rep->rmserror = ae_sqrt(rep->rmserror/n, _state); + rep->avgerror = rep->avgerror/n; + if( relcnt!=0 ) + { + rep->avgrelerror = rep->avgrelerror/relcnt; + } + ae_vector_set_length(&nzeros, n, _state); + ae_vector_set_length(&s, m, _state); + for(i=0; i<=m-1; i++) + { + s.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + for(j=0; j<=m-1; j++) + { + s.ptr.p_double[j] = s.ptr.p_double[j]+ae_sqr(fmatrix->ptr.pp_double[i][j], _state); + } + nzeros.ptr.p_double[i] = 0; + } + for(i=0; i<=m-1; i++) + { + if( ae_fp_neq(s.ptr.p_double[i],0) ) + { + s.ptr.p_double[i] = ae_sqrt(1/s.ptr.p_double[i], _state); + } + else + { + s.ptr.p_double[i] = 1; + } + } + lsfit_estimateerrors(fmatrix, &nzeros, y, w, c, &s, n, m, rep, &r, 1, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine +*************************************************************************/ +static void lsfit_lsfitclearrequestfields(lsfitstate* state, + ae_state *_state) +{ + + + state->needf = ae_false; + state->needfg = ae_false; + state->needfgh = ae_false; + state->xupdated = ae_false; +} + + +/************************************************************************* +Internal subroutine, calculates barycentric basis functions. +Used for efficient simultaneous calculation of N basis functions. + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +static void lsfit_barycentriccalcbasis(barycentricinterpolant* b, + double t, + /* Real */ ae_vector* y, + ae_state *_state) +{ + double s2; + double s; + double v; + ae_int_t i; + ae_int_t j; + + + + /* + * special case: N=1 + */ + if( b->n==1 ) + { + y->ptr.p_double[0] = 1; + return; + } + + /* + * Here we assume that task is normalized, i.e.: + * 1. abs(Y[i])<=1 + * 2. abs(W[i])<=1 + * 3. X[] is ordered + * + * First, we decide: should we use "safe" formula (guarded + * against overflow) or fast one? + */ + s = ae_fabs(t-b->x.ptr.p_double[0], _state); + for(i=0; i<=b->n-1; i++) + { + v = b->x.ptr.p_double[i]; + if( ae_fp_eq(v,t) ) + { + for(j=0; j<=b->n-1; j++) + { + y->ptr.p_double[j] = 0; + } + y->ptr.p_double[i] = 1; + return; + } + v = ae_fabs(t-v, _state); + if( ae_fp_less(v,s) ) + { + s = v; + } + } + s2 = 0; + for(i=0; i<=b->n-1; i++) + { + v = s/(t-b->x.ptr.p_double[i]); + v = v*b->w.ptr.p_double[i]; + y->ptr.p_double[i] = v; + s2 = s2+v; + } + v = 1/s2; + ae_v_muld(&y->ptr.p_double[0], 1, ae_v_len(0,b->n-1), v); +} + + +/************************************************************************* +This is internal function for Chebyshev fitting. + +It assumes that input data are normalized: +* X/XC belong to [-1,+1], +* mean(Y)=0, stddev(Y)=1. + +It does not checks inputs for errors. + +This function is used to fit general (shifted) Chebyshev models, power +basis models or barycentric models. + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + N - number of points, N>0. + XC - points where polynomial values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that P(XC[i])=YC[i] + * DC[i]=1 means that P'(XC[i])=YC[i] + K - number of constraints, 0<=K=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + C - interpolant in Chebyshev form; [-1,+1] is used as base interval + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +static void lsfit_internalchebyshevfit(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _xc; + ae_vector _yc; + ae_vector y2; + ae_vector w2; + ae_vector tmp; + ae_vector tmp2; + ae_vector tmpdiff; + ae_vector bx; + ae_vector by; + ae_vector bw; + ae_matrix fmatrix; + ae_matrix cmatrix; + ae_int_t i; + ae_int_t j; + double mx; + double decay; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_xc, xc, _state, ae_true); + xc = &_xc; + ae_vector_init_copy(&_yc, yc, _state, ae_true); + yc = &_yc; + *info = 0; + ae_vector_clear(c); + _lsfitreport_clear(rep); + ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpdiff, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&by, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bw, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&cmatrix, 0, 0, DT_REAL, _state, ae_true); + + lsfit_clearreport(rep, _state); + + /* + * weight decay for correct handling of task which becomes + * degenerate after constraints are applied + */ + decay = 10000*ae_machineepsilon; + + /* + * allocate space, initialize/fill: + * * FMatrix- values of basis functions at X[] + * * CMatrix- values (derivatives) of basis functions at XC[] + * * fill constraints matrix + * * fill first N rows of design matrix with values + * * fill next M rows of design matrix with regularizing term + * * append M zeros to Y + * * append M elements, mean(abs(W)) each, to W + */ + ae_vector_set_length(&y2, n+m, _state); + ae_vector_set_length(&w2, n+m, _state); + ae_vector_set_length(&tmp, m, _state); + ae_vector_set_length(&tmpdiff, m, _state); + ae_matrix_set_length(&fmatrix, n+m, m, _state); + if( k>0 ) + { + ae_matrix_set_length(&cmatrix, k, m+1, _state); + } + + /* + * Fill design matrix, Y2, W2: + * * first N rows with basis functions for original points + * * next M rows with decay terms + */ + for(i=0; i<=n-1; i++) + { + + /* + * prepare Ith row + * use Tmp for calculations to avoid multidimensional arrays overhead + */ + for(j=0; j<=m-1; j++) + { + if( j==0 ) + { + tmp.ptr.p_double[j] = 1; + } + else + { + if( j==1 ) + { + tmp.ptr.p_double[j] = x->ptr.p_double[i]; + } + else + { + tmp.ptr.p_double[j] = 2*x->ptr.p_double[i]*tmp.ptr.p_double[j-1]-tmp.ptr.p_double[j-2]; + } + } + } + ae_v_move(&fmatrix.ptr.pp_double[i][0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-1)); + } + for(i=0; i<=m-1; i++) + { + for(j=0; j<=m-1; j++) + { + if( i==j ) + { + fmatrix.ptr.pp_double[n+i][j] = decay; + } + else + { + fmatrix.ptr.pp_double[n+i][j] = 0; + } + } + } + ae_v_move(&y2.ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&w2.ptr.p_double[0], 1, &w->ptr.p_double[0], 1, ae_v_len(0,n-1)); + mx = 0; + for(i=0; i<=n-1; i++) + { + mx = mx+ae_fabs(w->ptr.p_double[i], _state); + } + mx = mx/n; + for(i=0; i<=m-1; i++) + { + y2.ptr.p_double[n+i] = 0; + w2.ptr.p_double[n+i] = mx; + } + + /* + * fill constraints matrix + */ + for(i=0; i<=k-1; i++) + { + + /* + * prepare Ith row + * use Tmp for basis function values, + * TmpDiff for basos function derivatives + */ + for(j=0; j<=m-1; j++) + { + if( j==0 ) + { + tmp.ptr.p_double[j] = 1; + tmpdiff.ptr.p_double[j] = 0; + } + else + { + if( j==1 ) + { + tmp.ptr.p_double[j] = xc->ptr.p_double[i]; + tmpdiff.ptr.p_double[j] = 1; + } + else + { + tmp.ptr.p_double[j] = 2*xc->ptr.p_double[i]*tmp.ptr.p_double[j-1]-tmp.ptr.p_double[j-2]; + tmpdiff.ptr.p_double[j] = 2*(tmp.ptr.p_double[j-1]+xc->ptr.p_double[i]*tmpdiff.ptr.p_double[j-1])-tmpdiff.ptr.p_double[j-2]; + } + } + } + if( dc->ptr.p_int[i]==0 ) + { + ae_v_move(&cmatrix.ptr.pp_double[i][0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-1)); + } + if( dc->ptr.p_int[i]==1 ) + { + ae_v_move(&cmatrix.ptr.pp_double[i][0], 1, &tmpdiff.ptr.p_double[0], 1, ae_v_len(0,m-1)); + } + cmatrix.ptr.pp_double[i][m] = yc->ptr.p_double[i]; + } + + /* + * Solve constrained task + */ + if( k>0 ) + { + + /* + * solve using regularization + */ + lsfitlinearwc(&y2, &w2, &fmatrix, &cmatrix, n+m, m, k, info, c, rep, _state); + } + else + { + + /* + * no constraints, no regularization needed + */ + lsfitlinearwc(y, w, &fmatrix, &cmatrix, n, m, 0, info, c, rep, _state); + } + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal Floater-Hormann fitting subroutine for fixed D +*************************************************************************/ +static void lsfit_barycentricfitwcfixedd(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t d, + ae_int_t* info, + barycentricinterpolant* b, + barycentricfitreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + ae_vector _w; + ae_vector _xc; + ae_vector _yc; + ae_matrix fmatrix; + ae_matrix cmatrix; + ae_vector y2; + ae_vector w2; + ae_vector sx; + ae_vector sy; + ae_vector sbf; + ae_vector xoriginal; + ae_vector yoriginal; + ae_vector tmp; + lsfitreport lrep; + double v0; + double v1; + double mx; + barycentricinterpolant b2; + ae_int_t i; + ae_int_t j; + ae_int_t relcnt; + double xa; + double xb; + double sa; + double sb; + double decay; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_vector_init_copy(&_w, w, _state, ae_true); + w = &_w; + ae_vector_init_copy(&_xc, xc, _state, ae_true); + xc = &_xc; + ae_vector_init_copy(&_yc, yc, _state, ae_true); + yc = &_yc; + *info = 0; + _barycentricinterpolant_clear(b); + _barycentricfitreport_clear(rep); + ae_matrix_init(&fmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&cmatrix, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sy, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sbf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xoriginal, 0, DT_REAL, _state, ae_true); + ae_vector_init(&yoriginal, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + _lsfitreport_init(&lrep, _state, ae_true); + _barycentricinterpolant_init(&b2, _state, ae_true); + + if( ((n<1||m<2)||k<0)||k>=m ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=k-1; i++) + { + *info = 0; + if( dc->ptr.p_int[i]<0 ) + { + *info = -1; + } + if( dc->ptr.p_int[i]>1 ) + { + *info = -1; + } + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + } + + /* + * weight decay for correct handling of task which becomes + * degenerate after constraints are applied + */ + decay = 10000*ae_machineepsilon; + + /* + * Scale X, Y, XC, YC + */ + lsfitscalexy(x, y, w, n, xc, yc, dc, k, &xa, &xb, &sa, &sb, &xoriginal, &yoriginal, _state); + + /* + * allocate space, initialize: + * * FMatrix- values of basis functions at X[] + * * CMatrix- values (derivatives) of basis functions at XC[] + */ + ae_vector_set_length(&y2, n+m, _state); + ae_vector_set_length(&w2, n+m, _state); + ae_matrix_set_length(&fmatrix, n+m, m, _state); + if( k>0 ) + { + ae_matrix_set_length(&cmatrix, k, m+1, _state); + } + ae_vector_set_length(&y2, n+m, _state); + ae_vector_set_length(&w2, n+m, _state); + + /* + * Prepare design and constraints matrices: + * * fill constraints matrix + * * fill first N rows of design matrix with values + * * fill next M rows of design matrix with regularizing term + * * append M zeros to Y + * * append M elements, mean(abs(W)) each, to W + */ + ae_vector_set_length(&sx, m, _state); + ae_vector_set_length(&sy, m, _state); + ae_vector_set_length(&sbf, m, _state); + for(j=0; j<=m-1; j++) + { + sx.ptr.p_double[j] = (double)(2*j)/(double)(m-1)-1; + } + for(i=0; i<=m-1; i++) + { + sy.ptr.p_double[i] = 1; + } + barycentricbuildfloaterhormann(&sx, &sy, m, d, &b2, _state); + mx = 0; + for(i=0; i<=n-1; i++) + { + lsfit_barycentriccalcbasis(&b2, x->ptr.p_double[i], &sbf, _state); + ae_v_move(&fmatrix.ptr.pp_double[i][0], 1, &sbf.ptr.p_double[0], 1, ae_v_len(0,m-1)); + y2.ptr.p_double[i] = y->ptr.p_double[i]; + w2.ptr.p_double[i] = w->ptr.p_double[i]; + mx = mx+ae_fabs(w->ptr.p_double[i], _state)/n; + } + for(i=0; i<=m-1; i++) + { + for(j=0; j<=m-1; j++) + { + if( i==j ) + { + fmatrix.ptr.pp_double[n+i][j] = decay; + } + else + { + fmatrix.ptr.pp_double[n+i][j] = 0; + } + } + y2.ptr.p_double[n+i] = 0; + w2.ptr.p_double[n+i] = mx; + } + if( k>0 ) + { + for(j=0; j<=m-1; j++) + { + for(i=0; i<=m-1; i++) + { + sy.ptr.p_double[i] = 0; + } + sy.ptr.p_double[j] = 1; + barycentricbuildfloaterhormann(&sx, &sy, m, d, &b2, _state); + for(i=0; i<=k-1; i++) + { + ae_assert(dc->ptr.p_int[i]>=0&&dc->ptr.p_int[i]<=1, "BarycentricFit: internal error!", _state); + barycentricdiff1(&b2, xc->ptr.p_double[i], &v0, &v1, _state); + if( dc->ptr.p_int[i]==0 ) + { + cmatrix.ptr.pp_double[i][j] = v0; + } + if( dc->ptr.p_int[i]==1 ) + { + cmatrix.ptr.pp_double[i][j] = v1; + } + } + } + for(i=0; i<=k-1; i++) + { + cmatrix.ptr.pp_double[i][m] = yc->ptr.p_double[i]; + } + } + + /* + * Solve constrained task + */ + if( k>0 ) + { + + /* + * solve using regularization + */ + lsfitlinearwc(&y2, &w2, &fmatrix, &cmatrix, n+m, m, k, info, &tmp, &lrep, _state); + } + else + { + + /* + * no constraints, no regularization needed + */ + lsfitlinearwc(y, w, &fmatrix, &cmatrix, n, m, k, info, &tmp, &lrep, _state); + } + if( *info<0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Generate interpolant and scale it + */ + ae_v_move(&sy.ptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,m-1)); + barycentricbuildfloaterhormann(&sx, &sy, m, d, b, _state); + barycentriclintransx(b, 2/(xb-xa), -(xa+xb)/(xb-xa), _state); + barycentriclintransy(b, sb-sa, sa, _state); + + /* + * Scale absolute errors obtained from LSFitLinearW. + * Relative error should be calculated separately + * (because of shifting/scaling of the task) + */ + rep->taskrcond = lrep.taskrcond; + rep->rmserror = lrep.rmserror*(sb-sa); + rep->avgerror = lrep.avgerror*(sb-sa); + rep->maxerror = lrep.maxerror*(sb-sa); + rep->avgrelerror = 0; + relcnt = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(yoriginal.ptr.p_double[i],0) ) + { + rep->avgrelerror = rep->avgrelerror+ae_fabs(barycentriccalc(b, xoriginal.ptr.p_double[i], _state)-yoriginal.ptr.p_double[i], _state)/ae_fabs(yoriginal.ptr.p_double[i], _state); + relcnt = relcnt+1; + } + } + if( relcnt!=0 ) + { + rep->avgrelerror = rep->avgrelerror/relcnt; + } + ae_frame_leave(_state); +} + + +static void lsfit_clearreport(lsfitreport* rep, ae_state *_state) +{ + + + rep->taskrcond = 0; + rep->iterationscount = 0; + rep->varidx = -1; + rep->rmserror = 0; + rep->avgerror = 0; + rep->avgrelerror = 0; + rep->maxerror = 0; + rep->wrmserror = 0; + rep->r2 = 0; + ae_matrix_set_length(&rep->covpar, 0, 0, _state); + ae_vector_set_length(&rep->errpar, 0, _state); + ae_vector_set_length(&rep->errcurve, 0, _state); + ae_vector_set_length(&rep->noise, 0, _state); +} + + +/************************************************************************* +This internal function estimates covariance matrix and other error-related +information for linear/nonlinear least squares model. + +It has a bit awkward interface, but it can be used for both linear and +nonlinear problems. + +INPUT PARAMETERS: + F1 - array[0..N-1,0..K-1]: + * for linear problems - matrix of function values + * for nonlinear problems - Jacobian matrix + F0 - array[0..N-1]: + * for linear problems - must be filled with zeros + * for nonlinear problems - must store values of function being + fitted + Y - array[0..N-1]: + * for linear and nonlinear problems - must store target values + W - weights, array[0..N-1]: + * for linear and nonlinear problems - weights + X - array[0..K-1]: + * for linear and nonlinear problems - current solution + S - array[0..K-1]: + * its components should be strictly positive + * squared inverse of this diagonal matrix is used as damping + factor for covariance matrix (linear and nonlinear problems) + * for nonlinear problems, when scale of the variables is usually + explicitly given by user, you may use scale vector for this + parameter + * for linear problems you may set this parameter to + S=sqrt(1/diag(F'*F)) + * this parameter is automatically rescaled by this function, + only relative magnitudes of its components (with respect to + each other) matter. + N - number of points, N>0. + K - number of dimensions + Rep - structure which is used to store results + Z - additional matrix which, depending on ZKind, may contain some + information used to accelerate calculations - or just can be + temporary buffer: + * for ZKind=0 Z contains no information, just temporary + buffer which can be resized and used as needed + * for ZKind=1 Z contains triangular matrix from QR + decomposition of W*F1. This matrix can be used + to speedup calculation of covariance matrix. + It should not be changed by algorithm. + ZKind- contents of Z + +OUTPUT PARAMETERS: + +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(J*CovPar*J')), + where J is Jacobian matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] +* Rep.R2 coefficient of determination (non-weighted) + +Other fields of Rep are not changed. + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +static void lsfit_estimateerrors(/* Real */ ae_matrix* f1, + /* Real */ ae_vector* f0, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_vector* x, + /* Real */ ae_vector* s, + ae_int_t n, + ae_int_t k, + lsfitreport* rep, + /* Real */ ae_matrix* z, + ae_int_t zkind, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _s; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + double v; + double noisec; + ae_int_t info; + matinvreport invrep; + ae_int_t nzcnt; + double avg; + double rss; + double tss; + double sz; + double ss; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_s, s, _state, ae_true); + s = &_s; + _matinvreport_init(&invrep, _state, ae_true); + + + /* + * Compute NZCnt - count of non-zero weights + */ + nzcnt = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(w->ptr.p_double[i],0) ) + { + nzcnt = nzcnt+1; + } + } + + /* + * Compute R2 + */ + if( nzcnt>0 ) + { + avg = 0.0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(w->ptr.p_double[i],0) ) + { + avg = avg+y->ptr.p_double[i]; + } + } + avg = avg/nzcnt; + rss = 0.0; + tss = 0.0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(w->ptr.p_double[i],0) ) + { + v = ae_v_dotproduct(&f1->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,k-1)); + v = v+f0->ptr.p_double[i]; + rss = rss+ae_sqr(v-y->ptr.p_double[i], _state); + tss = tss+ae_sqr(y->ptr.p_double[i]-avg, _state); + } + } + if( ae_fp_neq(tss,0) ) + { + rep->r2 = ae_maxreal(1.0-rss/tss, 0.0, _state); + } + else + { + rep->r2 = 1.0; + } + } + else + { + rep->r2 = 0; + } + + /* + * Compute estimate of proportionality between noise in the data and weights: + * NoiseC = mean(per-point-noise*per-point-weight) + * Noise level (standard deviation) at each point is equal to NoiseC/W[I]. + */ + if( nzcnt>k ) + { + noisec = 0.0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(w->ptr.p_double[i],0) ) + { + v = ae_v_dotproduct(&f1->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,k-1)); + v = v+f0->ptr.p_double[i]; + noisec = noisec+ae_sqr((v-y->ptr.p_double[i])*w->ptr.p_double[i], _state); + } + } + noisec = ae_sqrt(noisec/(nzcnt-k), _state); + } + else + { + noisec = 0.0; + } + + /* + * Two branches on noise level: + * * NoiseC>0 normal situation + * * NoiseC=0 degenerate case CovPar is filled by zeros + */ + rmatrixsetlengthatleast(&rep->covpar, k, k, _state); + if( ae_fp_greater(noisec,0) ) + { + + /* + * Normal situation: non-zero noise level + */ + ae_assert(zkind==0||zkind==1, "LSFit: internal error in EstimateErrors() function", _state); + if( zkind==0 ) + { + + /* + * Z contains no additional information which can be used to speed up + * calculations. We have to calculate covariance matrix on our own: + * * Compute scaled Jacobian N*J, where N[i,i]=WCur[I]/NoiseC, store in Z + * * Compute Z'*Z, store in CovPar + * * Apply moderate regularization to CovPar and compute matrix inverse. + * In case inverse failed, increase regularization parameter and try + * again. + */ + rmatrixsetlengthatleast(z, n, k, _state); + for(i=0; i<=n-1; i++) + { + v = w->ptr.p_double[i]/noisec; + ae_v_moved(&z->ptr.pp_double[i][0], 1, &f1->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); + } + + /* + * Convert S to automatically scaled damped matrix: + * * calculate SZ - sum of diagonal elements of Z'*Z + * * calculate SS - sum of diagonal elements of S^(-2) + * * overwrite S by (SZ/SS)*S^(-2) + * * now S has approximately same magnitude as giagonal of Z'*Z + */ + sz = 0; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=k-1; j++) + { + sz = sz+z->ptr.pp_double[i][j]*z->ptr.pp_double[i][j]; + } + } + if( ae_fp_eq(sz,0) ) + { + sz = 1; + } + ss = 0; + for(j=0; j<=k-1; j++) + { + ss = ss+1/ae_sqr(s->ptr.p_double[j], _state); + } + for(j=0; j<=k-1; j++) + { + s->ptr.p_double[j] = sz/ss/ae_sqr(s->ptr.p_double[j], _state); + } + + /* + * Calculate damped inverse inv(Z'*Z+S). + * We increase damping factor V until Z'*Z become well-conditioned. + */ + v = 1.0E3*ae_machineepsilon; + do + { + rmatrixsyrk(k, n, 1.0, z, 0, 0, 2, 0.0, &rep->covpar, 0, 0, ae_true, _state); + for(i=0; i<=k-1; i++) + { + rep->covpar.ptr.pp_double[i][i] = rep->covpar.ptr.pp_double[i][i]+v*s->ptr.p_double[i]; + } + spdmatrixinverse(&rep->covpar, k, ae_true, &info, &invrep, _state); + v = 10*v; + } + while(info<=0); + for(i=0; i<=k-1; i++) + { + for(j=i+1; j<=k-1; j++) + { + rep->covpar.ptr.pp_double[j][i] = rep->covpar.ptr.pp_double[i][j]; + } + } + } + if( zkind==1 ) + { + + /* + * We can reuse additional information: + * * Z contains R matrix from QR decomposition of W*F1 + * * After multiplication by 1/NoiseC we get Z_mod = N*F1, where diag(N)=w[i]/NoiseC + * * Such triangular Z_mod is a Cholesky factor from decomposition of J'*N'*N*J. + * Thus, we can calculate covariance matrix as inverse of the matrix given by + * its Cholesky decomposition. It allow us to avoid time-consuming calculation + * of J'*N'*N*J in CovPar - complexity is reduced from O(N*K^2) to O(K^3), which + * is quite good because K is usually orders of magnitude smaller than N. + * + * First, convert S to automatically scaled damped matrix: + * * calculate SZ - sum of magnitudes of diagonal elements of Z/NoiseC + * * calculate SS - sum of diagonal elements of S^(-1) + * * overwrite S by (SZ/SS)*S^(-1) + * * now S has approximately same magnitude as giagonal of Z'*Z + */ + sz = 0; + for(j=0; j<=k-1; j++) + { + sz = sz+ae_fabs(z->ptr.pp_double[j][j]/noisec, _state); + } + if( ae_fp_eq(sz,0) ) + { + sz = 1; + } + ss = 0; + for(j=0; j<=k-1; j++) + { + ss = ss+1/s->ptr.p_double[j]; + } + for(j=0; j<=k-1; j++) + { + s->ptr.p_double[j] = sz/ss/s->ptr.p_double[j]; + } + + /* + * Calculate damped inverse of inv((Z+v*S)'*(Z+v*S)) + * We increase damping factor V until matrix become well-conditioned. + */ + v = 1.0E3*ae_machineepsilon; + do + { + for(i=0; i<=k-1; i++) + { + for(j=i; j<=k-1; j++) + { + rep->covpar.ptr.pp_double[i][j] = z->ptr.pp_double[i][j]/noisec; + } + rep->covpar.ptr.pp_double[i][i] = rep->covpar.ptr.pp_double[i][i]+v*s->ptr.p_double[i]; + } + spdmatrixcholeskyinverse(&rep->covpar, k, ae_true, &info, &invrep, _state); + v = 10*v; + } + while(info<=0); + for(i=0; i<=k-1; i++) + { + for(j=i+1; j<=k-1; j++) + { + rep->covpar.ptr.pp_double[j][i] = rep->covpar.ptr.pp_double[i][j]; + } + } + } + } + else + { + + /* + * Degenerate situation: zero noise level, covariance matrix is zero. + */ + for(i=0; i<=k-1; i++) + { + for(j=0; j<=k-1; j++) + { + rep->covpar.ptr.pp_double[j][i] = 0; + } + } + } + + /* + * Estimate erorrs in parameters, curve and per-point noise + */ + rvectorsetlengthatleast(&rep->errpar, k, _state); + rvectorsetlengthatleast(&rep->errcurve, n, _state); + rvectorsetlengthatleast(&rep->noise, n, _state); + for(i=0; i<=k-1; i++) + { + rep->errpar.ptr.p_double[i] = ae_sqrt(rep->covpar.ptr.pp_double[i][i], _state); + } + for(i=0; i<=n-1; i++) + { + + /* + * ErrCurve[I] is sqrt(P[i,i]) where P=J*CovPar*J' + */ + v = 0.0; + for(j=0; j<=k-1; j++) + { + for(j1=0; j1<=k-1; j1++) + { + v = v+f1->ptr.pp_double[i][j]*rep->covpar.ptr.pp_double[j][j1]*f1->ptr.pp_double[i][j1]; + } + } + rep->errcurve.ptr.p_double[i] = ae_sqrt(v, _state); + + /* + * Noise[i] is filled using weights and current estimate of noise level + */ + if( ae_fp_neq(w->ptr.p_double[i],0) ) + { + rep->noise.ptr.p_double[i] = noisec/w->ptr.p_double[i]; + } + else + { + rep->noise.ptr.p_double[i] = 0; + } + } + ae_frame_leave(_state); +} + + +ae_bool _polynomialfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + polynomialfitreport *p = (polynomialfitreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _polynomialfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + polynomialfitreport *dst = (polynomialfitreport*)_dst; + polynomialfitreport *src = (polynomialfitreport*)_src; + dst->taskrcond = src->taskrcond; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + dst->maxerror = src->maxerror; + return ae_true; +} + + +void _polynomialfitreport_clear(void* _p) +{ + polynomialfitreport *p = (polynomialfitreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _polynomialfitreport_destroy(void* _p) +{ + polynomialfitreport *p = (polynomialfitreport*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _barycentricfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + barycentricfitreport *p = (barycentricfitreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _barycentricfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + barycentricfitreport *dst = (barycentricfitreport*)_dst; + barycentricfitreport *src = (barycentricfitreport*)_src; + dst->taskrcond = src->taskrcond; + dst->dbest = src->dbest; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + dst->maxerror = src->maxerror; + return ae_true; +} + + +void _barycentricfitreport_clear(void* _p) +{ + barycentricfitreport *p = (barycentricfitreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _barycentricfitreport_destroy(void* _p) +{ + barycentricfitreport *p = (barycentricfitreport*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _spline1dfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + spline1dfitreport *p = (spline1dfitreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _spline1dfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + spline1dfitreport *dst = (spline1dfitreport*)_dst; + spline1dfitreport *src = (spline1dfitreport*)_src; + dst->taskrcond = src->taskrcond; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + dst->maxerror = src->maxerror; + return ae_true; +} + + +void _spline1dfitreport_clear(void* _p) +{ + spline1dfitreport *p = (spline1dfitreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _spline1dfitreport_destroy(void* _p) +{ + spline1dfitreport *p = (spline1dfitreport*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _lsfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + lsfitreport *p = (lsfitreport*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->covpar, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->errpar, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->errcurve, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->noise, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _lsfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + lsfitreport *dst = (lsfitreport*)_dst; + lsfitreport *src = (lsfitreport*)_src; + dst->taskrcond = src->taskrcond; + dst->iterationscount = src->iterationscount; + dst->varidx = src->varidx; + dst->rmserror = src->rmserror; + dst->avgerror = src->avgerror; + dst->avgrelerror = src->avgrelerror; + dst->maxerror = src->maxerror; + dst->wrmserror = src->wrmserror; + if( !ae_matrix_init_copy(&dst->covpar, &src->covpar, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->errpar, &src->errpar, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->errcurve, &src->errcurve, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->noise, &src->noise, _state, make_automatic) ) + return ae_false; + dst->r2 = src->r2; + return ae_true; +} + + +void _lsfitreport_clear(void* _p) +{ + lsfitreport *p = (lsfitreport*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->covpar); + ae_vector_clear(&p->errpar); + ae_vector_clear(&p->errcurve); + ae_vector_clear(&p->noise); +} + + +void _lsfitreport_destroy(void* _p) +{ + lsfitreport *p = (lsfitreport*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->covpar); + ae_vector_destroy(&p->errpar); + ae_vector_destroy(&p->errcurve); + ae_vector_destroy(&p->noise); +} + + +ae_bool _lsfitstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + lsfitstate *p = (lsfitstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->taskx, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tasky, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->taskw, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->c, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->h, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->wcur, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tmpjac, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tmpjacw, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_matinvreport_init(&p->invrep, _state, make_automatic) ) + return ae_false; + if( !_lsfitreport_init(&p->rep, _state, make_automatic) ) + return ae_false; + if( !_minlmstate_init(&p->optstate, _state, make_automatic) ) + return ae_false; + if( !_minlmreport_init(&p->optrep, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _lsfitstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + lsfitstate *dst = (lsfitstate*)_dst; + lsfitstate *src = (lsfitstate*)_src; + dst->optalgo = src->optalgo; + dst->m = src->m; + dst->k = src->k; + dst->epsf = src->epsf; + dst->epsx = src->epsx; + dst->maxits = src->maxits; + dst->stpmax = src->stpmax; + dst->xrep = src->xrep; + if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->taskx, &src->taskx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tasky, &src->tasky, _state, make_automatic) ) + return ae_false; + dst->npoints = src->npoints; + if( !ae_vector_init_copy(&dst->taskw, &src->taskw, _state, make_automatic) ) + return ae_false; + dst->nweights = src->nweights; + dst->wkind = src->wkind; + dst->wits = src->wits; + dst->diffstep = src->diffstep; + dst->teststep = src->teststep; + dst->xupdated = src->xupdated; + dst->needf = src->needf; + dst->needfg = src->needfg; + dst->needfgh = src->needfgh; + dst->pointindex = src->pointindex; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->c, &src->c, _state, make_automatic) ) + return ae_false; + dst->f = src->f; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->h, &src->h, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->wcur, &src->wcur, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmp, &src->tmp, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpf, &src->tmpf, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tmpjac, &src->tmpjac, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tmpjacw, &src->tmpjacw, _state, make_automatic) ) + return ae_false; + dst->tmpnoise = src->tmpnoise; + if( !_matinvreport_init_copy(&dst->invrep, &src->invrep, _state, make_automatic) ) + return ae_false; + dst->repiterationscount = src->repiterationscount; + dst->repterminationtype = src->repterminationtype; + dst->repvaridx = src->repvaridx; + dst->reprmserror = src->reprmserror; + dst->repavgerror = src->repavgerror; + dst->repavgrelerror = src->repavgrelerror; + dst->repmaxerror = src->repmaxerror; + dst->repwrmserror = src->repwrmserror; + if( !_lsfitreport_init_copy(&dst->rep, &src->rep, _state, make_automatic) ) + return ae_false; + if( !_minlmstate_init_copy(&dst->optstate, &src->optstate, _state, make_automatic) ) + return ae_false; + if( !_minlmreport_init_copy(&dst->optrep, &src->optrep, _state, make_automatic) ) + return ae_false; + dst->prevnpt = src->prevnpt; + dst->prevalgo = src->prevalgo; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _lsfitstate_clear(void* _p) +{ + lsfitstate *p = (lsfitstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->s); + ae_vector_clear(&p->bndl); + ae_vector_clear(&p->bndu); + ae_matrix_clear(&p->taskx); + ae_vector_clear(&p->tasky); + ae_vector_clear(&p->taskw); + ae_vector_clear(&p->x); + ae_vector_clear(&p->c); + ae_vector_clear(&p->g); + ae_matrix_clear(&p->h); + ae_vector_clear(&p->wcur); + ae_vector_clear(&p->tmp); + ae_vector_clear(&p->tmpf); + ae_matrix_clear(&p->tmpjac); + ae_matrix_clear(&p->tmpjacw); + _matinvreport_clear(&p->invrep); + _lsfitreport_clear(&p->rep); + _minlmstate_clear(&p->optstate); + _minlmreport_clear(&p->optrep); + _rcommstate_clear(&p->rstate); +} + + +void _lsfitstate_destroy(void* _p) +{ + lsfitstate *p = (lsfitstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->s); + ae_vector_destroy(&p->bndl); + ae_vector_destroy(&p->bndu); + ae_matrix_destroy(&p->taskx); + ae_vector_destroy(&p->tasky); + ae_vector_destroy(&p->taskw); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->c); + ae_vector_destroy(&p->g); + ae_matrix_destroy(&p->h); + ae_vector_destroy(&p->wcur); + ae_vector_destroy(&p->tmp); + ae_vector_destroy(&p->tmpf); + ae_matrix_destroy(&p->tmpjac); + ae_matrix_destroy(&p->tmpjacw); + _matinvreport_destroy(&p->invrep); + _lsfitreport_destroy(&p->rep); + _minlmstate_destroy(&p->optstate); + _minlmreport_destroy(&p->optrep); + _rcommstate_destroy(&p->rstate); +} + + + + +/************************************************************************* +This function builds non-periodic 2-dimensional parametric spline which +starts at (X[0],Y[0]) and ends at (X[N-1],Y[N-1]). + +INPUT PARAMETERS: + XY - points, array[0..N-1,0..1]. + XY[I,0:1] corresponds to the Ith point. + Order of points is important! + N - points count, N>=5 for Akima splines, N>=2 for other types of + splines. + ST - spline type: + * 0 Akima spline + * 1 parabolically terminated Catmull-Rom spline (Tension=0) + * 2 parabolically terminated cubic spline + PT - parameterization type: + * 0 uniform + * 1 chord length + * 2 centripetal + +OUTPUT PARAMETERS: + P - parametric spline interpolant + + +NOTES: +* this function assumes that there all consequent points are distinct. + I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. + However, non-consequent points may coincide, i.e. we can have (x0,y0)= + =(x2,y2). + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2build(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t st, + ae_int_t pt, + pspline2interpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _xy; + ae_vector tmp; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_xy, xy, _state, ae_true); + xy = &_xy; + _pspline2interpolant_clear(p); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + ae_assert(st>=0&&st<=2, "PSpline2Build: incorrect spline type!", _state); + ae_assert(pt>=0&&pt<=2, "PSpline2Build: incorrect parameterization type!", _state); + if( st==0 ) + { + ae_assert(n>=5, "PSpline2Build: N<5 (minimum value for Akima splines)!", _state); + } + else + { + ae_assert(n>=2, "PSpline2Build: N<2!", _state); + } + + /* + * Prepare + */ + p->n = n; + p->periodic = ae_false; + ae_vector_set_length(&tmp, n, _state); + + /* + * Build parameterization, check that all parameters are distinct + */ + pspline_pspline2par(xy, n, pt, &p->p, _state); + ae_assert(aredistinct(&p->p, n, _state), "PSpline2Build: consequent points are too close!", _state); + + /* + * Build splines + */ + if( st==0 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); + spline1dbuildakima(&p->p, &tmp, n, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); + spline1dbuildakima(&p->p, &tmp, n, &p->y, _state); + } + if( st==1 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->y, _state); + } + if( st==2 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->y, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function builds non-periodic 3-dimensional parametric spline which +starts at (X[0],Y[0],Z[0]) and ends at (X[N-1],Y[N-1],Z[N-1]). + +Same as PSpline2Build() function, but for 3D, so we won't duplicate its +description here. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3build(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t st, + ae_int_t pt, + pspline3interpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _xy; + ae_vector tmp; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_xy, xy, _state, ae_true); + xy = &_xy; + _pspline3interpolant_clear(p); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + ae_assert(st>=0&&st<=2, "PSpline3Build: incorrect spline type!", _state); + ae_assert(pt>=0&&pt<=2, "PSpline3Build: incorrect parameterization type!", _state); + if( st==0 ) + { + ae_assert(n>=5, "PSpline3Build: N<5 (minimum value for Akima splines)!", _state); + } + else + { + ae_assert(n>=2, "PSpline3Build: N<2!", _state); + } + + /* + * Prepare + */ + p->n = n; + p->periodic = ae_false; + ae_vector_set_length(&tmp, n, _state); + + /* + * Build parameterization, check that all parameters are distinct + */ + pspline_pspline3par(xy, n, pt, &p->p, _state); + ae_assert(aredistinct(&p->p, n, _state), "PSpline3Build: consequent points are too close!", _state); + + /* + * Build splines + */ + if( st==0 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); + spline1dbuildakima(&p->p, &tmp, n, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); + spline1dbuildakima(&p->p, &tmp, n, &p->y, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][2], xy->stride, ae_v_len(0,n-1)); + spline1dbuildakima(&p->p, &tmp, n, &p->z, _state); + } + if( st==1 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->y, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][2], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcatmullrom(&p->p, &tmp, n, 0, 0.0, &p->z, _state); + } + if( st==2 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->y, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xy->ptr.pp_double[0][2], xy->stride, ae_v_len(0,n-1)); + spline1dbuildcubic(&p->p, &tmp, n, 0, 0.0, 0, 0.0, &p->z, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function builds periodic 2-dimensional parametric spline which +starts at (X[0],Y[0]), goes through all points to (X[N-1],Y[N-1]) and then +back to (X[0],Y[0]). + +INPUT PARAMETERS: + XY - points, array[0..N-1,0..1]. + XY[I,0:1] corresponds to the Ith point. + XY[N-1,0:1] must be different from XY[0,0:1]. + Order of points is important! + N - points count, N>=3 for other types of splines. + ST - spline type: + * 1 Catmull-Rom spline (Tension=0) with cyclic boundary conditions + * 2 cubic spline with cyclic boundary conditions + PT - parameterization type: + * 0 uniform + * 1 chord length + * 2 centripetal + +OUTPUT PARAMETERS: + P - parametric spline interpolant + + +NOTES: +* this function assumes that there all consequent points are distinct. + I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. + However, non-consequent points may coincide, i.e. we can have (x0,y0)= + =(x2,y2). +* last point of sequence is NOT equal to the first point. You shouldn't + make curve "explicitly periodic" by making them equal. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2buildperiodic(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t st, + ae_int_t pt, + pspline2interpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _xy; + ae_matrix xyp; + ae_vector tmp; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_xy, xy, _state, ae_true); + xy = &_xy; + _pspline2interpolant_clear(p); + ae_matrix_init(&xyp, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + ae_assert(st>=1&&st<=2, "PSpline2BuildPeriodic: incorrect spline type!", _state); + ae_assert(pt>=0&&pt<=2, "PSpline2BuildPeriodic: incorrect parameterization type!", _state); + ae_assert(n>=3, "PSpline2BuildPeriodic: N<3!", _state); + + /* + * Prepare + */ + p->n = n; + p->periodic = ae_true; + ae_vector_set_length(&tmp, n+1, _state); + ae_matrix_set_length(&xyp, n+1, 2, _state); + ae_v_move(&xyp.ptr.pp_double[0][0], xyp.stride, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); + ae_v_move(&xyp.ptr.pp_double[0][1], xyp.stride, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); + ae_v_move(&xyp.ptr.pp_double[n][0], 1, &xy->ptr.pp_double[0][0], 1, ae_v_len(0,1)); + + /* + * Build parameterization, check that all parameters are distinct + */ + pspline_pspline2par(&xyp, n+1, pt, &p->p, _state); + ae_assert(aredistinct(&p->p, n+1, _state), "PSpline2BuildPeriodic: consequent (or first and last) points are too close!", _state); + + /* + * Build splines + */ + if( st==1 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][0], xyp.stride, ae_v_len(0,n)); + spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][1], xyp.stride, ae_v_len(0,n)); + spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->y, _state); + } + if( st==2 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][0], xyp.stride, ae_v_len(0,n)); + spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][1], xyp.stride, ae_v_len(0,n)); + spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->y, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function builds periodic 3-dimensional parametric spline which +starts at (X[0],Y[0],Z[0]), goes through all points to (X[N-1],Y[N-1],Z[N-1]) +and then back to (X[0],Y[0],Z[0]). + +Same as PSpline2Build() function, but for 3D, so we won't duplicate its +description here. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3buildperiodic(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t st, + ae_int_t pt, + pspline3interpolant* p, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _xy; + ae_matrix xyp; + ae_vector tmp; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_xy, xy, _state, ae_true); + xy = &_xy; + _pspline3interpolant_clear(p); + ae_matrix_init(&xyp, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + ae_assert(st>=1&&st<=2, "PSpline3BuildPeriodic: incorrect spline type!", _state); + ae_assert(pt>=0&&pt<=2, "PSpline3BuildPeriodic: incorrect parameterization type!", _state); + ae_assert(n>=3, "PSpline3BuildPeriodic: N<3!", _state); + + /* + * Prepare + */ + p->n = n; + p->periodic = ae_true; + ae_vector_set_length(&tmp, n+1, _state); + ae_matrix_set_length(&xyp, n+1, 3, _state); + ae_v_move(&xyp.ptr.pp_double[0][0], xyp.stride, &xy->ptr.pp_double[0][0], xy->stride, ae_v_len(0,n-1)); + ae_v_move(&xyp.ptr.pp_double[0][1], xyp.stride, &xy->ptr.pp_double[0][1], xy->stride, ae_v_len(0,n-1)); + ae_v_move(&xyp.ptr.pp_double[0][2], xyp.stride, &xy->ptr.pp_double[0][2], xy->stride, ae_v_len(0,n-1)); + ae_v_move(&xyp.ptr.pp_double[n][0], 1, &xy->ptr.pp_double[0][0], 1, ae_v_len(0,2)); + + /* + * Build parameterization, check that all parameters are distinct + */ + pspline_pspline3par(&xyp, n+1, pt, &p->p, _state); + ae_assert(aredistinct(&p->p, n+1, _state), "PSplineBuild2Periodic: consequent (or first and last) points are too close!", _state); + + /* + * Build splines + */ + if( st==1 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][0], xyp.stride, ae_v_len(0,n)); + spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][1], xyp.stride, ae_v_len(0,n)); + spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->y, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][2], xyp.stride, ae_v_len(0,n)); + spline1dbuildcatmullrom(&p->p, &tmp, n+1, -1, 0.0, &p->z, _state); + } + if( st==2 ) + { + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][0], xyp.stride, ae_v_len(0,n)); + spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->x, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][1], xyp.stride, ae_v_len(0,n)); + spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->y, _state); + ae_v_move(&tmp.ptr.p_double[0], 1, &xyp.ptr.pp_double[0][2], xyp.stride, ae_v_len(0,n)); + spline1dbuildcubic(&p->p, &tmp, n+1, -1, 0.0, -1, 0.0, &p->z, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function returns vector of parameter values correspoding to points. + +I.e. for P created from (X[0],Y[0])...(X[N-1],Y[N-1]) and U=TValues(P) we +have + (X[0],Y[0]) = PSpline2Calc(P,U[0]), + (X[1],Y[1]) = PSpline2Calc(P,U[1]), + (X[2],Y[2]) = PSpline2Calc(P,U[2]), + ... + +INPUT PARAMETERS: + P - parametric spline interpolant + +OUTPUT PARAMETERS: + N - array size + T - array[0..N-1] + + +NOTES: +* for non-periodic splines U[0]=0, U[0]n>=2, "PSpline2ParameterValues: internal error!", _state); + *n = p->n; + ae_vector_set_length(t, *n, _state); + ae_v_move(&t->ptr.p_double[0], 1, &p->p.ptr.p_double[0], 1, ae_v_len(0,*n-1)); + t->ptr.p_double[0] = 0; + if( !p->periodic ) + { + t->ptr.p_double[*n-1] = 1; + } +} + + +/************************************************************************* +This function returns vector of parameter values correspoding to points. + +Same as PSpline2ParameterValues(), but for 3D. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3parametervalues(pspline3interpolant* p, + ae_int_t* n, + /* Real */ ae_vector* t, + ae_state *_state) +{ + + *n = 0; + ae_vector_clear(t); + + ae_assert(p->n>=2, "PSpline3ParameterValues: internal error!", _state); + *n = p->n; + ae_vector_set_length(t, *n, _state); + ae_v_move(&t->ptr.p_double[0], 1, &p->p.ptr.p_double[0], 1, ae_v_len(0,*n-1)); + t->ptr.p_double[0] = 0; + if( !p->periodic ) + { + t->ptr.p_double[*n-1] = 1; + } +} + + +/************************************************************************* +This function calculates the value of the parametric spline for a given +value of parameter T + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-position + Y - Y-position + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2calc(pspline2interpolant* p, + double t, + double* x, + double* y, + ae_state *_state) +{ + + *x = 0; + *y = 0; + + if( p->periodic ) + { + t = t-ae_ifloor(t, _state); + } + *x = spline1dcalc(&p->x, t, _state); + *y = spline1dcalc(&p->y, t, _state); +} + + +/************************************************************************* +This function calculates the value of the parametric spline for a given +value of parameter T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-position + Y - Y-position + Z - Z-position + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3calc(pspline3interpolant* p, + double t, + double* x, + double* y, + double* z, + ae_state *_state) +{ + + *x = 0; + *y = 0; + *z = 0; + + if( p->periodic ) + { + t = t-ae_ifloor(t, _state); + } + *x = spline1dcalc(&p->x, t, _state); + *y = spline1dcalc(&p->y, t, _state); + *z = spline1dcalc(&p->z, t, _state); +} + + +/************************************************************************* +This function calculates tangent vector for a given value of parameter T + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-component of tangent vector (normalized) + Y - Y-component of tangent vector (normalized) + +NOTE: + X^2+Y^2 is either 1 (for non-zero tangent vector) or 0. + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2tangent(pspline2interpolant* p, + double t, + double* x, + double* y, + ae_state *_state) +{ + double v; + double v0; + double v1; + + *x = 0; + *y = 0; + + if( p->periodic ) + { + t = t-ae_ifloor(t, _state); + } + pspline2diff(p, t, &v0, x, &v1, y, _state); + if( ae_fp_neq(*x,0)||ae_fp_neq(*y,0) ) + { + + /* + * this code is a bit more complex than X^2+Y^2 to avoid + * overflow for large values of X and Y. + */ + v = safepythag2(*x, *y, _state); + *x = *x/v; + *y = *y/v; + } +} + + +/************************************************************************* +This function calculates tangent vector for a given value of parameter T + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-component of tangent vector (normalized) + Y - Y-component of tangent vector (normalized) + Z - Z-component of tangent vector (normalized) + +NOTE: + X^2+Y^2+Z^2 is either 1 (for non-zero tangent vector) or 0. + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3tangent(pspline3interpolant* p, + double t, + double* x, + double* y, + double* z, + ae_state *_state) +{ + double v; + double v0; + double v1; + double v2; + + *x = 0; + *y = 0; + *z = 0; + + if( p->periodic ) + { + t = t-ae_ifloor(t, _state); + } + pspline3diff(p, t, &v0, x, &v1, y, &v2, z, _state); + if( (ae_fp_neq(*x,0)||ae_fp_neq(*y,0))||ae_fp_neq(*z,0) ) + { + v = safepythag3(*x, *y, *z, _state); + *x = *x/v; + *y = *y/v; + *z = *z/v; + } +} + + +/************************************************************************* +This function calculates derivative, i.e. it returns (dX/dT,dY/dT). + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - X-derivative + Y - Y-value + DY - Y-derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2diff(pspline2interpolant* p, + double t, + double* x, + double* dx, + double* y, + double* dy, + ae_state *_state) +{ + double d2s; + + *x = 0; + *dx = 0; + *y = 0; + *dy = 0; + + if( p->periodic ) + { + t = t-ae_ifloor(t, _state); + } + spline1ddiff(&p->x, t, x, dx, &d2s, _state); + spline1ddiff(&p->y, t, y, dy, &d2s, _state); +} + + +/************************************************************************* +This function calculates derivative, i.e. it returns (dX/dT,dY/dT,dZ/dT). + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - X-derivative + Y - Y-value + DY - Y-derivative + Z - Z-value + DZ - Z-derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3diff(pspline3interpolant* p, + double t, + double* x, + double* dx, + double* y, + double* dy, + double* z, + double* dz, + ae_state *_state) +{ + double d2s; + + *x = 0; + *dx = 0; + *y = 0; + *dy = 0; + *z = 0; + *dz = 0; + + if( p->periodic ) + { + t = t-ae_ifloor(t, _state); + } + spline1ddiff(&p->x, t, x, dx, &d2s, _state); + spline1ddiff(&p->y, t, y, dy, &d2s, _state); + spline1ddiff(&p->z, t, z, dz, &d2s, _state); +} + + +/************************************************************************* +This function calculates first and second derivative with respect to T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - derivative + D2X - second derivative + Y - Y-value + DY - derivative + D2Y - second derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2diff2(pspline2interpolant* p, + double t, + double* x, + double* dx, + double* d2x, + double* y, + double* dy, + double* d2y, + ae_state *_state) +{ + + *x = 0; + *dx = 0; + *d2x = 0; + *y = 0; + *dy = 0; + *d2y = 0; + + if( p->periodic ) + { + t = t-ae_ifloor(t, _state); + } + spline1ddiff(&p->x, t, x, dx, d2x, _state); + spline1ddiff(&p->y, t, y, dy, d2y, _state); +} + + +/************************************************************************* +This function calculates first and second derivative with respect to T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - derivative + D2X - second derivative + Y - Y-value + DY - derivative + D2Y - second derivative + Z - Z-value + DZ - derivative + D2Z - second derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3diff2(pspline3interpolant* p, + double t, + double* x, + double* dx, + double* d2x, + double* y, + double* dy, + double* d2y, + double* z, + double* dz, + double* d2z, + ae_state *_state) +{ + + *x = 0; + *dx = 0; + *d2x = 0; + *y = 0; + *dy = 0; + *d2y = 0; + *z = 0; + *dz = 0; + *d2z = 0; + + if( p->periodic ) + { + t = t-ae_ifloor(t, _state); + } + spline1ddiff(&p->x, t, x, dx, d2x, _state); + spline1ddiff(&p->y, t, y, dy, d2y, _state); + spline1ddiff(&p->z, t, z, dz, d2z, _state); +} + + +/************************************************************************* +This function calculates arc length, i.e. length of curve between t=a +and t=b. + +INPUT PARAMETERS: + P - parametric spline interpolant + A,B - parameter values corresponding to arc ends: + * B>A will result in positive length returned + * Bx, state.x, &sx, &dsx, &d2sx, _state); + spline1ddiff(&p->y, state.x, &sy, &dsy, &d2sy, _state); + state.f = safepythag2(dsx, dsy, _state); + } + autogkresults(&state, &result, &rep, _state); + ae_assert(rep.terminationtype>0, "PSpline2ArcLength: internal error!", _state); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +This function calculates arc length, i.e. length of curve between t=a +and t=b. + +INPUT PARAMETERS: + P - parametric spline interpolant + A,B - parameter values corresponding to arc ends: + * B>A will result in positive length returned + * Bx, state.x, &sx, &dsx, &d2sx, _state); + spline1ddiff(&p->y, state.x, &sy, &dsy, &d2sy, _state); + spline1ddiff(&p->z, state.x, &sz, &dsz, &d2sz, _state); + state.f = safepythag3(dsx, dsy, dsz, _state); + } + autogkresults(&state, &result, &rep, _state); + ae_assert(rep.terminationtype>0, "PSpline3ArcLength: internal error!", _state); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Builds non-periodic parameterization for 2-dimensional spline +*************************************************************************/ +static void pspline_pspline2par(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t pt, + /* Real */ ae_vector* p, + ae_state *_state) +{ + double v; + ae_int_t i; + + ae_vector_clear(p); + + ae_assert(pt>=0&&pt<=2, "PSpline2Par: internal error!", _state); + + /* + * Build parameterization: + * * fill by non-normalized values + * * normalize them so we have P[0]=0, P[N-1]=1. + */ + ae_vector_set_length(p, n, _state); + if( pt==0 ) + { + for(i=0; i<=n-1; i++) + { + p->ptr.p_double[i] = i; + } + } + if( pt==1 ) + { + p->ptr.p_double[0] = 0; + for(i=1; i<=n-1; i++) + { + p->ptr.p_double[i] = p->ptr.p_double[i-1]+safepythag2(xy->ptr.pp_double[i][0]-xy->ptr.pp_double[i-1][0], xy->ptr.pp_double[i][1]-xy->ptr.pp_double[i-1][1], _state); + } + } + if( pt==2 ) + { + p->ptr.p_double[0] = 0; + for(i=1; i<=n-1; i++) + { + p->ptr.p_double[i] = p->ptr.p_double[i-1]+ae_sqrt(safepythag2(xy->ptr.pp_double[i][0]-xy->ptr.pp_double[i-1][0], xy->ptr.pp_double[i][1]-xy->ptr.pp_double[i-1][1], _state), _state); + } + } + v = 1/p->ptr.p_double[n-1]; + ae_v_muld(&p->ptr.p_double[0], 1, ae_v_len(0,n-1), v); +} + + +/************************************************************************* +Builds non-periodic parameterization for 3-dimensional spline +*************************************************************************/ +static void pspline_pspline3par(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t pt, + /* Real */ ae_vector* p, + ae_state *_state) +{ + double v; + ae_int_t i; + + ae_vector_clear(p); + + ae_assert(pt>=0&&pt<=2, "PSpline3Par: internal error!", _state); + + /* + * Build parameterization: + * * fill by non-normalized values + * * normalize them so we have P[0]=0, P[N-1]=1. + */ + ae_vector_set_length(p, n, _state); + if( pt==0 ) + { + for(i=0; i<=n-1; i++) + { + p->ptr.p_double[i] = i; + } + } + if( pt==1 ) + { + p->ptr.p_double[0] = 0; + for(i=1; i<=n-1; i++) + { + p->ptr.p_double[i] = p->ptr.p_double[i-1]+safepythag3(xy->ptr.pp_double[i][0]-xy->ptr.pp_double[i-1][0], xy->ptr.pp_double[i][1]-xy->ptr.pp_double[i-1][1], xy->ptr.pp_double[i][2]-xy->ptr.pp_double[i-1][2], _state); + } + } + if( pt==2 ) + { + p->ptr.p_double[0] = 0; + for(i=1; i<=n-1; i++) + { + p->ptr.p_double[i] = p->ptr.p_double[i-1]+ae_sqrt(safepythag3(xy->ptr.pp_double[i][0]-xy->ptr.pp_double[i-1][0], xy->ptr.pp_double[i][1]-xy->ptr.pp_double[i-1][1], xy->ptr.pp_double[i][2]-xy->ptr.pp_double[i-1][2], _state), _state); + } + } + v = 1/p->ptr.p_double[n-1]; + ae_v_muld(&p->ptr.p_double[0], 1, ae_v_len(0,n-1), v); +} + + +ae_bool _pspline2interpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + pspline2interpolant *p = (pspline2interpolant*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->p, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init(&p->x, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init(&p->y, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _pspline2interpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + pspline2interpolant *dst = (pspline2interpolant*)_dst; + pspline2interpolant *src = (pspline2interpolant*)_src; + dst->n = src->n; + dst->periodic = src->periodic; + if( !ae_vector_init_copy(&dst->p, &src->p, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _pspline2interpolant_clear(void* _p) +{ + pspline2interpolant *p = (pspline2interpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->p); + _spline1dinterpolant_clear(&p->x); + _spline1dinterpolant_clear(&p->y); +} + + +void _pspline2interpolant_destroy(void* _p) +{ + pspline2interpolant *p = (pspline2interpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->p); + _spline1dinterpolant_destroy(&p->x); + _spline1dinterpolant_destroy(&p->y); +} + + +ae_bool _pspline3interpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + pspline3interpolant *p = (pspline3interpolant*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->p, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init(&p->x, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init(&p->y, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init(&p->z, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _pspline3interpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + pspline3interpolant *dst = (pspline3interpolant*)_dst; + pspline3interpolant *src = (pspline3interpolant*)_src; + dst->n = src->n; + dst->periodic = src->periodic; + if( !ae_vector_init_copy(&dst->p, &src->p, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + if( !_spline1dinterpolant_init_copy(&dst->z, &src->z, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _pspline3interpolant_clear(void* _p) +{ + pspline3interpolant *p = (pspline3interpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->p); + _spline1dinterpolant_clear(&p->x); + _spline1dinterpolant_clear(&p->y); + _spline1dinterpolant_clear(&p->z); +} + + +void _pspline3interpolant_destroy(void* _p) +{ + pspline3interpolant *p = (pspline3interpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->p); + _spline1dinterpolant_destroy(&p->x); + _spline1dinterpolant_destroy(&p->y); + _spline1dinterpolant_destroy(&p->z); +} + + + + +/************************************************************************* +This function creates RBF model for a scalar (NY=1) or vector (NY>1) +function in a NX-dimensional space (NX=2 or NX=3). + +Newly created model is empty. It can be used for interpolation right after +creation, but it just returns zeros. You have to add points to the model, +tune interpolation settings, and then call model construction function +RBFBuildModel() which will update model according to your specification. + +USAGE: +1. User creates model with RBFCreate() +2. User adds dataset with RBFSetPoints() (points do NOT have to be on a + regular grid) +3. (OPTIONAL) User chooses polynomial term by calling: + * RBFLinTerm() to set linear term + * RBFConstTerm() to set constant term + * RBFZeroTerm() to set zero term + By default, linear term is used. +4. User chooses specific RBF algorithm to use: either QNN (RBFSetAlgoQNN) + or ML (RBFSetAlgoMultiLayer). +5. User calls RBFBuildModel() function which rebuilds model according to + the specification +6. User may call RBFCalc() to calculate model value at the specified point, + RBFGridCalc() to calculate model values at the points of the regular + grid. User may extract model coefficients with RBFUnpack() call. + +INPUT PARAMETERS: + NX - dimension of the space, NX=2 or NX=3 + NY - function dimension, NY>=1 + +OUTPUT PARAMETERS: + S - RBF model (initially equals to zero) + +NOTE 1: memory requirements. RBF models require amount of memory which is + proportional to the number of data points. Memory is allocated + during model construction, but most of this memory is freed after + model coefficients are calculated. + + Some approximate estimates for N centers with default settings are + given below: + * about 250*N*(sizeof(double)+2*sizeof(int)) bytes of memory is + needed during model construction stage. + * about 15*N*sizeof(double) bytes is needed after model is built. + For example, for N=100000 we may need 0.6 GB of memory to build + model, but just about 0.012 GB to store it. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcreate(ae_int_t nx, ae_int_t ny, rbfmodel* s, ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + _rbfmodel_clear(s); + + ae_assert(nx==2||nx==3, "RBFCreate: NX<>2 and NX<>3", _state); + ae_assert(ny>=1, "RBFCreate: NY<1", _state); + s->nx = nx; + s->ny = ny; + s->nl = 0; + s->nc = 0; + ae_matrix_set_length(&s->v, ny, rbf_mxnx+1, _state); + for(i=0; i<=ny-1; i++) + { + for(j=0; j<=rbf_mxnx; j++) + { + s->v.ptr.pp_double[i][j] = 0; + } + } + s->n = 0; + s->rmax = 0; + s->gridtype = 2; + s->fixrad = ae_false; + s->radvalue = 1; + s->radzvalue = 5; + s->aterm = 1; + s->algorithmtype = 1; + + /* + * stopping criteria + */ + s->epsort = rbf_eps; + s->epserr = rbf_eps; + s->maxits = 0; +} + + +/************************************************************************* +This function adds dataset. + +This function overrides results of the previous calls, i.e. multiple calls +of this function will result in only the last set being added. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call. + XY - points, array[N,NX+NY]. One row corresponds to one point + in the dataset. First NX elements are coordinates, next + NY elements are function values. Array may be larger than + specific, in this case only leading [N,NX+NY] elements + will be used. + N - number of points in the dataset + +After you've added dataset and (optionally) tuned algorithm settings you +should call RBFBuildModel() in order to build a model for you. + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetpoints(rbfmodel* s, + /* Real */ ae_matrix* xy, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + + ae_assert(n>0, "RBFSetPoints: N<0", _state); + ae_assert(xy->rows>=n, "RBFSetPoints: Rows(XY)cols>=s->nx+s->ny, "RBFSetPoints: Cols(XY)n = n; + ae_matrix_set_length(&s->x, s->n, rbf_mxnx, _state); + ae_matrix_set_length(&s->y, s->n, s->ny, _state); + for(i=0; i<=s->n-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + s->x.ptr.pp_double[i][j] = 0; + } + for(j=0; j<=s->nx-1; j++) + { + s->x.ptr.pp_double[i][j] = xy->ptr.pp_double[i][j]; + } + for(j=0; j<=s->ny-1; j++) + { + s->y.ptr.pp_double[i][j] = xy->ptr.pp_double[i][j+s->nx]; + } + } +} + + +/************************************************************************* +This function sets RBF interpolation algorithm. ALGLIB supports several +RBF algorithms with different properties. + +This algorithm is called RBF-QNN and it is good for point sets with +following properties: +a) all points are distinct +b) all points are well separated. +c) points distribution is approximately uniform. There is no "contour + lines", clusters of points, or other small-scale structures. + +Algorithm description: +1) interpolation centers are allocated to data points +2) interpolation radii are calculated as distances to the nearest centers + times Q coefficient (where Q is a value from [0.75,1.50]). +3) after performing (2) radii are transformed in order to avoid situation + when single outlier has very large radius and influences many points + across all dataset. Transformation has following form: + new_r[i] = min(r[i],Z*median(r[])) + where r[i] is I-th radius, median() is a median radius across entire + dataset, Z is user-specified value which controls amount of deviation + from median radius. + +When (a) is violated, we will be unable to build RBF model. When (b) or +(c) are violated, model will be built, but interpolation quality will be +low. See http://www.alglib.net/interpolation/ for more information on this +subject. + +This algorithm is used by default. + +Additional Q parameter controls smoothness properties of the RBF basis: +* Q<0.75 will give perfectly conditioned basis, but terrible smoothness + properties (RBF interpolant will have sharp peaks around function values) +* Q around 1.0 gives good balance between smoothness and condition number +* Q>1.5 will lead to badly conditioned systems and slow convergence of the + underlying linear solver (although smoothness will be very good) +* Q>2.0 will effectively make optimizer useless because it won't converge + within reasonable amount of iterations. It is possible to set such large + Q, but it is advised not to do so. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + Q - Q parameter, Q>0, recommended value - 1.0 + Z - Z parameter, Z>0, recommended value - 5.0 + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetalgoqnn(rbfmodel* s, double q, double z, ae_state *_state) +{ + + + ae_assert(ae_isfinite(q, _state), "RBFSetAlgoQNN: Q is infinite or NAN", _state); + ae_assert(ae_fp_greater(q,0), "RBFSetAlgoQNN: Q<=0", _state); + rbf_rbfgridpoints(s, _state); + rbf_rbfradnn(s, q, z, _state); + s->algorithmtype = 1; +} + + +/************************************************************************* +This function sets RBF interpolation algorithm. ALGLIB supports several +RBF algorithms with different properties. + +This algorithm is called RBF-ML. It builds multilayer RBF model, i.e. +model with subsequently decreasing radii, which allows us to combine +smoothness (due to large radii of the first layers) with exactness (due +to small radii of the last layers) and fast convergence. + +Internally RBF-ML uses many different means of acceleration, from sparse +matrices to KD-trees, which results in algorithm whose working time is +roughly proportional to N*log(N)*Density*RBase^2*NLayers, where N is a +number of points, Density is an average density if points per unit of the +interpolation space, RBase is an initial radius, NLayers is a number of +layers. + +RBF-ML is good for following kinds of interpolation problems: +1. "exact" problems (perfect fit) with well separated points +2. least squares problems with arbitrary distribution of points (algorithm + gives perfect fit where it is possible, and resorts to least squares + fit in the hard areas). +3. noisy problems where we want to apply some controlled amount of + smoothing. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + RBase - RBase parameter, RBase>0 + NLayers - NLayers parameter, NLayers>0, recommended value to start + with - about 5. + LambdaV - regularization value, can be useful when solving problem + in the least squares sense. Optimal lambda is problem- + dependent and require trial and error. In our experience, + good lambda can be as large as 0.1, and you can use 0.001 + as initial guess. + Default value - 0.01, which is used when LambdaV is not + given. You can specify zero value, but it is not + recommended to do so. + +TUNING ALGORITHM + +In order to use this algorithm you have to choose three parameters: +* initial radius RBase +* number of layers in the model NLayers +* regularization coefficient LambdaV + +Initial radius is easy to choose - you can pick any number several times +larger than the average distance between points. Algorithm won't break +down if you choose radius which is too large (model construction time will +increase, but model will be built correctly). + +Choose such number of layers that RLast=RBase/2^(NLayers-1) (radius used +by the last layer) will be smaller than the typical distance between +points. In case model error is too large, you can increase number of +layers. Having more layers will make model construction and evaluation +proportionally slower, but it will allow you to have model which precisely +fits your data. From the other side, if you want to suppress noise, you +can DECREASE number of layers to make your model less flexible. + +Regularization coefficient LambdaV controls smoothness of the individual +models built for each layer. We recommend you to use default value in case +you don't want to tune this parameter, because having non-zero LambdaV +accelerates and stabilizes internal iterative algorithm. In case you want +to suppress noise you can use LambdaV as additional parameter (larger +value = more smoothness) to tune. + +TYPICAL ERRORS + +1. Using initial radius which is too large. Memory requirements of the + RBF-ML are roughly proportional to N*Density*RBase^2 (where Density is + an average density of points per unit of the interpolation space). In + the extreme case of the very large RBase we will need O(N^2) units of + memory - and many layers in order to decrease radius to some reasonably + small value. + +2. Using too small number of layers - RBF models with large radius are not + flexible enough to reproduce small variations in the target function. + You need many layers with different radii, from large to small, in + order to have good model. + +3. Using initial radius which is too small. You will get model with + "holes" in the areas which are too far away from interpolation centers. + However, algorithm will work correctly (and quickly) in this case. + +4. Using too many layers - you will get too large and too slow model. This + model will perfectly reproduce your function, but maybe you will be + able to achieve similar results with less layers (and less memory). + + -- ALGLIB -- + Copyright 02.03.2012 by Bochkanov Sergey +*************************************************************************/ +void rbfsetalgomultilayer(rbfmodel* s, + double rbase, + ae_int_t nlayers, + double lambdav, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(rbase, _state), "RBFSetAlgoMultiLayer: RBase is infinite or NaN", _state); + ae_assert(ae_fp_greater(rbase,0), "RBFSetAlgoMultiLayer: RBase<=0", _state); + ae_assert(nlayers>=0, "RBFSetAlgoMultiLayer: NLayers<0", _state); + ae_assert(ae_isfinite(lambdav, _state), "RBFSetAlgoMultiLayer: LambdaV is infinite or NAN", _state); + ae_assert(ae_fp_greater_eq(lambdav,0), "RBFSetAlgoMultiLayer: LambdaV<0", _state); + s->radvalue = rbase; + s->nlayers = nlayers; + s->algorithmtype = 2; + s->lambdav = lambdav; +} + + +/************************************************************************* +This function sets linear term (model is a sum of radial basis functions +plus linear polynomial). This function won't have effect until next call +to RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetlinterm(rbfmodel* s, ae_state *_state) +{ + + + s->aterm = 1; +} + + +/************************************************************************* +This function sets constant term (model is a sum of radial basis functions +plus constant). This function won't have effect until next call to +RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetconstterm(rbfmodel* s, ae_state *_state) +{ + + + s->aterm = 2; +} + + +/************************************************************************* +This function sets zero term (model is a sum of radial basis functions +without polynomial term). This function won't have effect until next call +to RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetzeroterm(rbfmodel* s, ae_state *_state) +{ + + + s->aterm = 3; +} + + +/************************************************************************* +This function sets stopping criteria of the underlying linear solver. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + EpsOrt - orthogonality stopping criterion, EpsOrt>=0. Algorithm will + stop when ||A'*r||<=EpsOrt where A' is a transpose of the + system matrix, r is a residual vector. + Recommended value of EpsOrt is equal to 1E-6. + This criterion will stop algorithm when we have "bad fit" + situation, i.e. when we should stop in a point with large, + nonzero residual. + EpsErr - residual stopping criterion. Algorithm will stop when + ||r||<=EpsErr*||b||, where r is a residual vector, b is a + right part of the system (function values). + Recommended value of EpsErr is equal to 1E-3 or 1E-6. + This criterion will stop algorithm in a "good fit" + situation when we have near-zero residual near the desired + solution. + MaxIts - this criterion will stop algorithm after MaxIts iterations. + It should be used for debugging purposes only! + Zero MaxIts means that no limit is placed on the number of + iterations. + +We recommend to set moderate non-zero values EpsOrt and EpsErr +simultaneously. Values equal to 10E-6 are good to start with. In case you +need high performance and do not need high precision , you may decrease +EpsErr down to 0.001. However, we do not recommend decreasing EpsOrt. + +As for MaxIts, we recommend to leave it zero unless you know what you do. + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetcond(rbfmodel* s, + double epsort, + double epserr, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsort, _state)&&ae_fp_greater_eq(epsort,0), "RBFSetCond: EpsOrt is negative, INF or NAN", _state); + ae_assert(ae_isfinite(epserr, _state)&&ae_fp_greater_eq(epserr,0), "RBFSetCond: EpsB is negative, INF or NAN", _state); + ae_assert(maxits>=0, "RBFSetCond: MaxIts is negative", _state); + if( (ae_fp_eq(epsort,0)&&ae_fp_eq(epserr,0))&&maxits==0 ) + { + s->epsort = rbf_eps; + s->epserr = rbf_eps; + s->maxits = 0; + } + else + { + s->epsort = epsort; + s->epserr = epserr; + s->maxits = maxits; + } +} + + +/************************************************************************* +This function builds RBF model and returns report (contains some +information which can be used for evaluation of the algorithm properties). + +Call to this function modifies RBF model by calculating its centers/radii/ +weights and saving them into RBFModel structure. Initially RBFModel +contain zero coefficients, but after call to this function we will have +coefficients which were calculated in order to fit our dataset. + +After you called this function you can call RBFCalc(), RBFGridCalc() and +other model calculation functions. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + Rep - report: + * Rep.TerminationType: + * -5 - non-distinct basis function centers were detected, + interpolation aborted + * -4 - nonconvergence of the internal SVD solver + * 1 - successful termination + Fields are used for debugging purposes: + * Rep.IterationsCount - iterations count of the LSQR solver + * Rep.NMV - number of matrix-vector products + * Rep.ARows - rows count for the system matrix + * Rep.ACols - columns count for the system matrix + * Rep.ANNZ - number of significantly non-zero elements + (elements above some algorithm-determined threshold) + +NOTE: failure to build model will leave current state of the structure +unchanged. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfbuildmodel(rbfmodel* s, rbfreport* rep, ae_state *_state) +{ + ae_frame _frame_block; + kdtree tree; + kdtree ctree; + ae_vector dist; + ae_vector xcx; + ae_matrix a; + ae_matrix v; + ae_matrix omega; + ae_vector y; + ae_matrix residualy; + ae_vector radius; + ae_matrix xc; + ae_vector mnx; + ae_vector mxx; + ae_vector edge; + ae_vector mxsteps; + ae_int_t nc; + double rmax; + ae_vector tags; + ae_vector ctags; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t k2; + ae_int_t snnz; + ae_vector tmp0; + ae_vector tmp1; + ae_int_t layerscnt; + + ae_frame_make(_state, &_frame_block); + _rbfreport_clear(rep); + _kdtree_init(&tree, _state, ae_true); + _kdtree_init(&ctree, _state, ae_true); + ae_vector_init(&dist, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xcx, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&v, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&omega, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&residualy, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&radius, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xc, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&mnx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&mxx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&edge, 0, DT_REAL, _state, ae_true); + ae_vector_init(&mxsteps, 0, DT_INT, _state, ae_true); + ae_vector_init(&tags, 0, DT_INT, _state, ae_true); + ae_vector_init(&ctags, 0, DT_INT, _state, ae_true); + ae_vector_init(&tmp0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp1, 0, DT_REAL, _state, ae_true); + + ae_assert(s->nx==2||s->nx==3, "RBFBuildModel: S.NX<>2 or S.NX<>3!", _state); + + /* + * Quick exit when we have no points + */ + if( s->n==0 ) + { + rep->terminationtype = 1; + rep->iterationscount = 0; + rep->nmv = 0; + rep->arows = 0; + rep->acols = 0; + kdtreebuildtagged(&s->xc, &tags, 0, rbf_mxnx, 0, 2, &s->tree, _state); + ae_matrix_set_length(&s->xc, 0, 0, _state); + ae_matrix_set_length(&s->wr, 0, 0, _state); + s->nc = 0; + s->rmax = 0; + ae_matrix_set_length(&s->v, s->ny, rbf_mxnx+1, _state); + for(i=0; i<=s->ny-1; i++) + { + for(j=0; j<=rbf_mxnx; j++) + { + s->v.ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return; + } + + /* + * General case, N>0 + */ + rep->annz = 0; + rep->iterationscount = 0; + rep->nmv = 0; + ae_vector_set_length(&xcx, rbf_mxnx, _state); + + /* + * First model in a sequence - linear model. + * Residuals from linear regression are stored in the ResidualY variable + * (used later to build RBF models). + */ + ae_matrix_set_length(&residualy, s->n, s->ny, _state); + for(i=0; i<=s->n-1; i++) + { + for(j=0; j<=s->ny-1; j++) + { + residualy.ptr.pp_double[i][j] = s->y.ptr.pp_double[i][j]; + } + } + if( !rbf_buildlinearmodel(&s->x, &residualy, s->n, s->ny, s->aterm, &v, _state) ) + { + rep->terminationtype = -5; + ae_frame_leave(_state); + return; + } + + /* + * Handle special case: multilayer model with NLayers=0. + * Quick exit. + */ + if( s->algorithmtype==2&&s->nlayers==0 ) + { + rep->terminationtype = 1; + rep->iterationscount = 0; + rep->nmv = 0; + rep->arows = 0; + rep->acols = 0; + kdtreebuildtagged(&s->xc, &tags, 0, rbf_mxnx, 0, 2, &s->tree, _state); + ae_matrix_set_length(&s->xc, 0, 0, _state); + ae_matrix_set_length(&s->wr, 0, 0, _state); + s->nc = 0; + s->rmax = 0; + ae_matrix_set_length(&s->v, s->ny, rbf_mxnx+1, _state); + for(i=0; i<=s->ny-1; i++) + { + for(j=0; j<=rbf_mxnx; j++) + { + s->v.ptr.pp_double[i][j] = v.ptr.pp_double[i][j]; + } + } + ae_frame_leave(_state); + return; + } + + /* + * Second model in a sequence - RBF term. + * + * NOTE: assignments below are not necessary, but without them + * MSVC complains about unitialized variables. + */ + nc = 0; + rmax = 0; + layerscnt = 0; + if( s->algorithmtype==1 ) + { + + /* + * Add RBF model. + * This model uses local KD-trees to speed-up nearest neighbor searches. + */ + if( s->gridtype==1 ) + { + ae_vector_set_length(&mxx, s->nx, _state); + ae_vector_set_length(&mnx, s->nx, _state); + ae_vector_set_length(&mxsteps, s->nx, _state); + ae_vector_set_length(&edge, s->nx, _state); + for(i=0; i<=s->nx-1; i++) + { + mxx.ptr.p_double[i] = s->x.ptr.pp_double[0][i]; + mnx.ptr.p_double[i] = s->x.ptr.pp_double[0][i]; + } + for(i=0; i<=s->n-1; i++) + { + for(j=0; j<=s->nx-1; j++) + { + if( ae_fp_less(mxx.ptr.p_double[j],s->x.ptr.pp_double[i][j]) ) + { + mxx.ptr.p_double[j] = s->x.ptr.pp_double[i][j]; + } + if( ae_fp_greater(mnx.ptr.p_double[j],s->x.ptr.pp_double[i][j]) ) + { + mnx.ptr.p_double[j] = s->x.ptr.pp_double[i][j]; + } + } + } + for(i=0; i<=s->nx-1; i++) + { + mxsteps.ptr.p_int[i] = ae_trunc((mxx.ptr.p_double[i]-mnx.ptr.p_double[i])/(2*s->h), _state)+1; + edge.ptr.p_double[i] = (mxx.ptr.p_double[i]+mnx.ptr.p_double[i])/2-s->h*mxsteps.ptr.p_int[i]; + } + nc = 1; + for(i=0; i<=s->nx-1; i++) + { + mxsteps.ptr.p_int[i] = 2*mxsteps.ptr.p_int[i]+1; + nc = nc*mxsteps.ptr.p_int[i]; + } + ae_matrix_set_length(&xc, nc, rbf_mxnx, _state); + if( s->nx==2 ) + { + for(i=0; i<=mxsteps.ptr.p_int[0]-1; i++) + { + for(j=0; j<=mxsteps.ptr.p_int[1]-1; j++) + { + for(k2=0; k2<=rbf_mxnx-1; k2++) + { + xc.ptr.pp_double[i*mxsteps.ptr.p_int[1]+j][k2] = 0; + } + xc.ptr.pp_double[i*mxsteps.ptr.p_int[1]+j][0] = edge.ptr.p_double[0]+s->h*i; + xc.ptr.pp_double[i*mxsteps.ptr.p_int[1]+j][1] = edge.ptr.p_double[1]+s->h*j; + } + } + } + if( s->nx==3 ) + { + for(i=0; i<=mxsteps.ptr.p_int[0]-1; i++) + { + for(j=0; j<=mxsteps.ptr.p_int[1]-1; j++) + { + for(k=0; k<=mxsteps.ptr.p_int[2]-1; k++) + { + for(k2=0; k2<=rbf_mxnx-1; k2++) + { + xc.ptr.pp_double[i*mxsteps.ptr.p_int[1]+j][k2] = 0; + } + xc.ptr.pp_double[(i*mxsteps.ptr.p_int[1]+j)*mxsteps.ptr.p_int[2]+k][0] = edge.ptr.p_double[0]+s->h*i; + xc.ptr.pp_double[(i*mxsteps.ptr.p_int[1]+j)*mxsteps.ptr.p_int[2]+k][1] = edge.ptr.p_double[1]+s->h*j; + xc.ptr.pp_double[(i*mxsteps.ptr.p_int[1]+j)*mxsteps.ptr.p_int[2]+k][2] = edge.ptr.p_double[2]+s->h*k; + } + } + } + } + } + else + { + if( s->gridtype==2 ) + { + nc = s->n; + ae_matrix_set_length(&xc, nc, rbf_mxnx, _state); + for(i=0; i<=nc-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + xc.ptr.pp_double[i][j] = s->x.ptr.pp_double[i][j]; + } + } + } + else + { + if( s->gridtype==3 ) + { + nc = s->nc; + ae_matrix_set_length(&xc, nc, rbf_mxnx, _state); + for(i=0; i<=nc-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + xc.ptr.pp_double[i][j] = s->xc.ptr.pp_double[i][j]; + } + } + } + else + { + ae_assert(ae_false, "RBFBuildModel: either S.GridType<1 or S.GridType>3!", _state); + } + } + } + rmax = 0; + ae_vector_set_length(&radius, nc, _state); + ae_vector_set_length(&ctags, nc, _state); + for(i=0; i<=nc-1; i++) + { + ctags.ptr.p_int[i] = i; + } + kdtreebuildtagged(&xc, &ctags, nc, rbf_mxnx, 0, 2, &ctree, _state); + if( s->fixrad ) + { + + /* + * Fixed radius + */ + for(i=0; i<=nc-1; i++) + { + radius.ptr.p_double[i] = s->radvalue; + } + rmax = radius.ptr.p_double[0]; + } + else + { + + /* + * Dynamic radius + */ + if( nc==0 ) + { + rmax = 1; + } + else + { + if( nc==1 ) + { + radius.ptr.p_double[0] = s->radvalue; + rmax = radius.ptr.p_double[0]; + } + else + { + + /* + * NC>1, calculate radii using distances to nearest neigbors + */ + for(i=0; i<=nc-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + xcx.ptr.p_double[j] = xc.ptr.pp_double[i][j]; + } + if( kdtreequeryknn(&ctree, &xcx, 1, ae_false, _state)>0 ) + { + kdtreequeryresultsdistances(&ctree, &dist, _state); + radius.ptr.p_double[i] = s->radvalue*dist.ptr.p_double[0]; + } + else + { + + /* + * No neighbors found (it will happen when we have only one center). + * Initialize radius with default value. + */ + radius.ptr.p_double[i] = 1.0; + } + } + + /* + * Apply filtering + */ + rvectorsetlengthatleast(&tmp0, nc, _state); + for(i=0; i<=nc-1; i++) + { + tmp0.ptr.p_double[i] = radius.ptr.p_double[i]; + } + tagsortfast(&tmp0, &tmp1, nc, _state); + for(i=0; i<=nc-1; i++) + { + radius.ptr.p_double[i] = ae_minreal(radius.ptr.p_double[i], s->radzvalue*tmp0.ptr.p_double[nc/2], _state); + } + + /* + * Calculate RMax, check that all radii are non-zero + */ + for(i=0; i<=nc-1; i++) + { + rmax = ae_maxreal(rmax, radius.ptr.p_double[i], _state); + } + for(i=0; i<=nc-1; i++) + { + if( ae_fp_eq(radius.ptr.p_double[i],0) ) + { + rep->terminationtype = -5; + ae_frame_leave(_state); + return; + } + } + } + } + } + ivectorsetlengthatleast(&tags, s->n, _state); + for(i=0; i<=s->n-1; i++) + { + tags.ptr.p_int[i] = i; + } + kdtreebuildtagged(&s->x, &tags, s->n, rbf_mxnx, 0, 2, &tree, _state); + rbf_buildrbfmodellsqr(&s->x, &residualy, &xc, &radius, s->n, nc, s->ny, &tree, &ctree, s->epsort, s->epserr, s->maxits, &rep->annz, &snnz, &omega, &rep->terminationtype, &rep->iterationscount, &rep->nmv, _state); + layerscnt = 1; + } + else + { + if( s->algorithmtype==2 ) + { + rmax = s->radvalue; + rbf_buildrbfmlayersmodellsqr(&s->x, &residualy, &xc, s->radvalue, &radius, s->n, &nc, s->ny, s->nlayers, &ctree, 1.0E-6, 1.0E-6, 50, s->lambdav, &rep->annz, &omega, &rep->terminationtype, &rep->iterationscount, &rep->nmv, _state); + layerscnt = s->nlayers; + } + else + { + ae_assert(ae_false, "RBFBuildModel: internal error(AlgorithmType neither 1 nor 2)", _state); + } + } + if( rep->terminationtype<=0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Model is built + */ + s->nc = nc/layerscnt; + s->rmax = rmax; + s->nl = layerscnt; + ae_matrix_set_length(&s->xc, s->nc, rbf_mxnx, _state); + ae_matrix_set_length(&s->wr, s->nc, 1+s->nl*s->ny, _state); + ae_matrix_set_length(&s->v, s->ny, rbf_mxnx+1, _state); + for(i=0; i<=s->nc-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + s->xc.ptr.pp_double[i][j] = xc.ptr.pp_double[i][j]; + } + } + ivectorsetlengthatleast(&tags, s->nc, _state); + for(i=0; i<=s->nc-1; i++) + { + tags.ptr.p_int[i] = i; + } + kdtreebuildtagged(&s->xc, &tags, s->nc, rbf_mxnx, 0, 2, &s->tree, _state); + for(i=0; i<=s->nc-1; i++) + { + s->wr.ptr.pp_double[i][0] = radius.ptr.p_double[i]; + for(k=0; k<=layerscnt-1; k++) + { + for(j=0; j<=s->ny-1; j++) + { + s->wr.ptr.pp_double[i][1+k*s->ny+j] = omega.ptr.pp_double[k*s->nc+i][j]; + } + } + } + for(i=0; i<=s->ny-1; i++) + { + for(j=0; j<=rbf_mxnx; j++) + { + s->v.ptr.pp_double[i][j] = v.ptr.pp_double[i][j]; + } + } + rep->terminationtype = 1; + rep->arows = s->n; + rep->acols = s->nc; + ae_frame_leave(_state); +} + + +/************************************************************************* +This function calculates values of the RBF model in the given point. + +This function should be used when we have NY=1 (scalar function) and NX=2 +(2-dimensional space). If you have 3-dimensional space, use RBFCalc3(). If +you have general situation (NX-dimensional space, NY-dimensional function) +you should use general, less efficient implementation RBFCalc(). + +If you want to calculate function values many times, consider using +RBFGridCalc2(), which is far more efficient than many subsequent calls to +RBFCalc2(). + +This function returns 0.0 when: +* model is not initialized +* NX<>2 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - first coordinate, finite number + X1 - second coordinate, finite number + +RESULT: + value of the model or 0.0 (as defined above) + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +double rbfcalc2(rbfmodel* s, double x0, double x1, ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t lx; + ae_int_t tg; + double d2; + double t; + double bfcur; + double rcur; + double result; + + + ae_assert(ae_isfinite(x0, _state), "RBFCalc2: invalid value for X0 (X0 is Inf)!", _state); + ae_assert(ae_isfinite(x1, _state), "RBFCalc2: invalid value for X1 (X1 is Inf)!", _state); + if( s->ny!=1||s->nx!=2 ) + { + result = 0; + return result; + } + result = s->v.ptr.pp_double[0][0]*x0+s->v.ptr.pp_double[0][1]*x1+s->v.ptr.pp_double[0][rbf_mxnx]; + if( s->nc==0 ) + { + return result; + } + rvectorsetlengthatleast(&s->calcbufxcx, rbf_mxnx, _state); + for(i=0; i<=rbf_mxnx-1; i++) + { + s->calcbufxcx.ptr.p_double[i] = 0.0; + } + s->calcbufxcx.ptr.p_double[0] = x0; + s->calcbufxcx.ptr.p_double[1] = x1; + lx = kdtreequeryrnn(&s->tree, &s->calcbufxcx, s->rmax*rbf_rbffarradius, ae_true, _state); + kdtreequeryresultsx(&s->tree, &s->calcbufx, _state); + kdtreequeryresultstags(&s->tree, &s->calcbuftags, _state); + for(i=0; i<=lx-1; i++) + { + tg = s->calcbuftags.ptr.p_int[i]; + d2 = ae_sqr(x0-s->calcbufx.ptr.pp_double[i][0], _state)+ae_sqr(x1-s->calcbufx.ptr.pp_double[i][1], _state); + rcur = s->wr.ptr.pp_double[tg][0]; + bfcur = ae_exp(-d2/(rcur*rcur), _state); + for(j=0; j<=s->nl-1; j++) + { + result = result+bfcur*s->wr.ptr.pp_double[tg][1+j]; + rcur = 0.5*rcur; + t = bfcur*bfcur; + bfcur = t*t; + } + } + return result; +} + + +/************************************************************************* +This function calculates values of the RBF model in the given point. + +This function should be used when we have NY=1 (scalar function) and NX=3 +(3-dimensional space). If you have 2-dimensional space, use RBFCalc2(). If +you have general situation (NX-dimensional space, NY-dimensional function) +you should use general, less efficient implementation RBFCalc(). + +This function returns 0.0 when: +* model is not initialized +* NX<>3 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - first coordinate, finite number + X1 - second coordinate, finite number + X2 - third coordinate, finite number + +RESULT: + value of the model or 0.0 (as defined above) + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +double rbfcalc3(rbfmodel* s, + double x0, + double x1, + double x2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t lx; + ae_int_t tg; + double t; + double rcur; + double bf; + double result; + + + ae_assert(ae_isfinite(x0, _state), "RBFCalc3: invalid value for X0 (X0 is Inf or NaN)!", _state); + ae_assert(ae_isfinite(x1, _state), "RBFCalc3: invalid value for X1 (X1 is Inf or NaN)!", _state); + ae_assert(ae_isfinite(x2, _state), "RBFCalc3: invalid value for X2 (X2 is Inf or NaN)!", _state); + if( s->ny!=1||s->nx!=3 ) + { + result = 0; + return result; + } + result = s->v.ptr.pp_double[0][0]*x0+s->v.ptr.pp_double[0][1]*x1+s->v.ptr.pp_double[0][2]*x2+s->v.ptr.pp_double[0][rbf_mxnx]; + if( s->nc==0 ) + { + return result; + } + + /* + * calculating value for F(X) + */ + rvectorsetlengthatleast(&s->calcbufxcx, rbf_mxnx, _state); + for(i=0; i<=rbf_mxnx-1; i++) + { + s->calcbufxcx.ptr.p_double[i] = 0.0; + } + s->calcbufxcx.ptr.p_double[0] = x0; + s->calcbufxcx.ptr.p_double[1] = x1; + s->calcbufxcx.ptr.p_double[2] = x2; + lx = kdtreequeryrnn(&s->tree, &s->calcbufxcx, s->rmax*rbf_rbffarradius, ae_true, _state); + kdtreequeryresultsx(&s->tree, &s->calcbufx, _state); + kdtreequeryresultstags(&s->tree, &s->calcbuftags, _state); + for(i=0; i<=lx-1; i++) + { + tg = s->calcbuftags.ptr.p_int[i]; + rcur = s->wr.ptr.pp_double[tg][0]; + bf = ae_exp(-(ae_sqr(x0-s->calcbufx.ptr.pp_double[i][0], _state)+ae_sqr(x1-s->calcbufx.ptr.pp_double[i][1], _state)+ae_sqr(x2-s->calcbufx.ptr.pp_double[i][2], _state))/ae_sqr(rcur, _state), _state); + for(j=0; j<=s->nl-1; j++) + { + result = result+bf*s->wr.ptr.pp_double[tg][1+j]; + t = bf*bf; + bf = t*t; + } + } + return result; +} + + +/************************************************************************* +This function calculates values of the RBF model at the given point. + +This is general function which can be used for arbitrary NX (dimension of +the space of arguments) and NY (dimension of the function itself). However +when you have NY=1 you may find more convenient to use RBFCalc2() or +RBFCalc3(). + +This function returns 0.0 when model is not initialized. + +INPUT PARAMETERS: + S - RBF model + X - coordinates, array[NX]. + X may have more than NX elements, in this case only + leading NX will be used. + +OUTPUT PARAMETERS: + Y - function value, array[NY]. Y is out-parameter and + reallocated after call to this function. In case you want + to reuse previously allocated Y, you may use RBFCalcBuf(), + which reallocates Y only when it is too small. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcalc(rbfmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + + ae_vector_clear(y); + + ae_assert(x->cnt>=s->nx, "RBFCalc: Length(X)nx, _state), "RBFCalc: X contains infinite or NaN values", _state); + rbfcalcbuf(s, x, y, _state); +} + + +/************************************************************************* +This function calculates values of the RBF model at the given point. + +Same as RBFCalc(), but does not reallocate Y when in is large enough to +store function values. + +INPUT PARAMETERS: + S - RBF model + X - coordinates, array[NX]. + X may have more than NX elements, in this case only + leading NX will be used. + Y - possibly preallocated array + +OUTPUT PARAMETERS: + Y - function value, array[NY]. Y is not reallocated when it + is larger than NY. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcalcbuf(rbfmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t lx; + ae_int_t tg; + double t; + double rcur; + double bf; + + + ae_assert(x->cnt>=s->nx, "RBFCalcBuf: Length(X)nx, _state), "RBFCalcBuf: X contains infinite or NaN values", _state); + if( y->cntny ) + { + ae_vector_set_length(y, s->ny, _state); + } + for(i=0; i<=s->ny-1; i++) + { + y->ptr.p_double[i] = s->v.ptr.pp_double[i][rbf_mxnx]; + for(j=0; j<=s->nx-1; j++) + { + y->ptr.p_double[i] = y->ptr.p_double[i]+s->v.ptr.pp_double[i][j]*x->ptr.p_double[j]; + } + } + if( s->nc==0 ) + { + return; + } + rvectorsetlengthatleast(&s->calcbufxcx, rbf_mxnx, _state); + for(i=0; i<=rbf_mxnx-1; i++) + { + s->calcbufxcx.ptr.p_double[i] = 0.0; + } + for(i=0; i<=s->nx-1; i++) + { + s->calcbufxcx.ptr.p_double[i] = x->ptr.p_double[i]; + } + lx = kdtreequeryrnn(&s->tree, &s->calcbufxcx, s->rmax*rbf_rbffarradius, ae_true, _state); + kdtreequeryresultsx(&s->tree, &s->calcbufx, _state); + kdtreequeryresultstags(&s->tree, &s->calcbuftags, _state); + for(i=0; i<=s->ny-1; i++) + { + for(j=0; j<=lx-1; j++) + { + tg = s->calcbuftags.ptr.p_int[j]; + rcur = s->wr.ptr.pp_double[tg][0]; + bf = ae_exp(-(ae_sqr(s->calcbufxcx.ptr.p_double[0]-s->calcbufx.ptr.pp_double[j][0], _state)+ae_sqr(s->calcbufxcx.ptr.p_double[1]-s->calcbufx.ptr.pp_double[j][1], _state)+ae_sqr(s->calcbufxcx.ptr.p_double[2]-s->calcbufx.ptr.pp_double[j][2], _state))/ae_sqr(rcur, _state), _state); + for(k=0; k<=s->nl-1; k++) + { + y->ptr.p_double[i] = y->ptr.p_double[i]+bf*s->wr.ptr.pp_double[tg][1+k*s->ny+i]; + t = bf*bf; + bf = t*t; + } + } + } +} + + +/************************************************************************* +This function calculates values of the RBF model at the regular grid. + +Grid have N0*N1 points, with Point[I,J] = (X0[I], X1[J]) + +This function returns 0.0 when: +* model is not initialized +* NX<>2 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - array of grid nodes, first coordinates, array[N0] + N0 - grid size (number of nodes) in the first dimension + X1 - array of grid nodes, second coordinates, array[N1] + N1 - grid size (number of nodes) in the second dimension + +OUTPUT PARAMETERS: + Y - function values, array[N0,N1]. Y is out-variable and + is reallocated by this function. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfgridcalc2(rbfmodel* s, + /* Real */ ae_vector* x0, + ae_int_t n0, + /* Real */ ae_vector* x1, + ae_int_t n1, + /* Real */ ae_matrix* y, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector cpx0; + ae_vector cpx1; + ae_vector p01; + ae_vector p11; + ae_vector p2; + double rlimit; + double xcnorm2; + ae_int_t hp01; + double hcpx0; + double xc0; + double xc1; + double omega; + double radius; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t d; + ae_int_t i00; + ae_int_t i01; + ae_int_t i10; + ae_int_t i11; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(y); + ae_vector_init(&cpx0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&cpx1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p01, 0, DT_INT, _state, ae_true); + ae_vector_init(&p11, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + + ae_assert(n0>0, "RBFGridCalc2: invalid value for N0 (N0<=0)!", _state); + ae_assert(n1>0, "RBFGridCalc2: invalid value for N1 (N1<=0)!", _state); + ae_assert(x0->cnt>=n0, "RBFGridCalc2: Length(X0)cnt>=n1, "RBFGridCalc2: Length(X1)ptr.pp_double[i][j] = 0; + } + } + if( (s->ny!=1||s->nx!=2)||s->nc==0 ) + { + ae_frame_leave(_state); + return; + } + + /* + *create and sort arrays + */ + ae_vector_set_length(&cpx0, n0, _state); + for(i=0; i<=n0-1; i++) + { + cpx0.ptr.p_double[i] = x0->ptr.p_double[i]; + } + tagsort(&cpx0, n0, &p01, &p2, _state); + ae_vector_set_length(&cpx1, n1, _state); + for(i=0; i<=n1-1; i++) + { + cpx1.ptr.p_double[i] = x1->ptr.p_double[i]; + } + tagsort(&cpx1, n1, &p11, &p2, _state); + + /* + *calculate function's value + */ + for(i=0; i<=s->nc-1; i++) + { + radius = s->wr.ptr.pp_double[i][0]; + for(d=0; d<=s->nl-1; d++) + { + omega = s->wr.ptr.pp_double[i][1+d]; + rlimit = radius*rbf_rbffarradius; + + /* + *search lower and upper indexes + */ + i00 = lowerbound(&cpx0, n0, s->xc.ptr.pp_double[i][0]-rlimit, _state); + i01 = upperbound(&cpx0, n0, s->xc.ptr.pp_double[i][0]+rlimit, _state); + i10 = lowerbound(&cpx1, n1, s->xc.ptr.pp_double[i][1]-rlimit, _state); + i11 = upperbound(&cpx1, n1, s->xc.ptr.pp_double[i][1]+rlimit, _state); + xc0 = s->xc.ptr.pp_double[i][0]; + xc1 = s->xc.ptr.pp_double[i][1]; + for(j=i00; j<=i01-1; j++) + { + hcpx0 = cpx0.ptr.p_double[j]; + hp01 = p01.ptr.p_int[j]; + for(k=i10; k<=i11-1; k++) + { + xcnorm2 = ae_sqr(hcpx0-xc0, _state)+ae_sqr(cpx1.ptr.p_double[k]-xc1, _state); + if( ae_fp_less_eq(xcnorm2,rlimit*rlimit) ) + { + y->ptr.pp_double[hp01][p11.ptr.p_int[k]] = y->ptr.pp_double[hp01][p11.ptr.p_int[k]]+ae_exp(-xcnorm2/ae_sqr(radius, _state), _state)*omega; + } + } + } + radius = 0.5*radius; + } + } + + /* + *add linear term + */ + for(i=0; i<=n0-1; i++) + { + for(j=0; j<=n1-1; j++) + { + y->ptr.pp_double[i][j] = y->ptr.pp_double[i][j]+s->v.ptr.pp_double[0][0]*x0->ptr.p_double[i]+s->v.ptr.pp_double[0][1]*x1->ptr.p_double[j]+s->v.ptr.pp_double[0][rbf_mxnx]; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function "unpacks" RBF model by extracting its coefficients. + +INPUT PARAMETERS: + S - RBF model + +OUTPUT PARAMETERS: + NX - dimensionality of argument + NY - dimensionality of the target function + XWR - model information, array[NC,NX+NY+1]. + One row of the array corresponds to one basis function: + * first NX columns - coordinates of the center + * next NY columns - weights, one per dimension of the + function being modelled + * last column - radius, same for all dimensions of + the function being modelled + NC - number of the centers + V - polynomial term , array[NY,NX+1]. One row per one + dimension of the function being modelled. First NX + elements are linear coefficients, V[NX] is equal to the + constant part. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfunpack(rbfmodel* s, + ae_int_t* nx, + ae_int_t* ny, + /* Real */ ae_matrix* xwr, + ae_int_t* nc, + /* Real */ ae_matrix* v, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double rcur; + + *nx = 0; + *ny = 0; + ae_matrix_clear(xwr); + *nc = 0; + ae_matrix_clear(v); + + *nx = s->nx; + *ny = s->ny; + *nc = s->nc; + + /* + * Fill V + */ + ae_matrix_set_length(v, s->ny, s->nx+1, _state); + for(i=0; i<=s->ny-1; i++) + { + ae_v_move(&v->ptr.pp_double[i][0], 1, &s->v.ptr.pp_double[i][0], 1, ae_v_len(0,s->nx-1)); + v->ptr.pp_double[i][s->nx] = s->v.ptr.pp_double[i][rbf_mxnx]; + } + + /* + * Fill XWR and V + */ + if( *nc*s->nl>0 ) + { + ae_matrix_set_length(xwr, s->nc*s->nl, s->nx+s->ny+1, _state); + for(i=0; i<=s->nc-1; i++) + { + rcur = s->wr.ptr.pp_double[i][0]; + for(j=0; j<=s->nl-1; j++) + { + ae_v_move(&xwr->ptr.pp_double[i*s->nl+j][0], 1, &s->xc.ptr.pp_double[i][0], 1, ae_v_len(0,s->nx-1)); + ae_v_move(&xwr->ptr.pp_double[i*s->nl+j][s->nx], 1, &s->wr.ptr.pp_double[i][1+j*s->ny], 1, ae_v_len(s->nx,s->nx+s->ny-1)); + xwr->ptr.pp_double[i*s->nl+j][s->nx+s->ny] = rcur; + rcur = 0.5*rcur; + } + } + } +} + + +/************************************************************************* +Serializer: allocation + + -- ALGLIB -- + Copyright 02.02.2012 by Bochkanov Sergey +*************************************************************************/ +void rbfalloc(ae_serializer* s, rbfmodel* model, ae_state *_state) +{ + + + + /* + * Header + */ + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + + /* + * Data + */ + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + ae_serializer_alloc_entry(s); + kdtreealloc(s, &model->tree, _state); + allocrealmatrix(s, &model->xc, -1, -1, _state); + allocrealmatrix(s, &model->wr, -1, -1, _state); + ae_serializer_alloc_entry(s); + allocrealmatrix(s, &model->v, -1, -1, _state); +} + + +/************************************************************************* +Serializer: serialization + + -- ALGLIB -- + Copyright 02.02.2012 by Bochkanov Sergey +*************************************************************************/ +void rbfserialize(ae_serializer* s, rbfmodel* model, ae_state *_state) +{ + + + + /* + * Header + */ + ae_serializer_serialize_int(s, getrbfserializationcode(_state), _state); + ae_serializer_serialize_int(s, rbf_rbffirstversion, _state); + + /* + * Data + */ + ae_serializer_serialize_int(s, model->nx, _state); + ae_serializer_serialize_int(s, model->ny, _state); + ae_serializer_serialize_int(s, model->nc, _state); + ae_serializer_serialize_int(s, model->nl, _state); + kdtreeserialize(s, &model->tree, _state); + serializerealmatrix(s, &model->xc, -1, -1, _state); + serializerealmatrix(s, &model->wr, -1, -1, _state); + ae_serializer_serialize_double(s, model->rmax, _state); + serializerealmatrix(s, &model->v, -1, -1, _state); +} + + +/************************************************************************* +Serializer: unserialization + + -- ALGLIB -- + Copyright 02.02.2012 by Bochkanov Sergey +*************************************************************************/ +void rbfunserialize(ae_serializer* s, rbfmodel* model, ae_state *_state) +{ + ae_int_t i0; + ae_int_t i1; + ae_int_t nx; + ae_int_t ny; + + _rbfmodel_clear(model); + + + /* + * Header + */ + ae_serializer_unserialize_int(s, &i0, _state); + ae_assert(i0==getrbfserializationcode(_state), "RBFUnserialize: stream header corrupted", _state); + ae_serializer_unserialize_int(s, &i1, _state); + ae_assert(i1==rbf_rbffirstversion, "RBFUnserialize: stream header corrupted", _state); + + /* + * Unserialize primary model parameters, initialize model. + * + * It is necessary to call RBFCreate() because some internal fields + * which are NOT unserialized will need initialization. + */ + ae_serializer_unserialize_int(s, &nx, _state); + ae_serializer_unserialize_int(s, &ny, _state); + rbfcreate(nx, ny, model, _state); + ae_serializer_unserialize_int(s, &model->nc, _state); + ae_serializer_unserialize_int(s, &model->nl, _state); + kdtreeunserialize(s, &model->tree, _state); + unserializerealmatrix(s, &model->xc, _state); + unserializerealmatrix(s, &model->wr, _state); + ae_serializer_unserialize_double(s, &model->rmax, _state); + unserializerealmatrix(s, &model->v, _state); +} + + +/************************************************************************* +This function changes centers allocation algorithm to one which allocates +centers exactly at the dataset points (one input point = one center). This +function won't have effect until next call to RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +static void rbf_rbfgridpoints(rbfmodel* s, ae_state *_state) +{ + + + s->gridtype = 2; +} + + +/************************************************************************* +This function changes radii calculation algorithm to one which makes +radius for I-th node equal to R[i]=DistNN[i]*Q, where: +* R[i] is a radius calculated by the algorithm +* DistNN[i] is distance from I-th center to its nearest neighbor center +* Q is a scale parameter, which should be within [0.75,1.50], with + recommended value equal to 1.0 +* after performing radii calculation, radii are transformed in order to + avoid situation when single outlier has very large radius and influences + many points across entire dataset. Transformation has following form: + new_r[i] = min(r[i],Z*median(r[])) + where r[i] is I-th radius, median() is a median radius across entire + dataset, Z is user-specified value which controls amount of deviation + from median radius. + +This function won't have effect until next call to RBFBuildModel(). + +The idea behind this algorithm is to choose radii corresponding to basis +functions is such way that I-th radius is approximately equal to distance +from I-th center to its nearest neighbor. In this case interactions with +distant points will be insignificant, and we will get well conditioned +basis. + +Properties of this basis depend on the value of Q: +* Q<0.75 will give perfectly conditioned basis, but terrible smoothness + properties (RBF interpolant will have sharp peaks around function values) +* Q>1.5 will lead to badly conditioned systems and slow convergence of the + underlying linear solver (although smoothness will be very good) +* Q around 1.0 gives good balance between smoothness and condition number + + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + Q - radius coefficient, Q>0 + Z - z-parameter, Z>0 + +Default value of Q is equal to 1.0 +Default value of Z is equal to 5.0 + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +static void rbf_rbfradnn(rbfmodel* s, + double q, + double z, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(q, _state)&&ae_fp_greater(q,0), "RBFRadNN: Q<=0, infinite or NAN", _state); + ae_assert(ae_isfinite(z, _state)&&ae_fp_greater(z,0), "RBFRadNN: Z<=0, infinite or NAN", _state); + s->fixrad = ae_false; + s->radvalue = q; + s->radzvalue = z; +} + + +static ae_bool rbf_buildlinearmodel(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t ny, + ae_int_t modeltype, + /* Real */ ae_matrix* v, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tmpy; + ae_matrix a; + double scaling; + ae_vector shifting; + double mn; + double mx; + ae_vector c; + lsfitreport rep; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t info; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(v); + ae_vector_init(&tmpy, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&shifting, 0, DT_REAL, _state, ae_true); + ae_vector_init(&c, 0, DT_REAL, _state, ae_true); + _lsfitreport_init(&rep, _state, ae_true); + + ae_assert(n>=0, "BuildLinearModel: N<0", _state); + ae_assert(ny>0, "BuildLinearModel: NY<=0", _state); + + /* + * Handle degenerate case (N=0) + */ + result = ae_true; + ae_matrix_set_length(v, ny, rbf_mxnx+1, _state); + if( n==0 ) + { + for(j=0; j<=rbf_mxnx; j++) + { + for(i=0; i<=ny-1; i++) + { + v->ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return result; + } + + /* + * Allocate temporaries + */ + ae_vector_set_length(&tmpy, n, _state); + + /* + * General linear model. + */ + if( modeltype==1 ) + { + + /* + * Calculate scaling/shifting, transform variables, prepare LLS problem + */ + ae_matrix_set_length(&a, n, rbf_mxnx+1, _state); + ae_vector_set_length(&shifting, rbf_mxnx, _state); + scaling = 0; + for(i=0; i<=rbf_mxnx-1; i++) + { + mn = x->ptr.pp_double[0][i]; + mx = mn; + for(j=1; j<=n-1; j++) + { + if( ae_fp_greater(mn,x->ptr.pp_double[j][i]) ) + { + mn = x->ptr.pp_double[j][i]; + } + if( ae_fp_less(mx,x->ptr.pp_double[j][i]) ) + { + mx = x->ptr.pp_double[j][i]; + } + } + scaling = ae_maxreal(scaling, mx-mn, _state); + shifting.ptr.p_double[i] = 0.5*(mx+mn); + } + if( ae_fp_eq(scaling,0) ) + { + scaling = 1; + } + else + { + scaling = 0.5*scaling; + } + for(i=0; i<=n-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + a.ptr.pp_double[i][j] = (x->ptr.pp_double[i][j]-shifting.ptr.p_double[j])/scaling; + } + } + for(i=0; i<=n-1; i++) + { + a.ptr.pp_double[i][rbf_mxnx] = 1; + } + + /* + * Solve linear system in transformed variables, make backward + */ + for(i=0; i<=ny-1; i++) + { + for(j=0; j<=n-1; j++) + { + tmpy.ptr.p_double[j] = y->ptr.pp_double[j][i]; + } + lsfitlinear(&tmpy, &a, n, rbf_mxnx+1, &info, &c, &rep, _state); + if( info<=0 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + for(j=0; j<=rbf_mxnx-1; j++) + { + v->ptr.pp_double[i][j] = c.ptr.p_double[j]/scaling; + } + v->ptr.pp_double[i][rbf_mxnx] = c.ptr.p_double[rbf_mxnx]; + for(j=0; j<=rbf_mxnx-1; j++) + { + v->ptr.pp_double[i][rbf_mxnx] = v->ptr.pp_double[i][rbf_mxnx]-shifting.ptr.p_double[j]*v->ptr.pp_double[i][j]; + } + for(j=0; j<=n-1; j++) + { + for(k=0; k<=rbf_mxnx-1; k++) + { + y->ptr.pp_double[j][i] = y->ptr.pp_double[j][i]-x->ptr.pp_double[j][k]*v->ptr.pp_double[i][k]; + } + y->ptr.pp_double[j][i] = y->ptr.pp_double[j][i]-v->ptr.pp_double[i][rbf_mxnx]; + } + } + ae_frame_leave(_state); + return result; + } + + /* + * Constant model, very simple + */ + if( modeltype==2 ) + { + for(i=0; i<=ny-1; i++) + { + for(j=0; j<=rbf_mxnx; j++) + { + v->ptr.pp_double[i][j] = 0; + } + for(j=0; j<=n-1; j++) + { + v->ptr.pp_double[i][rbf_mxnx] = v->ptr.pp_double[i][rbf_mxnx]+y->ptr.pp_double[j][i]; + } + if( n>0 ) + { + v->ptr.pp_double[i][rbf_mxnx] = v->ptr.pp_double[i][rbf_mxnx]/n; + } + for(j=0; j<=n-1; j++) + { + y->ptr.pp_double[j][i] = y->ptr.pp_double[j][i]-v->ptr.pp_double[i][rbf_mxnx]; + } + } + ae_frame_leave(_state); + return result; + } + + /* + * Zero model + */ + ae_assert(modeltype==3, "BuildLinearModel: unknown model type", _state); + for(i=0; i<=ny-1; i++) + { + for(j=0; j<=rbf_mxnx; j++) + { + v->ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return result; +} + + +static void rbf_buildrbfmodellsqr(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + /* Real */ ae_matrix* xc, + /* Real */ ae_vector* r, + ae_int_t n, + ae_int_t nc, + ae_int_t ny, + kdtree* pointstree, + kdtree* centerstree, + double epsort, + double epserr, + ae_int_t maxits, + ae_int_t* gnnz, + ae_int_t* snnz, + /* Real */ ae_matrix* w, + ae_int_t* info, + ae_int_t* iterationscount, + ae_int_t* nmv, + ae_state *_state) +{ + ae_frame _frame_block; + linlsqrstate state; + linlsqrreport lsqrrep; + sparsematrix spg; + sparsematrix sps; + ae_vector nearcenterscnt; + ae_vector nearpointscnt; + ae_vector skipnearpointscnt; + ae_vector farpointscnt; + ae_int_t maxnearcenterscnt; + ae_int_t maxnearpointscnt; + ae_int_t maxfarpointscnt; + ae_int_t sumnearcenterscnt; + ae_int_t sumnearpointscnt; + ae_int_t sumfarpointscnt; + double maxrad; + ae_vector pointstags; + ae_vector centerstags; + ae_matrix nearpoints; + ae_matrix nearcenters; + ae_matrix farpoints; + ae_int_t tmpi; + ae_int_t pointscnt; + ae_int_t centerscnt; + ae_vector xcx; + ae_vector tmpy; + ae_vector tc; + ae_vector g; + ae_vector c; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t sind; + ae_matrix a; + double vv; + double vx; + double vy; + double vz; + double vr; + double gnorm2; + ae_vector tmp0; + ae_vector tmp1; + ae_vector tmp2; + double fx; + ae_matrix xx; + ae_matrix cx; + double mrad; + + ae_frame_make(_state, &_frame_block); + *gnnz = 0; + *snnz = 0; + ae_matrix_clear(w); + *info = 0; + *iterationscount = 0; + *nmv = 0; + _linlsqrstate_init(&state, _state, ae_true); + _linlsqrreport_init(&lsqrrep, _state, ae_true); + _sparsematrix_init(&spg, _state, ae_true); + _sparsematrix_init(&sps, _state, ae_true); + ae_vector_init(&nearcenterscnt, 0, DT_INT, _state, ae_true); + ae_vector_init(&nearpointscnt, 0, DT_INT, _state, ae_true); + ae_vector_init(&skipnearpointscnt, 0, DT_INT, _state, ae_true); + ae_vector_init(&farpointscnt, 0, DT_INT, _state, ae_true); + ae_vector_init(&pointstags, 0, DT_INT, _state, ae_true); + ae_vector_init(¢erstags, 0, DT_INT, _state, ae_true); + ae_matrix_init(&nearpoints, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&nearcenters, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&farpoints, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xcx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpy, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&g, 0, DT_REAL, _state, ae_true); + ae_vector_init(&c, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp2, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xx, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&cx, 0, 0, DT_REAL, _state, ae_true); + + + /* + * Handle special cases: NC=0 + */ + if( nc==0 ) + { + *info = 1; + *iterationscount = 0; + *nmv = 0; + ae_frame_leave(_state); + return; + } + + /* + * Prepare for general case, NC>0 + */ + ae_vector_set_length(&xcx, rbf_mxnx, _state); + ae_vector_set_length(&pointstags, n, _state); + ae_vector_set_length(¢erstags, nc, _state); + *info = -1; + *iterationscount = 0; + *nmv = 0; + + /* + * This block prepares quantities used to compute approximate cardinal basis functions (ACBFs): + * * NearCentersCnt[] - array[NC], whose elements store number of near centers used to build ACBF + * * NearPointsCnt[] - array[NC], number of near points used to build ACBF + * * FarPointsCnt[] - array[NC], number of far points (ones where ACBF is nonzero) + * * MaxNearCentersCnt - max(NearCentersCnt) + * * MaxNearPointsCnt - max(NearPointsCnt) + * * SumNearCentersCnt - sum(NearCentersCnt) + * * SumNearPointsCnt - sum(NearPointsCnt) + * * SumFarPointsCnt - sum(FarPointsCnt) + */ + ae_vector_set_length(&nearcenterscnt, nc, _state); + ae_vector_set_length(&nearpointscnt, nc, _state); + ae_vector_set_length(&skipnearpointscnt, nc, _state); + ae_vector_set_length(&farpointscnt, nc, _state); + maxnearcenterscnt = 0; + maxnearpointscnt = 0; + maxfarpointscnt = 0; + sumnearcenterscnt = 0; + sumnearpointscnt = 0; + sumfarpointscnt = 0; + for(i=0; i<=nc-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + xcx.ptr.p_double[j] = xc->ptr.pp_double[i][j]; + } + + /* + * Determine number of near centers and maximum radius of near centers + */ + nearcenterscnt.ptr.p_int[i] = kdtreequeryrnn(centerstree, &xcx, r->ptr.p_double[i]*rbf_rbfnearradius, ae_true, _state); + kdtreequeryresultstags(centerstree, ¢erstags, _state); + maxrad = 0; + for(j=0; j<=nearcenterscnt.ptr.p_int[i]-1; j++) + { + maxrad = ae_maxreal(maxrad, ae_fabs(r->ptr.p_double[centerstags.ptr.p_int[j]], _state), _state); + } + + /* + * Determine number of near points (ones which used to build ACBF) + * and skipped points (the most near points which are NOT used to build ACBF + * and are NOT included in the near points count + */ + skipnearpointscnt.ptr.p_int[i] = kdtreequeryrnn(pointstree, &xcx, 0.1*r->ptr.p_double[i], ae_true, _state); + nearpointscnt.ptr.p_int[i] = kdtreequeryrnn(pointstree, &xcx, (r->ptr.p_double[i]+maxrad)*rbf_rbfnearradius, ae_true, _state)-skipnearpointscnt.ptr.p_int[i]; + ae_assert(nearpointscnt.ptr.p_int[i]>=0, "BuildRBFModelLSQR: internal error", _state); + + /* + * Determine number of far points + */ + farpointscnt.ptr.p_int[i] = kdtreequeryrnn(pointstree, &xcx, ae_maxreal(r->ptr.p_double[i]*rbf_rbfnearradius+maxrad*rbf_rbffarradius, r->ptr.p_double[i]*rbf_rbffarradius, _state), ae_true, _state); + + /* + * calculate sum and max, make some basic checks + */ + ae_assert(nearcenterscnt.ptr.p_int[i]>0, "BuildRBFModelLSQR: internal error", _state); + maxnearcenterscnt = ae_maxint(maxnearcenterscnt, nearcenterscnt.ptr.p_int[i], _state); + maxnearpointscnt = ae_maxint(maxnearpointscnt, nearpointscnt.ptr.p_int[i], _state); + maxfarpointscnt = ae_maxint(maxfarpointscnt, farpointscnt.ptr.p_int[i], _state); + sumnearcenterscnt = sumnearcenterscnt+nearcenterscnt.ptr.p_int[i]; + sumnearpointscnt = sumnearpointscnt+nearpointscnt.ptr.p_int[i]; + sumfarpointscnt = sumfarpointscnt+farpointscnt.ptr.p_int[i]; + } + *snnz = sumnearcenterscnt; + *gnnz = sumfarpointscnt; + ae_assert(maxnearcenterscnt>0, "BuildRBFModelLSQR: internal error", _state); + + /* + * Allocate temporaries. + * + * NOTE: we want to avoid allocation of zero-size arrays, so we + * use max(desired_size,1) instead of desired_size when performing + * memory allocation. + */ + ae_matrix_set_length(&a, maxnearpointscnt+maxnearcenterscnt, maxnearcenterscnt, _state); + ae_vector_set_length(&tmpy, maxnearpointscnt+maxnearcenterscnt, _state); + ae_vector_set_length(&g, maxnearcenterscnt, _state); + ae_vector_set_length(&c, maxnearcenterscnt, _state); + ae_matrix_set_length(&nearcenters, maxnearcenterscnt, rbf_mxnx, _state); + ae_matrix_set_length(&nearpoints, ae_maxint(maxnearpointscnt, 1, _state), rbf_mxnx, _state); + ae_matrix_set_length(&farpoints, ae_maxint(maxfarpointscnt, 1, _state), rbf_mxnx, _state); + + /* + * fill matrix SpG + */ + sparsecreate(n, nc, *gnnz, &spg, _state); + sparsecreate(nc, nc, *snnz, &sps, _state); + for(i=0; i<=nc-1; i++) + { + centerscnt = nearcenterscnt.ptr.p_int[i]; + + /* + * main center + */ + for(j=0; j<=rbf_mxnx-1; j++) + { + xcx.ptr.p_double[j] = xc->ptr.pp_double[i][j]; + } + + /* + * center's tree + */ + tmpi = kdtreequeryknn(centerstree, &xcx, centerscnt, ae_true, _state); + ae_assert(tmpi==centerscnt, "BuildRBFModelLSQR: internal error", _state); + kdtreequeryresultsx(centerstree, &cx, _state); + kdtreequeryresultstags(centerstree, ¢erstags, _state); + + /* + * point's tree + */ + mrad = 0; + for(j=0; j<=centerscnt-1; j++) + { + mrad = ae_maxreal(mrad, r->ptr.p_double[centerstags.ptr.p_int[j]], _state); + } + + /* + * we need to be sure that 'CTree' contains + * at least one side center + */ + sparseset(&sps, i, i, 1, _state); + c.ptr.p_double[0] = 1.0; + for(j=1; j<=centerscnt-1; j++) + { + c.ptr.p_double[j] = 0.0; + } + if( centerscnt>1&&nearpointscnt.ptr.p_int[i]>0 ) + { + + /* + * first KDTree request for points + */ + pointscnt = nearpointscnt.ptr.p_int[i]; + tmpi = kdtreequeryknn(pointstree, &xcx, skipnearpointscnt.ptr.p_int[i]+nearpointscnt.ptr.p_int[i], ae_true, _state); + ae_assert(tmpi==skipnearpointscnt.ptr.p_int[i]+nearpointscnt.ptr.p_int[i], "BuildRBFModelLSQR: internal error", _state); + kdtreequeryresultsx(pointstree, &xx, _state); + sind = skipnearpointscnt.ptr.p_int[i]; + for(j=0; j<=pointscnt-1; j++) + { + vx = xx.ptr.pp_double[sind+j][0]; + vy = xx.ptr.pp_double[sind+j][1]; + vz = xx.ptr.pp_double[sind+j][2]; + for(k=0; k<=centerscnt-1; k++) + { + vr = 0.0; + vv = vx-cx.ptr.pp_double[k][0]; + vr = vr+vv*vv; + vv = vy-cx.ptr.pp_double[k][1]; + vr = vr+vv*vv; + vv = vz-cx.ptr.pp_double[k][2]; + vr = vr+vv*vv; + vv = r->ptr.p_double[centerstags.ptr.p_int[k]]; + a.ptr.pp_double[j][k] = ae_exp(-vr/(vv*vv), _state); + } + } + for(j=0; j<=centerscnt-1; j++) + { + g.ptr.p_double[j] = ae_exp(-(ae_sqr(xcx.ptr.p_double[0]-cx.ptr.pp_double[j][0], _state)+ae_sqr(xcx.ptr.p_double[1]-cx.ptr.pp_double[j][1], _state)+ae_sqr(xcx.ptr.p_double[2]-cx.ptr.pp_double[j][2], _state))/ae_sqr(r->ptr.p_double[centerstags.ptr.p_int[j]], _state), _state); + } + + /* + * calculate the problem + */ + gnorm2 = ae_v_dotproduct(&g.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1)); + for(j=0; j<=pointscnt-1; j++) + { + vv = ae_v_dotproduct(&a.ptr.pp_double[j][0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1)); + vv = vv/gnorm2; + tmpy.ptr.p_double[j] = -vv; + ae_v_subd(&a.ptr.pp_double[j][0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1), vv); + } + for(j=pointscnt; j<=pointscnt+centerscnt-1; j++) + { + for(k=0; k<=centerscnt-1; k++) + { + a.ptr.pp_double[j][k] = 0.0; + } + a.ptr.pp_double[j][j-pointscnt] = 1.0E-6; + tmpy.ptr.p_double[j] = 0.0; + } + fblssolvels(&a, &tmpy, pointscnt+centerscnt, centerscnt, &tmp0, &tmp1, &tmp2, _state); + ae_v_move(&c.ptr.p_double[0], 1, &tmpy.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1)); + vv = ae_v_dotproduct(&g.ptr.p_double[0], 1, &c.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1)); + vv = vv/gnorm2; + ae_v_subd(&c.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1), vv); + vv = 1/gnorm2; + ae_v_addd(&c.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,centerscnt-1), vv); + for(j=0; j<=centerscnt-1; j++) + { + sparseset(&sps, i, centerstags.ptr.p_int[j], c.ptr.p_double[j], _state); + } + } + + /* + * second KDTree request for points + */ + pointscnt = farpointscnt.ptr.p_int[i]; + tmpi = kdtreequeryknn(pointstree, &xcx, pointscnt, ae_true, _state); + ae_assert(tmpi==pointscnt, "BuildRBFModelLSQR: internal error", _state); + kdtreequeryresultsx(pointstree, &xx, _state); + kdtreequeryresultstags(pointstree, &pointstags, _state); + + /* + *fill SpG matrix + */ + for(j=0; j<=pointscnt-1; j++) + { + fx = 0; + vx = xx.ptr.pp_double[j][0]; + vy = xx.ptr.pp_double[j][1]; + vz = xx.ptr.pp_double[j][2]; + for(k=0; k<=centerscnt-1; k++) + { + vr = 0.0; + vv = vx-cx.ptr.pp_double[k][0]; + vr = vr+vv*vv; + vv = vy-cx.ptr.pp_double[k][1]; + vr = vr+vv*vv; + vv = vz-cx.ptr.pp_double[k][2]; + vr = vr+vv*vv; + vv = r->ptr.p_double[centerstags.ptr.p_int[k]]; + vv = vv*vv; + fx = fx+c.ptr.p_double[k]*ae_exp(-vr/vv, _state); + } + sparseset(&spg, pointstags.ptr.p_int[j], i, fx, _state); + } + } + sparseconverttocrs(&spg, _state); + sparseconverttocrs(&sps, _state); + + /* + * solve by LSQR method + */ + ae_vector_set_length(&tmpy, n, _state); + ae_vector_set_length(&tc, nc, _state); + ae_matrix_set_length(w, nc, ny, _state); + linlsqrcreate(n, nc, &state, _state); + linlsqrsetcond(&state, epsort, epserr, maxits, _state); + for(i=0; i<=ny-1; i++) + { + for(j=0; j<=n-1; j++) + { + tmpy.ptr.p_double[j] = y->ptr.pp_double[j][i]; + } + linlsqrsolvesparse(&state, &spg, &tmpy, _state); + linlsqrresults(&state, &c, &lsqrrep, _state); + if( lsqrrep.terminationtype<=0 ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + sparsemtv(&sps, &c, &tc, _state); + for(j=0; j<=nc-1; j++) + { + w->ptr.pp_double[j][i] = tc.ptr.p_double[j]; + } + *iterationscount = *iterationscount+lsqrrep.iterationscount; + *nmv = *nmv+lsqrrep.nmv; + } + *info = 1; + ae_frame_leave(_state); +} + + +static void rbf_buildrbfmlayersmodellsqr(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + /* Real */ ae_matrix* xc, + double rval, + /* Real */ ae_vector* r, + ae_int_t n, + ae_int_t* nc, + ae_int_t ny, + ae_int_t nlayers, + kdtree* centerstree, + double epsort, + double epserr, + ae_int_t maxits, + double lambdav, + ae_int_t* annz, + /* Real */ ae_matrix* w, + ae_int_t* info, + ae_int_t* iterationscount, + ae_int_t* nmv, + ae_state *_state) +{ + ae_frame _frame_block; + linlsqrstate state; + linlsqrreport lsqrrep; + sparsematrix spa; + double anorm; + ae_vector omega; + ae_vector xx; + ae_vector tmpy; + ae_matrix cx; + double yval; + ae_int_t nec; + ae_vector centerstags; + ae_int_t layer; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double v; + double rmaxbefore; + double rmaxafter; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(xc); + ae_vector_clear(r); + *nc = 0; + *annz = 0; + ae_matrix_clear(w); + *info = 0; + *iterationscount = 0; + *nmv = 0; + _linlsqrstate_init(&state, _state, ae_true); + _linlsqrreport_init(&lsqrrep, _state, ae_true); + _sparsematrix_init(&spa, _state, ae_true); + ae_vector_init(&omega, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpy, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&cx, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(¢erstags, 0, DT_INT, _state, ae_true); + + ae_assert(nlayers>=0, "BuildRBFMLayersModelLSQR: invalid argument(NLayers<0)", _state); + ae_assert(n>=0, "BuildRBFMLayersModelLSQR: invalid argument(N<0)", _state); + ae_assert(rbf_mxnx>0&&rbf_mxnx<=3, "BuildRBFMLayersModelLSQR: internal error(invalid global const MxNX: either MxNX<=0 or MxNX>3)", _state); + *annz = 0; + if( n==0||nlayers==0 ) + { + *info = 1; + *iterationscount = 0; + *nmv = 0; + ae_frame_leave(_state); + return; + } + *nc = n*nlayers; + ae_vector_set_length(&xx, rbf_mxnx, _state); + ae_vector_set_length(¢erstags, n, _state); + ae_matrix_set_length(xc, *nc, rbf_mxnx, _state); + ae_vector_set_length(r, *nc, _state); + for(i=0; i<=*nc-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + xc->ptr.pp_double[i][j] = x->ptr.pp_double[i%n][j]; + } + } + for(i=0; i<=*nc-1; i++) + { + r->ptr.p_double[i] = rval/ae_pow(2, i/n, _state); + } + for(i=0; i<=n-1; i++) + { + centerstags.ptr.p_int[i] = i; + } + kdtreebuildtagged(xc, ¢erstags, n, rbf_mxnx, 0, 2, centerstree, _state); + ae_vector_set_length(&omega, n, _state); + ae_vector_set_length(&tmpy, n, _state); + ae_matrix_set_length(w, *nc, ny, _state); + *info = -1; + *iterationscount = 0; + *nmv = 0; + linlsqrcreate(n, n, &state, _state); + linlsqrsetcond(&state, epsort, epserr, maxits, _state); + linlsqrsetlambdai(&state, 1.0E-6, _state); + + /* + * calculate number of non-zero elements for sparse matrix + */ + for(i=0; i<=n-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + xx.ptr.p_double[j] = x->ptr.pp_double[i][j]; + } + *annz = *annz+kdtreequeryrnn(centerstree, &xx, r->ptr.p_double[0]*rbf_rbfmlradius, ae_true, _state); + } + for(layer=0; layer<=nlayers-1; layer++) + { + + /* + * Fill sparse matrix, calculate norm(A) + */ + anorm = 0.0; + sparsecreate(n, n, *annz, &spa, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=rbf_mxnx-1; j++) + { + xx.ptr.p_double[j] = x->ptr.pp_double[i][j]; + } + nec = kdtreequeryrnn(centerstree, &xx, r->ptr.p_double[layer*n]*rbf_rbfmlradius, ae_true, _state); + kdtreequeryresultsx(centerstree, &cx, _state); + kdtreequeryresultstags(centerstree, ¢erstags, _state); + for(j=0; j<=nec-1; j++) + { + v = ae_exp(-(ae_sqr(xx.ptr.p_double[0]-cx.ptr.pp_double[j][0], _state)+ae_sqr(xx.ptr.p_double[1]-cx.ptr.pp_double[j][1], _state)+ae_sqr(xx.ptr.p_double[2]-cx.ptr.pp_double[j][2], _state))/ae_sqr(r->ptr.p_double[layer*n+centerstags.ptr.p_int[j]], _state), _state); + sparseset(&spa, i, centerstags.ptr.p_int[j], v, _state); + anorm = anorm+ae_sqr(v, _state); + } + } + anorm = ae_sqrt(anorm, _state); + sparseconverttocrs(&spa, _state); + + /* + * Calculate maximum residual before adding new layer. + * This value is not used by algorithm, the only purpose is to make debugging easier. + */ + rmaxbefore = 0.0; + for(j=0; j<=n-1; j++) + { + for(i=0; i<=ny-1; i++) + { + rmaxbefore = ae_maxreal(rmaxbefore, ae_fabs(y->ptr.pp_double[j][i], _state), _state); + } + } + + /* + * Process NY dimensions of the target function + */ + for(i=0; i<=ny-1; i++) + { + for(j=0; j<=n-1; j++) + { + tmpy.ptr.p_double[j] = y->ptr.pp_double[j][i]; + } + + /* + * calculate Omega for current layer + */ + linlsqrsetlambdai(&state, lambdav*anorm/n, _state); + linlsqrsolvesparse(&state, &spa, &tmpy, _state); + linlsqrresults(&state, &omega, &lsqrrep, _state); + if( lsqrrep.terminationtype<=0 ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + + /* + * calculate error for current layer + */ + for(j=0; j<=n-1; j++) + { + yval = 0; + for(k=0; k<=rbf_mxnx-1; k++) + { + xx.ptr.p_double[k] = x->ptr.pp_double[j][k]; + } + nec = kdtreequeryrnn(centerstree, &xx, r->ptr.p_double[layer*n]*rbf_rbffarradius, ae_true, _state); + kdtreequeryresultsx(centerstree, &cx, _state); + kdtreequeryresultstags(centerstree, ¢erstags, _state); + for(k=0; k<=nec-1; k++) + { + yval = yval+omega.ptr.p_double[centerstags.ptr.p_int[k]]*ae_exp(-(ae_sqr(xx.ptr.p_double[0]-cx.ptr.pp_double[k][0], _state)+ae_sqr(xx.ptr.p_double[1]-cx.ptr.pp_double[k][1], _state)+ae_sqr(xx.ptr.p_double[2]-cx.ptr.pp_double[k][2], _state))/ae_sqr(r->ptr.p_double[layer*n+centerstags.ptr.p_int[k]], _state), _state); + } + y->ptr.pp_double[j][i] = y->ptr.pp_double[j][i]-yval; + } + + /* + * write Omega in out parameter W + */ + for(j=0; j<=n-1; j++) + { + w->ptr.pp_double[layer*n+j][i] = omega.ptr.p_double[j]; + } + *iterationscount = *iterationscount+lsqrrep.iterationscount; + *nmv = *nmv+lsqrrep.nmv; + } + + /* + * Calculate maximum residual before adding new layer. + * This value is not used by algorithm, the only purpose is to make debugging easier. + */ + rmaxafter = 0.0; + for(j=0; j<=n-1; j++) + { + for(i=0; i<=ny-1; i++) + { + rmaxafter = ae_maxreal(rmaxafter, ae_fabs(y->ptr.pp_double[j][i], _state), _state); + } + } + } + *info = 1; + ae_frame_leave(_state); +} + + +ae_bool _rbfmodel_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + rbfmodel *p = (rbfmodel*)_p; + ae_touch_ptr((void*)p); + if( !_kdtree_init(&p->tree, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->xc, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->wr, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->v, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->x, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->y, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->calcbufxcx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->calcbufx, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->calcbuftags, 0, DT_INT, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _rbfmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + rbfmodel *dst = (rbfmodel*)_dst; + rbfmodel *src = (rbfmodel*)_src; + dst->ny = src->ny; + dst->nx = src->nx; + dst->nc = src->nc; + dst->nl = src->nl; + if( !_kdtree_init_copy(&dst->tree, &src->tree, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->xc, &src->xc, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->wr, &src->wr, _state, make_automatic) ) + return ae_false; + dst->rmax = src->rmax; + if( !ae_matrix_init_copy(&dst->v, &src->v, _state, make_automatic) ) + return ae_false; + dst->gridtype = src->gridtype; + dst->fixrad = src->fixrad; + dst->lambdav = src->lambdav; + dst->radvalue = src->radvalue; + dst->radzvalue = src->radzvalue; + dst->nlayers = src->nlayers; + dst->aterm = src->aterm; + dst->algorithmtype = src->algorithmtype; + dst->epsort = src->epsort; + dst->epserr = src->epserr; + dst->maxits = src->maxits; + dst->h = src->h; + dst->n = src->n; + if( !ae_matrix_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->calcbufxcx, &src->calcbufxcx, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->calcbufx, &src->calcbufx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->calcbuftags, &src->calcbuftags, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _rbfmodel_clear(void* _p) +{ + rbfmodel *p = (rbfmodel*)_p; + ae_touch_ptr((void*)p); + _kdtree_clear(&p->tree); + ae_matrix_clear(&p->xc); + ae_matrix_clear(&p->wr); + ae_matrix_clear(&p->v); + ae_matrix_clear(&p->x); + ae_matrix_clear(&p->y); + ae_vector_clear(&p->calcbufxcx); + ae_matrix_clear(&p->calcbufx); + ae_vector_clear(&p->calcbuftags); +} + + +void _rbfmodel_destroy(void* _p) +{ + rbfmodel *p = (rbfmodel*)_p; + ae_touch_ptr((void*)p); + _kdtree_destroy(&p->tree); + ae_matrix_destroy(&p->xc); + ae_matrix_destroy(&p->wr); + ae_matrix_destroy(&p->v); + ae_matrix_destroy(&p->x); + ae_matrix_destroy(&p->y); + ae_vector_destroy(&p->calcbufxcx); + ae_matrix_destroy(&p->calcbufx); + ae_vector_destroy(&p->calcbuftags); +} + + +ae_bool _rbfreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + rbfreport *p = (rbfreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _rbfreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + rbfreport *dst = (rbfreport*)_dst; + rbfreport *src = (rbfreport*)_src; + dst->arows = src->arows; + dst->acols = src->acols; + dst->annz = src->annz; + dst->iterationscount = src->iterationscount; + dst->nmv = src->nmv; + dst->terminationtype = src->terminationtype; + return ae_true; +} + + +void _rbfreport_clear(void* _p) +{ + rbfreport *p = (rbfreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _rbfreport_destroy(void* _p) +{ + rbfreport *p = (rbfreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* +This subroutine calculates the value of the bilinear or bicubic spline at +the given point X. + +Input parameters: + C - coefficients table. + Built by BuildBilinearSpline or BuildBicubicSpline. + X, Y- point + +Result: + S(x,y) + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +double spline2dcalc(spline2dinterpolant* c, + double x, + double y, + ae_state *_state) +{ + double v; + double vx; + double vy; + double vxy; + double result; + + + ae_assert(c->stype==-1||c->stype==-3, "Spline2DCalc: incorrect C (incorrect parameter C.SType)", _state); + ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline2DCalc: X or Y contains NaN or Infinite value", _state); + if( c->d!=1 ) + { + result = 0; + return result; + } + spline2ddiff(c, x, y, &v, &vx, &vy, &vxy, _state); + result = v; + return result; +} + + +/************************************************************************* +This subroutine calculates the value of the bilinear or bicubic spline at +the given point X and its derivatives. + +Input parameters: + C - spline interpolant. + X, Y- point + +Output parameters: + F - S(x,y) + FX - dS(x,y)/dX + FY - dS(x,y)/dY + FXY - d2S(x,y)/dXdY + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2ddiff(spline2dinterpolant* c, + double x, + double y, + double* f, + double* fx, + double* fy, + double* fxy, + ae_state *_state) +{ + double t; + double dt; + double u; + double du; + ae_int_t ix; + ae_int_t iy; + ae_int_t l; + ae_int_t r; + ae_int_t h; + ae_int_t s1; + ae_int_t s2; + ae_int_t s3; + ae_int_t s4; + ae_int_t sfx; + ae_int_t sfy; + ae_int_t sfxy; + double y1; + double y2; + double y3; + double y4; + double v; + double t0; + double t1; + double t2; + double t3; + double u0; + double u1; + double u2; + double u3; + + *f = 0; + *fx = 0; + *fy = 0; + *fxy = 0; + + ae_assert(c->stype==-1||c->stype==-3, "Spline2DDiff: incorrect C (incorrect parameter C.SType)", _state); + ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline2DDiff: X or Y contains NaN or Infinite value", _state); + + /* + * Prepare F, dF/dX, dF/dY, d2F/dXdY + */ + *f = 0; + *fx = 0; + *fy = 0; + *fxy = 0; + if( c->d!=1 ) + { + return; + } + + /* + * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) + */ + l = 0; + r = c->n-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->x.ptr.p_double[h],x) ) + { + r = h; + } + else + { + l = h; + } + } + t = (x-c->x.ptr.p_double[l])/(c->x.ptr.p_double[l+1]-c->x.ptr.p_double[l]); + dt = 1.0/(c->x.ptr.p_double[l+1]-c->x.ptr.p_double[l]); + ix = l; + + /* + * Binary search in the [ y[0], ..., y[m-2] ] (y[m-1] is not included) + */ + l = 0; + r = c->m-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->y.ptr.p_double[h],y) ) + { + r = h; + } + else + { + l = h; + } + } + u = (y-c->y.ptr.p_double[l])/(c->y.ptr.p_double[l+1]-c->y.ptr.p_double[l]); + du = 1.0/(c->y.ptr.p_double[l+1]-c->y.ptr.p_double[l]); + iy = l; + + /* + * Bilinear interpolation + */ + if( c->stype==-1 ) + { + y1 = c->f.ptr.p_double[c->n*iy+ix]; + y2 = c->f.ptr.p_double[c->n*iy+(ix+1)]; + y3 = c->f.ptr.p_double[c->n*(iy+1)+(ix+1)]; + y4 = c->f.ptr.p_double[c->n*(iy+1)+ix]; + *f = (1-t)*(1-u)*y1+t*(1-u)*y2+t*u*y3+(1-t)*u*y4; + *fx = (-(1-u)*y1+(1-u)*y2+u*y3-u*y4)*dt; + *fy = (-(1-t)*y1-t*y2+t*y3+(1-t)*y4)*du; + *fxy = (y1-y2+y3-y4)*du*dt; + return; + } + + /* + * Bicubic interpolation + */ + if( c->stype==-3 ) + { + + /* + * Prepare info + */ + t0 = 1; + t1 = t; + t2 = ae_sqr(t, _state); + t3 = t*t2; + u0 = 1; + u1 = u; + u2 = ae_sqr(u, _state); + u3 = u*u2; + sfx = c->n*c->m; + sfy = 2*c->n*c->m; + sfxy = 3*c->n*c->m; + s1 = c->n*iy+ix; + s2 = c->n*iy+(ix+1); + s3 = c->n*(iy+1)+(ix+1); + s4 = c->n*(iy+1)+ix; + + /* + * Calculate + */ + v = c->f.ptr.p_double[s1]; + *f = *f+v*t0*u0; + v = c->f.ptr.p_double[sfy+s1]/du; + *f = *f+v*t0*u1; + *fy = *fy+v*t0*u0*du; + v = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s4]-2*c->f.ptr.p_double[sfy+s1]/du-c->f.ptr.p_double[sfy+s4]/du; + *f = *f+v*t0*u2; + *fy = *fy+2*v*t0*u1*du; + v = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s4]+c->f.ptr.p_double[sfy+s1]/du+c->f.ptr.p_double[sfy+s4]/du; + *f = *f+v*t0*u3; + *fy = *fy+3*v*t0*u2*du; + v = c->f.ptr.p_double[sfx+s1]/dt; + *f = *f+v*t1*u0; + *fx = *fx+v*t0*u0*dt; + v = c->f.ptr.p_double[sfxy+s1]/(dt*du); + *f = *f+v*t1*u1; + *fx = *fx+v*t0*u1*dt; + *fy = *fy+v*t1*u0*du; + *fxy = *fxy+v*t0*u0*dt*du; + v = -3*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); + *f = *f+v*t1*u2; + *fx = *fx+v*t0*u2*dt; + *fy = *fy+2*v*t1*u1*du; + *fxy = *fxy+2*v*t0*u1*dt*du; + v = 2*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); + *f = *f+v*t1*u3; + *fx = *fx+v*t0*u3*dt; + *fy = *fy+3*v*t1*u2*du; + *fxy = *fxy+3*v*t0*u2*dt*du; + v = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s2]-2*c->f.ptr.p_double[sfx+s1]/dt-c->f.ptr.p_double[sfx+s2]/dt; + *f = *f+v*t2*u0; + *fx = *fx+2*v*t1*u0*dt; + v = -3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du); + *f = *f+v*t2*u1; + *fx = *fx+2*v*t1*u1*dt; + *fy = *fy+v*t2*u0*du; + *fxy = *fxy+2*v*t1*u0*dt*du; + v = 9*c->f.ptr.p_double[s1]-9*c->f.ptr.p_double[s2]+9*c->f.ptr.p_double[s3]-9*c->f.ptr.p_double[s4]+6*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s2]/dt-3*c->f.ptr.p_double[sfx+s3]/dt-6*c->f.ptr.p_double[sfx+s4]/dt+6*c->f.ptr.p_double[sfy+s1]/du-6*c->f.ptr.p_double[sfy+s2]/du-3*c->f.ptr.p_double[sfy+s3]/du+3*c->f.ptr.p_double[sfy+s4]/du+4*c->f.ptr.p_double[sfxy+s1]/(dt*du)+2*c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+2*c->f.ptr.p_double[sfxy+s4]/(dt*du); + *f = *f+v*t2*u2; + *fx = *fx+2*v*t1*u2*dt; + *fy = *fy+2*v*t2*u1*du; + *fxy = *fxy+4*v*t1*u1*dt*du; + v = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-4*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s2]/dt+2*c->f.ptr.p_double[sfx+s3]/dt+4*c->f.ptr.p_double[sfx+s4]/dt-3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du+3*c->f.ptr.p_double[sfy+s3]/du-3*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-2*c->f.ptr.p_double[sfxy+s4]/(dt*du); + *f = *f+v*t2*u3; + *fx = *fx+2*v*t1*u3*dt; + *fy = *fy+3*v*t2*u2*du; + *fxy = *fxy+6*v*t1*u2*dt*du; + v = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s2]+c->f.ptr.p_double[sfx+s1]/dt+c->f.ptr.p_double[sfx+s2]/dt; + *f = *f+v*t3*u0; + *fx = *fx+3*v*t2*u0*dt; + v = 2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du); + *f = *f+v*t3*u1; + *fx = *fx+3*v*t2*u1*dt; + *fy = *fy+v*t3*u0*du; + *fxy = *fxy+3*v*t2*u0*dt*du; + v = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-3*c->f.ptr.p_double[sfx+s1]/dt-3*c->f.ptr.p_double[sfx+s2]/dt+3*c->f.ptr.p_double[sfx+s3]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-4*c->f.ptr.p_double[sfy+s1]/du+4*c->f.ptr.p_double[sfy+s2]/du+2*c->f.ptr.p_double[sfy+s3]/du-2*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-2*c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); + *f = *f+v*t3*u2; + *fx = *fx+3*v*t2*u2*dt; + *fy = *fy+2*v*t3*u1*du; + *fxy = *fxy+6*v*t2*u1*dt*du; + v = 4*c->f.ptr.p_double[s1]-4*c->f.ptr.p_double[s2]+4*c->f.ptr.p_double[s3]-4*c->f.ptr.p_double[s4]+2*c->f.ptr.p_double[sfx+s1]/dt+2*c->f.ptr.p_double[sfx+s2]/dt-2*c->f.ptr.p_double[sfx+s3]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfy+s3]/du+2*c->f.ptr.p_double[sfy+s4]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); + *f = *f+v*t3*u3; + *fx = *fx+3*v*t2*u3*dt; + *fy = *fy+3*v*t3*u2*du; + *fxy = *fxy+9*v*t2*u2*dt*du; + return; + } +} + + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +Input parameters: + C - spline interpolant + AX, BX - transformation coefficients: x = A*t + B + AY, BY - transformation coefficients: y = A*u + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dlintransxy(spline2dinterpolant* c, + double ax, + double bx, + double ay, + double by, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_vector f; + ae_vector v; + ae_int_t i; + ae_int_t j; + ae_int_t k; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&f, 0, DT_REAL, _state, ae_true); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + + ae_assert(c->stype==-3||c->stype==-1, "Spline2DLinTransXY: incorrect C (incorrect parameter C.SType)", _state); + ae_assert(ae_isfinite(ax, _state), "Spline2DLinTransXY: AX is infinite or NaN", _state); + ae_assert(ae_isfinite(bx, _state), "Spline2DLinTransXY: BX is infinite or NaN", _state); + ae_assert(ae_isfinite(ay, _state), "Spline2DLinTransXY: AY is infinite or NaN", _state); + ae_assert(ae_isfinite(by, _state), "Spline2DLinTransXY: BY is infinite or NaN", _state); + ae_vector_set_length(&x, c->n, _state); + ae_vector_set_length(&y, c->m, _state); + ae_vector_set_length(&f, c->m*c->n*c->d, _state); + for(j=0; j<=c->n-1; j++) + { + x.ptr.p_double[j] = c->x.ptr.p_double[j]; + } + for(i=0; i<=c->m-1; i++) + { + y.ptr.p_double[i] = c->y.ptr.p_double[i]; + } + for(i=0; i<=c->m-1; i++) + { + for(j=0; j<=c->n-1; j++) + { + for(k=0; k<=c->d-1; k++) + { + f.ptr.p_double[c->d*(i*c->n+j)+k] = c->f.ptr.p_double[c->d*(i*c->n+j)+k]; + } + } + } + + /* + * Handle different combinations of AX/AY + */ + if( ae_fp_eq(ax,0)&&ae_fp_neq(ay,0) ) + { + for(i=0; i<=c->m-1; i++) + { + spline2dcalcvbuf(c, bx, y.ptr.p_double[i], &v, _state); + y.ptr.p_double[i] = (y.ptr.p_double[i]-by)/ay; + for(j=0; j<=c->n-1; j++) + { + for(k=0; k<=c->d-1; k++) + { + f.ptr.p_double[c->d*(i*c->n+j)+k] = v.ptr.p_double[k]; + } + } + } + } + if( ae_fp_neq(ax,0)&&ae_fp_eq(ay,0) ) + { + for(j=0; j<=c->n-1; j++) + { + spline2dcalcvbuf(c, x.ptr.p_double[j], by, &v, _state); + x.ptr.p_double[j] = (x.ptr.p_double[j]-bx)/ax; + for(i=0; i<=c->m-1; i++) + { + for(k=0; k<=c->d-1; k++) + { + f.ptr.p_double[c->d*(i*c->n+j)+k] = v.ptr.p_double[k]; + } + } + } + } + if( ae_fp_neq(ax,0)&&ae_fp_neq(ay,0) ) + { + for(j=0; j<=c->n-1; j++) + { + x.ptr.p_double[j] = (x.ptr.p_double[j]-bx)/ax; + } + for(i=0; i<=c->m-1; i++) + { + y.ptr.p_double[i] = (y.ptr.p_double[i]-by)/ay; + } + } + if( ae_fp_eq(ax,0)&&ae_fp_eq(ay,0) ) + { + spline2dcalcvbuf(c, bx, by, &v, _state); + for(i=0; i<=c->m-1; i++) + { + for(j=0; j<=c->n-1; j++) + { + for(k=0; k<=c->d-1; k++) + { + f.ptr.p_double[c->d*(i*c->n+j)+k] = v.ptr.p_double[k]; + } + } + } + } + + /* + * Rebuild spline + */ + if( c->stype==-3 ) + { + spline2dbuildbicubicv(&x, c->n, &y, c->m, &f, c->d, c, _state); + } + if( c->stype==-1 ) + { + spline2dbuildbilinearv(&x, c->n, &y, c->m, &f, c->d, c, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +Input parameters: + C - spline interpolant. + A, B- transformation coefficients: S2(x,y) = A*S(x,y) + B + +Output parameters: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dlintransf(spline2dinterpolant* c, + double a, + double b, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_vector f; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&f, 0, DT_REAL, _state, ae_true); + + ae_assert(c->stype==-3||c->stype==-1, "Spline2DLinTransF: incorrect C (incorrect parameter C.SType)", _state); + ae_vector_set_length(&x, c->n, _state); + ae_vector_set_length(&y, c->m, _state); + ae_vector_set_length(&f, c->m*c->n*c->d, _state); + for(j=0; j<=c->n-1; j++) + { + x.ptr.p_double[j] = c->x.ptr.p_double[j]; + } + for(i=0; i<=c->m-1; i++) + { + y.ptr.p_double[i] = c->y.ptr.p_double[i]; + } + for(i=0; i<=c->m*c->n*c->d-1; i++) + { + f.ptr.p_double[i] = a*c->f.ptr.p_double[i]+b; + } + if( c->stype==-3 ) + { + spline2dbuildbicubicv(&x, c->n, &y, c->m, &f, c->d, c, _state); + } + if( c->stype==-1 ) + { + spline2dbuildbilinearv(&x, c->n, &y, c->m, &f, c->d, c, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine makes the copy of the spline model. + +Input parameters: + C - spline interpolant + +Output parameters: + CC - spline copy + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dcopy(spline2dinterpolant* c, + spline2dinterpolant* cc, + ae_state *_state) +{ + ae_int_t tblsize; + + _spline2dinterpolant_clear(cc); + + ae_assert(c->k==1||c->k==3, "Spline2DCopy: incorrect C (incorrect parameter C.K)", _state); + cc->k = c->k; + cc->n = c->n; + cc->m = c->m; + cc->d = c->d; + cc->stype = c->stype; + tblsize = -1; + if( c->stype==-3 ) + { + tblsize = 4*c->n*c->m*c->d; + } + if( c->stype==-1 ) + { + tblsize = c->n*c->m*c->d; + } + ae_assert(tblsize>0, "Spline2DCopy: internal error", _state); + ae_vector_set_length(&cc->x, cc->n, _state); + ae_vector_set_length(&cc->y, cc->m, _state); + ae_vector_set_length(&cc->f, tblsize, _state); + ae_v_move(&cc->x.ptr.p_double[0], 1, &c->x.ptr.p_double[0], 1, ae_v_len(0,cc->n-1)); + ae_v_move(&cc->y.ptr.p_double[0], 1, &c->y.ptr.p_double[0], 1, ae_v_len(0,cc->m-1)); + ae_v_move(&cc->f.ptr.p_double[0], 1, &c->f.ptr.p_double[0], 1, ae_v_len(0,tblsize-1)); +} + + +/************************************************************************* +Bicubic spline resampling + +Input parameters: + A - function values at the old grid, + array[0..OldHeight-1, 0..OldWidth-1] + OldHeight - old grid height, OldHeight>1 + OldWidth - old grid width, OldWidth>1 + NewHeight - new grid height, NewHeight>1 + NewWidth - new grid width, NewWidth>1 + +Output parameters: + B - function values at the new grid, + array[0..NewHeight-1, 0..NewWidth-1] + + -- ALGLIB routine -- + 15 May, 2007 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline2dresamplebicubic(/* Real */ ae_matrix* a, + ae_int_t oldheight, + ae_int_t oldwidth, + /* Real */ ae_matrix* b, + ae_int_t newheight, + ae_int_t newwidth, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix buf; + ae_vector x; + ae_vector y; + spline1dinterpolant c; + ae_int_t mw; + ae_int_t mh; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(b); + ae_matrix_init(&buf, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + _spline1dinterpolant_init(&c, _state, ae_true); + + ae_assert(oldwidth>1&&oldheight>1, "Spline2DResampleBicubic: width/height less than 1", _state); + ae_assert(newwidth>1&&newheight>1, "Spline2DResampleBicubic: width/height less than 1", _state); + + /* + * Prepare + */ + mw = ae_maxint(oldwidth, newwidth, _state); + mh = ae_maxint(oldheight, newheight, _state); + ae_matrix_set_length(b, newheight, newwidth, _state); + ae_matrix_set_length(&buf, oldheight, newwidth, _state); + ae_vector_set_length(&x, ae_maxint(mw, mh, _state), _state); + ae_vector_set_length(&y, ae_maxint(mw, mh, _state), _state); + + /* + * Horizontal interpolation + */ + for(i=0; i<=oldheight-1; i++) + { + + /* + * Fill X, Y + */ + for(j=0; j<=oldwidth-1; j++) + { + x.ptr.p_double[j] = (double)j/(double)(oldwidth-1); + y.ptr.p_double[j] = a->ptr.pp_double[i][j]; + } + + /* + * Interpolate and place result into temporary matrix + */ + spline1dbuildcubic(&x, &y, oldwidth, 0, 0.0, 0, 0.0, &c, _state); + for(j=0; j<=newwidth-1; j++) + { + buf.ptr.pp_double[i][j] = spline1dcalc(&c, (double)j/(double)(newwidth-1), _state); + } + } + + /* + * Vertical interpolation + */ + for(j=0; j<=newwidth-1; j++) + { + + /* + * Fill X, Y + */ + for(i=0; i<=oldheight-1; i++) + { + x.ptr.p_double[i] = (double)i/(double)(oldheight-1); + y.ptr.p_double[i] = buf.ptr.pp_double[i][j]; + } + + /* + * Interpolate and place result into B + */ + spline1dbuildcubic(&x, &y, oldheight, 0, 0.0, 0, 0.0, &c, _state); + for(i=0; i<=newheight-1; i++) + { + b->ptr.pp_double[i][j] = spline1dcalc(&c, (double)i/(double)(newheight-1), _state); + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Bilinear spline resampling + +Input parameters: + A - function values at the old grid, + array[0..OldHeight-1, 0..OldWidth-1] + OldHeight - old grid height, OldHeight>1 + OldWidth - old grid width, OldWidth>1 + NewHeight - new grid height, NewHeight>1 + NewWidth - new grid width, NewWidth>1 + +Output parameters: + B - function values at the new grid, + array[0..NewHeight-1, 0..NewWidth-1] + + -- ALGLIB routine -- + 09.07.2007 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline2dresamplebilinear(/* Real */ ae_matrix* a, + ae_int_t oldheight, + ae_int_t oldwidth, + /* Real */ ae_matrix* b, + ae_int_t newheight, + ae_int_t newwidth, + ae_state *_state) +{ + ae_int_t l; + ae_int_t c; + double t; + double u; + ae_int_t i; + ae_int_t j; + + ae_matrix_clear(b); + + ae_assert(oldwidth>1&&oldheight>1, "Spline2DResampleBilinear: width/height less than 1", _state); + ae_assert(newwidth>1&&newheight>1, "Spline2DResampleBilinear: width/height less than 1", _state); + ae_matrix_set_length(b, newheight, newwidth, _state); + for(i=0; i<=newheight-1; i++) + { + for(j=0; j<=newwidth-1; j++) + { + l = i*(oldheight-1)/(newheight-1); + if( l==oldheight-1 ) + { + l = oldheight-2; + } + u = (double)i/(double)(newheight-1)*(oldheight-1)-l; + c = j*(oldwidth-1)/(newwidth-1); + if( c==oldwidth-1 ) + { + c = oldwidth-2; + } + t = (double)(j*(oldwidth-1))/(double)(newwidth-1)-c; + b->ptr.pp_double[i][j] = (1-t)*(1-u)*a->ptr.pp_double[l][c]+t*(1-u)*a->ptr.pp_double[l][c+1]+t*u*a->ptr.pp_double[l+1][c+1]+(1-t)*u*a->ptr.pp_double[l+1][c]; + } + } +} + + +/************************************************************************* +This subroutine builds bilinear vector-valued spline. + +Input parameters: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + F - function values, array[0..M*N*D-1]: + * first D elements store D values at (X[0],Y[0]) + * next D elements store D values at (X[1],Y[0]) + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(J*N+I)...D*(J*N+I)+D-1]. + M,N - grid size, M>=2, N>=2 + D - vector dimension, D>=1 + +Output parameters: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbilinearv(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + /* Real */ ae_vector* f, + ae_int_t d, + spline2dinterpolant* c, + ae_state *_state) +{ + double t; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t i0; + + _spline2dinterpolant_clear(c); + + ae_assert(n>=2, "Spline2DBuildBilinearV: N is less then 2", _state); + ae_assert(m>=2, "Spline2DBuildBilinearV: M is less then 2", _state); + ae_assert(d>=1, "Spline2DBuildBilinearV: invalid argument D (D<1)", _state); + ae_assert(x->cnt>=n&&y->cnt>=m, "Spline2DBuildBilinearV: length of X or Y is too short (Length(X/Y)cnt>=k, "Spline2DBuildBilinearV: length of F is too short (Length(F)k = 1; + c->n = n; + c->m = m; + c->d = d; + c->stype = -1; + ae_vector_set_length(&c->x, c->n, _state); + ae_vector_set_length(&c->y, c->m, _state); + ae_vector_set_length(&c->f, k, _state); + for(i=0; i<=c->n-1; i++) + { + c->x.ptr.p_double[i] = x->ptr.p_double[i]; + } + for(i=0; i<=c->m-1; i++) + { + c->y.ptr.p_double[i] = y->ptr.p_double[i]; + } + for(i=0; i<=k-1; i++) + { + c->f.ptr.p_double[i] = f->ptr.p_double[i]; + } + + /* + * Sort points + */ + for(j=0; j<=c->n-1; j++) + { + k = j; + for(i=j+1; i<=c->n-1; i++) + { + if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) + { + k = i; + } + } + if( k!=j ) + { + for(i=0; i<=c->m-1; i++) + { + for(i0=0; i0<=c->d-1; i0++) + { + t = c->f.ptr.p_double[c->d*(i*c->n+j)+i0]; + c->f.ptr.p_double[c->d*(i*c->n+j)+i0] = c->f.ptr.p_double[c->d*(i*c->n+k)+i0]; + c->f.ptr.p_double[c->d*(i*c->n+k)+i0] = t; + } + } + t = c->x.ptr.p_double[j]; + c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; + c->x.ptr.p_double[k] = t; + } + } + for(i=0; i<=c->m-1; i++) + { + k = i; + for(j=i+1; j<=c->m-1; j++) + { + if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) + { + k = j; + } + } + if( k!=i ) + { + for(j=0; j<=c->n-1; j++) + { + for(i0=0; i0<=c->d-1; i0++) + { + t = c->f.ptr.p_double[c->d*(i*c->n+j)+i0]; + c->f.ptr.p_double[c->d*(i*c->n+j)+i0] = c->f.ptr.p_double[c->d*(k*c->n+j)+i0]; + c->f.ptr.p_double[c->d*(k*c->n+j)+i0] = t; + } + } + t = c->y.ptr.p_double[i]; + c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; + c->y.ptr.p_double[k] = t; + } + } +} + + +/************************************************************************* +This subroutine builds bicubic vector-valued spline. + +Input parameters: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + F - function values, array[0..M*N*D-1]: + * first D elements store D values at (X[0],Y[0]) + * next D elements store D values at (X[1],Y[0]) + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(J*N+I)...D*(J*N+I)+D-1]. + M,N - grid size, M>=2, N>=2 + D - vector dimension, D>=1 + +Output parameters: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbicubicv(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + /* Real */ ae_vector* f, + ae_int_t d, + spline2dinterpolant* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _f; + ae_matrix tf; + ae_matrix dx; + ae_matrix dy; + ae_matrix dxy; + double t; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t di; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_f, f, _state, ae_true); + f = &_f; + _spline2dinterpolant_clear(c); + ae_matrix_init(&tf, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&dx, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&dy, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&dxy, 0, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=2, "Spline2DBuildBicubicV: N is less than 2", _state); + ae_assert(m>=2, "Spline2DBuildBicubicV: M is less than 2", _state); + ae_assert(d>=1, "Spline2DBuildBicubicV: invalid argument D (D<1)", _state); + ae_assert(x->cnt>=n&&y->cnt>=m, "Spline2DBuildBicubicV: length of X or Y is too short (Length(X/Y)cnt>=k, "Spline2DBuildBicubicV: length of F is too short (Length(F)k = 3; + c->d = d; + c->n = n; + c->m = m; + c->stype = -3; + k = 4*k; + ae_vector_set_length(&c->x, c->n, _state); + ae_vector_set_length(&c->y, c->m, _state); + ae_vector_set_length(&c->f, k, _state); + ae_matrix_set_length(&tf, c->m, c->n, _state); + for(i=0; i<=c->n-1; i++) + { + c->x.ptr.p_double[i] = x->ptr.p_double[i]; + } + for(i=0; i<=c->m-1; i++) + { + c->y.ptr.p_double[i] = y->ptr.p_double[i]; + } + + /* + * Sort points + */ + for(j=0; j<=c->n-1; j++) + { + k = j; + for(i=j+1; i<=c->n-1; i++) + { + if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) + { + k = i; + } + } + if( k!=j ) + { + for(i=0; i<=c->m-1; i++) + { + for(di=0; di<=c->d-1; di++) + { + t = f->ptr.p_double[c->d*(i*c->n+j)+di]; + f->ptr.p_double[c->d*(i*c->n+j)+di] = f->ptr.p_double[c->d*(i*c->n+k)+di]; + f->ptr.p_double[c->d*(i*c->n+k)+di] = t; + } + } + t = c->x.ptr.p_double[j]; + c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; + c->x.ptr.p_double[k] = t; + } + } + for(i=0; i<=c->m-1; i++) + { + k = i; + for(j=i+1; j<=c->m-1; j++) + { + if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) + { + k = j; + } + } + if( k!=i ) + { + for(j=0; j<=c->n-1; j++) + { + for(di=0; di<=c->d-1; di++) + { + t = f->ptr.p_double[c->d*(i*c->n+j)+di]; + f->ptr.p_double[c->d*(i*c->n+j)+di] = f->ptr.p_double[c->d*(k*c->n+j)+di]; + f->ptr.p_double[c->d*(k*c->n+j)+di] = t; + } + } + t = c->y.ptr.p_double[i]; + c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; + c->y.ptr.p_double[k] = t; + } + } + for(di=0; di<=c->d-1; di++) + { + for(i=0; i<=c->m-1; i++) + { + for(j=0; j<=c->n-1; j++) + { + tf.ptr.pp_double[i][j] = f->ptr.p_double[c->d*(i*c->n+j)+di]; + } + } + spline2d_bicubiccalcderivatives(&tf, &c->x, &c->y, c->m, c->n, &dx, &dy, &dxy, _state); + for(i=0; i<=c->m-1; i++) + { + for(j=0; j<=c->n-1; j++) + { + k = c->d*(i*c->n+j)+di; + c->f.ptr.p_double[k] = tf.ptr.pp_double[i][j]; + c->f.ptr.p_double[c->n*c->m*c->d+k] = dx.ptr.pp_double[i][j]; + c->f.ptr.p_double[2*c->n*c->m*c->d+k] = dy.ptr.pp_double[i][j]; + c->f.ptr.p_double[3*c->n*c->m*c->d+k] = dxy.ptr.pp_double[i][j]; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y- point + F - output buffer, possibly preallocated array. In case array size + is large enough to store result, it is not reallocated. Array + which is too short will be reallocated + +OUTPUT PARAMETERS: + F - array[D] (or larger) which stores function values + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dcalcvbuf(spline2dinterpolant* c, + double x, + double y, + /* Real */ ae_vector* f, + ae_state *_state) +{ + double t; + double dt; + double u; + double du; + ae_int_t ix; + ae_int_t iy; + ae_int_t l; + ae_int_t r; + ae_int_t h; + ae_int_t s1; + ae_int_t s2; + ae_int_t s3; + ae_int_t s4; + ae_int_t sfx; + ae_int_t sfy; + ae_int_t sfxy; + double y1; + double y2; + double y3; + double y4; + double v; + double t0; + double t1; + double t2; + double t3; + double u0; + double u1; + double u2; + double u3; + ae_int_t i; + + + ae_assert(c->stype==-1||c->stype==-3, "Spline2DCalcVBuf: incorrect C (incorrect parameter C.SType)", _state); + ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline2DCalcVBuf: either X=NaN/Infinite or Y=NaN/Infinite", _state); + rvectorsetlengthatleast(f, c->d, _state); + + /* + * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) + */ + l = 0; + r = c->n-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->x.ptr.p_double[h],x) ) + { + r = h; + } + else + { + l = h; + } + } + t = (x-c->x.ptr.p_double[l])/(c->x.ptr.p_double[l+1]-c->x.ptr.p_double[l]); + dt = 1.0/(c->x.ptr.p_double[l+1]-c->x.ptr.p_double[l]); + ix = l; + + /* + * Binary search in the [ y[0], ..., y[m-2] ] (y[m-1] is not included) + */ + l = 0; + r = c->m-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->y.ptr.p_double[h],y) ) + { + r = h; + } + else + { + l = h; + } + } + u = (y-c->y.ptr.p_double[l])/(c->y.ptr.p_double[l+1]-c->y.ptr.p_double[l]); + du = 1.0/(c->y.ptr.p_double[l+1]-c->y.ptr.p_double[l]); + iy = l; + + /* + * Bilinear interpolation + */ + if( c->stype==-1 ) + { + for(i=0; i<=c->d-1; i++) + { + y1 = c->f.ptr.p_double[c->d*(c->n*iy+ix)+i]; + y2 = c->f.ptr.p_double[c->d*(c->n*iy+(ix+1))+i]; + y3 = c->f.ptr.p_double[c->d*(c->n*(iy+1)+(ix+1))+i]; + y4 = c->f.ptr.p_double[c->d*(c->n*(iy+1)+ix)+i]; + f->ptr.p_double[i] = (1-t)*(1-u)*y1+t*(1-u)*y2+t*u*y3+(1-t)*u*y4; + } + return; + } + + /* + * Bicubic interpolation + */ + if( c->stype==-3 ) + { + + /* + * Prepare info + */ + t0 = 1; + t1 = t; + t2 = ae_sqr(t, _state); + t3 = t*t2; + u0 = 1; + u1 = u; + u2 = ae_sqr(u, _state); + u3 = u*u2; + sfx = c->n*c->m*c->d; + sfy = 2*c->n*c->m*c->d; + sfxy = 3*c->n*c->m*c->d; + for(i=0; i<=c->d-1; i++) + { + + /* + * Prepare F, dF/dX, dF/dY, d2F/dXdY + */ + f->ptr.p_double[i] = 0; + s1 = c->d*(c->n*iy+ix)+i; + s2 = c->d*(c->n*iy+(ix+1))+i; + s3 = c->d*(c->n*(iy+1)+(ix+1))+i; + s4 = c->d*(c->n*(iy+1)+ix)+i; + + /* + * Calculate + */ + v = c->f.ptr.p_double[s1]; + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t0*u0; + v = c->f.ptr.p_double[sfy+s1]/du; + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t0*u1; + v = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s4]-2*c->f.ptr.p_double[sfy+s1]/du-c->f.ptr.p_double[sfy+s4]/du; + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t0*u2; + v = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s4]+c->f.ptr.p_double[sfy+s1]/du+c->f.ptr.p_double[sfy+s4]/du; + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t0*u3; + v = c->f.ptr.p_double[sfx+s1]/dt; + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t1*u0; + v = c->f.ptr.p_double[sfxy+s1]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t1*u1; + v = -3*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t1*u2; + v = 2*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t1*u3; + v = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s2]-2*c->f.ptr.p_double[sfx+s1]/dt-c->f.ptr.p_double[sfx+s2]/dt; + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t2*u0; + v = -3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t2*u1; + v = 9*c->f.ptr.p_double[s1]-9*c->f.ptr.p_double[s2]+9*c->f.ptr.p_double[s3]-9*c->f.ptr.p_double[s4]+6*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s2]/dt-3*c->f.ptr.p_double[sfx+s3]/dt-6*c->f.ptr.p_double[sfx+s4]/dt+6*c->f.ptr.p_double[sfy+s1]/du-6*c->f.ptr.p_double[sfy+s2]/du-3*c->f.ptr.p_double[sfy+s3]/du+3*c->f.ptr.p_double[sfy+s4]/du+4*c->f.ptr.p_double[sfxy+s1]/(dt*du)+2*c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+2*c->f.ptr.p_double[sfxy+s4]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t2*u2; + v = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-4*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s2]/dt+2*c->f.ptr.p_double[sfx+s3]/dt+4*c->f.ptr.p_double[sfx+s4]/dt-3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du+3*c->f.ptr.p_double[sfy+s3]/du-3*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-2*c->f.ptr.p_double[sfxy+s4]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t2*u3; + v = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s2]+c->f.ptr.p_double[sfx+s1]/dt+c->f.ptr.p_double[sfx+s2]/dt; + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t3*u0; + v = 2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t3*u1; + v = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-3*c->f.ptr.p_double[sfx+s1]/dt-3*c->f.ptr.p_double[sfx+s2]/dt+3*c->f.ptr.p_double[sfx+s3]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-4*c->f.ptr.p_double[sfy+s1]/du+4*c->f.ptr.p_double[sfy+s2]/du+2*c->f.ptr.p_double[sfy+s3]/du-2*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-2*c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t3*u2; + v = 4*c->f.ptr.p_double[s1]-4*c->f.ptr.p_double[s2]+4*c->f.ptr.p_double[s3]-4*c->f.ptr.p_double[s4]+2*c->f.ptr.p_double[sfx+s1]/dt+2*c->f.ptr.p_double[sfx+s2]/dt-2*c->f.ptr.p_double[sfx+s3]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfy+s3]/du+2*c->f.ptr.p_double[sfy+s4]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); + f->ptr.p_double[i] = f->ptr.p_double[i]+v*t3*u3; + } + return; + } +} + + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y- point + +OUTPUT PARAMETERS: + F - array[D] which stores function values. F is out-parameter and + it is reallocated after call to this function. In case you + want to reuse previously allocated F, you may use + Spline2DCalcVBuf(), which reallocates F only when it is too + small. + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dcalcv(spline2dinterpolant* c, + double x, + double y, + /* Real */ ae_vector* f, + ae_state *_state) +{ + + ae_vector_clear(f); + + ae_assert(c->stype==-1||c->stype==-3, "Spline2DCalcV: incorrect C (incorrect parameter C.SType)", _state); + ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline2DCalcV: either X=NaN/Infinite or Y=NaN/Infinite", _state); + ae_vector_set_length(f, c->d, _state); + spline2dcalcvbuf(c, x, y, f, _state); +} + + +/************************************************************************* +This subroutine unpacks two-dimensional spline into the coefficients table + +Input parameters: + C - spline interpolant. + +Result: + M, N- grid size (x-axis and y-axis) + D - number of components + Tbl - coefficients table, unpacked format, + D - components: [0..(N-1)*(M-1)*D-1, 0..19]. + For T=0..D-1 (component index), I = 0...N-2 (x index), + J=0..M-2 (y index): + K := T + I*D + J*D*(N-1) + + K-th row stores decomposition for T-th component of the + vector-valued function + + Tbl[K,0] = X[i] + Tbl[K,1] = X[i+1] + Tbl[K,2] = Y[j] + Tbl[K,3] = Y[j+1] + Tbl[K,4] = C00 + Tbl[K,5] = C01 + Tbl[K,6] = C02 + Tbl[K,7] = C03 + Tbl[K,8] = C10 + Tbl[K,9] = C11 + ... + Tbl[K,19] = C33 + On each grid square spline is equals to: + S(x) = SUM(c[i,j]*(t^i)*(u^j), i=0..3, j=0..3) + t = x-x[j] + u = y-y[i] + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dunpackv(spline2dinterpolant* c, + ae_int_t* m, + ae_int_t* n, + ae_int_t* d, + /* Real */ ae_matrix* tbl, + ae_state *_state) +{ + ae_int_t k; + ae_int_t p; + ae_int_t ci; + ae_int_t cj; + ae_int_t s1; + ae_int_t s2; + ae_int_t s3; + ae_int_t s4; + ae_int_t sfx; + ae_int_t sfy; + ae_int_t sfxy; + double y1; + double y2; + double y3; + double y4; + double dt; + double du; + ae_int_t i; + ae_int_t j; + ae_int_t k0; + + *m = 0; + *n = 0; + *d = 0; + ae_matrix_clear(tbl); + + ae_assert(c->stype==-3||c->stype==-1, "Spline2DUnpackV: incorrect C (incorrect parameter C.SType)", _state); + *n = c->n; + *m = c->m; + *d = c->d; + ae_matrix_set_length(tbl, (*n-1)*(*m-1)*(*d), 20, _state); + sfx = *n*(*m)*(*d); + sfy = 2*(*n)*(*m)*(*d); + sfxy = 3*(*n)*(*m)*(*d); + for(i=0; i<=*m-2; i++) + { + for(j=0; j<=*n-2; j++) + { + for(k=0; k<=*d-1; k++) + { + p = *d*(i*(*n-1)+j)+k; + tbl->ptr.pp_double[p][0] = c->x.ptr.p_double[j]; + tbl->ptr.pp_double[p][1] = c->x.ptr.p_double[j+1]; + tbl->ptr.pp_double[p][2] = c->y.ptr.p_double[i]; + tbl->ptr.pp_double[p][3] = c->y.ptr.p_double[i+1]; + dt = 1/(tbl->ptr.pp_double[p][1]-tbl->ptr.pp_double[p][0]); + du = 1/(tbl->ptr.pp_double[p][3]-tbl->ptr.pp_double[p][2]); + + /* + * Bilinear interpolation + */ + if( c->stype==-1 ) + { + for(k0=4; k0<=19; k0++) + { + tbl->ptr.pp_double[p][k0] = 0; + } + y1 = c->f.ptr.p_double[*d*(*n*i+j)+k]; + y2 = c->f.ptr.p_double[*d*(*n*i+(j+1))+k]; + y3 = c->f.ptr.p_double[*d*(*n*(i+1)+(j+1))+k]; + y4 = c->f.ptr.p_double[*d*(*n*(i+1)+j)+k]; + tbl->ptr.pp_double[p][4] = y1; + tbl->ptr.pp_double[p][4+1*4+0] = y2-y1; + tbl->ptr.pp_double[p][4+0*4+1] = y4-y1; + tbl->ptr.pp_double[p][4+1*4+1] = y3-y2-y4+y1; + } + + /* + * Bicubic interpolation + */ + if( c->stype==-3 ) + { + s1 = *d*(*n*i+j)+k; + s2 = *d*(*n*i+(j+1))+k; + s3 = *d*(*n*(i+1)+(j+1))+k; + s4 = *d*(*n*(i+1)+j)+k; + tbl->ptr.pp_double[p][4+0*4+0] = c->f.ptr.p_double[s1]; + tbl->ptr.pp_double[p][4+0*4+1] = c->f.ptr.p_double[sfy+s1]/du; + tbl->ptr.pp_double[p][4+0*4+2] = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s4]-2*c->f.ptr.p_double[sfy+s1]/du-c->f.ptr.p_double[sfy+s4]/du; + tbl->ptr.pp_double[p][4+0*4+3] = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s4]+c->f.ptr.p_double[sfy+s1]/du+c->f.ptr.p_double[sfy+s4]/du; + tbl->ptr.pp_double[p][4+1*4+0] = c->f.ptr.p_double[sfx+s1]/dt; + tbl->ptr.pp_double[p][4+1*4+1] = c->f.ptr.p_double[sfxy+s1]/(dt*du); + tbl->ptr.pp_double[p][4+1*4+2] = -3*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+1*4+3] = 2*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+2*4+0] = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s2]-2*c->f.ptr.p_double[sfx+s1]/dt-c->f.ptr.p_double[sfx+s2]/dt; + tbl->ptr.pp_double[p][4+2*4+1] = -3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du); + tbl->ptr.pp_double[p][4+2*4+2] = 9*c->f.ptr.p_double[s1]-9*c->f.ptr.p_double[s2]+9*c->f.ptr.p_double[s3]-9*c->f.ptr.p_double[s4]+6*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s2]/dt-3*c->f.ptr.p_double[sfx+s3]/dt-6*c->f.ptr.p_double[sfx+s4]/dt+6*c->f.ptr.p_double[sfy+s1]/du-6*c->f.ptr.p_double[sfy+s2]/du-3*c->f.ptr.p_double[sfy+s3]/du+3*c->f.ptr.p_double[sfy+s4]/du+4*c->f.ptr.p_double[sfxy+s1]/(dt*du)+2*c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+2*c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+2*4+3] = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-4*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s2]/dt+2*c->f.ptr.p_double[sfx+s3]/dt+4*c->f.ptr.p_double[sfx+s4]/dt-3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du+3*c->f.ptr.p_double[sfy+s3]/du-3*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-2*c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+3*4+0] = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s2]+c->f.ptr.p_double[sfx+s1]/dt+c->f.ptr.p_double[sfx+s2]/dt; + tbl->ptr.pp_double[p][4+3*4+1] = 2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du); + tbl->ptr.pp_double[p][4+3*4+2] = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-3*c->f.ptr.p_double[sfx+s1]/dt-3*c->f.ptr.p_double[sfx+s2]/dt+3*c->f.ptr.p_double[sfx+s3]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-4*c->f.ptr.p_double[sfy+s1]/du+4*c->f.ptr.p_double[sfy+s2]/du+2*c->f.ptr.p_double[sfy+s3]/du-2*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-2*c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+3*4+3] = 4*c->f.ptr.p_double[s1]-4*c->f.ptr.p_double[s2]+4*c->f.ptr.p_double[s3]-4*c->f.ptr.p_double[s4]+2*c->f.ptr.p_double[sfx+s1]/dt+2*c->f.ptr.p_double[sfx+s2]/dt-2*c->f.ptr.p_double[sfx+s3]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfy+s3]/du+2*c->f.ptr.p_double[sfy+s4]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); + } + + /* + * Rescale Cij + */ + for(ci=0; ci<=3; ci++) + { + for(cj=0; cj<=3; cj++) + { + tbl->ptr.pp_double[p][4+ci*4+cj] = tbl->ptr.pp_double[p][4+ci*4+cj]*ae_pow(dt, ci, _state)*ae_pow(du, cj, _state); + } + } + } + } + } +} + + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DBuildBilinearV(), which is more +flexible and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbilinear(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_matrix* f, + ae_int_t m, + ae_int_t n, + spline2dinterpolant* c, + ae_state *_state) +{ + double t; + ae_int_t i; + ae_int_t j; + ae_int_t k; + + _spline2dinterpolant_clear(c); + + ae_assert(n>=2, "Spline2DBuildBilinear: N<2", _state); + ae_assert(m>=2, "Spline2DBuildBilinear: M<2", _state); + ae_assert(x->cnt>=n&&y->cnt>=m, "Spline2DBuildBilinear: length of X or Y is too short (Length(X/Y)rows>=m&&f->cols>=n, "Spline2DBuildBilinear: size of F is too small (rows(F)k = 1; + c->n = n; + c->m = m; + c->d = 1; + c->stype = -1; + ae_vector_set_length(&c->x, c->n, _state); + ae_vector_set_length(&c->y, c->m, _state); + ae_vector_set_length(&c->f, c->n*c->m, _state); + for(i=0; i<=c->n-1; i++) + { + c->x.ptr.p_double[i] = x->ptr.p_double[i]; + } + for(i=0; i<=c->m-1; i++) + { + c->y.ptr.p_double[i] = y->ptr.p_double[i]; + } + for(i=0; i<=c->m-1; i++) + { + for(j=0; j<=c->n-1; j++) + { + c->f.ptr.p_double[i*c->n+j] = f->ptr.pp_double[i][j]; + } + } + + /* + * Sort points + */ + for(j=0; j<=c->n-1; j++) + { + k = j; + for(i=j+1; i<=c->n-1; i++) + { + if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) + { + k = i; + } + } + if( k!=j ) + { + for(i=0; i<=c->m-1; i++) + { + t = c->f.ptr.p_double[i*c->n+j]; + c->f.ptr.p_double[i*c->n+j] = c->f.ptr.p_double[i*c->n+k]; + c->f.ptr.p_double[i*c->n+k] = t; + } + t = c->x.ptr.p_double[j]; + c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; + c->x.ptr.p_double[k] = t; + } + } + for(i=0; i<=c->m-1; i++) + { + k = i; + for(j=i+1; j<=c->m-1; j++) + { + if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) + { + k = j; + } + } + if( k!=i ) + { + for(j=0; j<=c->n-1; j++) + { + t = c->f.ptr.p_double[i*c->n+j]; + c->f.ptr.p_double[i*c->n+j] = c->f.ptr.p_double[k*c->n+j]; + c->f.ptr.p_double[k*c->n+j] = t; + } + t = c->y.ptr.p_double[i]; + c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; + c->y.ptr.p_double[k] = t; + } + } +} + + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DBuildBicubicV(), which is more +flexible and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbicubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_matrix* f, + ae_int_t m, + ae_int_t n, + spline2dinterpolant* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _f; + ae_int_t sfx; + ae_int_t sfy; + ae_int_t sfxy; + ae_matrix dx; + ae_matrix dy; + ae_matrix dxy; + double t; + ae_int_t i; + ae_int_t j; + ae_int_t k; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_f, f, _state, ae_true); + f = &_f; + _spline2dinterpolant_clear(c); + ae_matrix_init(&dx, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&dy, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&dxy, 0, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=2, "Spline2DBuildBicubicSpline: N<2", _state); + ae_assert(m>=2, "Spline2DBuildBicubicSpline: M<2", _state); + ae_assert(x->cnt>=n&&y->cnt>=m, "Spline2DBuildBicubic: length of X or Y is too short (Length(X/Y)rows>=m&&f->cols>=n, "Spline2DBuildBicubic: size of F is too small (rows(F)k = 3; + c->d = 1; + c->n = n; + c->m = m; + c->stype = -3; + sfx = c->n*c->m; + sfy = 2*c->n*c->m; + sfxy = 3*c->n*c->m; + ae_vector_set_length(&c->x, c->n, _state); + ae_vector_set_length(&c->y, c->m, _state); + ae_vector_set_length(&c->f, 4*c->n*c->m, _state); + for(i=0; i<=c->n-1; i++) + { + c->x.ptr.p_double[i] = x->ptr.p_double[i]; + } + for(i=0; i<=c->m-1; i++) + { + c->y.ptr.p_double[i] = y->ptr.p_double[i]; + } + + /* + * Sort points + */ + for(j=0; j<=c->n-1; j++) + { + k = j; + for(i=j+1; i<=c->n-1; i++) + { + if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) + { + k = i; + } + } + if( k!=j ) + { + for(i=0; i<=c->m-1; i++) + { + t = f->ptr.pp_double[i][j]; + f->ptr.pp_double[i][j] = f->ptr.pp_double[i][k]; + f->ptr.pp_double[i][k] = t; + } + t = c->x.ptr.p_double[j]; + c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; + c->x.ptr.p_double[k] = t; + } + } + for(i=0; i<=c->m-1; i++) + { + k = i; + for(j=i+1; j<=c->m-1; j++) + { + if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) + { + k = j; + } + } + if( k!=i ) + { + for(j=0; j<=c->n-1; j++) + { + t = f->ptr.pp_double[i][j]; + f->ptr.pp_double[i][j] = f->ptr.pp_double[k][j]; + f->ptr.pp_double[k][j] = t; + } + t = c->y.ptr.p_double[i]; + c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; + c->y.ptr.p_double[k] = t; + } + } + spline2d_bicubiccalcderivatives(f, &c->x, &c->y, c->m, c->n, &dx, &dy, &dxy, _state); + for(i=0; i<=c->m-1; i++) + { + for(j=0; j<=c->n-1; j++) + { + k = i*c->n+j; + c->f.ptr.p_double[k] = f->ptr.pp_double[i][j]; + c->f.ptr.p_double[sfx+k] = dx.ptr.pp_double[i][j]; + c->f.ptr.p_double[sfy+k] = dy.ptr.pp_double[i][j]; + c->f.ptr.p_double[sfxy+k] = dxy.ptr.pp_double[i][j]; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DUnpackV(), which is more flexible +and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dunpack(spline2dinterpolant* c, + ae_int_t* m, + ae_int_t* n, + /* Real */ ae_matrix* tbl, + ae_state *_state) +{ + ae_int_t k; + ae_int_t p; + ae_int_t ci; + ae_int_t cj; + ae_int_t s1; + ae_int_t s2; + ae_int_t s3; + ae_int_t s4; + ae_int_t sfx; + ae_int_t sfy; + ae_int_t sfxy; + double y1; + double y2; + double y3; + double y4; + double dt; + double du; + ae_int_t i; + ae_int_t j; + + *m = 0; + *n = 0; + ae_matrix_clear(tbl); + + ae_assert(c->stype==-3||c->stype==-1, "Spline2DUnpack: incorrect C (incorrect parameter C.SType)", _state); + if( c->d!=1 ) + { + *n = 0; + *m = 0; + return; + } + *n = c->n; + *m = c->m; + ae_matrix_set_length(tbl, (*n-1)*(*m-1), 20, _state); + sfx = *n*(*m); + sfy = 2*(*n)*(*m); + sfxy = 3*(*n)*(*m); + + /* + * Fill + */ + for(i=0; i<=*m-2; i++) + { + for(j=0; j<=*n-2; j++) + { + p = i*(*n-1)+j; + tbl->ptr.pp_double[p][0] = c->x.ptr.p_double[j]; + tbl->ptr.pp_double[p][1] = c->x.ptr.p_double[j+1]; + tbl->ptr.pp_double[p][2] = c->y.ptr.p_double[i]; + tbl->ptr.pp_double[p][3] = c->y.ptr.p_double[i+1]; + dt = 1/(tbl->ptr.pp_double[p][1]-tbl->ptr.pp_double[p][0]); + du = 1/(tbl->ptr.pp_double[p][3]-tbl->ptr.pp_double[p][2]); + + /* + * Bilinear interpolation + */ + if( c->stype==-1 ) + { + for(k=4; k<=19; k++) + { + tbl->ptr.pp_double[p][k] = 0; + } + y1 = c->f.ptr.p_double[*n*i+j]; + y2 = c->f.ptr.p_double[*n*i+(j+1)]; + y3 = c->f.ptr.p_double[*n*(i+1)+(j+1)]; + y4 = c->f.ptr.p_double[*n*(i+1)+j]; + tbl->ptr.pp_double[p][4] = y1; + tbl->ptr.pp_double[p][4+1*4+0] = y2-y1; + tbl->ptr.pp_double[p][4+0*4+1] = y4-y1; + tbl->ptr.pp_double[p][4+1*4+1] = y3-y2-y4+y1; + } + + /* + * Bicubic interpolation + */ + if( c->stype==-3 ) + { + s1 = *n*i+j; + s2 = *n*i+(j+1); + s3 = *n*(i+1)+(j+1); + s4 = *n*(i+1)+j; + tbl->ptr.pp_double[p][4+0*4+0] = c->f.ptr.p_double[s1]; + tbl->ptr.pp_double[p][4+0*4+1] = c->f.ptr.p_double[sfy+s1]/du; + tbl->ptr.pp_double[p][4+0*4+2] = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s4]-2*c->f.ptr.p_double[sfy+s1]/du-c->f.ptr.p_double[sfy+s4]/du; + tbl->ptr.pp_double[p][4+0*4+3] = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s4]+c->f.ptr.p_double[sfy+s1]/du+c->f.ptr.p_double[sfy+s4]/du; + tbl->ptr.pp_double[p][4+1*4+0] = c->f.ptr.p_double[sfx+s1]/dt; + tbl->ptr.pp_double[p][4+1*4+1] = c->f.ptr.p_double[sfxy+s1]/(dt*du); + tbl->ptr.pp_double[p][4+1*4+2] = -3*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+1*4+3] = 2*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+2*4+0] = -3*c->f.ptr.p_double[s1]+3*c->f.ptr.p_double[s2]-2*c->f.ptr.p_double[sfx+s1]/dt-c->f.ptr.p_double[sfx+s2]/dt; + tbl->ptr.pp_double[p][4+2*4+1] = -3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du); + tbl->ptr.pp_double[p][4+2*4+2] = 9*c->f.ptr.p_double[s1]-9*c->f.ptr.p_double[s2]+9*c->f.ptr.p_double[s3]-9*c->f.ptr.p_double[s4]+6*c->f.ptr.p_double[sfx+s1]/dt+3*c->f.ptr.p_double[sfx+s2]/dt-3*c->f.ptr.p_double[sfx+s3]/dt-6*c->f.ptr.p_double[sfx+s4]/dt+6*c->f.ptr.p_double[sfy+s1]/du-6*c->f.ptr.p_double[sfy+s2]/du-3*c->f.ptr.p_double[sfy+s3]/du+3*c->f.ptr.p_double[sfy+s4]/du+4*c->f.ptr.p_double[sfxy+s1]/(dt*du)+2*c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+2*c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+2*4+3] = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-4*c->f.ptr.p_double[sfx+s1]/dt-2*c->f.ptr.p_double[sfx+s2]/dt+2*c->f.ptr.p_double[sfx+s3]/dt+4*c->f.ptr.p_double[sfx+s4]/dt-3*c->f.ptr.p_double[sfy+s1]/du+3*c->f.ptr.p_double[sfy+s2]/du+3*c->f.ptr.p_double[sfy+s3]/du-3*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-2*c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+3*4+0] = 2*c->f.ptr.p_double[s1]-2*c->f.ptr.p_double[s2]+c->f.ptr.p_double[sfx+s1]/dt+c->f.ptr.p_double[sfx+s2]/dt; + tbl->ptr.pp_double[p][4+3*4+1] = 2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du); + tbl->ptr.pp_double[p][4+3*4+2] = -6*c->f.ptr.p_double[s1]+6*c->f.ptr.p_double[s2]-6*c->f.ptr.p_double[s3]+6*c->f.ptr.p_double[s4]-3*c->f.ptr.p_double[sfx+s1]/dt-3*c->f.ptr.p_double[sfx+s2]/dt+3*c->f.ptr.p_double[sfx+s3]/dt+3*c->f.ptr.p_double[sfx+s4]/dt-4*c->f.ptr.p_double[sfy+s1]/du+4*c->f.ptr.p_double[sfy+s2]/du+2*c->f.ptr.p_double[sfy+s3]/du-2*c->f.ptr.p_double[sfy+s4]/du-2*c->f.ptr.p_double[sfxy+s1]/(dt*du)-2*c->f.ptr.p_double[sfxy+s2]/(dt*du)-c->f.ptr.p_double[sfxy+s3]/(dt*du)-c->f.ptr.p_double[sfxy+s4]/(dt*du); + tbl->ptr.pp_double[p][4+3*4+3] = 4*c->f.ptr.p_double[s1]-4*c->f.ptr.p_double[s2]+4*c->f.ptr.p_double[s3]-4*c->f.ptr.p_double[s4]+2*c->f.ptr.p_double[sfx+s1]/dt+2*c->f.ptr.p_double[sfx+s2]/dt-2*c->f.ptr.p_double[sfx+s3]/dt-2*c->f.ptr.p_double[sfx+s4]/dt+2*c->f.ptr.p_double[sfy+s1]/du-2*c->f.ptr.p_double[sfy+s2]/du-2*c->f.ptr.p_double[sfy+s3]/du+2*c->f.ptr.p_double[sfy+s4]/du+c->f.ptr.p_double[sfxy+s1]/(dt*du)+c->f.ptr.p_double[sfxy+s2]/(dt*du)+c->f.ptr.p_double[sfxy+s3]/(dt*du)+c->f.ptr.p_double[sfxy+s4]/(dt*du); + } + + /* + * Rescale Cij + */ + for(ci=0; ci<=3; ci++) + { + for(cj=0; cj<=3; cj++) + { + tbl->ptr.pp_double[p][4+ci*4+cj] = tbl->ptr.pp_double[p][4+ci*4+cj]*ae_pow(dt, ci, _state)*ae_pow(du, cj, _state); + } + } + } + } +} + + +/************************************************************************* +Internal subroutine. +Calculation of the first derivatives and the cross-derivative. +*************************************************************************/ +static void spline2d_bicubiccalcderivatives(/* Real */ ae_matrix* a, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* dx, + /* Real */ ae_matrix* dy, + /* Real */ ae_matrix* dxy, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector xt; + ae_vector ft; + double s; + double ds; + double d2s; + spline1dinterpolant c; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(dx); + ae_matrix_clear(dy); + ae_matrix_clear(dxy); + ae_vector_init(&xt, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ft, 0, DT_REAL, _state, ae_true); + _spline1dinterpolant_init(&c, _state, ae_true); + + ae_matrix_set_length(dx, m, n, _state); + ae_matrix_set_length(dy, m, n, _state); + ae_matrix_set_length(dxy, m, n, _state); + + /* + * dF/dX + */ + ae_vector_set_length(&xt, n, _state); + ae_vector_set_length(&ft, n, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + xt.ptr.p_double[j] = x->ptr.p_double[j]; + ft.ptr.p_double[j] = a->ptr.pp_double[i][j]; + } + spline1dbuildcubic(&xt, &ft, n, 0, 0.0, 0, 0.0, &c, _state); + for(j=0; j<=n-1; j++) + { + spline1ddiff(&c, x->ptr.p_double[j], &s, &ds, &d2s, _state); + dx->ptr.pp_double[i][j] = ds; + } + } + + /* + * dF/dY + */ + ae_vector_set_length(&xt, m, _state); + ae_vector_set_length(&ft, m, _state); + for(j=0; j<=n-1; j++) + { + for(i=0; i<=m-1; i++) + { + xt.ptr.p_double[i] = y->ptr.p_double[i]; + ft.ptr.p_double[i] = a->ptr.pp_double[i][j]; + } + spline1dbuildcubic(&xt, &ft, m, 0, 0.0, 0, 0.0, &c, _state); + for(i=0; i<=m-1; i++) + { + spline1ddiff(&c, y->ptr.p_double[i], &s, &ds, &d2s, _state); + dy->ptr.pp_double[i][j] = ds; + } + } + + /* + * d2F/dXdY + */ + ae_vector_set_length(&xt, n, _state); + ae_vector_set_length(&ft, n, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + xt.ptr.p_double[j] = x->ptr.p_double[j]; + ft.ptr.p_double[j] = dy->ptr.pp_double[i][j]; + } + spline1dbuildcubic(&xt, &ft, n, 0, 0.0, 0, 0.0, &c, _state); + for(j=0; j<=n-1; j++) + { + spline1ddiff(&c, x->ptr.p_double[j], &s, &ds, &d2s, _state); + dxy->ptr.pp_double[i][j] = ds; + } + } + ae_frame_leave(_state); +} + + +ae_bool _spline2dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + spline2dinterpolant *p = (spline2dinterpolant*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->f, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _spline2dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + spline2dinterpolant *dst = (spline2dinterpolant*)_dst; + spline2dinterpolant *src = (spline2dinterpolant*)_src; + dst->k = src->k; + dst->stype = src->stype; + dst->n = src->n; + dst->m = src->m; + dst->d = src->d; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->f, &src->f, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _spline2dinterpolant_clear(void* _p) +{ + spline2dinterpolant *p = (spline2dinterpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x); + ae_vector_clear(&p->y); + ae_vector_clear(&p->f); +} + + +void _spline2dinterpolant_destroy(void* _p) +{ + spline2dinterpolant *p = (spline2dinterpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->y); + ae_vector_destroy(&p->f); +} + + + + +/************************************************************************* +This subroutine calculates the value of the trilinear or tricubic spline at +the given point (X,Y,Z). + +INPUT PARAMETERS: + C - coefficients table. + Built by BuildBilinearSpline or BuildBicubicSpline. + X, Y, + Z - point + +Result: + S(x,y,z) + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +double spline3dcalc(spline3dinterpolant* c, + double x, + double y, + double z, + ae_state *_state) +{ + double v; + double vx; + double vy; + double vxy; + double result; + + + ae_assert(c->stype==-1||c->stype==-3, "Spline3DCalc: incorrect C (incorrect parameter C.SType)", _state); + ae_assert((ae_isfinite(x, _state)&&ae_isfinite(y, _state))&&ae_isfinite(z, _state), "Spline3DCalc: X=NaN/Infinite, Y=NaN/Infinite or Z=NaN/Infinite", _state); + if( c->d!=1 ) + { + result = 0; + return result; + } + spline3d_spline3ddiff(c, x, y, z, &v, &vx, &vy, &vxy, _state); + result = v; + return result; +} + + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +INPUT PARAMETERS: + C - spline interpolant + AX, BX - transformation coefficients: x = A*u + B + AY, BY - transformation coefficients: y = A*v + B + AZ, BZ - transformation coefficients: z = A*w + B + +OUTPUT PARAMETERS: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dlintransxyz(spline3dinterpolant* c, + double ax, + double bx, + double ay, + double by, + double az, + double bz, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_vector z; + ae_vector f; + ae_vector v; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t di; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&z, 0, DT_REAL, _state, ae_true); + ae_vector_init(&f, 0, DT_REAL, _state, ae_true); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + + ae_assert(c->stype==-3||c->stype==-1, "Spline3DLinTransXYZ: incorrect C (incorrect parameter C.SType)", _state); + ae_vector_set_length(&x, c->n, _state); + ae_vector_set_length(&y, c->m, _state); + ae_vector_set_length(&z, c->l, _state); + ae_vector_set_length(&f, c->m*c->n*c->l*c->d, _state); + for(j=0; j<=c->n-1; j++) + { + x.ptr.p_double[j] = c->x.ptr.p_double[j]; + } + for(i=0; i<=c->m-1; i++) + { + y.ptr.p_double[i] = c->y.ptr.p_double[i]; + } + for(i=0; i<=c->l-1; i++) + { + z.ptr.p_double[i] = c->z.ptr.p_double[i]; + } + + /* + * Handle different combinations of zero/nonzero AX/AY/AZ + */ + if( (ae_fp_neq(ax,0)&&ae_fp_neq(ay,0))&&ae_fp_neq(az,0) ) + { + ae_v_move(&f.ptr.p_double[0], 1, &c->f.ptr.p_double[0], 1, ae_v_len(0,c->m*c->n*c->l*c->d-1)); + } + if( (ae_fp_eq(ax,0)&&ae_fp_neq(ay,0))&&ae_fp_neq(az,0) ) + { + for(i=0; i<=c->m-1; i++) + { + for(j=0; j<=c->l-1; j++) + { + spline3dcalcv(c, bx, y.ptr.p_double[i], z.ptr.p_double[j], &v, _state); + for(k=0; k<=c->n-1; k++) + { + for(di=0; di<=c->d-1; di++) + { + f.ptr.p_double[c->d*(c->n*(c->m*j+i)+k)+di] = v.ptr.p_double[di]; + } + } + } + } + ax = 1; + bx = 0; + } + if( (ae_fp_neq(ax,0)&&ae_fp_eq(ay,0))&&ae_fp_neq(az,0) ) + { + for(i=0; i<=c->n-1; i++) + { + for(j=0; j<=c->l-1; j++) + { + spline3dcalcv(c, x.ptr.p_double[i], by, z.ptr.p_double[j], &v, _state); + for(k=0; k<=c->m-1; k++) + { + for(di=0; di<=c->d-1; di++) + { + f.ptr.p_double[c->d*(c->n*(c->m*j+k)+i)+di] = v.ptr.p_double[di]; + } + } + } + } + ay = 1; + by = 0; + } + if( (ae_fp_neq(ax,0)&&ae_fp_neq(ay,0))&&ae_fp_eq(az,0) ) + { + for(i=0; i<=c->n-1; i++) + { + for(j=0; j<=c->m-1; j++) + { + spline3dcalcv(c, x.ptr.p_double[i], y.ptr.p_double[j], bz, &v, _state); + for(k=0; k<=c->l-1; k++) + { + for(di=0; di<=c->d-1; di++) + { + f.ptr.p_double[c->d*(c->n*(c->m*k+j)+i)+di] = v.ptr.p_double[di]; + } + } + } + } + az = 1; + bz = 0; + } + if( (ae_fp_eq(ax,0)&&ae_fp_eq(ay,0))&&ae_fp_neq(az,0) ) + { + for(i=0; i<=c->l-1; i++) + { + spline3dcalcv(c, bx, by, z.ptr.p_double[i], &v, _state); + for(k=0; k<=c->m-1; k++) + { + for(j=0; j<=c->n-1; j++) + { + for(di=0; di<=c->d-1; di++) + { + f.ptr.p_double[c->d*(c->n*(c->m*i+k)+j)+di] = v.ptr.p_double[di]; + } + } + } + } + ax = 1; + bx = 0; + ay = 1; + by = 0; + } + if( (ae_fp_eq(ax,0)&&ae_fp_neq(ay,0))&&ae_fp_eq(az,0) ) + { + for(i=0; i<=c->m-1; i++) + { + spline3dcalcv(c, bx, y.ptr.p_double[i], bz, &v, _state); + for(k=0; k<=c->l-1; k++) + { + for(j=0; j<=c->n-1; j++) + { + for(di=0; di<=c->d-1; di++) + { + f.ptr.p_double[c->d*(c->n*(c->m*k+i)+j)+di] = v.ptr.p_double[di]; + } + } + } + } + ax = 1; + bx = 0; + az = 1; + bz = 0; + } + if( (ae_fp_neq(ax,0)&&ae_fp_eq(ay,0))&&ae_fp_eq(az,0) ) + { + for(i=0; i<=c->n-1; i++) + { + spline3dcalcv(c, x.ptr.p_double[i], by, bz, &v, _state); + for(k=0; k<=c->l-1; k++) + { + for(j=0; j<=c->m-1; j++) + { + for(di=0; di<=c->d-1; di++) + { + f.ptr.p_double[c->d*(c->n*(c->m*k+j)+i)+di] = v.ptr.p_double[di]; + } + } + } + } + ay = 1; + by = 0; + az = 1; + bz = 0; + } + if( (ae_fp_eq(ax,0)&&ae_fp_eq(ay,0))&&ae_fp_eq(az,0) ) + { + spline3dcalcv(c, bx, by, bz, &v, _state); + for(k=0; k<=c->l-1; k++) + { + for(j=0; j<=c->m-1; j++) + { + for(i=0; i<=c->n-1; i++) + { + for(di=0; di<=c->d-1; di++) + { + f.ptr.p_double[c->d*(c->n*(c->m*k+j)+i)+di] = v.ptr.p_double[di]; + } + } + } + } + ax = 1; + bx = 0; + ay = 1; + by = 0; + az = 1; + bz = 0; + } + + /* + * General case: AX<>0, AY<>0, AZ<>0 + * Unpack, scale and pack again. + */ + for(i=0; i<=c->n-1; i++) + { + x.ptr.p_double[i] = (x.ptr.p_double[i]-bx)/ax; + } + for(i=0; i<=c->m-1; i++) + { + y.ptr.p_double[i] = (y.ptr.p_double[i]-by)/ay; + } + for(i=0; i<=c->l-1; i++) + { + z.ptr.p_double[i] = (z.ptr.p_double[i]-bz)/az; + } + if( c->stype==-1 ) + { + spline3dbuildtrilinearv(&x, c->n, &y, c->m, &z, c->l, &f, c->d, c, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: S2(x,y) = A*S(x,y,z) + B + +OUTPUT PARAMETERS: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dlintransf(spline3dinterpolant* c, + double a, + double b, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector x; + ae_vector y; + ae_vector z; + ae_vector f; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&x, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&z, 0, DT_REAL, _state, ae_true); + ae_vector_init(&f, 0, DT_REAL, _state, ae_true); + + ae_assert(c->stype==-3||c->stype==-1, "Spline3DLinTransF: incorrect C (incorrect parameter C.SType)", _state); + ae_vector_set_length(&x, c->n, _state); + ae_vector_set_length(&y, c->m, _state); + ae_vector_set_length(&z, c->l, _state); + ae_vector_set_length(&f, c->m*c->n*c->l*c->d, _state); + for(j=0; j<=c->n-1; j++) + { + x.ptr.p_double[j] = c->x.ptr.p_double[j]; + } + for(i=0; i<=c->m-1; i++) + { + y.ptr.p_double[i] = c->y.ptr.p_double[i]; + } + for(i=0; i<=c->l-1; i++) + { + z.ptr.p_double[i] = c->z.ptr.p_double[i]; + } + for(i=0; i<=c->m*c->n*c->l*c->d-1; i++) + { + f.ptr.p_double[i] = a*c->f.ptr.p_double[i]+b; + } + if( c->stype==-1 ) + { + spline3dbuildtrilinearv(&x, c->n, &y, c->m, &z, c->l, &f, c->d, c, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine makes the copy of the spline model. + +INPUT PARAMETERS: + C - spline interpolant + +OUTPUT PARAMETERS: + CC - spline copy + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dcopy(spline3dinterpolant* c, + spline3dinterpolant* cc, + ae_state *_state) +{ + ae_int_t tblsize; + + _spline3dinterpolant_clear(cc); + + ae_assert(c->k==1||c->k==3, "Spline3DCopy: incorrect C (incorrect parameter C.K)", _state); + cc->k = c->k; + cc->n = c->n; + cc->m = c->m; + cc->l = c->l; + cc->d = c->d; + tblsize = c->n*c->m*c->l*c->d; + cc->stype = c->stype; + ae_vector_set_length(&cc->x, cc->n, _state); + ae_vector_set_length(&cc->y, cc->m, _state); + ae_vector_set_length(&cc->z, cc->l, _state); + ae_vector_set_length(&cc->f, tblsize, _state); + ae_v_move(&cc->x.ptr.p_double[0], 1, &c->x.ptr.p_double[0], 1, ae_v_len(0,cc->n-1)); + ae_v_move(&cc->y.ptr.p_double[0], 1, &c->y.ptr.p_double[0], 1, ae_v_len(0,cc->m-1)); + ae_v_move(&cc->z.ptr.p_double[0], 1, &c->z.ptr.p_double[0], 1, ae_v_len(0,cc->l-1)); + ae_v_move(&cc->f.ptr.p_double[0], 1, &c->f.ptr.p_double[0], 1, ae_v_len(0,tblsize-1)); +} + + +/************************************************************************* +Trilinear spline resampling + +INPUT PARAMETERS: + A - array[0..OldXCount*OldYCount*OldZCount-1], function + values at the old grid, : + A[0] x=0,y=0,z=0 + A[1] x=1,y=0,z=0 + A[..] ... + A[..] x=oldxcount-1,y=0,z=0 + A[..] x=0,y=1,z=0 + A[..] ... + ... + OldZCount - old Z-count, OldZCount>1 + OldYCount - old Y-count, OldYCount>1 + OldXCount - old X-count, OldXCount>1 + NewZCount - new Z-count, NewZCount>1 + NewYCount - new Y-count, NewYCount>1 + NewXCount - new X-count, NewXCount>1 + +OUTPUT PARAMETERS: + B - array[0..NewXCount*NewYCount*NewZCount-1], function + values at the new grid: + B[0] x=0,y=0,z=0 + B[1] x=1,y=0,z=0 + B[..] ... + B[..] x=newxcount-1,y=0,z=0 + B[..] x=0,y=1,z=0 + B[..] ... + ... + + -- ALGLIB routine -- + 26.04.2012 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline3dresampletrilinear(/* Real */ ae_vector* a, + ae_int_t oldzcount, + ae_int_t oldycount, + ae_int_t oldxcount, + ae_int_t newzcount, + ae_int_t newycount, + ae_int_t newxcount, + /* Real */ ae_vector* b, + ae_state *_state) +{ + double xd; + double yd; + double zd; + double c0; + double c1; + double c2; + double c3; + ae_int_t ix; + ae_int_t iy; + ae_int_t iz; + ae_int_t i; + ae_int_t j; + ae_int_t k; + + ae_vector_clear(b); + + ae_assert((oldycount>1&&oldzcount>1)&&oldxcount>1, "Spline3DResampleTrilinear: length/width/height less than 1", _state); + ae_assert((newycount>1&&newzcount>1)&&newxcount>1, "Spline3DResampleTrilinear: length/width/height less than 1", _state); + ae_assert(a->cnt>=oldycount*oldzcount*oldxcount, "Spline3DResampleTrilinear: length/width/height less than 1", _state); + ae_vector_set_length(b, newxcount*newycount*newzcount, _state); + for(i=0; i<=newxcount-1; i++) + { + for(j=0; j<=newycount-1; j++) + { + for(k=0; k<=newzcount-1; k++) + { + ix = i*(oldxcount-1)/(newxcount-1); + if( ix==oldxcount-1 ) + { + ix = oldxcount-2; + } + xd = (double)(i*(oldxcount-1))/(double)(newxcount-1)-ix; + iy = j*(oldycount-1)/(newycount-1); + if( iy==oldycount-1 ) + { + iy = oldycount-2; + } + yd = (double)(j*(oldycount-1))/(double)(newycount-1)-iy; + iz = k*(oldzcount-1)/(newzcount-1); + if( iz==oldzcount-1 ) + { + iz = oldzcount-2; + } + zd = (double)(k*(oldzcount-1))/(double)(newzcount-1)-iz; + c0 = a->ptr.p_double[oldxcount*(oldycount*iz+iy)+ix]*(1-xd)+a->ptr.p_double[oldxcount*(oldycount*iz+iy)+(ix+1)]*xd; + c1 = a->ptr.p_double[oldxcount*(oldycount*iz+(iy+1))+ix]*(1-xd)+a->ptr.p_double[oldxcount*(oldycount*iz+(iy+1))+(ix+1)]*xd; + c2 = a->ptr.p_double[oldxcount*(oldycount*(iz+1)+iy)+ix]*(1-xd)+a->ptr.p_double[oldxcount*(oldycount*(iz+1)+iy)+(ix+1)]*xd; + c3 = a->ptr.p_double[oldxcount*(oldycount*(iz+1)+(iy+1))+ix]*(1-xd)+a->ptr.p_double[oldxcount*(oldycount*(iz+1)+(iy+1))+(ix+1)]*xd; + c0 = c0*(1-yd)+c1*yd; + c1 = c2*(1-yd)+c3*yd; + b->ptr.p_double[newxcount*(newycount*k+j)+i] = c0*(1-zd)+c1*zd; + } + } + } +} + + +/************************************************************************* +This subroutine builds trilinear vector-valued spline. + +INPUT PARAMETERS: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + Z - spline applicates, array[0..L-1] + F - function values, array[0..M*N*L*D-1]: + * first D elements store D values at (X[0],Y[0],Z[0]) + * next D elements store D values at (X[1],Y[0],Z[0]) + * next D elements store D values at (X[2],Y[0],Z[0]) + * ... + * next D elements store D values at (X[0],Y[1],Z[0]) + * next D elements store D values at (X[1],Y[1],Z[0]) + * next D elements store D values at (X[2],Y[1],Z[0]) + * ... + * next D elements store D values at (X[0],Y[0],Z[1]) + * next D elements store D values at (X[1],Y[0],Z[1]) + * next D elements store D values at (X[2],Y[0],Z[1]) + * ... + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(N*(M*K+J)+I)...D*(N*(M*K+J)+I)+D-1]. + M,N, + L - grid size, M>=2, N>=2, L>=2 + D - vector dimension, D>=1 + +OUTPUT PARAMETERS: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dbuildtrilinearv(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + /* Real */ ae_vector* z, + ae_int_t l, + /* Real */ ae_vector* f, + ae_int_t d, + spline3dinterpolant* c, + ae_state *_state) +{ + double t; + ae_int_t tblsize; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t i0; + ae_int_t j0; + + _spline3dinterpolant_clear(c); + + ae_assert(m>=2, "Spline3DBuildTrilinearV: M<2", _state); + ae_assert(n>=2, "Spline3DBuildTrilinearV: N<2", _state); + ae_assert(l>=2, "Spline3DBuildTrilinearV: L<2", _state); + ae_assert(d>=1, "Spline3DBuildTrilinearV: D<1", _state); + ae_assert((x->cnt>=n&&y->cnt>=m)&&z->cnt>=l, "Spline3DBuildTrilinearV: length of X, Y or Z is too short (Length(X/Y/Z)cnt>=tblsize, "Spline3DBuildTrilinearV: length of F is too short (Length(F)k = 1; + c->n = n; + c->m = m; + c->l = l; + c->d = d; + c->stype = -1; + ae_vector_set_length(&c->x, c->n, _state); + ae_vector_set_length(&c->y, c->m, _state); + ae_vector_set_length(&c->z, c->l, _state); + ae_vector_set_length(&c->f, tblsize, _state); + for(i=0; i<=c->n-1; i++) + { + c->x.ptr.p_double[i] = x->ptr.p_double[i]; + } + for(i=0; i<=c->m-1; i++) + { + c->y.ptr.p_double[i] = y->ptr.p_double[i]; + } + for(i=0; i<=c->l-1; i++) + { + c->z.ptr.p_double[i] = z->ptr.p_double[i]; + } + for(i=0; i<=tblsize-1; i++) + { + c->f.ptr.p_double[i] = f->ptr.p_double[i]; + } + + /* + * Sort points: + * * sort x; + * * sort y; + * * sort z. + */ + for(j=0; j<=c->n-1; j++) + { + k = j; + for(i=j+1; i<=c->n-1; i++) + { + if( ae_fp_less(c->x.ptr.p_double[i],c->x.ptr.p_double[k]) ) + { + k = i; + } + } + if( k!=j ) + { + for(i=0; i<=c->m-1; i++) + { + for(j0=0; j0<=c->l-1; j0++) + { + for(i0=0; i0<=c->d-1; i0++) + { + t = c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+j)+i0]; + c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+j)+i0] = c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+k)+i0]; + c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+k)+i0] = t; + } + } + } + t = c->x.ptr.p_double[j]; + c->x.ptr.p_double[j] = c->x.ptr.p_double[k]; + c->x.ptr.p_double[k] = t; + } + } + for(i=0; i<=c->m-1; i++) + { + k = i; + for(j=i+1; j<=c->m-1; j++) + { + if( ae_fp_less(c->y.ptr.p_double[j],c->y.ptr.p_double[k]) ) + { + k = j; + } + } + if( k!=i ) + { + for(j=0; j<=c->n-1; j++) + { + for(j0=0; j0<=c->l-1; j0++) + { + for(i0=0; i0<=c->d-1; i0++) + { + t = c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+j)+i0]; + c->f.ptr.p_double[c->d*(c->n*(c->m*j0+i)+j)+i0] = c->f.ptr.p_double[c->d*(c->n*(c->m*j0+k)+j)+i0]; + c->f.ptr.p_double[c->d*(c->n*(c->m*j0+k)+j)+i0] = t; + } + } + } + t = c->y.ptr.p_double[i]; + c->y.ptr.p_double[i] = c->y.ptr.p_double[k]; + c->y.ptr.p_double[k] = t; + } + } + for(k=0; k<=c->l-1; k++) + { + i = k; + for(j=i+1; j<=c->l-1; j++) + { + if( ae_fp_less(c->z.ptr.p_double[j],c->z.ptr.p_double[i]) ) + { + i = j; + } + } + if( i!=k ) + { + for(j=0; j<=c->m-1; j++) + { + for(j0=0; j0<=c->n-1; j0++) + { + for(i0=0; i0<=c->d-1; i0++) + { + t = c->f.ptr.p_double[c->d*(c->n*(c->m*k+j)+j0)+i0]; + c->f.ptr.p_double[c->d*(c->n*(c->m*k+j)+j0)+i0] = c->f.ptr.p_double[c->d*(c->n*(c->m*i+j)+j0)+i0]; + c->f.ptr.p_double[c->d*(c->n*(c->m*i+j)+j0)+i0] = t; + } + } + } + t = c->z.ptr.p_double[k]; + c->z.ptr.p_double[k] = c->z.ptr.p_double[i]; + c->z.ptr.p_double[i] = t; + } + } +} + + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y,Z). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y, + Z - point + F - output buffer, possibly preallocated array. In case array size + is large enough to store result, it is not reallocated. Array + which is too short will be reallocated + +OUTPUT PARAMETERS: + F - array[D] (or larger) which stores function values + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dcalcvbuf(spline3dinterpolant* c, + double x, + double y, + double z, + /* Real */ ae_vector* f, + ae_state *_state) +{ + double xd; + double yd; + double zd; + double c0; + double c1; + double c2; + double c3; + ae_int_t ix; + ae_int_t iy; + ae_int_t iz; + ae_int_t l; + ae_int_t r; + ae_int_t h; + ae_int_t i; + + + ae_assert(c->stype==-1||c->stype==-3, "Spline3DCalcVBuf: incorrect C (incorrect parameter C.SType)", _state); + ae_assert((ae_isfinite(x, _state)&&ae_isfinite(y, _state))&&ae_isfinite(z, _state), "Spline3DCalcVBuf: X, Y or Z contains NaN/Infinite", _state); + rvectorsetlengthatleast(f, c->d, _state); + + /* + * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) + */ + l = 0; + r = c->n-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->x.ptr.p_double[h],x) ) + { + r = h; + } + else + { + l = h; + } + } + ix = l; + + /* + * Binary search in the [ y[0], ..., y[n-2] ] (y[n-1] is not included) + */ + l = 0; + r = c->m-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->y.ptr.p_double[h],y) ) + { + r = h; + } + else + { + l = h; + } + } + iy = l; + + /* + * Binary search in the [ z[0], ..., z[n-2] ] (z[n-1] is not included) + */ + l = 0; + r = c->l-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->z.ptr.p_double[h],z) ) + { + r = h; + } + else + { + l = h; + } + } + iz = l; + xd = (x-c->x.ptr.p_double[ix])/(c->x.ptr.p_double[ix+1]-c->x.ptr.p_double[ix]); + yd = (y-c->y.ptr.p_double[iy])/(c->y.ptr.p_double[iy+1]-c->y.ptr.p_double[iy]); + zd = (z-c->z.ptr.p_double[iz])/(c->z.ptr.p_double[iz+1]-c->z.ptr.p_double[iz]); + for(i=0; i<=c->d-1; i++) + { + + /* + * Trilinear interpolation + */ + if( c->stype==-1 ) + { + c0 = c->f.ptr.p_double[c->d*(c->n*(c->m*iz+iy)+ix)+i]*(1-xd)+c->f.ptr.p_double[c->d*(c->n*(c->m*iz+iy)+(ix+1))+i]*xd; + c1 = c->f.ptr.p_double[c->d*(c->n*(c->m*iz+(iy+1))+ix)+i]*(1-xd)+c->f.ptr.p_double[c->d*(c->n*(c->m*iz+(iy+1))+(ix+1))+i]*xd; + c2 = c->f.ptr.p_double[c->d*(c->n*(c->m*(iz+1)+iy)+ix)+i]*(1-xd)+c->f.ptr.p_double[c->d*(c->n*(c->m*(iz+1)+iy)+(ix+1))+i]*xd; + c3 = c->f.ptr.p_double[c->d*(c->n*(c->m*(iz+1)+(iy+1))+ix)+i]*(1-xd)+c->f.ptr.p_double[c->d*(c->n*(c->m*(iz+1)+(iy+1))+(ix+1))+i]*xd; + c0 = c0*(1-yd)+c1*yd; + c1 = c2*(1-yd)+c3*yd; + f->ptr.p_double[i] = c0*(1-zd)+c1*zd; + } + } +} + + +/************************************************************************* +This subroutine calculates trilinear or tricubic vector-valued spline at the +given point (X,Y,Z). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y, + Z - point + +OUTPUT PARAMETERS: + F - array[D] which stores function values. F is out-parameter and + it is reallocated after call to this function. In case you + want to reuse previously allocated F, you may use + Spline2DCalcVBuf(), which reallocates F only when it is too + small. + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dcalcv(spline3dinterpolant* c, + double x, + double y, + double z, + /* Real */ ae_vector* f, + ae_state *_state) +{ + + ae_vector_clear(f); + + ae_assert(c->stype==-1||c->stype==-3, "Spline3DCalcV: incorrect C (incorrect parameter C.SType)", _state); + ae_assert((ae_isfinite(x, _state)&&ae_isfinite(y, _state))&&ae_isfinite(z, _state), "Spline3DCalcV: X=NaN/Infinite, Y=NaN/Infinite or Z=NaN/Infinite", _state); + ae_vector_set_length(f, c->d, _state); + spline3dcalcvbuf(c, x, y, z, f, _state); +} + + +/************************************************************************* +This subroutine unpacks tri-dimensional spline into the coefficients table + +INPUT PARAMETERS: + C - spline interpolant. + +Result: + N - grid size (X) + M - grid size (Y) + L - grid size (Z) + D - number of components + SType- spline type. Currently, only one spline type is supported: + trilinear spline, as indicated by SType=1. + Tbl - spline coefficients: [0..(N-1)*(M-1)*(L-1)*D-1, 0..13]. + For T=0..D-1 (component index), I = 0...N-2 (x index), + J=0..M-2 (y index), K=0..L-2 (z index): + Q := T + I*D + J*D*(N-1) + K*D*(N-1)*(M-1), + + Q-th row stores decomposition for T-th component of the + vector-valued function + + Tbl[Q,0] = X[i] + Tbl[Q,1] = X[i+1] + Tbl[Q,2] = Y[j] + Tbl[Q,3] = Y[j+1] + Tbl[Q,4] = Z[k] + Tbl[Q,5] = Z[k+1] + + Tbl[Q,6] = C000 + Tbl[Q,7] = C100 + Tbl[Q,8] = C010 + Tbl[Q,9] = C110 + Tbl[Q,10]= C001 + Tbl[Q,11]= C101 + Tbl[Q,12]= C011 + Tbl[Q,13]= C111 + On each grid square spline is equals to: + S(x) = SUM(c[i,j,k]*(x^i)*(y^j)*(z^k), i=0..1, j=0..1, k=0..1) + t = x-x[j] + u = y-y[i] + v = z-z[k] + + NOTE: format of Tbl is given for SType=1. Future versions of + ALGLIB can use different formats for different values of + SType. + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dunpackv(spline3dinterpolant* c, + ae_int_t* n, + ae_int_t* m, + ae_int_t* l, + ae_int_t* d, + ae_int_t* stype, + /* Real */ ae_matrix* tbl, + ae_state *_state) +{ + ae_int_t p; + ae_int_t ci; + ae_int_t cj; + ae_int_t ck; + double du; + double dv; + double dw; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t di; + ae_int_t i0; + + *n = 0; + *m = 0; + *l = 0; + *d = 0; + *stype = 0; + ae_matrix_clear(tbl); + + ae_assert(c->stype==-1, "Spline3DUnpackV: incorrect C (incorrect parameter C.SType)", _state); + *n = c->n; + *m = c->m; + *l = c->l; + *d = c->d; + *stype = ae_iabs(c->stype, _state); + ae_matrix_set_length(tbl, (*n-1)*(*m-1)*(*l-1)*(*d), 14, _state); + + /* + * Fill + */ + for(i=0; i<=*n-2; i++) + { + for(j=0; j<=*m-2; j++) + { + for(k=0; k<=*l-2; k++) + { + for(di=0; di<=*d-1; di++) + { + p = *d*((*n-1)*((*m-1)*k+j)+i)+di; + tbl->ptr.pp_double[p][0] = c->x.ptr.p_double[i]; + tbl->ptr.pp_double[p][1] = c->x.ptr.p_double[i+1]; + tbl->ptr.pp_double[p][2] = c->y.ptr.p_double[j]; + tbl->ptr.pp_double[p][3] = c->y.ptr.p_double[j+1]; + tbl->ptr.pp_double[p][4] = c->z.ptr.p_double[k]; + tbl->ptr.pp_double[p][5] = c->z.ptr.p_double[k+1]; + du = 1/(tbl->ptr.pp_double[p][1]-tbl->ptr.pp_double[p][0]); + dv = 1/(tbl->ptr.pp_double[p][3]-tbl->ptr.pp_double[p][2]); + dw = 1/(tbl->ptr.pp_double[p][5]-tbl->ptr.pp_double[p][4]); + + /* + * Trilinear interpolation + */ + if( c->stype==-1 ) + { + for(i0=6; i0<=13; i0++) + { + tbl->ptr.pp_double[p][i0] = 0; + } + tbl->ptr.pp_double[p][6+2*(2*0+0)+0] = c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; + tbl->ptr.pp_double[p][6+2*(2*0+0)+1] = c->f.ptr.p_double[*d*(*n*(*m*k+j)+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; + tbl->ptr.pp_double[p][6+2*(2*0+1)+0] = c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; + tbl->ptr.pp_double[p][6+2*(2*0+1)+1] = c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+(i+1))+di]+c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; + tbl->ptr.pp_double[p][6+2*(2*1+0)+0] = c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; + tbl->ptr.pp_double[p][6+2*(2*1+0)+1] = c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+(i+1))+di]+c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; + tbl->ptr.pp_double[p][6+2*(2*1+1)+0] = c->f.ptr.p_double[*d*(*n*(*m*(k+1)+(j+1))+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+i)+di]+c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; + tbl->ptr.pp_double[p][6+2*(2*1+1)+1] = c->f.ptr.p_double[*d*(*n*(*m*(k+1)+(j+1))+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*(k+1)+(j+1))+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+(i+1))+di]+c->f.ptr.p_double[*d*(*n*(*m*(k+1)+j)+i)+di]-c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+(i+1))+di]+c->f.ptr.p_double[*d*(*n*(*m*k+(j+1))+i)+di]+c->f.ptr.p_double[*d*(*n*(*m*k+j)+(i+1))+di]-c->f.ptr.p_double[*d*(*n*(*m*k+j)+i)+di]; + } + + /* + * Rescale Cij + */ + for(ci=0; ci<=1; ci++) + { + for(cj=0; cj<=1; cj++) + { + for(ck=0; ck<=1; ck++) + { + tbl->ptr.pp_double[p][6+2*(2*ck+cj)+ci] = tbl->ptr.pp_double[p][6+2*(2*ck+cj)+ci]*ae_pow(du, ci, _state)*ae_pow(dv, cj, _state)*ae_pow(dw, ck, _state); + } + } + } + } + } + } + } +} + + +/************************************************************************* +This subroutine calculates the value of the trilinear(or tricubic;possible +will be later) spline at the given point X(and its derivatives; possible +will be later). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y, Z - point + +OUTPUT PARAMETERS: + F - S(x,y,z) + FX - dS(x,y,z)/dX + FY - dS(x,y,z)/dY + FXY - d2S(x,y,z)/dXdY + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +static void spline3d_spline3ddiff(spline3dinterpolant* c, + double x, + double y, + double z, + double* f, + double* fx, + double* fy, + double* fxy, + ae_state *_state) +{ + double xd; + double yd; + double zd; + double c0; + double c1; + double c2; + double c3; + ae_int_t ix; + ae_int_t iy; + ae_int_t iz; + ae_int_t l; + ae_int_t r; + ae_int_t h; + + *f = 0; + *fx = 0; + *fy = 0; + *fxy = 0; + + ae_assert(c->stype==-1||c->stype==-3, "Spline3DDiff: incorrect C (incorrect parameter C.SType)", _state); + ae_assert(ae_isfinite(x, _state)&&ae_isfinite(y, _state), "Spline3DDiff: X or Y contains NaN or Infinite value", _state); + + /* + * Prepare F, dF/dX, dF/dY, d2F/dXdY + */ + *f = 0; + *fx = 0; + *fy = 0; + *fxy = 0; + if( c->d!=1 ) + { + return; + } + + /* + * Binary search in the [ x[0], ..., x[n-2] ] (x[n-1] is not included) + */ + l = 0; + r = c->n-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->x.ptr.p_double[h],x) ) + { + r = h; + } + else + { + l = h; + } + } + ix = l; + + /* + * Binary search in the [ y[0], ..., y[n-2] ] (y[n-1] is not included) + */ + l = 0; + r = c->m-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->y.ptr.p_double[h],y) ) + { + r = h; + } + else + { + l = h; + } + } + iy = l; + + /* + * Binary search in the [ z[0], ..., z[n-2] ] (z[n-1] is not included) + */ + l = 0; + r = c->l-1; + while(l!=r-1) + { + h = (l+r)/2; + if( ae_fp_greater_eq(c->z.ptr.p_double[h],z) ) + { + r = h; + } + else + { + l = h; + } + } + iz = l; + xd = (x-c->x.ptr.p_double[ix])/(c->x.ptr.p_double[ix+1]-c->x.ptr.p_double[ix]); + yd = (y-c->y.ptr.p_double[iy])/(c->y.ptr.p_double[iy+1]-c->y.ptr.p_double[iy]); + zd = (z-c->z.ptr.p_double[iz])/(c->z.ptr.p_double[iz+1]-c->z.ptr.p_double[iz]); + + /* + * Trilinear interpolation + */ + if( c->stype==-1 ) + { + c0 = c->f.ptr.p_double[c->n*(c->m*iz+iy)+ix]*(1-xd)+c->f.ptr.p_double[c->n*(c->m*iz+iy)+(ix+1)]*xd; + c1 = c->f.ptr.p_double[c->n*(c->m*iz+(iy+1))+ix]*(1-xd)+c->f.ptr.p_double[c->n*(c->m*iz+(iy+1))+(ix+1)]*xd; + c2 = c->f.ptr.p_double[c->n*(c->m*(iz+1)+iy)+ix]*(1-xd)+c->f.ptr.p_double[c->n*(c->m*(iz+1)+iy)+(ix+1)]*xd; + c3 = c->f.ptr.p_double[c->n*(c->m*(iz+1)+(iy+1))+ix]*(1-xd)+c->f.ptr.p_double[c->n*(c->m*(iz+1)+(iy+1))+(ix+1)]*xd; + c0 = c0*(1-yd)+c1*yd; + c1 = c2*(1-yd)+c3*yd; + *f = c0*(1-zd)+c1*zd; + } +} + + +ae_bool _spline3dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + spline3dinterpolant *p = (spline3dinterpolant*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->y, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->z, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->f, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _spline3dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + spline3dinterpolant *dst = (spline3dinterpolant*)_dst; + spline3dinterpolant *src = (spline3dinterpolant*)_src; + dst->k = src->k; + dst->stype = src->stype; + dst->n = src->n; + dst->m = src->m; + dst->l = src->l; + dst->d = src->d; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->y, &src->y, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->z, &src->z, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->f, &src->f, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _spline3dinterpolant_clear(void* _p) +{ + spline3dinterpolant *p = (spline3dinterpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x); + ae_vector_clear(&p->y); + ae_vector_clear(&p->z); + ae_vector_clear(&p->f); +} + + +void _spline3dinterpolant_destroy(void* _p) +{ + spline3dinterpolant *p = (spline3dinterpolant*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->y); + ae_vector_destroy(&p->z); + ae_vector_destroy(&p->f); +} + + + +} + diff --git a/psdlag/src/interpolation.h b/psdlag/src/interpolation.h new file mode 100644 index 0000000..f2c9d34 --- /dev/null +++ b/psdlag/src/interpolation.h @@ -0,0 +1,5906 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _interpolation_pkg_h +#define _interpolation_pkg_h +#include "ap.h" +#include "alglibinternal.h" +#include "alglibmisc.h" +#include "linalg.h" +#include "solvers.h" +#include "optimization.h" +#include "specialfunctions.h" +#include "integration.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + ae_int_t n; + ae_int_t nx; + ae_int_t d; + double r; + ae_int_t nw; + kdtree tree; + ae_int_t modeltype; + ae_matrix q; + ae_vector xbuf; + ae_vector tbuf; + ae_vector rbuf; + ae_matrix xybuf; + ae_int_t debugsolverfailures; + double debugworstrcond; + double debugbestrcond; +} idwinterpolant; +typedef struct +{ + ae_int_t n; + double sy; + ae_vector x; + ae_vector y; + ae_vector w; +} barycentricinterpolant; +typedef struct +{ + ae_bool periodic; + ae_int_t n; + ae_int_t k; + ae_int_t continuity; + ae_vector x; + ae_vector c; +} spline1dinterpolant; +typedef struct +{ + double taskrcond; + double rmserror; + double avgerror; + double avgrelerror; + double maxerror; +} polynomialfitreport; +typedef struct +{ + double taskrcond; + ae_int_t dbest; + double rmserror; + double avgerror; + double avgrelerror; + double maxerror; +} barycentricfitreport; +typedef struct +{ + double taskrcond; + double rmserror; + double avgerror; + double avgrelerror; + double maxerror; +} spline1dfitreport; +typedef struct +{ + double taskrcond; + ae_int_t iterationscount; + ae_int_t varidx; + double rmserror; + double avgerror; + double avgrelerror; + double maxerror; + double wrmserror; + ae_matrix covpar; + ae_vector errpar; + ae_vector errcurve; + ae_vector noise; + double r2; +} lsfitreport; +typedef struct +{ + ae_int_t optalgo; + ae_int_t m; + ae_int_t k; + double epsf; + double epsx; + ae_int_t maxits; + double stpmax; + ae_bool xrep; + ae_vector s; + ae_vector bndl; + ae_vector bndu; + ae_matrix taskx; + ae_vector tasky; + ae_int_t npoints; + ae_vector taskw; + ae_int_t nweights; + ae_int_t wkind; + ae_int_t wits; + double diffstep; + double teststep; + ae_bool xupdated; + ae_bool needf; + ae_bool needfg; + ae_bool needfgh; + ae_int_t pointindex; + ae_vector x; + ae_vector c; + double f; + ae_vector g; + ae_matrix h; + ae_vector wcur; + ae_vector tmp; + ae_vector tmpf; + ae_matrix tmpjac; + ae_matrix tmpjacw; + double tmpnoise; + matinvreport invrep; + ae_int_t repiterationscount; + ae_int_t repterminationtype; + ae_int_t repvaridx; + double reprmserror; + double repavgerror; + double repavgrelerror; + double repmaxerror; + double repwrmserror; + lsfitreport rep; + minlmstate optstate; + minlmreport optrep; + ae_int_t prevnpt; + ae_int_t prevalgo; + rcommstate rstate; +} lsfitstate; +typedef struct +{ + ae_int_t n; + ae_bool periodic; + ae_vector p; + spline1dinterpolant x; + spline1dinterpolant y; +} pspline2interpolant; +typedef struct +{ + ae_int_t n; + ae_bool periodic; + ae_vector p; + spline1dinterpolant x; + spline1dinterpolant y; + spline1dinterpolant z; +} pspline3interpolant; +typedef struct +{ + ae_int_t ny; + ae_int_t nx; + ae_int_t nc; + ae_int_t nl; + kdtree tree; + ae_matrix xc; + ae_matrix wr; + double rmax; + ae_matrix v; + ae_int_t gridtype; + ae_bool fixrad; + double lambdav; + double radvalue; + double radzvalue; + ae_int_t nlayers; + ae_int_t aterm; + ae_int_t algorithmtype; + double epsort; + double epserr; + ae_int_t maxits; + double h; + ae_int_t n; + ae_matrix x; + ae_matrix y; + ae_vector calcbufxcx; + ae_matrix calcbufx; + ae_vector calcbuftags; +} rbfmodel; +typedef struct +{ + ae_int_t arows; + ae_int_t acols; + ae_int_t annz; + ae_int_t iterationscount; + ae_int_t nmv; + ae_int_t terminationtype; +} rbfreport; +typedef struct +{ + ae_int_t k; + ae_int_t stype; + ae_int_t n; + ae_int_t m; + ae_int_t d; + ae_vector x; + ae_vector y; + ae_vector f; +} spline2dinterpolant; +typedef struct +{ + ae_int_t k; + ae_int_t stype; + ae_int_t n; + ae_int_t m; + ae_int_t l; + ae_int_t d; + ae_vector x; + ae_vector y; + ae_vector z; + ae_vector f; +} spline3dinterpolant; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + +/************************************************************************* +IDW interpolant. +*************************************************************************/ +class _idwinterpolant_owner +{ +public: + _idwinterpolant_owner(); + _idwinterpolant_owner(const _idwinterpolant_owner &rhs); + _idwinterpolant_owner& operator=(const _idwinterpolant_owner &rhs); + virtual ~_idwinterpolant_owner(); + alglib_impl::idwinterpolant* c_ptr(); + alglib_impl::idwinterpolant* c_ptr() const; +protected: + alglib_impl::idwinterpolant *p_struct; +}; +class idwinterpolant : public _idwinterpolant_owner +{ +public: + idwinterpolant(); + idwinterpolant(const idwinterpolant &rhs); + idwinterpolant& operator=(const idwinterpolant &rhs); + virtual ~idwinterpolant(); + +}; + +/************************************************************************* +Barycentric interpolant. +*************************************************************************/ +class _barycentricinterpolant_owner +{ +public: + _barycentricinterpolant_owner(); + _barycentricinterpolant_owner(const _barycentricinterpolant_owner &rhs); + _barycentricinterpolant_owner& operator=(const _barycentricinterpolant_owner &rhs); + virtual ~_barycentricinterpolant_owner(); + alglib_impl::barycentricinterpolant* c_ptr(); + alglib_impl::barycentricinterpolant* c_ptr() const; +protected: + alglib_impl::barycentricinterpolant *p_struct; +}; +class barycentricinterpolant : public _barycentricinterpolant_owner +{ +public: + barycentricinterpolant(); + barycentricinterpolant(const barycentricinterpolant &rhs); + barycentricinterpolant& operator=(const barycentricinterpolant &rhs); + virtual ~barycentricinterpolant(); + +}; + + + +/************************************************************************* +1-dimensional spline interpolant +*************************************************************************/ +class _spline1dinterpolant_owner +{ +public: + _spline1dinterpolant_owner(); + _spline1dinterpolant_owner(const _spline1dinterpolant_owner &rhs); + _spline1dinterpolant_owner& operator=(const _spline1dinterpolant_owner &rhs); + virtual ~_spline1dinterpolant_owner(); + alglib_impl::spline1dinterpolant* c_ptr(); + alglib_impl::spline1dinterpolant* c_ptr() const; +protected: + alglib_impl::spline1dinterpolant *p_struct; +}; +class spline1dinterpolant : public _spline1dinterpolant_owner +{ +public: + spline1dinterpolant(); + spline1dinterpolant(const spline1dinterpolant &rhs); + spline1dinterpolant& operator=(const spline1dinterpolant &rhs); + virtual ~spline1dinterpolant(); + +}; + +/************************************************************************* +Polynomial fitting report: + TaskRCond reciprocal of task's condition number + RMSError RMS error + AvgError average error + AvgRelError average relative error (for non-zero Y[I]) + MaxError maximum error +*************************************************************************/ +class _polynomialfitreport_owner +{ +public: + _polynomialfitreport_owner(); + _polynomialfitreport_owner(const _polynomialfitreport_owner &rhs); + _polynomialfitreport_owner& operator=(const _polynomialfitreport_owner &rhs); + virtual ~_polynomialfitreport_owner(); + alglib_impl::polynomialfitreport* c_ptr(); + alglib_impl::polynomialfitreport* c_ptr() const; +protected: + alglib_impl::polynomialfitreport *p_struct; +}; +class polynomialfitreport : public _polynomialfitreport_owner +{ +public: + polynomialfitreport(); + polynomialfitreport(const polynomialfitreport &rhs); + polynomialfitreport& operator=(const polynomialfitreport &rhs); + virtual ~polynomialfitreport(); + double &taskrcond; + double &rmserror; + double &avgerror; + double &avgrelerror; + double &maxerror; + +}; + + +/************************************************************************* +Barycentric fitting report: + RMSError RMS error + AvgError average error + AvgRelError average relative error (for non-zero Y[I]) + MaxError maximum error + TaskRCond reciprocal of task's condition number +*************************************************************************/ +class _barycentricfitreport_owner +{ +public: + _barycentricfitreport_owner(); + _barycentricfitreport_owner(const _barycentricfitreport_owner &rhs); + _barycentricfitreport_owner& operator=(const _barycentricfitreport_owner &rhs); + virtual ~_barycentricfitreport_owner(); + alglib_impl::barycentricfitreport* c_ptr(); + alglib_impl::barycentricfitreport* c_ptr() const; +protected: + alglib_impl::barycentricfitreport *p_struct; +}; +class barycentricfitreport : public _barycentricfitreport_owner +{ +public: + barycentricfitreport(); + barycentricfitreport(const barycentricfitreport &rhs); + barycentricfitreport& operator=(const barycentricfitreport &rhs); + virtual ~barycentricfitreport(); + double &taskrcond; + ae_int_t &dbest; + double &rmserror; + double &avgerror; + double &avgrelerror; + double &maxerror; + +}; + + +/************************************************************************* +Spline fitting report: + RMSError RMS error + AvgError average error + AvgRelError average relative error (for non-zero Y[I]) + MaxError maximum error + +Fields below are filled by obsolete functions (Spline1DFitCubic, +Spline1DFitHermite). Modern fitting functions do NOT fill these fields: + TaskRCond reciprocal of task's condition number +*************************************************************************/ +class _spline1dfitreport_owner +{ +public: + _spline1dfitreport_owner(); + _spline1dfitreport_owner(const _spline1dfitreport_owner &rhs); + _spline1dfitreport_owner& operator=(const _spline1dfitreport_owner &rhs); + virtual ~_spline1dfitreport_owner(); + alglib_impl::spline1dfitreport* c_ptr(); + alglib_impl::spline1dfitreport* c_ptr() const; +protected: + alglib_impl::spline1dfitreport *p_struct; +}; +class spline1dfitreport : public _spline1dfitreport_owner +{ +public: + spline1dfitreport(); + spline1dfitreport(const spline1dfitreport &rhs); + spline1dfitreport& operator=(const spline1dfitreport &rhs); + virtual ~spline1dfitreport(); + double &taskrcond; + double &rmserror; + double &avgerror; + double &avgrelerror; + double &maxerror; + +}; + + +/************************************************************************* +Least squares fitting report. This structure contains informational fields +which are set by fitting functions provided by this unit. + +Different functions initialize different sets of fields, so you should +read documentation on specific function you used in order to know which +fields are initialized. + + TaskRCond reciprocal of task's condition number + IterationsCount number of internal iterations + + VarIdx if user-supplied gradient contains errors which were + detected by nonlinear fitter, this field is set to + index of the first component of gradient which is + suspected to be spoiled by bugs. + + RMSError RMS error + AvgError average error + AvgRelError average relative error (for non-zero Y[I]) + MaxError maximum error + + WRMSError weighted RMS error + + CovPar covariance matrix for parameters, filled by some solvers + ErrPar vector of errors in parameters, filled by some solvers + ErrCurve vector of fit errors - variability of the best-fit + curve, filled by some solvers. + Noise vector of per-point noise estimates, filled by + some solvers. + R2 coefficient of determination (non-weighted, non-adjusted), + filled by some solvers. +*************************************************************************/ +class _lsfitreport_owner +{ +public: + _lsfitreport_owner(); + _lsfitreport_owner(const _lsfitreport_owner &rhs); + _lsfitreport_owner& operator=(const _lsfitreport_owner &rhs); + virtual ~_lsfitreport_owner(); + alglib_impl::lsfitreport* c_ptr(); + alglib_impl::lsfitreport* c_ptr() const; +protected: + alglib_impl::lsfitreport *p_struct; +}; +class lsfitreport : public _lsfitreport_owner +{ +public: + lsfitreport(); + lsfitreport(const lsfitreport &rhs); + lsfitreport& operator=(const lsfitreport &rhs); + virtual ~lsfitreport(); + double &taskrcond; + ae_int_t &iterationscount; + ae_int_t &varidx; + double &rmserror; + double &avgerror; + double &avgrelerror; + double &maxerror; + double &wrmserror; + real_2d_array covpar; + real_1d_array errpar; + real_1d_array errcurve; + real_1d_array noise; + double &r2; + +}; + + +/************************************************************************* +Nonlinear fitter. + +You should use ALGLIB functions to work with fitter. +Never try to access its fields directly! +*************************************************************************/ +class _lsfitstate_owner +{ +public: + _lsfitstate_owner(); + _lsfitstate_owner(const _lsfitstate_owner &rhs); + _lsfitstate_owner& operator=(const _lsfitstate_owner &rhs); + virtual ~_lsfitstate_owner(); + alglib_impl::lsfitstate* c_ptr(); + alglib_impl::lsfitstate* c_ptr() const; +protected: + alglib_impl::lsfitstate *p_struct; +}; +class lsfitstate : public _lsfitstate_owner +{ +public: + lsfitstate(); + lsfitstate(const lsfitstate &rhs); + lsfitstate& operator=(const lsfitstate &rhs); + virtual ~lsfitstate(); + ae_bool &needf; + ae_bool &needfg; + ae_bool &needfgh; + ae_bool &xupdated; + real_1d_array c; + double &f; + real_1d_array g; + real_2d_array h; + real_1d_array x; + +}; + +/************************************************************************* +Parametric spline inteprolant: 2-dimensional curve. + +You should not try to access its members directly - use PSpline2XXXXXXXX() +functions instead. +*************************************************************************/ +class _pspline2interpolant_owner +{ +public: + _pspline2interpolant_owner(); + _pspline2interpolant_owner(const _pspline2interpolant_owner &rhs); + _pspline2interpolant_owner& operator=(const _pspline2interpolant_owner &rhs); + virtual ~_pspline2interpolant_owner(); + alglib_impl::pspline2interpolant* c_ptr(); + alglib_impl::pspline2interpolant* c_ptr() const; +protected: + alglib_impl::pspline2interpolant *p_struct; +}; +class pspline2interpolant : public _pspline2interpolant_owner +{ +public: + pspline2interpolant(); + pspline2interpolant(const pspline2interpolant &rhs); + pspline2interpolant& operator=(const pspline2interpolant &rhs); + virtual ~pspline2interpolant(); + +}; + + +/************************************************************************* +Parametric spline inteprolant: 3-dimensional curve. + +You should not try to access its members directly - use PSpline3XXXXXXXX() +functions instead. +*************************************************************************/ +class _pspline3interpolant_owner +{ +public: + _pspline3interpolant_owner(); + _pspline3interpolant_owner(const _pspline3interpolant_owner &rhs); + _pspline3interpolant_owner& operator=(const _pspline3interpolant_owner &rhs); + virtual ~_pspline3interpolant_owner(); + alglib_impl::pspline3interpolant* c_ptr(); + alglib_impl::pspline3interpolant* c_ptr() const; +protected: + alglib_impl::pspline3interpolant *p_struct; +}; +class pspline3interpolant : public _pspline3interpolant_owner +{ +public: + pspline3interpolant(); + pspline3interpolant(const pspline3interpolant &rhs); + pspline3interpolant& operator=(const pspline3interpolant &rhs); + virtual ~pspline3interpolant(); + +}; + +/************************************************************************* +RBF model. + +Never try to directly work with fields of this object - always use ALGLIB +functions to use this object. +*************************************************************************/ +class _rbfmodel_owner +{ +public: + _rbfmodel_owner(); + _rbfmodel_owner(const _rbfmodel_owner &rhs); + _rbfmodel_owner& operator=(const _rbfmodel_owner &rhs); + virtual ~_rbfmodel_owner(); + alglib_impl::rbfmodel* c_ptr(); + alglib_impl::rbfmodel* c_ptr() const; +protected: + alglib_impl::rbfmodel *p_struct; +}; +class rbfmodel : public _rbfmodel_owner +{ +public: + rbfmodel(); + rbfmodel(const rbfmodel &rhs); + rbfmodel& operator=(const rbfmodel &rhs); + virtual ~rbfmodel(); + +}; + + +/************************************************************************* +RBF solution report: +* TerminationType - termination type, positive values - success, + non-positive - failure. +*************************************************************************/ +class _rbfreport_owner +{ +public: + _rbfreport_owner(); + _rbfreport_owner(const _rbfreport_owner &rhs); + _rbfreport_owner& operator=(const _rbfreport_owner &rhs); + virtual ~_rbfreport_owner(); + alglib_impl::rbfreport* c_ptr(); + alglib_impl::rbfreport* c_ptr() const; +protected: + alglib_impl::rbfreport *p_struct; +}; +class rbfreport : public _rbfreport_owner +{ +public: + rbfreport(); + rbfreport(const rbfreport &rhs); + rbfreport& operator=(const rbfreport &rhs); + virtual ~rbfreport(); + ae_int_t &arows; + ae_int_t &acols; + ae_int_t &annz; + ae_int_t &iterationscount; + ae_int_t &nmv; + ae_int_t &terminationtype; + +}; + +/************************************************************************* +2-dimensional spline inteprolant +*************************************************************************/ +class _spline2dinterpolant_owner +{ +public: + _spline2dinterpolant_owner(); + _spline2dinterpolant_owner(const _spline2dinterpolant_owner &rhs); + _spline2dinterpolant_owner& operator=(const _spline2dinterpolant_owner &rhs); + virtual ~_spline2dinterpolant_owner(); + alglib_impl::spline2dinterpolant* c_ptr(); + alglib_impl::spline2dinterpolant* c_ptr() const; +protected: + alglib_impl::spline2dinterpolant *p_struct; +}; +class spline2dinterpolant : public _spline2dinterpolant_owner +{ +public: + spline2dinterpolant(); + spline2dinterpolant(const spline2dinterpolant &rhs); + spline2dinterpolant& operator=(const spline2dinterpolant &rhs); + virtual ~spline2dinterpolant(); + +}; + +/************************************************************************* +3-dimensional spline inteprolant +*************************************************************************/ +class _spline3dinterpolant_owner +{ +public: + _spline3dinterpolant_owner(); + _spline3dinterpolant_owner(const _spline3dinterpolant_owner &rhs); + _spline3dinterpolant_owner& operator=(const _spline3dinterpolant_owner &rhs); + virtual ~_spline3dinterpolant_owner(); + alglib_impl::spline3dinterpolant* c_ptr(); + alglib_impl::spline3dinterpolant* c_ptr() const; +protected: + alglib_impl::spline3dinterpolant *p_struct; +}; +class spline3dinterpolant : public _spline3dinterpolant_owner +{ +public: + spline3dinterpolant(); + spline3dinterpolant(const spline3dinterpolant &rhs); + spline3dinterpolant& operator=(const spline3dinterpolant &rhs); + virtual ~spline3dinterpolant(); + +}; + +/************************************************************************* +IDW interpolation + +INPUT PARAMETERS: + Z - IDW interpolant built with one of model building + subroutines. + X - array[0..NX-1], interpolation point + +Result: + IDW interpolant Z(X) + + -- ALGLIB -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +double idwcalc(const idwinterpolant &z, const real_1d_array &x); + + +/************************************************************************* +IDW interpolant using modified Shepard method for uniform point +distributions. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + D - nodal function type, either: + * 0 constant model. Just for demonstration only, worst + model ever. + * 1 linear model, least squares fitting. Simpe model for + datasets too small for quadratic models + * 2 quadratic model, least squares fitting. Best model + available (if your dataset is large enough). + * -1 "fast" linear model, use with caution!!! It is + significantly faster than linear/quadratic and better + than constant model. But it is less robust (especially + in the presence of noise). + NQ - number of points used to calculate nodal functions (ignored + for constant models). NQ should be LARGER than: + * max(1.5*(1+NX),2^NX+1) for linear model, + * max(3/4*(NX+2)*(NX+1),2^NX+1) for quadratic model. + Values less than this threshold will be silently increased. + NW - number of points used to calculate weights and to interpolate. + Required: >=2^NX+1, values less than this threshold will be + silently increased. + Recommended value: about 2*NQ + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: + * best results are obtained with quadratic models, worst - with constant + models + * when N is large, NQ and NW must be significantly smaller than N both + to obtain optimal performance and to obtain optimal accuracy. In 2 or + 3-dimensional tasks NQ=15 and NW=25 are good values to start with. + * NQ and NW may be greater than N. In such cases they will be + automatically decreased. + * this subroutine is always succeeds (as long as correct parameters are + passed). + * see 'Multivariate Interpolation of Large Sets of Scattered Data' by + Robert J. Renka for more information on this algorithm. + * this subroutine assumes that point distribution is uniform at the small + scales. If it isn't - for example, points are concentrated along + "lines", but "lines" distribution is uniform at the larger scale - then + you should use IDWBuildModifiedShepardR() + + + -- ALGLIB PROJECT -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildmodifiedshepard(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t d, const ae_int_t nq, const ae_int_t nw, idwinterpolant &z); + + +/************************************************************************* +IDW interpolant using modified Shepard method for non-uniform datasets. + +This type of model uses constant nodal functions and interpolates using +all nodes which are closer than user-specified radius R. It may be used +when points distribution is non-uniform at the small scale, but it is at +the distances as large as R. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + R - radius, R>0 + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: +* if there is less than IDWKMin points within R-ball, algorithm selects + IDWKMin closest ones, so that continuity properties of interpolant are + preserved even far from points. + + -- ALGLIB PROJECT -- + Copyright 11.04.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildmodifiedshepardr(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const double r, idwinterpolant &z); + + +/************************************************************************* +IDW model for noisy data. + +This subroutine may be used to handle noisy data, i.e. data with noise in +OUTPUT values. It differs from IDWBuildModifiedShepard() in the following +aspects: +* nodal functions are not constrained to pass through nodes: Qi(xi)<>yi, + i.e. we have fitting instead of interpolation. +* weights which are used during least squares fitting stage are all equal + to 1.0 (independently of distance) +* "fast"-linear or constant nodal functions are not supported (either not + robust enough or too rigid) + +This problem require far more complex tuning than interpolation problems. +Below you can find some recommendations regarding this problem: +* focus on tuning NQ; it controls noise reduction. As for NW, you can just + make it equal to 2*NQ. +* you can use cross-validation to determine optimal NQ. +* optimal NQ is a result of complex tradeoff between noise level (more + noise = larger NQ required) and underlying function complexity (given + fixed N, larger NQ means smoothing of compex features in the data). For + example, NQ=N will reduce noise to the minimum level possible, but you + will end up with just constant/linear/quadratic (depending on D) least + squares model for the whole dataset. + +INPUT PARAMETERS: + XY - X and Y values, array[0..N-1,0..NX]. + First NX columns contain X-values, last column contain + Y-values. + N - number of nodes, N>0. + NX - space dimension, NX>=1. + D - nodal function degree, either: + * 1 linear model, least squares fitting. Simpe model for + datasets too small for quadratic models (or for very + noisy problems). + * 2 quadratic model, least squares fitting. Best model + available (if your dataset is large enough). + NQ - number of points used to calculate nodal functions. NQ should + be significantly larger than 1.5 times the number of + coefficients in a nodal function to overcome effects of noise: + * larger than 1.5*(1+NX) for linear model, + * larger than 3/4*(NX+2)*(NX+1) for quadratic model. + Values less than this threshold will be silently increased. + NW - number of points used to calculate weights and to interpolate. + Required: >=2^NX+1, values less than this threshold will be + silently increased. + Recommended value: about 2*NQ or larger + +OUTPUT PARAMETERS: + Z - IDW interpolant. + +NOTES: + * best results are obtained with quadratic models, linear models are not + recommended to use unless you are pretty sure that it is what you want + * this subroutine is always succeeds (as long as correct parameters are + passed). + * see 'Multivariate Interpolation of Large Sets of Scattered Data' by + Robert J. Renka for more information on this algorithm. + + + -- ALGLIB PROJECT -- + Copyright 02.03.2010 by Bochkanov Sergey +*************************************************************************/ +void idwbuildnoisy(const real_2d_array &xy, const ae_int_t n, const ae_int_t nx, const ae_int_t d, const ae_int_t nq, const ae_int_t nw, idwinterpolant &z); + +/************************************************************************* +Rational interpolation using barycentric formula + +F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) + +Input parameters: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +Result: + barycentric interpolant F(t) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +double barycentriccalc(const barycentricinterpolant &b, const double t); + + +/************************************************************************* +Differentiation of barycentric interpolant: first derivative. + +Algorithm used in this subroutine is very robust and should not fail until +provided with values too close to MaxRealNumber (usually MaxRealNumber/N +or greater will overflow). + +INPUT PARAMETERS: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +OUTPUT PARAMETERS: + F - barycentric interpolant at T + DF - first derivative + +NOTE + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricdiff1(const barycentricinterpolant &b, const double t, double &f, double &df); + + +/************************************************************************* +Differentiation of barycentric interpolant: first/second derivatives. + +INPUT PARAMETERS: + B - barycentric interpolant built with one of model building + subroutines. + T - interpolation point + +OUTPUT PARAMETERS: + F - barycentric interpolant at T + DF - first derivative + D2F - second derivative + +NOTE: this algorithm may fail due to overflow/underflor if used on data +whose values are close to MaxRealNumber or MinRealNumber. Use more robust +BarycentricDiff1() subroutine in such cases. + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricdiff2(const barycentricinterpolant &b, const double t, double &f, double &df, double &d2f); + + +/************************************************************************* +This subroutine performs linear transformation of the argument. + +INPUT PARAMETERS: + B - rational interpolant in barycentric form + CA, CB - transformation coefficients: x = CA*t + CB + +OUTPUT PARAMETERS: + B - transformed interpolant with X replaced by T + + -- ALGLIB PROJECT -- + Copyright 19.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentriclintransx(const barycentricinterpolant &b, const double ca, const double cb); + + +/************************************************************************* +This subroutine performs linear transformation of the barycentric +interpolant. + +INPUT PARAMETERS: + B - rational interpolant in barycentric form + CA, CB - transformation coefficients: B2(x) = CA*B(x) + CB + +OUTPUT PARAMETERS: + B - transformed interpolant + + -- ALGLIB PROJECT -- + Copyright 19.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentriclintransy(const barycentricinterpolant &b, const double ca, const double cb); + + +/************************************************************************* +Extracts X/Y/W arrays from rational interpolant + +INPUT PARAMETERS: + B - barycentric interpolant + +OUTPUT PARAMETERS: + N - nodes count, N>0 + X - interpolation nodes, array[0..N-1] + F - function values, array[0..N-1] + W - barycentric weights, array[0..N-1] + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricunpack(const barycentricinterpolant &b, ae_int_t &n, real_1d_array &x, real_1d_array &y, real_1d_array &w); + + +/************************************************************************* +Rational interpolant from X/Y/W arrays + +F(t) = SUM(i=0,n-1,w[i]*f[i]/(t-x[i])) / SUM(i=0,n-1,w[i]/(t-x[i])) + +INPUT PARAMETERS: + X - interpolation nodes, array[0..N-1] + F - function values, array[0..N-1] + W - barycentric weights, array[0..N-1] + N - nodes count, N>0 + +OUTPUT PARAMETERS: + B - barycentric interpolant built from (X, Y, W) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricbuildxyw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, barycentricinterpolant &b); + + +/************************************************************************* +Rational interpolant without poles + +The subroutine constructs the rational interpolating function without real +poles (see 'Barycentric rational interpolation with no poles and high +rates of approximation', Michael S. Floater. and Kai Hormann, for more +information on this subject). + +Input parameters: + X - interpolation nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of nodes, N>0. + D - order of the interpolation scheme, 0 <= D <= N-1. + D<0 will cause an error. + D>=N it will be replaced with D=N-1. + if you don't know what D to choose, use small value about 3-5. + +Output parameters: + B - barycentric interpolant. + +Note: + this algorithm always succeeds and calculates the weights with close + to machine precision. + + -- ALGLIB PROJECT -- + Copyright 17.06.2007 by Bochkanov Sergey +*************************************************************************/ +void barycentricbuildfloaterhormann(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t d, barycentricinterpolant &b); + +/************************************************************************* +Conversion from barycentric representation to Chebyshev basis. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + P - polynomial in barycentric form + A,B - base interval for Chebyshev polynomials (see below) + A<>B + +OUTPUT PARAMETERS + T - coefficients of Chebyshev representation; + P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N-1 }, + where Ti - I-th Chebyshev polynomial. + +NOTES: + barycentric interpolant passed as P may be either polynomial obtained + from polynomial interpolation/ fitting or rational function which is + NOT polynomial. We can't distinguish between these two cases, and this + algorithm just tries to work assuming that P IS a polynomial. If not, + algorithm will return results, but they won't have any meaning. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialbar2cheb(const barycentricinterpolant &p, const double a, const double b, real_1d_array &t); + + +/************************************************************************* +Conversion from Chebyshev basis to barycentric representation. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + T - coefficients of Chebyshev representation; + P(x) = sum { T[i]*Ti(2*(x-A)/(B-A)-1), i=0..N }, + where Ti - I-th Chebyshev polynomial. + N - number of coefficients: + * if given, only leading N elements of T are used + * if not given, automatically determined from size of T + A,B - base interval for Chebyshev polynomials (see above) + A0. + +OUTPUT PARAMETERS + A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } + N - number of coefficients (polynomial degree plus 1) + +NOTES: +1. this function accepts offset and scale, which can be set to improve + numerical properties of polynomial. For example, if P was obtained as + result of interpolation on [-1,+1], you can set C=0 and S=1 and + represent P as sum of 1, x, x^2, x^3 and so on. In most cases you it + is exactly what you need. + + However, if your interpolation model was built on [999,1001], you will + see significant growth of numerical errors when using {1, x, x^2, x^3} + as basis. Representing P as sum of 1, (x-1000), (x-1000)^2, (x-1000)^3 + will be better option. Such representation can be obtained by using + 1000.0 as offset C and 1.0 as scale S. + +2. power basis is ill-conditioned and tricks described above can't solve + this problem completely. This function will return coefficients in + any case, but for N>8 they will become unreliable. However, N's + less than 5 are pretty safe. + +3. barycentric interpolant passed as P may be either polynomial obtained + from polynomial interpolation/ fitting or rational function which is + NOT polynomial. We can't distinguish between these two cases, and this + algorithm just tries to work assuming that P IS a polynomial. If not, + algorithm will return results, but they won't have any meaning. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialbar2pow(const barycentricinterpolant &p, const double c, const double s, real_1d_array &a); +void polynomialbar2pow(const barycentricinterpolant &p, real_1d_array &a); + + +/************************************************************************* +Conversion from power basis to barycentric representation. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + A - coefficients, P(x) = sum { A[i]*((X-C)/S)^i, i=0..N-1 } + N - number of coefficients (polynomial degree plus 1) + * if given, only leading N elements of A are used + * if not given, automatically determined from size of A + C - offset (see below); 0.0 is used as default value. + S - scale (see below); 1.0 is used as default value. S<>0. + +OUTPUT PARAMETERS + P - polynomial in barycentric form + + +NOTES: +1. this function accepts offset and scale, which can be set to improve + numerical properties of polynomial. For example, if you interpolate on + [-1,+1], you can set C=0 and S=1 and convert from sum of 1, x, x^2, + x^3 and so on. In most cases you it is exactly what you need. + + However, if your interpolation model was built on [999,1001], you will + see significant growth of numerical errors when using {1, x, x^2, x^3} + as input basis. Converting from sum of 1, (x-1000), (x-1000)^2, + (x-1000)^3 will be better option (you have to specify 1000.0 as offset + C and 1.0 as scale S). + +2. power basis is ill-conditioned and tricks described above can't solve + this problem completely. This function will return barycentric model + in any case, but for N>8 accuracy well degrade. However, N's less than + 5 are pretty safe. + + -- ALGLIB -- + Copyright 30.09.2010 by Bochkanov Sergey +*************************************************************************/ +void polynomialpow2bar(const real_1d_array &a, const ae_int_t n, const double c, const double s, barycentricinterpolant &p); +void polynomialpow2bar(const real_1d_array &a, barycentricinterpolant &p); + + +/************************************************************************* +Lagrange intepolant: generation of the model on the general grid. +This function has O(N^2) complexity. + +INPUT PARAMETERS: + X - abscissas, array[0..N-1] + Y - function values, array[0..N-1] + N - number of points, N>=1 + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuild(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p); +void polynomialbuild(const real_1d_array &x, const real_1d_array &y, barycentricinterpolant &p); + + +/************************************************************************* +Lagrange intepolant: generation of the model on equidistant grid. +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1] + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildeqdist(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p); +void polynomialbuildeqdist(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p); + + +/************************************************************************* +Lagrange intepolant on Chebyshev grid (first kind). +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1], + Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n))) + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildcheb1(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p); +void polynomialbuildcheb1(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p); + + +/************************************************************************* +Lagrange intepolant on Chebyshev grid (second kind). +This function has O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + Y - function values at the nodes, array[0..N-1], + Y[I] = Y(0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1))) + N - number of points, N>=1 + for N=1 a constant model is constructed. + +OUTPUT PARAMETERS + P - barycentric model which represents Lagrange interpolant + (see ratint unit info and BarycentricCalc() description for + more information). + + -- ALGLIB -- + Copyright 03.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialbuildcheb2(const double a, const double b, const real_1d_array &y, const ae_int_t n, barycentricinterpolant &p); +void polynomialbuildcheb2(const double a, const double b, const real_1d_array &y, barycentricinterpolant &p); + + +/************************************************************************* +Fast equidistant polynomial interpolation function with O(N) complexity + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on equidistant grid, N>=1 + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolynomialBuildEqDist()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalceqdist(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t); +double polynomialcalceqdist(const double a, const double b, const real_1d_array &f, const double t); + + +/************************************************************************* +Fast polynomial interpolation function on Chebyshev points (first kind) +with O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on Chebyshev grid (first kind), + X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*(2*i+1)/(2*n)) + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolIntBuildCheb1()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalccheb1(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t); +double polynomialcalccheb1(const double a, const double b, const real_1d_array &f, const double t); + + +/************************************************************************* +Fast polynomial interpolation function on Chebyshev points (second kind) +with O(N) complexity. + +INPUT PARAMETERS: + A - left boundary of [A,B] + B - right boundary of [A,B] + F - function values, array[0..N-1] + N - number of points on Chebyshev grid (second kind), + X[i] = 0.5*(B+A) + 0.5*(B-A)*Cos(PI*i/(n-1)) + for N=1 a constant model is constructed. + T - position where P(x) is calculated + +RESULT + value of the Lagrange interpolant at T + +IMPORTANT + this function provides fast interface which is not overflow-safe + nor it is very precise. + the best option is to use PolIntBuildCheb2()/BarycentricCalc() + subroutines unless you are pretty sure that your data will not result + in overflow. + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +double polynomialcalccheb2(const double a, const double b, const real_1d_array &f, const ae_int_t n, const double t); +double polynomialcalccheb2(const double a, const double b, const real_1d_array &f, const double t); + +/************************************************************************* +This subroutine builds linear spline interpolant + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildlinear(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c); +void spline1dbuildlinear(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c); + + +/************************************************************************* +This subroutine builds cubic spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + C - spline interpolant + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, spline1dinterpolant &c); +void spline1dbuildcubic(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c); + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at nodes x[], it calculates and returns table of function derivatives d[] +(calculated at the same nodes x[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - spline nodes + Y - function values + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + D - derivative values at X[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Derivative values are correctly reordered on return, so D[I] is always +equal to S'(X[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dgriddiffcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, real_1d_array &d); +void spline1dgriddiffcubic(const real_1d_array &x, const real_1d_array &y, real_1d_array &d); + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at nodes x[], it calculates and returns tables of first and second +function derivatives d1[] and d2[] (calculated at the same nodes x[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - spline nodes + Y - function values + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + +OUTPUT PARAMETERS: + D1 - S' values at X[] + D2 - S'' values at X[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Derivative values are correctly reordered on return, so D[I] is always +equal to S'(X[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dgriddiff2cubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, real_1d_array &d1, real_1d_array &d2); +void spline1dgriddiff2cubic(const real_1d_array &x, const real_1d_array &y, real_1d_array &d1, real_1d_array &d2); + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[] (calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2); +void spline1dconvcubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2); + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[] and derivatives d2[] (calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + D2 - first derivatives at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiffcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2, real_1d_array &d2); +void spline1dconvdiffcubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2, real_1d_array &d2); + + +/************************************************************************* +This function solves following problem: given table y[] of function values +at old nodes x[] and new nodes x2[], it calculates and returns table of +function values y2[], first and second derivatives d2[] and dd2[] +(calculated at x2[]). + +This function yields same result as Spline1DBuildCubic() call followed by +sequence of Spline1DDiff() calls, but it can be several times faster when +called for ordered X[] and X2[]. + +INPUT PARAMETERS: + X - old spline nodes + Y - function values + X2 - new spline nodes + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points from X/Y are used + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundLType - boundary condition type for the left boundary + BoundL - left boundary condition (first or second derivative, + depending on the BoundLType) + BoundRType - boundary condition type for the right boundary + BoundR - right boundary condition (first or second derivative, + depending on the BoundRType) + N2 - new points count: + * N2>=2 + * if given, only first N2 points from X2 are used + * if not given, automatically detected from X2 size + +OUTPUT PARAMETERS: + F2 - function values at X2[] + D2 - first derivatives at X2[] + DD2 - second derivatives at X2[] + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. +Function values are correctly reordered on return, so F2[I] is always +equal to S(X2[I]) independently of points order. + +SETTING BOUNDARY VALUES: + +The BoundLType/BoundRType parameters can have the following values: + * -1, which corresonds to the periodic (cyclic) boundary conditions. + In this case: + * both BoundLType and BoundRType must be equal to -1. + * BoundL/BoundR are ignored + * Y[last] is ignored (it is assumed to be equal to Y[first]). + * 0, which corresponds to the parabolically terminated spline + (BoundL and/or BoundR are ignored). + * 1, which corresponds to the first derivative boundary condition + * 2, which corresponds to the second derivative boundary condition + * by default, BoundType=0 is used + +PROBLEMS WITH PERIODIC BOUNDARY CONDITIONS: + +Problems with periodic boundary conditions have Y[first_point]=Y[last_point]. +However, this subroutine doesn't require you to specify equal values for +the first and last points - it automatically forces them to be equal by +copying Y[first_point] (corresponds to the leftmost, minimal X[]) to +Y[last_point]. However it is recommended to pass consistent values of Y[], +i.e. to make Y[first_point]=Y[last_point]. + + -- ALGLIB PROJECT -- + Copyright 03.09.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dconvdiff2cubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t boundltype, const double boundl, const ae_int_t boundrtype, const double boundr, const real_1d_array &x2, const ae_int_t n2, real_1d_array &y2, real_1d_array &d2, real_1d_array &dd2); +void spline1dconvdiff2cubic(const real_1d_array &x, const real_1d_array &y, const real_1d_array &x2, real_1d_array &y2, real_1d_array &d2, real_1d_array &dd2); + + +/************************************************************************* +This subroutine builds Catmull-Rom spline interpolant. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. + Y - function values, array[0..N-1]. + +OPTIONAL PARAMETERS: + N - points count: + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + BoundType - boundary condition type: + * -1 for periodic boundary condition + * 0 for parabolically terminated spline (default) + Tension - tension parameter: + * tension=0 corresponds to classic Catmull-Rom spline (default) + * 0=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant. + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildhermite(const real_1d_array &x, const real_1d_array &y, const real_1d_array &d, const ae_int_t n, spline1dinterpolant &c); +void spline1dbuildhermite(const real_1d_array &x, const real_1d_array &y, const real_1d_array &d, spline1dinterpolant &c); + + +/************************************************************************* +This subroutine builds Akima spline interpolant + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1] + Y - function values, array[0..N-1] + N - points count (optional): + * N>=2 + * if given, only first N points are used to build spline + * if not given, automatically detected from X/Y sizes + (len(X) must be equal to len(Y)) + +OUTPUT PARAMETERS: + C - spline interpolant + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildakima(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c); +void spline1dbuildakima(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c); + + +/************************************************************************* +This subroutine calculates the value of the spline at the given point X. + +INPUT PARAMETERS: + C - spline interpolant + X - point + +Result: + S(x) + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +double spline1dcalc(const spline1dinterpolant &c, const double x); + + +/************************************************************************* +This subroutine differentiates the spline. + +INPUT PARAMETERS: + C - spline interpolant. + X - point + +Result: + S - S(x) + DS - S'(x) + D2S - S''(x) + + -- ALGLIB PROJECT -- + Copyright 24.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1ddiff(const spline1dinterpolant &c, const double x, double &s, double &ds, double &d2s); + + +/************************************************************************* +This subroutine unpacks the spline into the coefficients table. + +INPUT PARAMETERS: + C - spline interpolant. + X - point + +OUTPUT PARAMETERS: + Tbl - coefficients table, unpacked format, array[0..N-2, 0..5]. + For I = 0...N-2: + Tbl[I,0] = X[i] + Tbl[I,1] = X[i+1] + Tbl[I,2] = C0 + Tbl[I,3] = C1 + Tbl[I,4] = C2 + Tbl[I,5] = C3 + On [x[i], x[i+1]] spline is equals to: + S(x) = C0 + C1*t + C2*t^2 + C3*t^3 + t = x-x[i] + +NOTE: + You can rebuild spline with Spline1DBuildHermite() function, which + accepts as inputs function values and derivatives at nodes, which are + easy to calculate when you have coefficients. + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dunpack(const spline1dinterpolant &c, ae_int_t &n, real_2d_array &tbl); + + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: x = A*t + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dlintransx(const spline1dinterpolant &c, const double a, const double b); + + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: S2(x) = A*S(x) + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline1dlintransy(const spline1dinterpolant &c, const double a, const double b); + + +/************************************************************************* +This subroutine integrates the spline. + +INPUT PARAMETERS: + C - spline interpolant. + X - right bound of the integration interval [a, x], + here 'a' denotes min(x[]) +Result: + integral(S(t)dt,a,x) + + -- ALGLIB PROJECT -- + Copyright 23.06.2007 by Bochkanov Sergey +*************************************************************************/ +double spline1dintegrate(const spline1dinterpolant &c, const double x); + + +/************************************************************************* +This function builds monotone cubic Hermite interpolant. This interpolant +is monotonic in [x(0),x(n-1)] and is constant outside of this interval. + +In case y[] form non-monotonic sequence, interpolant is piecewise +monotonic. Say, for x=(0,1,2,3,4) and y=(0,1,2,1,0) interpolant will +monotonically grow at [0..2] and monotonically decrease at [2..4]. + +INPUT PARAMETERS: + X - spline nodes, array[0..N-1]. Subroutine automatically + sorts points, so caller may pass unsorted array. + Y - function values, array[0..N-1] + N - the number of points(N>=2). + +OUTPUT PARAMETERS: + C - spline interpolant. + + -- ALGLIB PROJECT -- + Copyright 21.06.2012 by Bochkanov Sergey +*************************************************************************/ +void spline1dbuildmonotone(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, spline1dinterpolant &c); +void spline1dbuildmonotone(const real_1d_array &x, const real_1d_array &y, spline1dinterpolant &c); + +/************************************************************************* +Fitting by polynomials in barycentric form. This function provides simple +unterface for unconstrained unweighted fitting. See PolynomialFitWC() if +you need constrained fitting. + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO: + PolynomialFitWC() + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0 + * if given, only leading N elements of X/Y are used + * if not given, automatically determined from sizes of X/Y + M - number of basis functions (= polynomial_degree + 1), M>=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + P - interpolant in barycentric form. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +NOTES: + you can convert P from barycentric form to the power or Chebyshev + basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from + POLINT subpackage. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialfit(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep); +void polynomialfit(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep); + + +/************************************************************************* +Weighted fitting by polynomials in barycentric form, with constraints on +function values or first derivatives. + +Small regularizing term is used when solving constrained tasks (to improve +stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO: + PolynomialFit() + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points, N>0. + * if given, only leading N elements of X/Y/W are used + * if not given, automatically determined from sizes of X/Y/W + XC - points where polynomial values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that P(XC[i])=YC[i] + * DC[i]=1 means that P'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints, 0<=K=1 + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + P - interpolant in barycentric form. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +NOTES: + you can convert P from barycentric form to the power or Chebyshev + basis with PolynomialBar2Pow() or PolynomialBar2Cheb() functions from + POLINT subpackage. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* even simple constraints can be inconsistent, see Wikipedia article on + this subject: http://en.wikipedia.org/wiki/Birkhoff_interpolation +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints is NOT GUARANTEED. +* in the one special cases, however, we can guarantee consistency. This + case is: M>1 and constraints on the function values (NOT DERIVATIVES) + +Our final recommendation is to use constraints WHEN AND ONLY when you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 10.12.2009 by Bochkanov Sergey +*************************************************************************/ +void polynomialfitwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep); +void polynomialfitwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, barycentricinterpolant &p, polynomialfitreport &rep); + + +/************************************************************************* +Weghted rational least squares fitting using Floater-Hormann rational +functions with optimal D chosen from [0,9], with constraints and +individual weights. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least WEIGHTED root +mean square error) is chosen. Task is linear, so linear least squares +solver is used. Complexity of this computational scheme is O(N*M^2) +(mostly dominated by the least squares solver). + +SEE ALSO +* BarycentricFitFloaterHormann(), "lightweight" fitting without invididual + weights and constraints. + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points, N>0. + XC - points where function values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints, 0<=K=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + -1 means another errors in parameters passed + (N<=0, for example) + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroutine doesn't calculate task's condition number for K<>0. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained barycentric interpolants: +* excessive constraints can be inconsistent. Floater-Hormann basis + functions aren't as flexible as splines (although they are very smooth). +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints IS NOT GUARANTEED. +* in the several special cases, however, we CAN guarantee consistency. +* one of this cases is constraints on the function VALUES at the interval + boundaries. Note that consustency of the constraints on the function + DERIVATIVES is NOT guaranteed (you can use in such cases cubic splines + which are more flexible). +* another special case is ONE constraint on the function value (OR, but + not AND, derivative) anywhere in the interval + +Our final recommendation is to use constraints WHEN AND ONLY WHEN you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricfitfloaterhormannwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, barycentricinterpolant &b, barycentricfitreport &rep); + + +/************************************************************************* +Rational least squares fitting using Floater-Hormann rational functions +with optimal D chosen from [0,9]. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least root mean +square error) is chosen. Task is linear, so linear least squares solver +is used. Complexity of this computational scheme is O(N*M^2) (mostly +dominated by the least squares solver). + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0. + M - number of basis functions ( = number_of_nodes), M>=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void barycentricfitfloaterhormann(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, barycentricinterpolant &b, barycentricfitreport &rep); + + +/************************************************************************* +Rational least squares fitting using Floater-Hormann rational functions +with optimal D chosen from [0,9]. + +Equidistant grid with M node on [min(x),max(x)] is used to build basis +functions. Different values of D are tried, optimal D (least root mean +square error) is chosen. Task is linear, so linear least squares solver +is used. Complexity of this computational scheme is O(N*M^2) (mostly +dominated by the least squares solver). + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + N - number of points, N>0. + M - number of basis functions ( = number_of_nodes), M>=2. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + B - barycentric interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * DBest best value of the D parameter + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitpenalized(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); +void spline1dfitpenalized(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); + + +/************************************************************************* +Weighted fitting by penalized cubic spline. + +Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are cubic splines with natural boundary +conditions. Problem is regularized by adding non-linearity penalty to the +usual least squares penalty function: + + S(x) = arg min { LS + P }, where + LS = SUM { w[i]^2*(y[i] - S(x[i]))^2 } - least squares penalty + P = C*10^rho*integral{ S''(x)^2*dx } - non-linearity penalty + rho - tunable constant given by user + C - automatically determined scale parameter, + makes penalty invariant with respect to scaling of X, Y, W. + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + problem. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + M - number of basis functions ( = number_of_nodes), M>=4. + Rho - regularization constant passed by user. It penalizes + nonlinearity in the regression spline. It is logarithmically + scaled, i.e. actual value of regularization constant is + calculated as 10^Rho. It is automatically scaled so that: + * Rho=2.0 corresponds to moderate amount of nonlinearity + * generally, it should be somewhere in the [-8.0,+8.0] + If you do not want to penalize nonlineary, + pass small Rho. Values as low as -15 should work. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD or + Cholesky decomposition; problem may be + too ill-conditioned (very rare) + S - spline interpolant. + Rep - Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +NOTE 1: additional nodes are added to the spline outside of the fitting +interval to force linearity when xmax(x,xc). It is done +for consistency - we penalize non-linearity at [min(x,xc),max(x,xc)], so +it is natural to force linearity outside of this interval. + +NOTE 2: function automatically sorts points, so caller may pass unsorted +array. + + -- ALGLIB PROJECT -- + Copyright 19.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitpenalizedw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); +void spline1dfitpenalizedw(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t m, const double rho, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); + + +/************************************************************************* +Weighted fitting by cubic spline, with constraints on function values or +derivatives. + +Equidistant grid with M-2 nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are cubic splines with continuous second +derivatives and non-fixed first derivatives at interval ends. Small +regularizing term is used when solving constrained tasks (to improve +stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO + Spline1DFitHermiteWC() - fitting by Hermite splines (more flexible, + less smooth) + Spline1DFitCubic() - "lightweight" fitting by cubic splines, + without invididual weights and constraints + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + XC - points where spline values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints (optional): + * 0<=K=4. + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearWC() subroutine. + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + S - spline interpolant. + Rep - report, same format as in LSFitLinearWC() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* excessive constraints can be inconsistent. Splines are piecewise cubic + functions, and it is easy to create an example, where large number of + constraints concentrated in small area will result in inconsistency. + Just because spline is not flexible enough to satisfy all of them. And + same constraints spread across the [min(x),max(x)] will be perfectly + consistent. +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints IS NOT GUARANTEED. +* in the several special cases, however, we CAN guarantee consistency. +* one of this cases is constraints on the function values AND/OR its + derivatives at the interval boundaries. +* another special case is ONE constraint on the function value (OR, but + not AND, derivative) anywhere in the interval + +Our final recommendation is to use constraints WHEN AND ONLY WHEN you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitcubicwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); +void spline1dfitcubicwc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); + + +/************************************************************************* +Weighted fitting by Hermite spline, with constraints on function values +or first derivatives. + +Equidistant grid with M nodes on [min(x,xc),max(x,xc)] is used to build +basis functions. Basis functions are Hermite splines. Small regularizing +term is used when solving constrained tasks (to improve stability). + +Task is linear, so linear least squares solver is used. Complexity of this +computational scheme is O(N*M^2), mostly dominated by least squares solver + +SEE ALSO + Spline1DFitCubicWC() - fitting by Cubic splines (less flexible, + more smooth) + Spline1DFitHermite() - "lightweight" Hermite fitting, without + invididual weights and constraints + +INPUT PARAMETERS: + X - points, array[0..N-1]. + Y - function values, array[0..N-1]. + W - weights, array[0..N-1] + Each summand in square sum of approximation deviations from + given values is multiplied by the square of corresponding + weight. Fill it by 1's if you don't want to solve weighted + task. + N - number of points (optional): + * N>0 + * if given, only first N elements of X/Y/W are processed + * if not given, automatically determined from X/Y/W sizes + XC - points where spline values/derivatives are constrained, + array[0..K-1]. + YC - values of constraints, array[0..K-1] + DC - array[0..K-1], types of constraints: + * DC[i]=0 means that S(XC[i])=YC[i] + * DC[i]=1 means that S'(XC[i])=YC[i] + SEE BELOW FOR IMPORTANT INFORMATION ON CONSTRAINTS + K - number of constraints (optional): + * 0<=K=4, + M IS EVEN! + +OUTPUT PARAMETERS: + Info- same format as in LSFitLinearW() subroutine: + * Info>0 task is solved + * Info<=0 an error occured: + -4 means inconvergence of internal SVD + -3 means inconsistent constraints + -2 means odd M was passed (which is not supported) + -1 means another errors in parameters passed + (N<=0, for example) + S - spline interpolant. + Rep - report, same format as in LSFitLinearW() subroutine. + Following fields are set: + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +IMPORTANT: + this subroitine supports only even M's + + +ORDER OF POINTS + +Subroutine automatically sorts points, so caller may pass unsorted array. + +SETTING CONSTRAINTS - DANGERS AND OPPORTUNITIES: + +Setting constraints can lead to undesired results, like ill-conditioned +behavior, or inconsistency being detected. From the other side, it allows +us to improve quality of the fit. Here we summarize our experience with +constrained regression splines: +* excessive constraints can be inconsistent. Splines are piecewise cubic + functions, and it is easy to create an example, where large number of + constraints concentrated in small area will result in inconsistency. + Just because spline is not flexible enough to satisfy all of them. And + same constraints spread across the [min(x),max(x)] will be perfectly + consistent. +* the more evenly constraints are spread across [min(x),max(x)], the more + chances that they will be consistent +* the greater is M (given fixed constraints), the more chances that + constraints will be consistent +* in the general case, consistency of constraints is NOT GUARANTEED. +* in the several special cases, however, we can guarantee consistency. +* one of this cases is M>=4 and constraints on the function value + (AND/OR its derivative) at the interval boundaries. +* another special case is M>=4 and ONE constraint on the function value + (OR, BUT NOT AND, derivative) anywhere in [min(x),max(x)] + +Our final recommendation is to use constraints WHEN AND ONLY when you +can't solve your task without them. Anything beyond special cases given +above is not guaranteed and may result in inconsistency. + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfithermitewc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const ae_int_t n, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t k, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); +void spline1dfithermitewc(const real_1d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &xc, const real_1d_array &yc, const integer_1d_array &dc, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); + + +/************************************************************************* +Least squares fitting by cubic spline. + +This subroutine is "lightweight" alternative for more complex and feature- +rich Spline1DFitCubicWC(). See Spline1DFitCubicWC() for more information +about subroutine parameters (we don't duplicate it here because of length) + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfitcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); +void spline1dfitcubic(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); + + +/************************************************************************* +Least squares fitting by Hermite spline. + +This subroutine is "lightweight" alternative for more complex and feature- +rich Spline1DFitHermiteWC(). See Spline1DFitHermiteWC() description for +more information about subroutine parameters (we don't duplicate it here +because of length). + + -- ALGLIB PROJECT -- + Copyright 18.08.2009 by Bochkanov Sergey +*************************************************************************/ +void spline1dfithermite(const real_1d_array &x, const real_1d_array &y, const ae_int_t n, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); +void spline1dfithermite(const real_1d_array &x, const real_1d_array &y, const ae_int_t m, ae_int_t &info, spline1dinterpolant &s, spline1dfitreport &rep); + + +/************************************************************************* +Weighted linear least squares fitting. + +QR decomposition is used to reduce task to MxM, then triangular solver or +SVD-based solver is used depending on condition number of the system. It +allows to maximize speed and retain decent accuracy. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + W - array[0..N-1] Weights corresponding to function values. + Each summand in square sum of approximation deviations + from given values is multiplied by the square of + corresponding weight. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I, J] - value of J-th basis function in I-th point. + N - number of points used. N>=1. + M - number of basis functions, M>=1. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -1 incorrect N/M were specified + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * Rep.TaskRCond reciprocal of condition number + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearw(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const ae_int_t n, const ae_int_t m, ae_int_t &info, real_1d_array &c, lsfitreport &rep); +void lsfitlinearw(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep); + + +/************************************************************************* +Weighted constained linear least squares fitting. + +This is variation of LSFitLinearW(), which searchs for min|A*x=b| given +that K additional constaints C*x=bc are satisfied. It reduces original +task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinearW() +is called. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + W - array[0..N-1] Weights corresponding to function values. + Each summand in square sum of approximation deviations + from given values is multiplied by the square of + corresponding weight. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I,J] - value of J-th basis function in I-th point. + CMatrix - a table of constaints, array[0..K-1,0..M]. + I-th row of CMatrix corresponds to I-th linear constraint: + CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] + N - number of points used. N>=1. + M - number of basis functions, M>=1. + K - number of constraints, 0 <= K < M + K=0 corresponds to absence of constraints. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -3 either too many constraints (M or more), + degenerate constraints (some constraints are + repetead twice) or inconsistent constraints were + specified. + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 07.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearwc(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const real_2d_array &cmatrix, const ae_int_t n, const ae_int_t m, const ae_int_t k, ae_int_t &info, real_1d_array &c, lsfitreport &rep); +void lsfitlinearwc(const real_1d_array &y, const real_1d_array &w, const real_2d_array &fmatrix, const real_2d_array &cmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep); + + +/************************************************************************* +Linear least squares fitting. + +QR decomposition is used to reduce task to MxM, then triangular solver or +SVD-based solver is used depending on condition number of the system. It +allows to maximize speed and retain decent accuracy. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I, J] - value of J-th basis function in I-th point. + N - number of points used. N>=1. + M - number of basis functions, M>=1. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * Rep.TaskRCond reciprocal of condition number + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinear(const real_1d_array &y, const real_2d_array &fmatrix, const ae_int_t n, const ae_int_t m, ae_int_t &info, real_1d_array &c, lsfitreport &rep); +void lsfitlinear(const real_1d_array &y, const real_2d_array &fmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep); + + +/************************************************************************* +Constained linear least squares fitting. + +This is variation of LSFitLinear(), which searchs for min|A*x=b| given +that K additional constaints C*x=bc are satisfied. It reduces original +task to modified one: min|B*y-d| WITHOUT constraints, then LSFitLinear() +is called. + +IMPORTANT: if you want to perform polynomial fitting, it may be more + convenient to use PolynomialFit() function. This function gives + best results on polynomial problems and solves numerical + stability issues which arise when you fit high-degree + polynomials to your data. + +INPUT PARAMETERS: + Y - array[0..N-1] Function values in N points. + FMatrix - a table of basis functions values, array[0..N-1, 0..M-1]. + FMatrix[I,J] - value of J-th basis function in I-th point. + CMatrix - a table of constaints, array[0..K-1,0..M]. + I-th row of CMatrix corresponds to I-th linear constraint: + CMatrix[I,0]*C[0] + ... + CMatrix[I,M-1]*C[M-1] = CMatrix[I,M] + N - number of points used. N>=1. + M - number of basis functions, M>=1. + K - number of constraints, 0 <= K < M + K=0 corresponds to absence of constraints. + +OUTPUT PARAMETERS: + Info - error code: + * -4 internal SVD decomposition subroutine failed (very + rare and for degenerate systems only) + * -3 either too many constraints (M or more), + degenerate constraints (some constraints are + repetead twice) or inconsistent constraints were + specified. + * 1 task is solved + C - decomposition coefficients, array[0..M-1] + Rep - fitting report. Following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + +IMPORTANT: + this subroitine doesn't calculate task's condition number for K<>0. + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(F*CovPar*F')), + where F is functions matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 07.09.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitlinearc(const real_1d_array &y, const real_2d_array &fmatrix, const real_2d_array &cmatrix, const ae_int_t n, const ae_int_t m, const ae_int_t k, ae_int_t &info, real_1d_array &c, lsfitreport &rep); +void lsfitlinearc(const real_1d_array &y, const real_2d_array &fmatrix, const real_2d_array &cmatrix, ae_int_t &info, real_1d_array &c, lsfitreport &rep); + + +/************************************************************************* +Weighted nonlinear least squares fitting using function values only. + +Combination of numerical differentiation and secant updates is used to +obtain function Jacobian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]). + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + DiffStep- numerical differentiation step; + should not be very small or large; + large = loss of accuracy + small = growth of round-off errors + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 18.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewf(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const double diffstep, lsfitstate &state); +void lsfitcreatewf(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const double diffstep, lsfitstate &state); + + +/************************************************************************* +Nonlinear least squares fitting using function values only. + +Combination of numerical differentiation and secant updates is used to +obtain function Jacobian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (f(c,x[0])-y[0])^2 + ... + (f(c,x[n-1])-y[n-1])^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]). + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + DiffStep- numerical differentiation step; + should not be very small or large; + large = loss of accuracy + small = growth of round-off errors + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 18.10.2008 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatef(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const double diffstep, lsfitstate &state); +void lsfitcreatef(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const double diffstep, lsfitstate &state); + + +/************************************************************************* +Weighted nonlinear least squares fitting using gradient only. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]) and its gradient. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + CheapFG - boolean flag, which is: + * True if both function and gradient calculation complexity + are less than O(M^2). An improved algorithm can + be used which corresponds to FGJ scheme from + MINLM unit. + * False otherwise. + Standard Jacibian-bases Levenberg-Marquardt algo + will be used (FJ scheme). + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +See also: + LSFitResults + LSFitCreateFG (fitting without weights) + LSFitCreateWFGH (fitting using Hessian) + LSFitCreateFGH (fitting using Hessian, without weights) + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewfg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const bool cheapfg, lsfitstate &state); +void lsfitcreatewfg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const bool cheapfg, lsfitstate &state); + + +/************************************************************************* +Nonlinear least squares fitting using gradient only, without individual +weights. + +Nonlinear task min(F(c)) is solved, where + + F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses only f(c,x[i]) and its gradient. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + CheapFG - boolean flag, which is: + * True if both function and gradient calculation complexity + are less than O(M^2). An improved algorithm can + be used which corresponds to FGJ scheme from + MINLM unit. + * False otherwise. + Standard Jacibian-bases Levenberg-Marquardt algo + will be used (FJ scheme). + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatefg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, const bool cheapfg, lsfitstate &state); +void lsfitcreatefg(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const bool cheapfg, lsfitstate &state); + + +/************************************************************************* +Weighted nonlinear least squares fitting using gradient/Hessian. + +Nonlinear task min(F(c)) is solved, where + + F(c) = (w[0]*(f(c,x[0])-y[0]))^2 + ... + (w[n-1]*(f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * w is an N-dimensional vector of weight coefficients, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses f(c,x[i]), its gradient and its Hessian. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + W - weights, array[0..N-1] + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatewfgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, lsfitstate &state); +void lsfitcreatewfgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &w, const real_1d_array &c, lsfitstate &state); + + +/************************************************************************* +Nonlinear least squares fitting using gradient/Hessian, without individial +weights. + +Nonlinear task min(F(c)) is solved, where + + F(c) = ((f(c,x[0])-y[0]))^2 + ... + ((f(c,x[n-1])-y[n-1]))^2, + + * N is a number of points, + * M is a dimension of a space points belong to, + * K is a dimension of a space of parameters being fitted, + * x is a set of N points, each of them is an M-dimensional vector, + * c is a K-dimensional vector of parameters being fitted + +This subroutine uses f(c,x[i]), its gradient and its Hessian. + +INPUT PARAMETERS: + X - array[0..N-1,0..M-1], points (one row = one point) + Y - array[0..N-1], function values. + C - array[0..K-1], initial approximation to the solution, + N - number of points, N>1 + M - dimension of space + K - number of parameters being fitted + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitcreatefgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, const ae_int_t n, const ae_int_t m, const ae_int_t k, lsfitstate &state); +void lsfitcreatefgh(const real_2d_array &x, const real_1d_array &y, const real_1d_array &c, lsfitstate &state); + + +/************************************************************************* +Stopping conditions for nonlinear least squares fitting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsF - stopping criterion. Algorithm stops if + |F(k+1)-F(k)| <= EpsF*max{|F(k)|, |F(k+1)|, 1} + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by LSFitSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. Only Levenberg-Marquardt + iterations are counted (L-BFGS/CG iterations are NOT + counted because their cost is very low compared to that of + LM). + +NOTE + +Passing EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to automatic +stopping criterion selection (according to the scheme used by MINLM unit). + + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetcond(const lsfitstate &state, const double epsf, const double epsx, const ae_int_t maxits); + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + +NOTE: non-zero StpMax leads to moderate performance degradation because +intermediate step of preconditioned L-BFGS optimization is incompatible +with limits on step size. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetstpmax(const lsfitstate &state, const double stpmax); + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +When reports are needed, State.C (current parameters) and State.F (current +value of fitting function) are reported. + + + -- ALGLIB -- + Copyright 15.08.2010 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetxrep(const lsfitstate &state, const bool needxrep); + + +/************************************************************************* +This function sets scaling coefficients for underlying optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Generally, scale is NOT considered to be a form of preconditioner. But LM +optimizer is unique in that it uses scaling matrix both in the stopping +condition tests and as Marquardt damping factor. + +Proper scaling is very important for the algorithm performance. It is less +important for the quality of results, but still has some influence (it is +easier to converge when variables are properly scaled, so premature +stopping is possible when very badly scalled variables are combined with +relaxed stopping conditions). + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetscale(const lsfitstate &state, const real_1d_array &s); + + +/************************************************************************* +This function sets boundary constraints for underlying optimizer + +Boundary constraints are inactive by default (after initial creation). +They are preserved until explicitly turned off with another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[K]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[K]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + +NOTE 2: unlike other constrained optimization algorithms, this solver has +following useful properties: +* bound constraints are always satisfied exactly +* function is evaluated only INSIDE area specified by bound constraints + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetbc(const lsfitstate &state, const real_1d_array &bndl, const real_1d_array &bndu); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool lsfititeration(const lsfitstate &state); + + +/************************************************************************* +This family of functions is used to launcn iterations of nonlinear fitter + +These functions accept following parameters: + state - algorithm state + func - callback which calculates function (or merit function) + value func at given point x + grad - callback which calculates function (or merit function) + value func and gradient grad at given point x + hess - callback which calculates function (or merit function) + value func, gradient grad and Hessian hess at given point x + rep - optional callback which is called after each iteration + can be NULL + ptr - optional pointer which is passed to func/grad/hess/jac/rep + can be NULL + +NOTES: + +1. this algorithm is somewhat unusual because it works with parameterized + function f(C,X), where X is a function argument (we have many points + which are characterized by different argument values), and C is a + parameter to fit. + + For example, if we want to do linear fit by f(c0,c1,x) = c0*x+c1, then + x will be argument, and {c0,c1} will be parameters. + + It is important to understand that this algorithm finds minimum in the + space of function PARAMETERS (not arguments), so it needs derivatives + of f() with respect to C, not X. + + In the example above it will need f=c0*x+c1 and {df/dc0,df/dc1} = {x,1} + instead of {df/dx} = {c0}. + +2. Callback functions accept C as the first parameter, and X as the second + +3. If state was created with LSFitCreateFG(), algorithm needs just + function and its gradient, but if state was created with + LSFitCreateFGH(), algorithm will need function, gradient and Hessian. + + According to the said above, there ase several versions of this + function, which accept different sets of callbacks. + + This flexibility opens way to subtle errors - you may create state with + LSFitCreateFGH() (optimization using Hessian), but call function which + does not accept Hessian. So when algorithm will request Hessian, there + will be no callback to call. In this case exception will be thrown. + + Be careful to avoid such errors because there is no way to find them at + compile time - you can see them at runtime only. + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey + +*************************************************************************/ +void lsfitfit(lsfitstate &state, + void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), + void (*rep)(const real_1d_array &c, double func, void *ptr) = NULL, + void *ptr = NULL); +void lsfitfit(lsfitstate &state, + void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), + void (*grad)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &c, double func, void *ptr) = NULL, + void *ptr = NULL); +void lsfitfit(lsfitstate &state, + void (*func)(const real_1d_array &c, const real_1d_array &x, double &func, void *ptr), + void (*grad)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*hess)(const real_1d_array &c, const real_1d_array &x, double &func, real_1d_array &grad, real_2d_array &hess, void *ptr), + void (*rep)(const real_1d_array &c, double func, void *ptr) = NULL, + void *ptr = NULL); + + +/************************************************************************* +Nonlinear least squares fitting results. + +Called after return from LSFitFit(). + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + Info - completion code: + * -7 gradient verification failed. + See LSFitSetGradientCheck() for more information. + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + C - array[0..K-1], solution + Rep - optimization report. On success following fields are set: + * R2 non-adjusted coefficient of determination + (non-weighted) + * RMSError rms error on the (X,Y). + * AvgError average error on the (X,Y). + * AvgRelError average relative error on the non-zero Y + * MaxError maximum error + NON-WEIGHTED ERRORS ARE CALCULATED + * WRMSError weighted rms error on the (X,Y). + +ERRORS IN PARAMETERS + +This solver also calculates different kinds of errors in parameters and +fills corresponding fields of report: +* Rep.CovPar covariance matrix for parameters, array[K,K]. +* Rep.ErrPar errors in parameters, array[K], + errpar = sqrt(diag(CovPar)) +* Rep.ErrCurve vector of fit errors - standard deviations of empirical + best-fit curve from "ideal" best-fit curve built with + infinite number of samples, array[N]. + errcurve = sqrt(diag(J*CovPar*J')), + where J is Jacobian matrix. +* Rep.Noise vector of per-point estimates of noise, array[N] + +IMPORTANT: errors in parameters are calculated without taking into + account boundary/linear constraints! Presence of constraints + changes distribution of errors, but there is no easy way to + account for constraints when you calculate covariance matrix. + +NOTE: noise in the data is estimated as follows: + * for fitting without user-supplied weights all points are + assumed to have same level of noise, which is estimated from + the data + * for fitting with user-supplied weights we assume that noise + level in I-th point is inversely proportional to Ith weight. + Coefficient of proportionality is estimated from the data. + +NOTE: we apply small amount of regularization when we invert squared + Jacobian and calculate covariance matrix. It guarantees that + algorithm won't divide by zero during inversion, but skews + error estimates a bit (fractional error is about 10^-9). + + However, we believe that this difference is insignificant for + all practical purposes except for the situation when you want + to compare ALGLIB results with "reference" implementation up + to the last significant digit. + +NOTE: covariance matrix is estimated using correction for degrees + of freedom (covariances are divided by N-M instead of dividing + by N). + + -- ALGLIB -- + Copyright 17.08.2009 by Bochkanov Sergey +*************************************************************************/ +void lsfitresults(const lsfitstate &state, ae_int_t &info, real_1d_array &c, lsfitreport &rep); + + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before fitting begins +* LSFitFit() is called +* prior to actual fitting, for each point in data set X_i and each + component of parameters being fited C_j algorithm performs following + steps: + * two trial steps are made to C_j-TestStep*S[j] and C_j+TestStep*S[j], + where C_j is j-th parameter and S[j] is a scale of j-th parameter + * if needed, steps are bounded with respect to constraints on C[] + * F(X_i|C) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N*K (points count * parameters count) gradient + evaluations. It is very costly and you should use it only for low + dimensional problems, when you want to be sure that you've + correctly calculated analytic derivatives. You should not use it + in the production code (unless you want to check derivatives + provided by some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with LSFitSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +NOTE 4: this function works only for optimizers created with LSFitCreateWFG() + or LSFitCreateFG() constructors. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void lsfitsetgradientcheck(const lsfitstate &state, const double teststep); + +/************************************************************************* +This function builds non-periodic 2-dimensional parametric spline which +starts at (X[0],Y[0]) and ends at (X[N-1],Y[N-1]). + +INPUT PARAMETERS: + XY - points, array[0..N-1,0..1]. + XY[I,0:1] corresponds to the Ith point. + Order of points is important! + N - points count, N>=5 for Akima splines, N>=2 for other types of + splines. + ST - spline type: + * 0 Akima spline + * 1 parabolically terminated Catmull-Rom spline (Tension=0) + * 2 parabolically terminated cubic spline + PT - parameterization type: + * 0 uniform + * 1 chord length + * 2 centripetal + +OUTPUT PARAMETERS: + P - parametric spline interpolant + + +NOTES: +* this function assumes that there all consequent points are distinct. + I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. + However, non-consequent points may coincide, i.e. we can have (x0,y0)= + =(x2,y2). + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2build(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline2interpolant &p); + + +/************************************************************************* +This function builds non-periodic 3-dimensional parametric spline which +starts at (X[0],Y[0],Z[0]) and ends at (X[N-1],Y[N-1],Z[N-1]). + +Same as PSpline2Build() function, but for 3D, so we won't duplicate its +description here. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3build(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline3interpolant &p); + + +/************************************************************************* +This function builds periodic 2-dimensional parametric spline which +starts at (X[0],Y[0]), goes through all points to (X[N-1],Y[N-1]) and then +back to (X[0],Y[0]). + +INPUT PARAMETERS: + XY - points, array[0..N-1,0..1]. + XY[I,0:1] corresponds to the Ith point. + XY[N-1,0:1] must be different from XY[0,0:1]. + Order of points is important! + N - points count, N>=3 for other types of splines. + ST - spline type: + * 1 Catmull-Rom spline (Tension=0) with cyclic boundary conditions + * 2 cubic spline with cyclic boundary conditions + PT - parameterization type: + * 0 uniform + * 1 chord length + * 2 centripetal + +OUTPUT PARAMETERS: + P - parametric spline interpolant + + +NOTES: +* this function assumes that there all consequent points are distinct. + I.e. (x0,y0)<>(x1,y1), (x1,y1)<>(x2,y2), (x2,y2)<>(x3,y3) and so on. + However, non-consequent points may coincide, i.e. we can have (x0,y0)= + =(x2,y2). +* last point of sequence is NOT equal to the first point. You shouldn't + make curve "explicitly periodic" by making them equal. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2buildperiodic(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline2interpolant &p); + + +/************************************************************************* +This function builds periodic 3-dimensional parametric spline which +starts at (X[0],Y[0],Z[0]), goes through all points to (X[N-1],Y[N-1],Z[N-1]) +and then back to (X[0],Y[0],Z[0]). + +Same as PSpline2Build() function, but for 3D, so we won't duplicate its +description here. + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3buildperiodic(const real_2d_array &xy, const ae_int_t n, const ae_int_t st, const ae_int_t pt, pspline3interpolant &p); + + +/************************************************************************* +This function returns vector of parameter values correspoding to points. + +I.e. for P created from (X[0],Y[0])...(X[N-1],Y[N-1]) and U=TValues(P) we +have + (X[0],Y[0]) = PSpline2Calc(P,U[0]), + (X[1],Y[1]) = PSpline2Calc(P,U[1]), + (X[2],Y[2]) = PSpline2Calc(P,U[2]), + ... + +INPUT PARAMETERS: + P - parametric spline interpolant + +OUTPUT PARAMETERS: + N - array size + T - array[0..N-1] + + +NOTES: +* for non-periodic splines U[0]=0, U[0]1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-position + Y - Y-position + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2calc(const pspline2interpolant &p, const double t, double &x, double &y); + + +/************************************************************************* +This function calculates the value of the parametric spline for a given +value of parameter T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-position + Y - Y-position + Z - Z-position + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3calc(const pspline3interpolant &p, const double t, double &x, double &y, double &z); + + +/************************************************************************* +This function calculates tangent vector for a given value of parameter T + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-component of tangent vector (normalized) + Y - Y-component of tangent vector (normalized) + +NOTE: + X^2+Y^2 is either 1 (for non-zero tangent vector) or 0. + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2tangent(const pspline2interpolant &p, const double t, double &x, double &y); + + +/************************************************************************* +This function calculates tangent vector for a given value of parameter T + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-component of tangent vector (normalized) + Y - Y-component of tangent vector (normalized) + Z - Z-component of tangent vector (normalized) + +NOTE: + X^2+Y^2+Z^2 is either 1 (for non-zero tangent vector) or 0. + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3tangent(const pspline3interpolant &p, const double t, double &x, double &y, double &z); + + +/************************************************************************* +This function calculates derivative, i.e. it returns (dX/dT,dY/dT). + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - X-derivative + Y - Y-value + DY - Y-derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2diff(const pspline2interpolant &p, const double t, double &x, double &dx, double &y, double &dy); + + +/************************************************************************* +This function calculates derivative, i.e. it returns (dX/dT,dY/dT,dZ/dT). + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - X-derivative + Y - Y-value + DY - Y-derivative + Z - Z-value + DZ - Z-derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3diff(const pspline3interpolant &p, const double t, double &x, double &dx, double &y, double &dy, double &z, double &dz); + + +/************************************************************************* +This function calculates first and second derivative with respect to T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - derivative + D2X - second derivative + Y - Y-value + DY - derivative + D2Y - second derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline2diff2(const pspline2interpolant &p, const double t, double &x, double &dx, double &d2x, double &y, double &dy, double &d2y); + + +/************************************************************************* +This function calculates first and second derivative with respect to T. + +INPUT PARAMETERS: + P - parametric spline interpolant + T - point: + * T in [0,1] corresponds to interval spanned by points + * for non-periodic splines T<0 (or T>1) correspond to parts of + the curve before the first (after the last) point + * for periodic splines T<0 (or T>1) are projected into [0,1] + by making T=T-floor(T). + +OUTPUT PARAMETERS: + X - X-value + DX - derivative + D2X - second derivative + Y - Y-value + DY - derivative + D2Y - second derivative + Z - Z-value + DZ - derivative + D2Z - second derivative + + + -- ALGLIB PROJECT -- + Copyright 28.05.2010 by Bochkanov Sergey +*************************************************************************/ +void pspline3diff2(const pspline3interpolant &p, const double t, double &x, double &dx, double &d2x, double &y, double &dy, double &d2y, double &z, double &dz, double &d2z); + + +/************************************************************************* +This function calculates arc length, i.e. length of curve between t=a +and t=b. + +INPUT PARAMETERS: + P - parametric spline interpolant + A,B - parameter values corresponding to arc ends: + * B>A will result in positive length returned + * BA will result in positive length returned + * B1) +function in a NX-dimensional space (NX=2 or NX=3). + +Newly created model is empty. It can be used for interpolation right after +creation, but it just returns zeros. You have to add points to the model, +tune interpolation settings, and then call model construction function +RBFBuildModel() which will update model according to your specification. + +USAGE: +1. User creates model with RBFCreate() +2. User adds dataset with RBFSetPoints() (points do NOT have to be on a + regular grid) +3. (OPTIONAL) User chooses polynomial term by calling: + * RBFLinTerm() to set linear term + * RBFConstTerm() to set constant term + * RBFZeroTerm() to set zero term + By default, linear term is used. +4. User chooses specific RBF algorithm to use: either QNN (RBFSetAlgoQNN) + or ML (RBFSetAlgoMultiLayer). +5. User calls RBFBuildModel() function which rebuilds model according to + the specification +6. User may call RBFCalc() to calculate model value at the specified point, + RBFGridCalc() to calculate model values at the points of the regular + grid. User may extract model coefficients with RBFUnpack() call. + +INPUT PARAMETERS: + NX - dimension of the space, NX=2 or NX=3 + NY - function dimension, NY>=1 + +OUTPUT PARAMETERS: + S - RBF model (initially equals to zero) + +NOTE 1: memory requirements. RBF models require amount of memory which is + proportional to the number of data points. Memory is allocated + during model construction, but most of this memory is freed after + model coefficients are calculated. + + Some approximate estimates for N centers with default settings are + given below: + * about 250*N*(sizeof(double)+2*sizeof(int)) bytes of memory is + needed during model construction stage. + * about 15*N*sizeof(double) bytes is needed after model is built. + For example, for N=100000 we may need 0.6 GB of memory to build + model, but just about 0.012 GB to store it. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcreate(const ae_int_t nx, const ae_int_t ny, rbfmodel &s); + + +/************************************************************************* +This function adds dataset. + +This function overrides results of the previous calls, i.e. multiple calls +of this function will result in only the last set being added. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call. + XY - points, array[N,NX+NY]. One row corresponds to one point + in the dataset. First NX elements are coordinates, next + NY elements are function values. Array may be larger than + specific, in this case only leading [N,NX+NY] elements + will be used. + N - number of points in the dataset + +After you've added dataset and (optionally) tuned algorithm settings you +should call RBFBuildModel() in order to build a model for you. + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetpoints(const rbfmodel &s, const real_2d_array &xy, const ae_int_t n); +void rbfsetpoints(const rbfmodel &s, const real_2d_array &xy); + + +/************************************************************************* +This function sets RBF interpolation algorithm. ALGLIB supports several +RBF algorithms with different properties. + +This algorithm is called RBF-QNN and it is good for point sets with +following properties: +a) all points are distinct +b) all points are well separated. +c) points distribution is approximately uniform. There is no "contour + lines", clusters of points, or other small-scale structures. + +Algorithm description: +1) interpolation centers are allocated to data points +2) interpolation radii are calculated as distances to the nearest centers + times Q coefficient (where Q is a value from [0.75,1.50]). +3) after performing (2) radii are transformed in order to avoid situation + when single outlier has very large radius and influences many points + across all dataset. Transformation has following form: + new_r[i] = min(r[i],Z*median(r[])) + where r[i] is I-th radius, median() is a median radius across entire + dataset, Z is user-specified value which controls amount of deviation + from median radius. + +When (a) is violated, we will be unable to build RBF model. When (b) or +(c) are violated, model will be built, but interpolation quality will be +low. See http://www.alglib.net/interpolation/ for more information on this +subject. + +This algorithm is used by default. + +Additional Q parameter controls smoothness properties of the RBF basis: +* Q<0.75 will give perfectly conditioned basis, but terrible smoothness + properties (RBF interpolant will have sharp peaks around function values) +* Q around 1.0 gives good balance between smoothness and condition number +* Q>1.5 will lead to badly conditioned systems and slow convergence of the + underlying linear solver (although smoothness will be very good) +* Q>2.0 will effectively make optimizer useless because it won't converge + within reasonable amount of iterations. It is possible to set such large + Q, but it is advised not to do so. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + Q - Q parameter, Q>0, recommended value - 1.0 + Z - Z parameter, Z>0, recommended value - 5.0 + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetalgoqnn(const rbfmodel &s, const double q, const double z); +void rbfsetalgoqnn(const rbfmodel &s); + + +/************************************************************************* +This function sets RBF interpolation algorithm. ALGLIB supports several +RBF algorithms with different properties. + +This algorithm is called RBF-ML. It builds multilayer RBF model, i.e. +model with subsequently decreasing radii, which allows us to combine +smoothness (due to large radii of the first layers) with exactness (due +to small radii of the last layers) and fast convergence. + +Internally RBF-ML uses many different means of acceleration, from sparse +matrices to KD-trees, which results in algorithm whose working time is +roughly proportional to N*log(N)*Density*RBase^2*NLayers, where N is a +number of points, Density is an average density if points per unit of the +interpolation space, RBase is an initial radius, NLayers is a number of +layers. + +RBF-ML is good for following kinds of interpolation problems: +1. "exact" problems (perfect fit) with well separated points +2. least squares problems with arbitrary distribution of points (algorithm + gives perfect fit where it is possible, and resorts to least squares + fit in the hard areas). +3. noisy problems where we want to apply some controlled amount of + smoothing. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + RBase - RBase parameter, RBase>0 + NLayers - NLayers parameter, NLayers>0, recommended value to start + with - about 5. + LambdaV - regularization value, can be useful when solving problem + in the least squares sense. Optimal lambda is problem- + dependent and require trial and error. In our experience, + good lambda can be as large as 0.1, and you can use 0.001 + as initial guess. + Default value - 0.01, which is used when LambdaV is not + given. You can specify zero value, but it is not + recommended to do so. + +TUNING ALGORITHM + +In order to use this algorithm you have to choose three parameters: +* initial radius RBase +* number of layers in the model NLayers +* regularization coefficient LambdaV + +Initial radius is easy to choose - you can pick any number several times +larger than the average distance between points. Algorithm won't break +down if you choose radius which is too large (model construction time will +increase, but model will be built correctly). + +Choose such number of layers that RLast=RBase/2^(NLayers-1) (radius used +by the last layer) will be smaller than the typical distance between +points. In case model error is too large, you can increase number of +layers. Having more layers will make model construction and evaluation +proportionally slower, but it will allow you to have model which precisely +fits your data. From the other side, if you want to suppress noise, you +can DECREASE number of layers to make your model less flexible. + +Regularization coefficient LambdaV controls smoothness of the individual +models built for each layer. We recommend you to use default value in case +you don't want to tune this parameter, because having non-zero LambdaV +accelerates and stabilizes internal iterative algorithm. In case you want +to suppress noise you can use LambdaV as additional parameter (larger +value = more smoothness) to tune. + +TYPICAL ERRORS + +1. Using initial radius which is too large. Memory requirements of the + RBF-ML are roughly proportional to N*Density*RBase^2 (where Density is + an average density of points per unit of the interpolation space). In + the extreme case of the very large RBase we will need O(N^2) units of + memory - and many layers in order to decrease radius to some reasonably + small value. + +2. Using too small number of layers - RBF models with large radius are not + flexible enough to reproduce small variations in the target function. + You need many layers with different radii, from large to small, in + order to have good model. + +3. Using initial radius which is too small. You will get model with + "holes" in the areas which are too far away from interpolation centers. + However, algorithm will work correctly (and quickly) in this case. + +4. Using too many layers - you will get too large and too slow model. This + model will perfectly reproduce your function, but maybe you will be + able to achieve similar results with less layers (and less memory). + + -- ALGLIB -- + Copyright 02.03.2012 by Bochkanov Sergey +*************************************************************************/ +void rbfsetalgomultilayer(const rbfmodel &s, const double rbase, const ae_int_t nlayers, const double lambdav); +void rbfsetalgomultilayer(const rbfmodel &s, const double rbase, const ae_int_t nlayers); + + +/************************************************************************* +This function sets linear term (model is a sum of radial basis functions +plus linear polynomial). This function won't have effect until next call +to RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetlinterm(const rbfmodel &s); + + +/************************************************************************* +This function sets constant term (model is a sum of radial basis functions +plus constant). This function won't have effect until next call to +RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetconstterm(const rbfmodel &s); + + +/************************************************************************* +This function sets zero term (model is a sum of radial basis functions +without polynomial term). This function won't have effect until next call +to RBFBuildModel(). + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + +NOTE: this function has some serialization-related subtleties. We + recommend you to study serialization examples from ALGLIB Reference + Manual if you want to perform serialization of your models. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfsetzeroterm(const rbfmodel &s); + + +/************************************************************************* +This function builds RBF model and returns report (contains some +information which can be used for evaluation of the algorithm properties). + +Call to this function modifies RBF model by calculating its centers/radii/ +weights and saving them into RBFModel structure. Initially RBFModel +contain zero coefficients, but after call to this function we will have +coefficients which were calculated in order to fit our dataset. + +After you called this function you can call RBFCalc(), RBFGridCalc() and +other model calculation functions. + +INPUT PARAMETERS: + S - RBF model, initialized by RBFCreate() call + Rep - report: + * Rep.TerminationType: + * -5 - non-distinct basis function centers were detected, + interpolation aborted + * -4 - nonconvergence of the internal SVD solver + * 1 - successful termination + Fields are used for debugging purposes: + * Rep.IterationsCount - iterations count of the LSQR solver + * Rep.NMV - number of matrix-vector products + * Rep.ARows - rows count for the system matrix + * Rep.ACols - columns count for the system matrix + * Rep.ANNZ - number of significantly non-zero elements + (elements above some algorithm-determined threshold) + +NOTE: failure to build model will leave current state of the structure +unchanged. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfbuildmodel(const rbfmodel &s, rbfreport &rep); + + +/************************************************************************* +This function calculates values of the RBF model in the given point. + +This function should be used when we have NY=1 (scalar function) and NX=2 +(2-dimensional space). If you have 3-dimensional space, use RBFCalc3(). If +you have general situation (NX-dimensional space, NY-dimensional function) +you should use general, less efficient implementation RBFCalc(). + +If you want to calculate function values many times, consider using +RBFGridCalc2(), which is far more efficient than many subsequent calls to +RBFCalc2(). + +This function returns 0.0 when: +* model is not initialized +* NX<>2 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - first coordinate, finite number + X1 - second coordinate, finite number + +RESULT: + value of the model or 0.0 (as defined above) + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +double rbfcalc2(const rbfmodel &s, const double x0, const double x1); + + +/************************************************************************* +This function calculates values of the RBF model in the given point. + +This function should be used when we have NY=1 (scalar function) and NX=3 +(3-dimensional space). If you have 2-dimensional space, use RBFCalc2(). If +you have general situation (NX-dimensional space, NY-dimensional function) +you should use general, less efficient implementation RBFCalc(). + +This function returns 0.0 when: +* model is not initialized +* NX<>3 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - first coordinate, finite number + X1 - second coordinate, finite number + X2 - third coordinate, finite number + +RESULT: + value of the model or 0.0 (as defined above) + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +double rbfcalc3(const rbfmodel &s, const double x0, const double x1, const double x2); + + +/************************************************************************* +This function calculates values of the RBF model at the given point. + +This is general function which can be used for arbitrary NX (dimension of +the space of arguments) and NY (dimension of the function itself). However +when you have NY=1 you may find more convenient to use RBFCalc2() or +RBFCalc3(). + +This function returns 0.0 when model is not initialized. + +INPUT PARAMETERS: + S - RBF model + X - coordinates, array[NX]. + X may have more than NX elements, in this case only + leading NX will be used. + +OUTPUT PARAMETERS: + Y - function value, array[NY]. Y is out-parameter and + reallocated after call to this function. In case you want + to reuse previously allocated Y, you may use RBFCalcBuf(), + which reallocates Y only when it is too small. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcalc(const rbfmodel &s, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +This function calculates values of the RBF model at the given point. + +Same as RBFCalc(), but does not reallocate Y when in is large enough to +store function values. + +INPUT PARAMETERS: + S - RBF model + X - coordinates, array[NX]. + X may have more than NX elements, in this case only + leading NX will be used. + Y - possibly preallocated array + +OUTPUT PARAMETERS: + Y - function value, array[NY]. Y is not reallocated when it + is larger than NY. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfcalcbuf(const rbfmodel &s, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +This function calculates values of the RBF model at the regular grid. + +Grid have N0*N1 points, with Point[I,J] = (X0[I], X1[J]) + +This function returns 0.0 when: +* model is not initialized +* NX<>2 + *NY<>1 + +INPUT PARAMETERS: + S - RBF model + X0 - array of grid nodes, first coordinates, array[N0] + N0 - grid size (number of nodes) in the first dimension + X1 - array of grid nodes, second coordinates, array[N1] + N1 - grid size (number of nodes) in the second dimension + +OUTPUT PARAMETERS: + Y - function values, array[N0,N1]. Y is out-variable and + is reallocated by this function. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfgridcalc2(const rbfmodel &s, const real_1d_array &x0, const ae_int_t n0, const real_1d_array &x1, const ae_int_t n1, real_2d_array &y); + + +/************************************************************************* +This function "unpacks" RBF model by extracting its coefficients. + +INPUT PARAMETERS: + S - RBF model + +OUTPUT PARAMETERS: + NX - dimensionality of argument + NY - dimensionality of the target function + XWR - model information, array[NC,NX+NY+1]. + One row of the array corresponds to one basis function: + * first NX columns - coordinates of the center + * next NY columns - weights, one per dimension of the + function being modelled + * last column - radius, same for all dimensions of + the function being modelled + NC - number of the centers + V - polynomial term , array[NY,NX+1]. One row per one + dimension of the function being modelled. First NX + elements are linear coefficients, V[NX] is equal to the + constant part. + + -- ALGLIB -- + Copyright 13.12.2011 by Bochkanov Sergey +*************************************************************************/ +void rbfunpack(const rbfmodel &s, ae_int_t &nx, ae_int_t &ny, real_2d_array &xwr, ae_int_t &nc, real_2d_array &v); + +/************************************************************************* +This subroutine calculates the value of the bilinear or bicubic spline at +the given point X. + +Input parameters: + C - coefficients table. + Built by BuildBilinearSpline or BuildBicubicSpline. + X, Y- point + +Result: + S(x,y) + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +double spline2dcalc(const spline2dinterpolant &c, const double x, const double y); + + +/************************************************************************* +This subroutine calculates the value of the bilinear or bicubic spline at +the given point X and its derivatives. + +Input parameters: + C - spline interpolant. + X, Y- point + +Output parameters: + F - S(x,y) + FX - dS(x,y)/dX + FY - dS(x,y)/dY + FXY - d2S(x,y)/dXdY + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2ddiff(const spline2dinterpolant &c, const double x, const double y, double &f, double &fx, double &fy, double &fxy); + + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +Input parameters: + C - spline interpolant + AX, BX - transformation coefficients: x = A*t + B + AY, BY - transformation coefficients: y = A*u + B +Result: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dlintransxy(const spline2dinterpolant &c, const double ax, const double bx, const double ay, const double by); + + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +Input parameters: + C - spline interpolant. + A, B- transformation coefficients: S2(x,y) = A*S(x,y) + B + +Output parameters: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 30.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dlintransf(const spline2dinterpolant &c, const double a, const double b); + + +/************************************************************************* +This subroutine makes the copy of the spline model. + +Input parameters: + C - spline interpolant + +Output parameters: + CC - spline copy + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dcopy(const spline2dinterpolant &c, spline2dinterpolant &cc); + + +/************************************************************************* +Bicubic spline resampling + +Input parameters: + A - function values at the old grid, + array[0..OldHeight-1, 0..OldWidth-1] + OldHeight - old grid height, OldHeight>1 + OldWidth - old grid width, OldWidth>1 + NewHeight - new grid height, NewHeight>1 + NewWidth - new grid width, NewWidth>1 + +Output parameters: + B - function values at the new grid, + array[0..NewHeight-1, 0..NewWidth-1] + + -- ALGLIB routine -- + 15 May, 2007 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline2dresamplebicubic(const real_2d_array &a, const ae_int_t oldheight, const ae_int_t oldwidth, real_2d_array &b, const ae_int_t newheight, const ae_int_t newwidth); + + +/************************************************************************* +Bilinear spline resampling + +Input parameters: + A - function values at the old grid, + array[0..OldHeight-1, 0..OldWidth-1] + OldHeight - old grid height, OldHeight>1 + OldWidth - old grid width, OldWidth>1 + NewHeight - new grid height, NewHeight>1 + NewWidth - new grid width, NewWidth>1 + +Output parameters: + B - function values at the new grid, + array[0..NewHeight-1, 0..NewWidth-1] + + -- ALGLIB routine -- + 09.07.2007 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline2dresamplebilinear(const real_2d_array &a, const ae_int_t oldheight, const ae_int_t oldwidth, real_2d_array &b, const ae_int_t newheight, const ae_int_t newwidth); + + +/************************************************************************* +This subroutine builds bilinear vector-valued spline. + +Input parameters: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + F - function values, array[0..M*N*D-1]: + * first D elements store D values at (X[0],Y[0]) + * next D elements store D values at (X[1],Y[0]) + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(J*N+I)...D*(J*N+I)+D-1]. + M,N - grid size, M>=2, N>=2 + D - vector dimension, D>=1 + +Output parameters: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbilinearv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &f, const ae_int_t d, spline2dinterpolant &c); + + +/************************************************************************* +This subroutine builds bicubic vector-valued spline. + +Input parameters: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + F - function values, array[0..M*N*D-1]: + * first D elements store D values at (X[0],Y[0]) + * next D elements store D values at (X[1],Y[0]) + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(J*N+I)...D*(J*N+I)+D-1]. + M,N - grid size, M>=2, N>=2 + D - vector dimension, D>=1 + +Output parameters: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbicubicv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &f, const ae_int_t d, spline2dinterpolant &c); + + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y- point + F - output buffer, possibly preallocated array. In case array size + is large enough to store result, it is not reallocated. Array + which is too short will be reallocated + +OUTPUT PARAMETERS: + F - array[D] (or larger) which stores function values + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dcalcvbuf(const spline2dinterpolant &c, const double x, const double y, real_1d_array &f); + + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y- point + +OUTPUT PARAMETERS: + F - array[D] which stores function values. F is out-parameter and + it is reallocated after call to this function. In case you + want to reuse previously allocated F, you may use + Spline2DCalcVBuf(), which reallocates F only when it is too + small. + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dcalcv(const spline2dinterpolant &c, const double x, const double y, real_1d_array &f); + + +/************************************************************************* +This subroutine unpacks two-dimensional spline into the coefficients table + +Input parameters: + C - spline interpolant. + +Result: + M, N- grid size (x-axis and y-axis) + D - number of components + Tbl - coefficients table, unpacked format, + D - components: [0..(N-1)*(M-1)*D-1, 0..19]. + For T=0..D-1 (component index), I = 0...N-2 (x index), + J=0..M-2 (y index): + K := T + I*D + J*D*(N-1) + + K-th row stores decomposition for T-th component of the + vector-valued function + + Tbl[K,0] = X[i] + Tbl[K,1] = X[i+1] + Tbl[K,2] = Y[j] + Tbl[K,3] = Y[j+1] + Tbl[K,4] = C00 + Tbl[K,5] = C01 + Tbl[K,6] = C02 + Tbl[K,7] = C03 + Tbl[K,8] = C10 + Tbl[K,9] = C11 + ... + Tbl[K,19] = C33 + On each grid square spline is equals to: + S(x) = SUM(c[i,j]*(t^i)*(u^j), i=0..3, j=0..3) + t = x-x[j] + u = y-y[i] + + -- ALGLIB PROJECT -- + Copyright 16.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline2dunpackv(const spline2dinterpolant &c, ae_int_t &m, ae_int_t &n, ae_int_t &d, real_2d_array &tbl); + + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DBuildBilinearV(), which is more +flexible and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbilinear(const real_1d_array &x, const real_1d_array &y, const real_2d_array &f, const ae_int_t m, const ae_int_t n, spline2dinterpolant &c); + + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DBuildBicubicV(), which is more +flexible and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 05.07.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dbuildbicubic(const real_1d_array &x, const real_1d_array &y, const real_2d_array &f, const ae_int_t m, const ae_int_t n, spline2dinterpolant &c); + + +/************************************************************************* +This subroutine was deprecated in ALGLIB 3.6.0 + +We recommend you to switch to Spline2DUnpackV(), which is more flexible +and accepts its arguments in more convenient order. + + -- ALGLIB PROJECT -- + Copyright 29.06.2007 by Bochkanov Sergey +*************************************************************************/ +void spline2dunpack(const spline2dinterpolant &c, ae_int_t &m, ae_int_t &n, real_2d_array &tbl); + +/************************************************************************* +This subroutine calculates the value of the trilinear or tricubic spline at +the given point (X,Y,Z). + +INPUT PARAMETERS: + C - coefficients table. + Built by BuildBilinearSpline or BuildBicubicSpline. + X, Y, + Z - point + +Result: + S(x,y,z) + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +double spline3dcalc(const spline3dinterpolant &c, const double x, const double y, const double z); + + +/************************************************************************* +This subroutine performs linear transformation of the spline argument. + +INPUT PARAMETERS: + C - spline interpolant + AX, BX - transformation coefficients: x = A*u + B + AY, BY - transformation coefficients: y = A*v + B + AZ, BZ - transformation coefficients: z = A*w + B + +OUTPUT PARAMETERS: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dlintransxyz(const spline3dinterpolant &c, const double ax, const double bx, const double ay, const double by, const double az, const double bz); + + +/************************************************************************* +This subroutine performs linear transformation of the spline. + +INPUT PARAMETERS: + C - spline interpolant. + A, B- transformation coefficients: S2(x,y) = A*S(x,y,z) + B + +OUTPUT PARAMETERS: + C - transformed spline + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dlintransf(const spline3dinterpolant &c, const double a, const double b); + + +/************************************************************************* +Trilinear spline resampling + +INPUT PARAMETERS: + A - array[0..OldXCount*OldYCount*OldZCount-1], function + values at the old grid, : + A[0] x=0,y=0,z=0 + A[1] x=1,y=0,z=0 + A[..] ... + A[..] x=oldxcount-1,y=0,z=0 + A[..] x=0,y=1,z=0 + A[..] ... + ... + OldZCount - old Z-count, OldZCount>1 + OldYCount - old Y-count, OldYCount>1 + OldXCount - old X-count, OldXCount>1 + NewZCount - new Z-count, NewZCount>1 + NewYCount - new Y-count, NewYCount>1 + NewXCount - new X-count, NewXCount>1 + +OUTPUT PARAMETERS: + B - array[0..NewXCount*NewYCount*NewZCount-1], function + values at the new grid: + B[0] x=0,y=0,z=0 + B[1] x=1,y=0,z=0 + B[..] ... + B[..] x=newxcount-1,y=0,z=0 + B[..] x=0,y=1,z=0 + B[..] ... + ... + + -- ALGLIB routine -- + 26.04.2012 + Copyright by Bochkanov Sergey +*************************************************************************/ +void spline3dresampletrilinear(const real_1d_array &a, const ae_int_t oldzcount, const ae_int_t oldycount, const ae_int_t oldxcount, const ae_int_t newzcount, const ae_int_t newycount, const ae_int_t newxcount, real_1d_array &b); + + +/************************************************************************* +This subroutine builds trilinear vector-valued spline. + +INPUT PARAMETERS: + X - spline abscissas, array[0..N-1] + Y - spline ordinates, array[0..M-1] + Z - spline applicates, array[0..L-1] + F - function values, array[0..M*N*L*D-1]: + * first D elements store D values at (X[0],Y[0],Z[0]) + * next D elements store D values at (X[1],Y[0],Z[0]) + * next D elements store D values at (X[2],Y[0],Z[0]) + * ... + * next D elements store D values at (X[0],Y[1],Z[0]) + * next D elements store D values at (X[1],Y[1],Z[0]) + * next D elements store D values at (X[2],Y[1],Z[0]) + * ... + * next D elements store D values at (X[0],Y[0],Z[1]) + * next D elements store D values at (X[1],Y[0],Z[1]) + * next D elements store D values at (X[2],Y[0],Z[1]) + * ... + * general form - D function values at (X[i],Y[j]) are stored + at F[D*(N*(M*K+J)+I)...D*(N*(M*K+J)+I)+D-1]. + M,N, + L - grid size, M>=2, N>=2, L>=2 + D - vector dimension, D>=1 + +OUTPUT PARAMETERS: + C - spline interpolant + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dbuildtrilinearv(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, const real_1d_array &z, const ae_int_t l, const real_1d_array &f, const ae_int_t d, spline3dinterpolant &c); + + +/************************************************************************* +This subroutine calculates bilinear or bicubic vector-valued spline at the +given point (X,Y,Z). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y, + Z - point + F - output buffer, possibly preallocated array. In case array size + is large enough to store result, it is not reallocated. Array + which is too short will be reallocated + +OUTPUT PARAMETERS: + F - array[D] (or larger) which stores function values + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dcalcvbuf(const spline3dinterpolant &c, const double x, const double y, const double z, real_1d_array &f); + + +/************************************************************************* +This subroutine calculates trilinear or tricubic vector-valued spline at the +given point (X,Y,Z). + +INPUT PARAMETERS: + C - spline interpolant. + X, Y, + Z - point + +OUTPUT PARAMETERS: + F - array[D] which stores function values. F is out-parameter and + it is reallocated after call to this function. In case you + want to reuse previously allocated F, you may use + Spline2DCalcVBuf(), which reallocates F only when it is too + small. + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dcalcv(const spline3dinterpolant &c, const double x, const double y, const double z, real_1d_array &f); + + +/************************************************************************* +This subroutine unpacks tri-dimensional spline into the coefficients table + +INPUT PARAMETERS: + C - spline interpolant. + +Result: + N - grid size (X) + M - grid size (Y) + L - grid size (Z) + D - number of components + SType- spline type. Currently, only one spline type is supported: + trilinear spline, as indicated by SType=1. + Tbl - spline coefficients: [0..(N-1)*(M-1)*(L-1)*D-1, 0..13]. + For T=0..D-1 (component index), I = 0...N-2 (x index), + J=0..M-2 (y index), K=0..L-2 (z index): + Q := T + I*D + J*D*(N-1) + K*D*(N-1)*(M-1), + + Q-th row stores decomposition for T-th component of the + vector-valued function + + Tbl[Q,0] = X[i] + Tbl[Q,1] = X[i+1] + Tbl[Q,2] = Y[j] + Tbl[Q,3] = Y[j+1] + Tbl[Q,4] = Z[k] + Tbl[Q,5] = Z[k+1] + + Tbl[Q,6] = C000 + Tbl[Q,7] = C100 + Tbl[Q,8] = C010 + Tbl[Q,9] = C110 + Tbl[Q,10]= C001 + Tbl[Q,11]= C101 + Tbl[Q,12]= C011 + Tbl[Q,13]= C111 + On each grid square spline is equals to: + S(x) = SUM(c[i,j,k]*(x^i)*(y^j)*(z^k), i=0..1, j=0..1, k=0..1) + t = x-x[j] + u = y-y[i] + v = z-z[k] + + NOTE: format of Tbl is given for SType=1. Future versions of + ALGLIB can use different formats for different values of + SType. + + -- ALGLIB PROJECT -- + Copyright 26.04.2012 by Bochkanov Sergey +*************************************************************************/ +void spline3dunpackv(const spline3dinterpolant &c, ae_int_t &n, ae_int_t &m, ae_int_t &l, ae_int_t &d, ae_int_t &stype, real_2d_array &tbl); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +double idwcalc(idwinterpolant* z, + /* Real */ ae_vector* x, + ae_state *_state); +void idwbuildmodifiedshepard(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t nx, + ae_int_t d, + ae_int_t nq, + ae_int_t nw, + idwinterpolant* z, + ae_state *_state); +void idwbuildmodifiedshepardr(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t nx, + double r, + idwinterpolant* z, + ae_state *_state); +void idwbuildnoisy(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t nx, + ae_int_t d, + ae_int_t nq, + ae_int_t nw, + idwinterpolant* z, + ae_state *_state); +ae_bool _idwinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _idwinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _idwinterpolant_clear(void* _p); +void _idwinterpolant_destroy(void* _p); +double barycentriccalc(barycentricinterpolant* b, + double t, + ae_state *_state); +void barycentricdiff1(barycentricinterpolant* b, + double t, + double* f, + double* df, + ae_state *_state); +void barycentricdiff2(barycentricinterpolant* b, + double t, + double* f, + double* df, + double* d2f, + ae_state *_state); +void barycentriclintransx(barycentricinterpolant* b, + double ca, + double cb, + ae_state *_state); +void barycentriclintransy(barycentricinterpolant* b, + double ca, + double cb, + ae_state *_state); +void barycentricunpack(barycentricinterpolant* b, + ae_int_t* n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_state *_state); +void barycentricbuildxyw(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + barycentricinterpolant* b, + ae_state *_state); +void barycentricbuildfloaterhormann(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t d, + barycentricinterpolant* b, + ae_state *_state); +void barycentriccopy(barycentricinterpolant* b, + barycentricinterpolant* b2, + ae_state *_state); +ae_bool _barycentricinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _barycentricinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _barycentricinterpolant_clear(void* _p); +void _barycentricinterpolant_destroy(void* _p); +void polynomialbar2cheb(barycentricinterpolant* p, + double a, + double b, + /* Real */ ae_vector* t, + ae_state *_state); +void polynomialcheb2bar(/* Real */ ae_vector* t, + ae_int_t n, + double a, + double b, + barycentricinterpolant* p, + ae_state *_state); +void polynomialbar2pow(barycentricinterpolant* p, + double c, + double s, + /* Real */ ae_vector* a, + ae_state *_state); +void polynomialpow2bar(/* Real */ ae_vector* a, + ae_int_t n, + double c, + double s, + barycentricinterpolant* p, + ae_state *_state); +void polynomialbuild(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + barycentricinterpolant* p, + ae_state *_state); +void polynomialbuildeqdist(double a, + double b, + /* Real */ ae_vector* y, + ae_int_t n, + barycentricinterpolant* p, + ae_state *_state); +void polynomialbuildcheb1(double a, + double b, + /* Real */ ae_vector* y, + ae_int_t n, + barycentricinterpolant* p, + ae_state *_state); +void polynomialbuildcheb2(double a, + double b, + /* Real */ ae_vector* y, + ae_int_t n, + barycentricinterpolant* p, + ae_state *_state); +double polynomialcalceqdist(double a, + double b, + /* Real */ ae_vector* f, + ae_int_t n, + double t, + ae_state *_state); +double polynomialcalccheb1(double a, + double b, + /* Real */ ae_vector* f, + ae_int_t n, + double t, + ae_state *_state); +double polynomialcalccheb2(double a, + double b, + /* Real */ ae_vector* f, + ae_int_t n, + double t, + ae_state *_state); +void spline1dbuildlinear(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + spline1dinterpolant* c, + ae_state *_state); +void spline1dbuildcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + spline1dinterpolant* c, + ae_state *_state); +void spline1dgriddiffcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* d, + ae_state *_state); +void spline1dgriddiff2cubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* d1, + /* Real */ ae_vector* d2, + ae_state *_state); +void spline1dconvcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* x2, + ae_int_t n2, + /* Real */ ae_vector* y2, + ae_state *_state); +void spline1dconvdiffcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* x2, + ae_int_t n2, + /* Real */ ae_vector* y2, + /* Real */ ae_vector* d2, + ae_state *_state); +void spline1dconvdiff2cubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundltype, + double boundl, + ae_int_t boundrtype, + double boundr, + /* Real */ ae_vector* x2, + ae_int_t n2, + /* Real */ ae_vector* y2, + /* Real */ ae_vector* d2, + /* Real */ ae_vector* dd2, + ae_state *_state); +void spline1dbuildcatmullrom(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t boundtype, + double tension, + spline1dinterpolant* c, + ae_state *_state); +void spline1dbuildhermite(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* d, + ae_int_t n, + spline1dinterpolant* c, + ae_state *_state); +void spline1dbuildakima(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + spline1dinterpolant* c, + ae_state *_state); +double spline1dcalc(spline1dinterpolant* c, double x, ae_state *_state); +void spline1ddiff(spline1dinterpolant* c, + double x, + double* s, + double* ds, + double* d2s, + ae_state *_state); +void spline1dcopy(spline1dinterpolant* c, + spline1dinterpolant* cc, + ae_state *_state); +void spline1dunpack(spline1dinterpolant* c, + ae_int_t* n, + /* Real */ ae_matrix* tbl, + ae_state *_state); +void spline1dlintransx(spline1dinterpolant* c, + double a, + double b, + ae_state *_state); +void spline1dlintransy(spline1dinterpolant* c, + double a, + double b, + ae_state *_state); +double spline1dintegrate(spline1dinterpolant* c, + double x, + ae_state *_state); +void spline1dconvdiffinternal(/* Real */ ae_vector* xold, + /* Real */ ae_vector* yold, + /* Real */ ae_vector* dold, + ae_int_t n, + /* Real */ ae_vector* x2, + ae_int_t n2, + /* Real */ ae_vector* y, + ae_bool needy, + /* Real */ ae_vector* d1, + ae_bool needd1, + /* Real */ ae_vector* d2, + ae_bool needd2, + ae_state *_state); +void spline1drootsandextrema(spline1dinterpolant* c, + /* Real */ ae_vector* r, + ae_int_t* nr, + ae_bool* dr, + /* Real */ ae_vector* e, + /* Integer */ ae_vector* et, + ae_int_t* ne, + ae_bool* de, + ae_state *_state); +void heapsortdpoints(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* d, + ae_int_t n, + ae_state *_state); +void solvepolinom2(double p0, + double m0, + double p1, + double m1, + double* x0, + double* x1, + ae_int_t* nr, + ae_state *_state); +void solvecubicpolinom(double pa, + double ma, + double pb, + double mb, + double a, + double b, + double* x0, + double* x1, + double* x2, + double* ex0, + double* ex1, + ae_int_t* nr, + ae_int_t* ne, + /* Real */ ae_vector* tempdata, + ae_state *_state); +ae_int_t bisectmethod(double pa, + double ma, + double pb, + double mb, + double a, + double b, + double* x, + ae_state *_state); +void spline1dbuildmonotone(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + spline1dinterpolant* c, + ae_state *_state); +ae_bool _spline1dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _spline1dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _spline1dinterpolant_clear(void* _p); +void _spline1dinterpolant_destroy(void* _p); +void polynomialfit(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + barycentricinterpolant* p, + polynomialfitreport* rep, + ae_state *_state); +void polynomialfitwc(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + barycentricinterpolant* p, + polynomialfitreport* rep, + ae_state *_state); +void barycentricfitfloaterhormannwc(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + barycentricinterpolant* b, + barycentricfitreport* rep, + ae_state *_state); +void barycentricfitfloaterhormann(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + barycentricinterpolant* b, + barycentricfitreport* rep, + ae_state *_state); +void spline1dfitpenalized(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + double rho, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state); +void spline1dfitpenalizedw(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + ae_int_t m, + double rho, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state); +void spline1dfitcubicwc(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state); +void spline1dfithermitewc(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state); +void spline1dfitcubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state); +void spline1dfithermite(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + spline1dinterpolant* s, + spline1dfitreport* rep, + ae_state *_state); +void lsfitlinearw(/* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* fmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state); +void lsfitlinearwc(/* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* fmatrix, + /* Real */ ae_matrix* cmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t k, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state); +void lsfitlinear(/* Real */ ae_vector* y, + /* Real */ ae_matrix* fmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state); +void lsfitlinearc(/* Real */ ae_vector* y, + /* Real */ ae_matrix* fmatrix, + /* Real */ ae_matrix* cmatrix, + ae_int_t n, + ae_int_t m, + ae_int_t k, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state); +void lsfitcreatewf(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + double diffstep, + lsfitstate* state, + ae_state *_state); +void lsfitcreatef(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + double diffstep, + lsfitstate* state, + ae_state *_state); +void lsfitcreatewfg(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + ae_bool cheapfg, + lsfitstate* state, + ae_state *_state); +void lsfitcreatefg(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + ae_bool cheapfg, + lsfitstate* state, + ae_state *_state); +void lsfitcreatewfgh(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + lsfitstate* state, + ae_state *_state); +void lsfitcreatefgh(/* Real */ ae_matrix* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* c, + ae_int_t n, + ae_int_t m, + ae_int_t k, + lsfitstate* state, + ae_state *_state); +void lsfitsetcond(lsfitstate* state, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state); +void lsfitsetstpmax(lsfitstate* state, double stpmax, ae_state *_state); +void lsfitsetxrep(lsfitstate* state, ae_bool needxrep, ae_state *_state); +void lsfitsetscale(lsfitstate* state, + /* Real */ ae_vector* s, + ae_state *_state); +void lsfitsetbc(lsfitstate* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state); +ae_bool lsfititeration(lsfitstate* state, ae_state *_state); +void lsfitresults(lsfitstate* state, + ae_int_t* info, + /* Real */ ae_vector* c, + lsfitreport* rep, + ae_state *_state); +void lsfitsetgradientcheck(lsfitstate* state, + double teststep, + ae_state *_state); +void lsfitscalexy(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* w, + ae_int_t n, + /* Real */ ae_vector* xc, + /* Real */ ae_vector* yc, + /* Integer */ ae_vector* dc, + ae_int_t k, + double* xa, + double* xb, + double* sa, + double* sb, + /* Real */ ae_vector* xoriginal, + /* Real */ ae_vector* yoriginal, + ae_state *_state); +ae_bool _polynomialfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _polynomialfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _polynomialfitreport_clear(void* _p); +void _polynomialfitreport_destroy(void* _p); +ae_bool _barycentricfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _barycentricfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _barycentricfitreport_clear(void* _p); +void _barycentricfitreport_destroy(void* _p); +ae_bool _spline1dfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _spline1dfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _spline1dfitreport_clear(void* _p); +void _spline1dfitreport_destroy(void* _p); +ae_bool _lsfitreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _lsfitreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _lsfitreport_clear(void* _p); +void _lsfitreport_destroy(void* _p); +ae_bool _lsfitstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _lsfitstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _lsfitstate_clear(void* _p); +void _lsfitstate_destroy(void* _p); +void pspline2build(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t st, + ae_int_t pt, + pspline2interpolant* p, + ae_state *_state); +void pspline3build(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t st, + ae_int_t pt, + pspline3interpolant* p, + ae_state *_state); +void pspline2buildperiodic(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t st, + ae_int_t pt, + pspline2interpolant* p, + ae_state *_state); +void pspline3buildperiodic(/* Real */ ae_matrix* xy, + ae_int_t n, + ae_int_t st, + ae_int_t pt, + pspline3interpolant* p, + ae_state *_state); +void pspline2parametervalues(pspline2interpolant* p, + ae_int_t* n, + /* Real */ ae_vector* t, + ae_state *_state); +void pspline3parametervalues(pspline3interpolant* p, + ae_int_t* n, + /* Real */ ae_vector* t, + ae_state *_state); +void pspline2calc(pspline2interpolant* p, + double t, + double* x, + double* y, + ae_state *_state); +void pspline3calc(pspline3interpolant* p, + double t, + double* x, + double* y, + double* z, + ae_state *_state); +void pspline2tangent(pspline2interpolant* p, + double t, + double* x, + double* y, + ae_state *_state); +void pspline3tangent(pspline3interpolant* p, + double t, + double* x, + double* y, + double* z, + ae_state *_state); +void pspline2diff(pspline2interpolant* p, + double t, + double* x, + double* dx, + double* y, + double* dy, + ae_state *_state); +void pspline3diff(pspline3interpolant* p, + double t, + double* x, + double* dx, + double* y, + double* dy, + double* z, + double* dz, + ae_state *_state); +void pspline2diff2(pspline2interpolant* p, + double t, + double* x, + double* dx, + double* d2x, + double* y, + double* dy, + double* d2y, + ae_state *_state); +void pspline3diff2(pspline3interpolant* p, + double t, + double* x, + double* dx, + double* d2x, + double* y, + double* dy, + double* d2y, + double* z, + double* dz, + double* d2z, + ae_state *_state); +double pspline2arclength(pspline2interpolant* p, + double a, + double b, + ae_state *_state); +double pspline3arclength(pspline3interpolant* p, + double a, + double b, + ae_state *_state); +ae_bool _pspline2interpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _pspline2interpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _pspline2interpolant_clear(void* _p); +void _pspline2interpolant_destroy(void* _p); +ae_bool _pspline3interpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _pspline3interpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _pspline3interpolant_clear(void* _p); +void _pspline3interpolant_destroy(void* _p); +void rbfcreate(ae_int_t nx, ae_int_t ny, rbfmodel* s, ae_state *_state); +void rbfsetpoints(rbfmodel* s, + /* Real */ ae_matrix* xy, + ae_int_t n, + ae_state *_state); +void rbfsetalgoqnn(rbfmodel* s, double q, double z, ae_state *_state); +void rbfsetalgomultilayer(rbfmodel* s, + double rbase, + ae_int_t nlayers, + double lambdav, + ae_state *_state); +void rbfsetlinterm(rbfmodel* s, ae_state *_state); +void rbfsetconstterm(rbfmodel* s, ae_state *_state); +void rbfsetzeroterm(rbfmodel* s, ae_state *_state); +void rbfsetcond(rbfmodel* s, + double epsort, + double epserr, + ae_int_t maxits, + ae_state *_state); +void rbfbuildmodel(rbfmodel* s, rbfreport* rep, ae_state *_state); +double rbfcalc2(rbfmodel* s, double x0, double x1, ae_state *_state); +double rbfcalc3(rbfmodel* s, + double x0, + double x1, + double x2, + ae_state *_state); +void rbfcalc(rbfmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void rbfcalcbuf(rbfmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void rbfgridcalc2(rbfmodel* s, + /* Real */ ae_vector* x0, + ae_int_t n0, + /* Real */ ae_vector* x1, + ae_int_t n1, + /* Real */ ae_matrix* y, + ae_state *_state); +void rbfunpack(rbfmodel* s, + ae_int_t* nx, + ae_int_t* ny, + /* Real */ ae_matrix* xwr, + ae_int_t* nc, + /* Real */ ae_matrix* v, + ae_state *_state); +void rbfalloc(ae_serializer* s, rbfmodel* model, ae_state *_state); +void rbfserialize(ae_serializer* s, rbfmodel* model, ae_state *_state); +void rbfunserialize(ae_serializer* s, rbfmodel* model, ae_state *_state); +ae_bool _rbfmodel_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _rbfmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _rbfmodel_clear(void* _p); +void _rbfmodel_destroy(void* _p); +ae_bool _rbfreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _rbfreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _rbfreport_clear(void* _p); +void _rbfreport_destroy(void* _p); +double spline2dcalc(spline2dinterpolant* c, + double x, + double y, + ae_state *_state); +void spline2ddiff(spline2dinterpolant* c, + double x, + double y, + double* f, + double* fx, + double* fy, + double* fxy, + ae_state *_state); +void spline2dlintransxy(spline2dinterpolant* c, + double ax, + double bx, + double ay, + double by, + ae_state *_state); +void spline2dlintransf(spline2dinterpolant* c, + double a, + double b, + ae_state *_state); +void spline2dcopy(spline2dinterpolant* c, + spline2dinterpolant* cc, + ae_state *_state); +void spline2dresamplebicubic(/* Real */ ae_matrix* a, + ae_int_t oldheight, + ae_int_t oldwidth, + /* Real */ ae_matrix* b, + ae_int_t newheight, + ae_int_t newwidth, + ae_state *_state); +void spline2dresamplebilinear(/* Real */ ae_matrix* a, + ae_int_t oldheight, + ae_int_t oldwidth, + /* Real */ ae_matrix* b, + ae_int_t newheight, + ae_int_t newwidth, + ae_state *_state); +void spline2dbuildbilinearv(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + /* Real */ ae_vector* f, + ae_int_t d, + spline2dinterpolant* c, + ae_state *_state); +void spline2dbuildbicubicv(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + /* Real */ ae_vector* f, + ae_int_t d, + spline2dinterpolant* c, + ae_state *_state); +void spline2dcalcvbuf(spline2dinterpolant* c, + double x, + double y, + /* Real */ ae_vector* f, + ae_state *_state); +void spline2dcalcv(spline2dinterpolant* c, + double x, + double y, + /* Real */ ae_vector* f, + ae_state *_state); +void spline2dunpackv(spline2dinterpolant* c, + ae_int_t* m, + ae_int_t* n, + ae_int_t* d, + /* Real */ ae_matrix* tbl, + ae_state *_state); +void spline2dbuildbilinear(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_matrix* f, + ae_int_t m, + ae_int_t n, + spline2dinterpolant* c, + ae_state *_state); +void spline2dbuildbicubic(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_matrix* f, + ae_int_t m, + ae_int_t n, + spline2dinterpolant* c, + ae_state *_state); +void spline2dunpack(spline2dinterpolant* c, + ae_int_t* m, + ae_int_t* n, + /* Real */ ae_matrix* tbl, + ae_state *_state); +ae_bool _spline2dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _spline2dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _spline2dinterpolant_clear(void* _p); +void _spline2dinterpolant_destroy(void* _p); +double spline3dcalc(spline3dinterpolant* c, + double x, + double y, + double z, + ae_state *_state); +void spline3dlintransxyz(spline3dinterpolant* c, + double ax, + double bx, + double ay, + double by, + double az, + double bz, + ae_state *_state); +void spline3dlintransf(spline3dinterpolant* c, + double a, + double b, + ae_state *_state); +void spline3dcopy(spline3dinterpolant* c, + spline3dinterpolant* cc, + ae_state *_state); +void spline3dresampletrilinear(/* Real */ ae_vector* a, + ae_int_t oldzcount, + ae_int_t oldycount, + ae_int_t oldxcount, + ae_int_t newzcount, + ae_int_t newycount, + ae_int_t newxcount, + /* Real */ ae_vector* b, + ae_state *_state); +void spline3dbuildtrilinearv(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + /* Real */ ae_vector* z, + ae_int_t l, + /* Real */ ae_vector* f, + ae_int_t d, + spline3dinterpolant* c, + ae_state *_state); +void spline3dcalcvbuf(spline3dinterpolant* c, + double x, + double y, + double z, + /* Real */ ae_vector* f, + ae_state *_state); +void spline3dcalcv(spline3dinterpolant* c, + double x, + double y, + double z, + /* Real */ ae_vector* f, + ae_state *_state); +void spline3dunpackv(spline3dinterpolant* c, + ae_int_t* n, + ae_int_t* m, + ae_int_t* l, + ae_int_t* d, + ae_int_t* stype, + /* Real */ ae_matrix* tbl, + ae_state *_state); +ae_bool _spline3dinterpolant_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _spline3dinterpolant_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _spline3dinterpolant_clear(void* _p); +void _spline3dinterpolant_destroy(void* _p); + +} +#endif + diff --git a/psdlag/src/lag.cpp b/psdlag/src/lag.cpp new file mode 100644 index 0000000..3c1cde4 --- /dev/null +++ b/psdlag/src/lag.cpp @@ -0,0 +1,227 @@ +/* + * lag.cpp + * + * Created on: Jun 1, 2013 + * Author: azoghbi + */ + +#include "inc/lag.hpp" + +lag::lag( lcurve lc1 , lcurve lc2 , vec fqL , vec pars ) { + + // ----------- initial parameters ------------ // + n1 = lc1.len; + n = n1 + lc2.len; + dt = lc1.dt; + // ------------------------------------------ // + + + // ----------- light curve setup ------------ // + setlc(); + lc1.demean(); lc2.demean(); + int i; + for( i=0 ; i3000 ){dpar[i] = 3000;} if( dpar[i]<-3000 ){dpar[i] = -3000;} + pars[i] += dpar[i]/((n<10)?10:1); + } +} + + +void lag::print_pars( vec& pars , vec& errs ){ + for( int i=0 ; i M_PI ){ pars[i+nfq] -= 2*M_PI; } + while( pars[i+nfq] <-M_PI ){ pars[i+nfq] += 2*M_PI; } + } + mod::print_pars( pars , errs ); +} + + +// ****************************************** // + + +lag10::lag10( lcurve lc1 , lcurve lc2 , vec fqL , vec pars ) { + + // ----------- initial parameters ------------ // + n1 = lc1.len; + n = n1 + lc2.len; + dt = lc1.dt; + // ------------------------------------------ // + + + // ----------- light curve setup ------------ // + setlc(); + lc1.demean(); lc2.demean(); + int i; + for( i=0 ; i3 ){dpar[i] = 3;} if( dpar[i]<-3 ){dpar[i] = -3;} + //pars[i] += dpar[i]; + pars[i] += dpar[i]/((n<5)?10:1); + } +} + + +void lag10::print_pars( vec& pars , vec& errs ){ + for( int i=0 ; i M_PI ){ pars[i+nfq] -= 2*M_PI; } + while( pars[i+nfq] <-M_PI ){ pars[i+nfq] += 2*M_PI; } + } + mod::print_pars( pars , errs ); +} + +void lag10::what_pars( int& ip1 , int& ip2 ){ + ip1 = nfq; ip2 = npar; +} diff --git a/psdlag/src/linalg.cpp b/psdlag/src/linalg.cpp new file mode 100644 index 0000000..1ef178c --- /dev/null +++ b/psdlag/src/linalg.cpp @@ -0,0 +1,33805 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "linalg.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void cmatrixtranspose(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixtranspose(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(b.c_ptr()), ib, jb, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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) + B - destination matrix, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void rmatrixtranspose(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_2d_array &b, const ae_int_t ib, const ae_int_t jb) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixtranspose(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(b.c_ptr()), ib, jb, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixenforcesymmetricity(const real_2d_array &a, const ae_int_t n, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixenforcesymmetricity(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void cmatrixcopy(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixcopy(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(b.c_ptr()), ib, jb, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void rmatrixcopy(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_2d_array &b, const ae_int_t ib, const ae_int_t jb) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixcopy(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(b.c_ptr()), ib, jb, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixrank1(const ae_int_t m, const ae_int_t n, complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_1d_array &u, const ae_int_t iu, complex_1d_array &v, const ae_int_t iv) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixrank1(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(u.c_ptr()), iu, const_cast(v.c_ptr()), iv, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixrank1(const ae_int_t m, const ae_int_t n, real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_1d_array &u, const ae_int_t iu, real_1d_array &v, const ae_int_t iv) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixrank1(m, n, const_cast(a.c_ptr()), ia, ja, const_cast(u.c_ptr()), iu, const_cast(v.c_ptr()), iv, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + Y - preallocated matrix, must be large enough to store result + +OUTPUT PARAMETERS: + Y - vector which stores result + +if M=0, then subroutine does nothing. +if N=0, Y is filled by zeros. + + + -- ALGLIB routine -- + + 28.01.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixmv(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const complex_1d_array &x, const ae_int_t ix, complex_1d_array &y, const ae_int_t iy) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixmv(m, n, const_cast(a.c_ptr()), ia, ja, opa, const_cast(x.c_ptr()), ix, const_cast(y.c_ptr()), iy, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + Y - preallocated matrix, must be large enough to store result + +OUTPUT PARAMETERS: + Y - vector which stores result + +if M=0, then subroutine does nothing. +if N=0, Y is filled by zeros. + + + -- ALGLIB routine -- + + 28.01.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixmv(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const real_1d_array &x, const ae_int_t ix, real_1d_array &y, const ae_int_t iy) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixmv(m, n, const_cast(a.c_ptr()), ia, ja, opa, const_cast(x.c_ptr()), ix, const_cast(y.c_ptr()), iy, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixrighttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_cmatrixrighttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixlefttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_cmatrixlefttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixrighttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_rmatrixrighttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixlefttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_rmatrixlefttrsm(m, n, const_cast(a.c_ptr()), i1, j1, isupper, isunit, optype, const_cast(x.c_ptr()), i2, j2, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixsyrk(n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, beta, const_cast(c.c_ptr()), ic, jc, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_cmatrixsyrk(n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, beta, const_cast(c.c_ptr()), ic, jc, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixsyrk(n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, beta, const_cast(c.c_ptr()), ic, jc, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_rmatrixsyrk(n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, beta, const_cast(c.c_ptr()), ic, jc, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixgemm(m, n, k, *alpha.c_ptr(), const_cast(a.c_ptr()), ia, ja, optypea, const_cast(b.c_ptr()), ib, jb, optypeb, *beta.c_ptr(), const_cast(c.c_ptr()), ic, jc, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_cmatrixgemm(m, n, k, *alpha.c_ptr(), const_cast(a.c_ptr()), ia, ja, optypea, const_cast(b.c_ptr()), ib, jb, optypeb, *beta.c_ptr(), const_cast(c.c_ptr()), ic, jc, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixgemm(m, n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, const_cast(b.c_ptr()), ib, jb, optypeb, beta, const_cast(c.c_ptr()), ic, jc, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_rmatrixgemm(m, n, k, alpha, const_cast(a.c_ptr()), ia, ja, optypea, const_cast(b.c_ptr()), ib, jb, optypeb, beta, const_cast(c.c_ptr()), ic, jc, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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). + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqr(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixqr(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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). + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlq(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixlq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixqr(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixqr(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixlq(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixlq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqrunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qcolumns, real_2d_array &q) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixqrunpackq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), qcolumns, const_cast(q.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqrunpackr(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixqrunpackr(const_cast(a.c_ptr()), m, n, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlqunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qrows, real_2d_array &q) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixlqunpackq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), qrows, const_cast(q.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlqunpackl(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &l) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixlqunpackl(const_cast(a.c_ptr()), m, n, const_cast(l.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixqrunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qcolumns, complex_2d_array &q) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixqrunpackq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), qcolumns, const_cast(q.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixqrunpackr(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &r) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixqrunpackr(const_cast(a.c_ptr()), m, n, const_cast(r.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlqunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qrows, complex_2d_array &q) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixlqunpackq(const_cast(a.c_ptr()), m, n, const_cast(tau.c_ptr()), qrows, const_cast(q.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlqunpackl(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &l) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixlqunpackl(const_cast(a.c_ptr()), m, n, const_cast(l.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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): 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. + + -- 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. + Sergey Bochkanov, ALGLIB project, translation from FORTRAN to + pseudocode, 2007-2010. +*************************************************************************/ +void rmatrixbd(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tauq, real_1d_array &taup) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixbd(const_cast(a.c_ptr()), m, n, const_cast(tauq.c_ptr()), const_cast(taup.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, const ae_int_t qcolumns, real_2d_array &q) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixbdunpackq(const_cast(qp.c_ptr()), m, n, const_cast(tauq.c_ptr()), qcolumns, const_cast(q.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdmultiplybyq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixbdmultiplybyq(const_cast(qp.c_ptr()), m, n, const_cast(tauq.c_ptr()), const_cast(z.c_ptr()), zrows, zcolumns, fromtheright, dotranspose, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackpt(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, const ae_int_t ptrows, real_2d_array &pt) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixbdunpackpt(const_cast(qp.c_ptr()), m, n, const_cast(taup.c_ptr()), ptrows, const_cast(pt.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdmultiplybyp(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixbdmultiplybyp(const_cast(qp.c_ptr()), m, n, const_cast(taup.c_ptr()), const_cast(z.c_ptr()), zrows, zcolumns, fromtheright, dotranspose, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackdiagonals(const real_2d_array &b, const ae_int_t m, const ae_int_t n, bool &isupper, real_1d_array &d, real_1d_array &e) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixbdunpackdiagonals(const_cast(b.c_ptr()), m, n, &isupper, const_cast(d.c_ptr()), const_cast(e.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixhessenberg(real_2d_array &a, const ae_int_t n, real_1d_array &tau) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixhessenberg(const_cast(a.c_ptr()), n, const_cast(tau.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixhessenbergunpackq(const real_2d_array &a, const ae_int_t n, const real_1d_array &tau, real_2d_array &q) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixhessenbergunpackq(const_cast(a.c_ptr()), n, const_cast(tau.c_ptr()), const_cast(q.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixhessenbergunpackh(const real_2d_array &a, const ae_int_t n, real_2d_array &h) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixhessenbergunpackh(const_cast(a.c_ptr()), n, const_cast(h.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 smatrixtd(real_2d_array &a, const ae_int_t n, const bool isupper, real_1d_array &tau, real_1d_array &d, real_1d_array &e) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::smatrixtd(const_cast(a.c_ptr()), n, isupper, const_cast(tau.c_ptr()), const_cast(d.c_ptr()), const_cast(e.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void smatrixtdunpackq(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &tau, real_2d_array &q) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::smatrixtdunpackq(const_cast(a.c_ptr()), n, isupper, const_cast(tau.c_ptr()), const_cast(q.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 hmatrixtd(complex_2d_array &a, const ae_int_t n, const bool isupper, complex_1d_array &tau, real_1d_array &d, real_1d_array &e) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hmatrixtd(const_cast(a.c_ptr()), n, isupper, const_cast(tau.c_ptr()), const_cast(d.c_ptr()), const_cast(e.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void hmatrixtdunpackq(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &tau, complex_2d_array &q) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hmatrixtdunpackq(const_cast(a.c_ptr()), n, isupper, const_cast(tau.c_ptr()), const_cast(q.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 - + THIS PARAMETER IS IGNORED SINCE ALGLIB 3.5.0 + SINGULAR VALUES ARE ALWAYS SEARCHED WITH HIGH ACCURACY. + 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 rmatrixbdsvd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const bool isupper, const bool isfractionalaccuracyrequired, real_2d_array &u, const ae_int_t nru, real_2d_array &c, const ae_int_t ncc, real_2d_array &vt, const ae_int_t ncvt) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::rmatrixbdsvd(const_cast(d.c_ptr()), const_cast(e.c_ptr()), n, isupper, isfractionalaccuracyrequired, const_cast(u.c_ptr()), nru, const_cast(c.c_ptr()), ncc, const_cast(vt.c_ptr()), ncvt, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +bool rmatrixsvd(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const ae_int_t uneeded, const ae_int_t vtneeded, const ae_int_t additionalmemory, real_1d_array &w, real_2d_array &u, real_2d_array &vt) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::rmatrixsvd(const_cast(a.c_ptr()), m, n, uneeded, vtneeded, additionalmemory, const_cast(w.c_ptr()), const_cast(u.c_ptr()), const_cast(vt.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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). + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +bool smatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, real_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::smatrixevd(const_cast(a.c_ptr()), n, zneeded, isupper, const_cast(d.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 07.01.2006 by Bochkanov Sergey +*************************************************************************/ +bool smatrixevdr(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, real_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::smatrixevdr(const_cast(a.c_ptr()), n, zneeded, isupper, b1, b2, &m, const_cast(w.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 07.01.2006 by Bochkanov Sergey +*************************************************************************/ +bool smatrixevdi(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, real_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::smatrixevdi(const_cast(a.c_ptr()), n, zneeded, isupper, i1, i2, const_cast(w.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005, 23 March 2007 by Bochkanov Sergey +*************************************************************************/ +bool hmatrixevd(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, complex_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::hmatrixevd(const_cast(a.c_ptr()), n, zneeded, isupper, const_cast(d.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. +*************************************************************************/ +bool hmatrixevdr(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, complex_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::hmatrixevdr(const_cast(a.c_ptr()), n, zneeded, isupper, b1, b2, &m, const_cast(w.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 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. + + -- ALGLIB -- + Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. +*************************************************************************/ +bool hmatrixevdi(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, complex_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::hmatrixevdi(const_cast(a.c_ptr()), n, zneeded, isupper, i1, i2, const_cast(w.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 smatrixtdevd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, real_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::smatrixtdevd(const_cast(d.c_ptr()), const_cast(e.c_ptr()), n, zneeded, const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 31.03.2008 by Bochkanov Sergey +*************************************************************************/ +bool smatrixtdevdr(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const double a, const double b, ae_int_t &m, real_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::smatrixtdevdr(const_cast(d.c_ptr()), const_cast(e.c_ptr()), n, zneeded, a, b, &m, const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 25.12.2005 by Bochkanov Sergey +*************************************************************************/ +bool smatrixtdevdi(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const ae_int_t i1, const ae_int_t i2, real_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::smatrixtdevdi(const_cast(d.c_ptr()), const_cast(e.c_ptr()), n, zneeded, i1, i2, const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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]. + WR - 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 rmatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t vneeded, real_1d_array &wr, real_1d_array &wi, real_2d_array &vl, real_2d_array &vr) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::rmatrixevd(const_cast(a.c_ptr()), n, vneeded, const_cast(wr.c_ptr()), const_cast(wi.c_ptr()), const_cast(vl.c_ptr()), const_cast(vr.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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] + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonal(const ae_int_t n, real_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixrndorthogonal(n, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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] + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonal(const ae_int_t n, complex_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixrndorthogonal(n, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void smatrixrndcond(const ae_int_t n, const double c, real_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::smatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixrndcond(n, c, const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonalfromtheright(real_2d_array &a, const ae_int_t m, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixrndorthogonalfromtheright(const_cast(a.c_ptr()), m, n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonalfromtheleft(real_2d_array &a, const ae_int_t m, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixrndorthogonalfromtheleft(const_cast(a.c_ptr()), m, n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonalfromtheright(complex_2d_array &a, const ae_int_t m, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixrndorthogonalfromtheright(const_cast(a.c_ptr()), m, n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonalfromtheleft(complex_2d_array &a, const ae_int_t m, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixrndorthogonalfromtheleft(const_cast(a.c_ptr()), m, n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void smatrixrndmultiply(real_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::smatrixrndmultiply(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hmatrixrndmultiply(complex_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hmatrixrndmultiply(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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)]. + + -- ALGLIB routine -- + 10.01.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlu(real_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &pivots) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixlu(const_cast(a.c_ptr()), m, n, const_cast(pivots.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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)]. + + -- ALGLIB routine -- + 10.01.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlu(complex_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &pivots) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixlu(const_cast(a.c_ptr()), m, n, const_cast(pivots.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +bool hpdmatrixcholesky(complex_2d_array &a, const ae_int_t n, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::hpdmatrixcholesky(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +bool spdmatrixcholesky(real_2d_array &a, const ae_int_t n, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::spdmatrixcholesky(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixrcond1(const real_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixrcond1(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixrcondinf(const real_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixrcondinf(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 spdmatrixrcond(const real_2d_array &a, const ae_int_t n, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spdmatrixrcond(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixtrrcond1(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixtrrcond1(const_cast(a.c_ptr()), n, isupper, isunit, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixtrrcondinf(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixtrrcondinf(const_cast(a.c_ptr()), n, isupper, isunit, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 hpdmatrixrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hpdmatrixrcond(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixrcond1(const complex_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::cmatrixrcond1(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixrcondinf(const complex_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::cmatrixrcondinf(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixlurcond1(const real_2d_array &lua, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixlurcond1(const_cast(lua.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixlurcondinf(const real_2d_array &lua, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixlurcondinf(const_cast(lua.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 spdmatrixcholeskyrcond(const real_2d_array &a, const ae_int_t n, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spdmatrixcholeskyrcond(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 hpdmatrixcholeskyrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hpdmatrixcholeskyrcond(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixlurcond1(const complex_2d_array &lua, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::cmatrixlurcond1(const_cast(lua.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixlurcondinf(const complex_2d_array &lua, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::cmatrixlurcondinf(const_cast(lua.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixtrrcond1(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::cmatrixtrrcond1(const_cast(a.c_ptr()), n, isupper, isunit, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 cmatrixtrrcondinf(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::cmatrixtrrcondinf(const_cast(a.c_ptr()), n, isupper, isunit, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Matrix inverse report: +* R1 reciprocal of condition number in 1-norm +* RInf reciprocal of condition number in inf-norm +*************************************************************************/ +_matinvreport_owner::_matinvreport_owner() +{ + p_struct = (alglib_impl::matinvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::matinvreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_matinvreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_matinvreport_owner::_matinvreport_owner(const _matinvreport_owner &rhs) +{ + p_struct = (alglib_impl::matinvreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::matinvreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_matinvreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_matinvreport_owner& _matinvreport_owner::operator=(const _matinvreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_matinvreport_clear(p_struct); + if( !alglib_impl::_matinvreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_matinvreport_owner::~_matinvreport_owner() +{ + alglib_impl::_matinvreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::matinvreport* _matinvreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::matinvreport* _matinvreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +matinvreport::matinvreport() : _matinvreport_owner() ,r1(p_struct->r1),rinf(p_struct->rinf) +{ +} + +matinvreport::matinvreport(const matinvreport &rhs):_matinvreport_owner(rhs) ,r1(p_struct->r1),rinf(p_struct->rinf) +{ +} + +matinvreport& matinvreport::operator=(const matinvreport &rhs) +{ + if( this==&rhs ) + return *this; + _matinvreport_owner::operator=(rhs); + return *this; +} + +matinvreport::~matinvreport() +{ +} + +/************************************************************************* +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. + + -- ALGLIB routine -- + 05.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixluinverse(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB routine -- + 05.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.cols()!=a.rows()) || (a.cols()!=pivots.length())) + throw ap_error("Error while calling 'rmatrixluinverse': looks like one of arguments has wrong size"); + n = a.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixluinverse(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinverse(real_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixinverse(const_cast(a.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.cols()!=a.rows())) + throw ap_error("Error while calling 'rmatrixinverse': looks like one of arguments has wrong size"); + n = a.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixinverse(const_cast(a.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 05.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixluinverse(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 05.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.cols()!=a.rows()) || (a.cols()!=pivots.length())) + throw ap_error("Error while calling 'cmatrixluinverse': looks like one of arguments has wrong size"); + n = a.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixluinverse(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void cmatrixinverse(complex_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixinverse(const_cast(a.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void cmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.cols()!=a.rows())) + throw ap_error("Error while calling 'cmatrixinverse': looks like one of arguments has wrong size"); + n = a.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixinverse(const_cast(a.c_ptr()), n, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskyinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixcholeskyinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskyinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + bool isupper; + if( (a.cols()!=a.rows())) + throw ap_error("Error while calling 'spdmatrixcholeskyinverse': looks like one of arguments has wrong size"); + n = a.cols(); + isupper = false; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixcholeskyinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + bool isupper; + if( (a.cols()!=a.rows())) + throw ap_error("Error while calling 'spdmatrixinverse': looks like one of arguments has wrong size"); + if( !alglib_impl::ae_is_symmetric(const_cast(a.c_ptr())) ) + throw ap_error("'a' parameter is not symmetric matrix"); + n = a.cols(); + isupper = false; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + if( !alglib_impl::ae_force_symmetric(const_cast(a.c_ptr())) ) + throw ap_error("Internal error while forcing symmetricity of 'a' parameter"); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskyinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixcholeskyinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskyinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + bool isupper; + if( (a.cols()!=a.rows())) + throw ap_error("Error while calling 'hpdmatrixcholeskyinverse': looks like one of arguments has wrong size"); + n = a.cols(); + isupper = false; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixcholeskyinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + bool isupper; + if( (a.cols()!=a.rows())) + throw ap_error("Error while calling 'hpdmatrixinverse': looks like one of arguments has wrong size"); + if( !alglib_impl::ae_is_hermitian(const_cast(a.c_ptr())) ) + throw ap_error("'a' parameter is not Hermitian matrix"); + n = a.cols(); + isupper = false; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixinverse(const_cast(a.c_ptr()), n, isupper, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + if( !alglib_impl::ae_force_hermitian(const_cast(a.c_ptr())) ) + throw ap_error("Internal error while forcing Hermitian properties of 'a' parameter"); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 05.02.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixtrinverse(real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixtrinverse(const_cast(a.c_ptr()), n, isupper, isunit, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 05.02.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixtrinverse(real_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + bool isunit; + if( (a.cols()!=a.rows())) + throw ap_error("Error while calling 'rmatrixtrinverse': looks like one of arguments has wrong size"); + n = a.cols(); + isunit = false; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixtrinverse(const_cast(a.c_ptr()), n, isupper, isunit, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 05.02.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixtrinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixtrinverse(const_cast(a.c_ptr()), n, isupper, isunit, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 05.02.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixtrinverse(complex_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + bool isunit; + if( (a.cols()!=a.rows())) + throw ap_error("Error while calling 'cmatrixtrinverse': looks like one of arguments has wrong size"); + n = a.cols(); + isunit = false; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixtrinverse(const_cast(a.c_ptr()), n, isupper, isunit, &info, const_cast(rep.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Sparse matrix + +You should use ALGLIB functions to work with sparse matrix. +Never try to access its fields directly! +*************************************************************************/ +_sparsematrix_owner::_sparsematrix_owner() +{ + p_struct = (alglib_impl::sparsematrix*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsematrix), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_sparsematrix_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_sparsematrix_owner::_sparsematrix_owner(const _sparsematrix_owner &rhs) +{ + p_struct = (alglib_impl::sparsematrix*)alglib_impl::ae_malloc(sizeof(alglib_impl::sparsematrix), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_sparsematrix_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_sparsematrix_owner& _sparsematrix_owner::operator=(const _sparsematrix_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_sparsematrix_clear(p_struct); + if( !alglib_impl::_sparsematrix_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_sparsematrix_owner::~_sparsematrix_owner() +{ + alglib_impl::_sparsematrix_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::sparsematrix* _sparsematrix_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::sparsematrix* _sparsematrix_owner::c_ptr() const +{ + return const_cast(p_struct); +} +sparsematrix::sparsematrix() : _sparsematrix_owner() +{ +} + +sparsematrix::sparsematrix(const sparsematrix &rhs):_sparsematrix_owner(rhs) +{ +} + +sparsematrix& sparsematrix::operator=(const sparsematrix &rhs) +{ + if( this==&rhs ) + return *this; + _sparsematrix_owner::operator=(rhs); + return *this; +} + +sparsematrix::~sparsematrix() +{ +} + +/************************************************************************* +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 is 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. + +Sparse matrices can be stored using either Hash-Table representation or +Compressed Row Storage representation. Hast-table is better suited for +querying and dynamic operations (thus, it is used for matrix +initialization), but it is inefficient when you want to make some linear +algebra operations. + +From the other side, CRS is better suited for linear algebra operations, +but initialization is less convenient - you have to tell row sizes at the +initialization, and you can fill matrix only row by row, from left to +right. CRS is also very inefficient when you want to find matrix element +by its index. + +Thus, Hash-Table representation does not support linear algebra +operations, while CRS format does not support modification of the table. +Tables below outline information about these two formats: + + OPERATIONS WITH MATRIX HASH CRS + create + + + read element + + + modify element + + add value to element + + A*x (dense vector) + + A'*x (dense vector) + + A*X (dense matrix) + + A'*X (dense matrix) + + +NOTE 2. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecreate(const ae_int_t m, const ae_int_t n, const ae_int_t k, sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsecreate(m, n, k, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 is 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. + +Sparse matrices can be stored using either Hash-Table representation or +Compressed Row Storage representation. Hast-table is better suited for +querying and dynamic operations (thus, it is used for matrix +initialization), but it is inefficient when you want to make some linear +algebra operations. + +From the other side, CRS is better suited for linear algebra operations, +but initialization is less convenient - you have to tell row sizes at the +initialization, and you can fill matrix only row by row, from left to +right. CRS is also very inefficient when you want to find matrix element +by its index. + +Thus, Hash-Table representation does not support linear algebra +operations, while CRS format does not support modification of the table. +Tables below outline information about these two formats: + + OPERATIONS WITH MATRIX HASH CRS + create + + + read element + + + modify element + + add value to element + + A*x (dense vector) + + A'*x (dense vector) + + A*X (dense matrix) + + A'*X (dense matrix) + + +NOTE 2. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecreate(const ae_int_t m, const ae_int_t n, sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t k; + + k = 0; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsecreate(m, n, k, const_cast(s.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 +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 + 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 1. + +Sparse matrices can be stored using either Hash-Table representation or +Compressed Row Storage representation. Hast-table is better suited for +querying and dynamic operations (thus, it is used for matrix +initialization), but it is inefficient when you want to make some linear +algebra operations. + +From the other side, CRS is better suited for linear algebra operations, +but initialization is less convenient - you have to tell row sizes at the +initialization, and you can fill matrix only row by row, from left to +right. CRS is also very inefficient when you want to find matrix element +by its index. + +Thus, Hash-Table representation does not support linear algebra +operations, while CRS format does not support modification of the table. +Tables below outline information about these two formats: + + OPERATIONS WITH MATRIX HASH CRS + create + + + read element + + + modify element + + add value to element + + A*x (dense vector) + + A'*x (dense vector) + + A*X (dense matrix) + + A'*X (dense matrix) + + +NOTE 2. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecreatecrs(const ae_int_t m, const ae_int_t n, const integer_1d_array &ner, sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsecreatecrs(m, n, const_cast(ner.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function copies S0 to S1. + +NOTE: this function does not verify its arguments, it just copies all +fields of the structure. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecopy(const sparsematrix &s0, sparsematrix &s1) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsecopy(const_cast(s0.c_ptr()), const_cast(s1.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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(s.c_ptr()), i, j, v, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function modifies S[i,j] - element of the sparse matrix. + +For Hash-based storage format: +* 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: +* new value MUST be non-zero. Exception will be thrown for zero V. +* elements must be initialized in correct order - from top row to bottom, + within row - from left to right. + +INPUT PARAMETERS + S - sparse M*N matrix in Hash-Table or CRS representation. + I - row index of the element to modify, 0<=I(s.c_ptr()), i, j, v, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns S[i,j] - element of the sparse matrix. Matrix can +be in any mode (Hash-Table or CRS), but this function is less efficient +for CRS matrices. Hash-Table 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 in Hash-Table representation. + Exception will be thrown for CRS matrix. + I - row index of the element to modify, 0<=I(s.c_ptr()), i, j, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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(s.c_ptr()), i, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function converts matrix to CRS format. + +Some algorithms (linear algebra ones, for example) require matrices in +CRS format. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparseconverttocrs(const sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparseconverttocrs(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates matrix-vector product S*x. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemv(const sparsematrix &s, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsemv(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates matrix-vector product S^T*x. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemtv(const sparsematrix &s, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsemtv(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function simultaneously calculates two matrix-vector products: + S*x and S^T*x. +S must be square (non-rectangular) matrix stored in CRS format (exception +will be thrown otherwise). + +INPUT PARAMETERS + S - sparse N*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. It also throws exception when S is non-square. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemv2(const sparsematrix &s, const real_1d_array &x, real_1d_array &y0, real_1d_array &y1) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsemv2(const_cast(s.c_ptr()), const_cast(x.c_ptr()), const_cast(y0.c_ptr()), const_cast(y1.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates matrix-vector product S*x, when S is symmetric +matrix. Matrix S must be stored in CRS format (exception will be +thrown otherwise). + +INPUT PARAMETERS + S - sparse M*M matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsesmv(const sparsematrix &s, const bool isupper, const real_1d_array &x, real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsesmv(const_cast(s.c_ptr()), isupper, const_cast(x.c_ptr()), const_cast(y.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates matrix-matrix product S*A. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsemm(const_cast(s.c_ptr()), const_cast(a.c_ptr()), k, const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates matrix-matrix product S^T*A. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemtm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsemtm(const_cast(s.c_ptr()), const_cast(a.c_ptr()), k, const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function simultaneously calculates two matrix-matrix products: + S*A and S^T*A. +S must be square (non-rectangular) matrix stored in CRS format (exception +will be thrown otherwise). + +INPUT PARAMETERS + S - sparse N*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. It also throws exception when S is non-square. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemm2(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b0, real_2d_array &b1) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsemm2(const_cast(s.c_ptr()), const_cast(a.c_ptr()), k, const_cast(b0.c_ptr()), const_cast(b1.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function calculates matrix-matrix product S*A, when S is symmetric +matrix. Matrix S must be stored in CRS format (exception will be +thrown otherwise). + +INPUT PARAMETERS + S - sparse M*M matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsesmm(const sparsematrix &s, const bool isupper, const real_2d_array &a, const ae_int_t k, real_2d_array &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsesmm(const_cast(s.c_ptr()), isupper, const_cast(a.c_ptr()), k, const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparseresizematrix(const sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparseresizematrix(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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(s.c_ptr()), &t0, &t1, &i, &j, &v, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function rewrites existing (non-zero) element. It returns True if +element exists or False, when it is called for non-existing (zero) +element. + +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 Hash-Table or CRS representation. + I - row index of non-zero element to modify, 0<=I(s.c_ptr()), i, j, v, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function returns I-th row of the sparse matrix stored in CRS format. + +NOTE: when incorrect I (outside of [0,M-1]) or matrix (non-CRS) are + passed, this function throws exception. + +INPUT PARAMETERS: + S - sparse M*N matrix in CRS format + I - row index, 0<=I(s.c_ptr()), i, const_cast(irow.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function performs in-place conversion from CRS format 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. + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +void sparseconverttohash(const sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparseconverttohash(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +void sparsecopytohash(const sparsematrix &s0, sparsematrix &s1) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsecopytohash(const_cast(s0.c_ptr()), const_cast(s1.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +void sparsecopytocrs(const sparsematrix &s0, sparsematrix &s1) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsecopytocrs(const_cast(s0.c_ptr()), const_cast(s1.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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-format + +NOTE: future versions of ALGLIB may include additional sparse storage + formats. + + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t sparsegetmatrixtype(const sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::sparsegetmatrixtype(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +bool sparseishash(const sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::sparseishash(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +bool sparseiscrs(const sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::sparseiscrs(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The function frees all memory occupied by sparse matrix. Sparse matrix +structure becomes unusable after this call. + +OUTPUT PARAMETERS + S - sparse matrix to delete + + -- ALGLIB PROJECT -- + Copyright 24.07.2012 by Bochkanov Sergey +*************************************************************************/ +void sparsefree(sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sparsefree(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The function returns number of rows of a sparse matrix. + +RESULT: number of rows of a sparse matrix. + + -- ALGLIB PROJECT -- + Copyright 23.08.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t sparsegetnrows(const sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::sparsegetnrows(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The function returns number of columns of a sparse matrix. + +RESULT: number of columns of a sparse matrix. + + -- ALGLIB PROJECT -- + Copyright 23.08.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t sparsegetncols(const sparsematrix &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_int_t result = alglib_impl::sparsegetncols(const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +This object stores state of the iterative norm estimation algorithm. + +You should use ALGLIB functions to work with this object. +*************************************************************************/ +_normestimatorstate_owner::_normestimatorstate_owner() +{ + p_struct = (alglib_impl::normestimatorstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::normestimatorstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_normestimatorstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_normestimatorstate_owner::_normestimatorstate_owner(const _normestimatorstate_owner &rhs) +{ + p_struct = (alglib_impl::normestimatorstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::normestimatorstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_normestimatorstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_normestimatorstate_owner& _normestimatorstate_owner::operator=(const _normestimatorstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_normestimatorstate_clear(p_struct); + if( !alglib_impl::_normestimatorstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_normestimatorstate_owner::~_normestimatorstate_owner() +{ + alglib_impl::_normestimatorstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::normestimatorstate* _normestimatorstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::normestimatorstate* _normestimatorstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +normestimatorstate::normestimatorstate() : _normestimatorstate_owner() +{ +} + +normestimatorstate::normestimatorstate(const normestimatorstate &rhs):_normestimatorstate_owner(rhs) +{ +} + +normestimatorstate& normestimatorstate::operator=(const normestimatorstate &rhs) +{ + if( this==&rhs ) + return *this; + _normestimatorstate_owner::operator=(rhs); + return *this; +} + +normestimatorstate::~normestimatorstate() +{ +} + +/************************************************************************* +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 vectors, 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. + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorcreate(const ae_int_t m, const ae_int_t n, const ae_int_t nstart, const ae_int_t nits, normestimatorstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::normestimatorcreate(m, n, nstart, nits, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorsetseed(const normestimatorstate &state, const ae_int_t seedval) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::normestimatorsetseed(const_cast(state.c_ptr()), seedval, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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). + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorestimatesparse(const normestimatorstate &state, const sparsematrix &a) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::normestimatorestimatesparse(const_cast(state.c_ptr()), const_cast(a.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Matrix norm estimation results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + Nrm - estimate of the matrix norm, Nrm>=0 + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorresults(const normestimatorstate &state, double &nrm) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::normestimatorresults(const_cast(state.c_ptr()), &nrm, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixludet(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.rows()!=a.cols()) || (a.rows()!=pivots.length())) + throw ap_error("Error while calling 'rmatrixludet': looks like one of arguments has wrong size"); + n = a.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixludet(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +double rmatrixdet(const real_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixdet(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +double rmatrixdet(const real_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.rows()!=a.cols())) + throw ap_error("Error while calling 'rmatrixdet': looks like one of arguments has wrong size"); + n = a.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::rmatrixdet(const_cast(a.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_complex result = alglib_impl::cmatrixludet(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.rows()!=a.cols()) || (a.rows()!=pivots.length())) + throw ap_error("Error while calling 'cmatrixludet': looks like one of arguments has wrong size"); + n = a.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_complex result = alglib_impl::cmatrixludet(const_cast(a.c_ptr()), const_cast(pivots.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +alglib::complex cmatrixdet(const complex_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_complex result = alglib_impl::cmatrixdet(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +alglib::complex cmatrixdet(const complex_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.rows()!=a.cols())) + throw ap_error("Error while calling 'cmatrixdet': looks like one of arguments has wrong size"); + n = a.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ae_complex result = alglib_impl::cmatrixdet(const_cast(a.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +double spdmatrixcholeskydet(const real_2d_array &a, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spdmatrixcholeskydet(const_cast(a.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +double spdmatrixcholeskydet(const real_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (a.rows()!=a.cols())) + throw ap_error("Error while calling 'spdmatrixcholeskydet': looks like one of arguments has wrong size"); + n = a.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spdmatrixcholeskydet(const_cast(a.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +double spdmatrixdet(const real_2d_array &a, const ae_int_t n, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spdmatrixdet(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +double spdmatrixdet(const real_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + bool isupper; + if( (a.rows()!=a.cols())) + throw ap_error("Error while calling 'spdmatrixdet': looks like one of arguments has wrong size"); + if( !alglib_impl::ae_is_symmetric(const_cast(a.c_ptr())) ) + throw ap_error("'a' parameter is not symmetric matrix"); + n = a.rows(); + isupper = false; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spdmatrixdet(const_cast(a.c_ptr()), n, isupper, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 1.28.2006 by Bochkanov Sergey +*************************************************************************/ +bool smatrixgevd(const real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t zneeded, const ae_int_t problemtype, real_1d_array &d, real_2d_array &z) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::smatrixgevd(const_cast(a.c_ptr()), n, isuppera, const_cast(b.c_ptr()), isupperb, zneeded, problemtype, const_cast(d.c_ptr()), const_cast(z.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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). + + -- ALGLIB -- + Copyright 1.28.2006 by Bochkanov Sergey +*************************************************************************/ +bool smatrixgevdreduce(real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t problemtype, real_2d_array &r, bool &isupperr) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::smatrixgevdreduce(const_cast(a.c_ptr()), n, isuppera, const_cast(b.c_ptr()), isupperb, problemtype, const_cast(r.c_ptr()), &isupperr, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdatesimple(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const ae_int_t updcolumn, const double updval) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixinvupdatesimple(const_cast(inva.c_ptr()), n, updrow, updcolumn, updval, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdaterow(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const real_1d_array &v) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixinvupdaterow(const_cast(inva.c_ptr()), n, updrow, const_cast(v.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdatecolumn(real_2d_array &inva, const ae_int_t n, const ae_int_t updcolumn, const real_1d_array &u) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixinvupdatecolumn(const_cast(inva.c_ptr()), n, updcolumn, const_cast(u.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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'. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdateuv(real_2d_array &inva, const ae_int_t n, const real_1d_array &u, const real_1d_array &v) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixinvupdateuv(const_cast(inva.c_ptr()), n, const_cast(u.c_ptr()), const_cast(v.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +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 rmatrixschur(real_2d_array &a, const ae_int_t n, real_2d_array &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::rmatrixschur(const_cast(a.c_ptr()), n, const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +static ae_int_t ablas_rgemmparallelsize = 64; +static ae_int_t ablas_cgemmparallelsize = 64; +static void ablas_ablasinternalsplitlength(ae_int_t n, + ae_int_t nb, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state); +static void ablas_cmatrixrighttrsm2(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +static void ablas_cmatrixlefttrsm2(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +static void ablas_rmatrixrighttrsm2(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +static void ablas_rmatrixlefttrsm2(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +static void ablas_cmatrixsyrk2(ae_int_t n, + ae_int_t k, + double alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state); +static void ablas_rmatrixsyrk2(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state); + + +static void ortfac_cmatrixqrbasecase(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* work, + /* Complex */ ae_vector* t, + /* Complex */ ae_vector* tau, + ae_state *_state); +static void ortfac_cmatrixlqbasecase(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* work, + /* Complex */ ae_vector* t, + /* Complex */ ae_vector* tau, + ae_state *_state); +static void ortfac_rmatrixblockreflector(/* Real */ ae_matrix* a, + /* Real */ ae_vector* tau, + ae_bool columnwisea, + ae_int_t lengtha, + ae_int_t blocksize, + /* Real */ ae_matrix* t, + /* Real */ ae_vector* work, + ae_state *_state); +static void ortfac_cmatrixblockreflector(/* Complex */ ae_matrix* a, + /* Complex */ ae_vector* tau, + ae_bool columnwisea, + ae_int_t lengtha, + ae_int_t blocksize, + /* Complex */ ae_matrix* t, + /* Complex */ ae_vector* work, + ae_state *_state); + + +static ae_bool bdsvd_bidiagonalsvddecompositioninternal(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_bool isupper, + ae_bool isfractionalaccuracyrequired, + /* Real */ ae_matrix* u, + ae_int_t ustart, + ae_int_t nru, + /* Real */ ae_matrix* c, + ae_int_t cstart, + ae_int_t ncc, + /* Real */ ae_matrix* vt, + ae_int_t vstart, + ae_int_t ncvt, + ae_state *_state); +static double bdsvd_extsignbdsqr(double a, double b, ae_state *_state); +static void bdsvd_svd2x2(double f, + double g, + double h, + double* ssmin, + double* ssmax, + ae_state *_state); +static void bdsvd_svdv2x2(double f, + double g, + double h, + double* ssmin, + double* ssmax, + double* snr, + double* csr, + double* snl, + double* csl, + ae_state *_state); + + + + +static ae_bool evd_tridiagonalevd(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t zneeded, + /* Real */ ae_matrix* z, + ae_state *_state); +static void evd_tdevde2(double a, + double b, + double c, + double* rt1, + double* rt2, + ae_state *_state); +static void evd_tdevdev2(double a, + double b, + double c, + double* rt1, + double* rt2, + double* cs1, + double* sn1, + ae_state *_state); +static double evd_tdevdpythag(double a, double b, ae_state *_state); +static double evd_tdevdextsign(double a, double b, ae_state *_state); +static ae_bool evd_internalbisectioneigenvalues(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t irange, + ae_int_t iorder, + double vl, + double vu, + ae_int_t il, + ae_int_t iu, + double abstol, + /* Real */ ae_vector* w, + ae_int_t* m, + ae_int_t* nsplit, + /* Integer */ ae_vector* iblock, + /* Integer */ ae_vector* isplit, + ae_int_t* errorcode, + ae_state *_state); +static void evd_internaldstein(ae_int_t n, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t m, + /* Real */ ae_vector* w, + /* Integer */ ae_vector* iblock, + /* Integer */ ae_vector* isplit, + /* Real */ ae_matrix* z, + /* Integer */ ae_vector* ifail, + ae_int_t* info, + ae_state *_state); +static void evd_tdininternaldlagtf(ae_int_t n, + /* Real */ ae_vector* a, + double lambdav, + /* Real */ ae_vector* b, + /* Real */ ae_vector* c, + double tol, + /* Real */ ae_vector* d, + /* Integer */ ae_vector* iin, + ae_int_t* info, + ae_state *_state); +static void evd_tdininternaldlagts(ae_int_t n, + /* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* c, + /* Real */ ae_vector* d, + /* Integer */ ae_vector* iin, + /* Real */ ae_vector* y, + double* tol, + ae_int_t* info, + ae_state *_state); +static void evd_internaldlaebz(ae_int_t ijob, + ae_int_t nitmax, + ae_int_t n, + ae_int_t mmax, + ae_int_t minp, + double abstol, + double reltol, + double pivmin, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + /* Real */ ae_vector* e2, + /* Integer */ ae_vector* nval, + /* Real */ ae_matrix* ab, + /* Real */ ae_vector* c, + ae_int_t* mout, + /* Integer */ ae_matrix* nab, + /* Real */ ae_vector* work, + /* Integer */ ae_vector* iwork, + ae_int_t* info, + ae_state *_state); +static void evd_internaltrevc(/* Real */ ae_matrix* t, + ae_int_t n, + ae_int_t side, + ae_int_t howmny, + /* Boolean */ ae_vector* vselect, + /* Real */ ae_matrix* vl, + /* Real */ ae_matrix* vr, + ae_int_t* m, + ae_int_t* info, + ae_state *_state); +static void evd_internalhsevdlaln2(ae_bool ltrans, + ae_int_t na, + ae_int_t nw, + double smin, + double ca, + /* Real */ ae_matrix* a, + double d1, + double d2, + /* Real */ ae_matrix* b, + double wr, + double wi, + /* Boolean */ ae_vector* rswap4, + /* Boolean */ ae_vector* zswap4, + /* Integer */ ae_matrix* ipivot44, + /* Real */ ae_vector* civ4, + /* Real */ ae_vector* crv4, + /* Real */ ae_matrix* x, + double* scl, + double* xnorm, + ae_int_t* info, + ae_state *_state); +static void evd_internalhsevdladiv(double a, + double b, + double c, + double d, + double* p, + double* q, + ae_state *_state); +static ae_bool evd_nonsymmetricevd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t vneeded, + /* Real */ ae_vector* wr, + /* Real */ ae_vector* wi, + /* Real */ ae_matrix* vl, + /* Real */ ae_matrix* vr, + ae_state *_state); +static void evd_toupperhessenberg(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_state *_state); +static void evd_unpackqfromupperhessenberg(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* tau, + /* Real */ ae_matrix* q, + ae_state *_state); + + + + +static void trfac_cmatrixluprec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Complex */ ae_vector* tmp, + ae_state *_state); +static void trfac_rmatrixluprec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Real */ ae_vector* tmp, + ae_state *_state); +static void trfac_cmatrixplurec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Complex */ ae_vector* tmp, + ae_state *_state); +static void trfac_rmatrixplurec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Real */ ae_vector* tmp, + ae_state *_state); +static void trfac_cmatrixlup2(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Complex */ ae_vector* tmp, + ae_state *_state); +static void trfac_rmatrixlup2(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Real */ ae_vector* tmp, + ae_state *_state); +static void trfac_cmatrixplu2(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Complex */ ae_vector* tmp, + ae_state *_state); +static void trfac_rmatrixplu2(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Real */ ae_vector* tmp, + ae_state *_state); +static ae_bool trfac_hpdmatrixcholeskyrec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tmp, + ae_state *_state); +static ae_bool trfac_hpdmatrixcholesky2(/* Complex */ ae_matrix* aaa, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tmp, + ae_state *_state); +static ae_bool trfac_spdmatrixcholesky2(/* Real */ ae_matrix* aaa, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tmp, + ae_state *_state); + + +static void rcond_rmatrixrcondtrinternal(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_bool onenorm, + double anorm, + double* rc, + ae_state *_state); +static void rcond_cmatrixrcondtrinternal(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_bool onenorm, + double anorm, + double* rc, + ae_state *_state); +static void rcond_spdmatrixrcondcholeskyinternal(/* Real */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + ae_bool isnormprovided, + double anorm, + double* rc, + ae_state *_state); +static void rcond_hpdmatrixrcondcholeskyinternal(/* Complex */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + ae_bool isnormprovided, + double anorm, + double* rc, + ae_state *_state); +static void rcond_rmatrixrcondluinternal(/* Real */ ae_matrix* lua, + ae_int_t n, + ae_bool onenorm, + ae_bool isanormprovided, + double anorm, + double* rc, + ae_state *_state); +static void rcond_cmatrixrcondluinternal(/* Complex */ ae_matrix* lua, + ae_int_t n, + ae_bool onenorm, + ae_bool isanormprovided, + double anorm, + double* rc, + ae_state *_state); +static void rcond_rmatrixestimatenorm(ae_int_t n, + /* Real */ ae_vector* v, + /* Real */ ae_vector* x, + /* Integer */ ae_vector* isgn, + double* est, + ae_int_t* kase, + ae_state *_state); +static void rcond_cmatrixestimatenorm(ae_int_t n, + /* Complex */ ae_vector* v, + /* Complex */ ae_vector* x, + double* est, + ae_int_t* kase, + /* Integer */ ae_vector* isave, + /* Real */ ae_vector* rsave, + ae_state *_state); +static double rcond_internalcomplexrcondscsum1(/* Complex */ ae_vector* x, + ae_int_t n, + ae_state *_state); +static ae_int_t rcond_internalcomplexrcondicmax1(/* Complex */ ae_vector* x, + ae_int_t n, + ae_state *_state); +static void rcond_internalcomplexrcondsaveall(/* Integer */ ae_vector* isave, + /* Real */ ae_vector* rsave, + ae_int_t* i, + ae_int_t* iter, + ae_int_t* j, + ae_int_t* jlast, + ae_int_t* jump, + double* absxi, + double* altsgn, + double* estold, + double* temp, + ae_state *_state); +static void rcond_internalcomplexrcondloadall(/* Integer */ ae_vector* isave, + /* Real */ ae_vector* rsave, + ae_int_t* i, + ae_int_t* iter, + ae_int_t* j, + ae_int_t* jlast, + ae_int_t* jump, + double* absxi, + double* altsgn, + double* estold, + double* temp, + ae_state *_state); + + +static void matinv_rmatrixtrinverserec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + /* Real */ ae_vector* tmp, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +static void matinv_cmatrixtrinverserec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + /* Complex */ ae_vector* tmp, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +static void matinv_rmatrixluinverserec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + /* Real */ ae_vector* work, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +static void matinv_cmatrixluinverserec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + /* Complex */ ae_vector* work, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +static void matinv_spdmatrixcholeskyinverserec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tmp, + ae_state *_state); +static void matinv_hpdmatrixcholeskyinverserec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tmp, + ae_state *_state); + + +static double sparse_desiredloadfactor = 0.66; +static double sparse_maxloadfactor = 0.75; +static double sparse_growfactor = 2.00; +static ae_int_t sparse_additional = 10; +static ae_int_t sparse_linalgswitch = 16; +static void sparse_sparseinitduidx(sparsematrix* s, ae_state *_state); +static ae_int_t sparse_hash(ae_int_t i, + ae_int_t j, + ae_int_t tabsize, + ae_state *_state); + + + + + + + + + + + + + + + + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +void ablassplitlength(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state) +{ + + *n1 = 0; + *n2 = 0; + + if( n>ablasblocksize(a, _state) ) + { + ablas_ablasinternalsplitlength(n, ablasblocksize(a, _state), n1, n2, _state); + } + else + { + ablas_ablasinternalsplitlength(n, ablasmicroblocksize(_state), n1, n2, _state); + } +} + + +/************************************************************************* +Complex ABLASSplitLength + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +void ablascomplexsplitlength(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state) +{ + + *n1 = 0; + *n2 = 0; + + if( n>ablascomplexblocksize(a, _state) ) + { + ablas_ablasinternalsplitlength(n, ablascomplexblocksize(a, _state), n1, n2, _state); + } + else + { + ablas_ablasinternalsplitlength(n, ablasmicroblocksize(_state), n1, n2, _state); + } +} + + +/************************************************************************* +Returns block size - subdivision size where cache-oblivious soubroutines +switch to the optimized kernel. + +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. + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +ae_int_t ablasblocksize(/* Real */ ae_matrix* a, ae_state *_state) +{ + ae_int_t result; + + + result = 32; + return result; +} + + +/************************************************************************* +Block size for complex subroutines. + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +ae_int_t ablascomplexblocksize(/* Complex */ ae_matrix* a, + ae_state *_state) +{ + ae_int_t result; + + + result = 24; + return result; +} + + +/************************************************************************* +Microblock size + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +ae_int_t ablasmicroblocksize(ae_state *_state) +{ + ae_int_t result; + + + result = 8; + return result; +} + + +/************************************************************************* +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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void cmatrixtranspose(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_state *_state) +{ + ae_int_t i; + ae_int_t s1; + ae_int_t s2; + + + if( m<=2*ablascomplexblocksize(a, _state)&&n<=2*ablascomplexblocksize(a, _state) ) + { + + /* + * base case + */ + for(i=0; i<=m-1; i++) + { + ae_v_cmove(&b->ptr.pp_complex[ib][jb+i], b->stride, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(ib,ib+n-1)); + } + } + else + { + + /* + * Cache-oblivious recursion + */ + if( m>n ) + { + ablascomplexsplitlength(a, m, &s1, &s2, _state); + cmatrixtranspose(s1, n, a, ia, ja, b, ib, jb, _state); + cmatrixtranspose(s2, n, a, ia+s1, ja, b, ib, jb+s1, _state); + } + else + { + ablascomplexsplitlength(a, n, &s1, &s2, _state); + cmatrixtranspose(m, s1, a, ia, ja, b, ib, jb, _state); + cmatrixtranspose(m, s2, a, ia, ja+s1, b, ib+s1, jb, _state); + } + } +} + + +/************************************************************************* +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) + B - destination matrix, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void rmatrixtranspose(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_state *_state) +{ + ae_int_t i; + ae_int_t s1; + ae_int_t s2; + + + if( m<=2*ablasblocksize(a, _state)&&n<=2*ablasblocksize(a, _state) ) + { + + /* + * base case + */ + for(i=0; i<=m-1; i++) + { + ae_v_move(&b->ptr.pp_double[ib][jb+i], b->stride, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(ib,ib+n-1)); + } + } + else + { + + /* + * Cache-oblivious recursion + */ + if( m>n ) + { + ablassplitlength(a, m, &s1, &s2, _state); + rmatrixtranspose(s1, n, a, ia, ja, b, ib, jb, _state); + rmatrixtranspose(s2, n, a, ia+s1, ja, b, ib, jb+s1, _state); + } + else + { + ablassplitlength(a, n, &s1, &s2, _state); + rmatrixtranspose(m, s1, a, ia, ja, b, ib, jb, _state); + rmatrixtranspose(m, s2, a, ia, ja+s1, b, ib+s1, jb, _state); + } + } +} + + +/************************************************************************* +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 rmatrixenforcesymmetricity(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + + if( isupper ) + { + for(i=0; i<=n-1; i++) + { + for(j=i+1; j<=n-1; j++) + { + a->ptr.pp_double[j][i] = a->ptr.pp_double[i][j]; + } + } + } + else + { + for(i=0; i<=n-1; i++) + { + for(j=i+1; j<=n-1; j++) + { + a->ptr.pp_double[i][j] = a->ptr.pp_double[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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void cmatrixcopy(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_state *_state) +{ + ae_int_t i; + + + if( m==0||n==0 ) + { + return; + } + for(i=0; i<=m-1; i++) + { + ae_v_cmove(&b->ptr.pp_complex[ib+i][jb], 1, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(jb,jb+n-1)); + } +} + + +/************************************************************************* +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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void rmatrixcopy(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_state *_state) +{ + ae_int_t i; + + + if( m==0||n==0 ) + { + return; + } + for(i=0; i<=m-1; i++) + { + ae_v_move(&b->ptr.pp_double[ib+i][jb], 1, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(jb,jb+n-1)); + } +} + + +/************************************************************************* +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 cmatrixrank1(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Complex */ ae_vector* u, + ae_int_t iu, + /* Complex */ ae_vector* v, + ae_int_t iv, + ae_state *_state) +{ + ae_int_t i; + ae_complex s; + + + if( m==0||n==0 ) + { + return; + } + if( cmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv, _state) ) + { + return; + } + for(i=0; i<=m-1; i++) + { + s = u->ptr.p_complex[iu+i]; + ae_v_caddc(&a->ptr.pp_complex[ia+i][ja], 1, &v->ptr.p_complex[iv], 1, "N", ae_v_len(ja,ja+n-1), s); + } +} + + +/************************************************************************* +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 rmatrixrank1(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_vector* u, + ae_int_t iu, + /* Real */ ae_vector* v, + ae_int_t iv, + ae_state *_state) +{ + ae_int_t i; + double s; + + + if( m==0||n==0 ) + { + return; + } + if( rmatrixrank1f(m, n, a, ia, ja, u, iu, v, iv, _state) ) + { + return; + } + for(i=0; i<=m-1; i++) + { + s = u->ptr.p_double[iu+i]; + ae_v_addd(&a->ptr.pp_double[ia+i][ja], 1, &v->ptr.p_double[iv], 1, ae_v_len(ja,ja+n-1), s); + } +} + + +/************************************************************************* +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 + Y - preallocated matrix, must be large enough to store result + +OUTPUT PARAMETERS: + Y - vector which stores result + +if M=0, then subroutine does nothing. +if N=0, Y is filled by zeros. + + + -- ALGLIB routine -- + + 28.01.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixmv(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t opa, + /* Complex */ ae_vector* x, + ae_int_t ix, + /* Complex */ ae_vector* y, + ae_int_t iy, + ae_state *_state) +{ + ae_int_t i; + ae_complex v; + + + if( m==0 ) + { + return; + } + if( n==0 ) + { + for(i=0; i<=m-1; i++) + { + y->ptr.p_complex[iy+i] = ae_complex_from_d(0); + } + return; + } + if( cmatrixmvf(m, n, a, ia, ja, opa, x, ix, y, iy, _state) ) + { + return; + } + if( opa==0 ) + { + + /* + * y = A*x + */ + for(i=0; i<=m-1; i++) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+i][ja], 1, "N", &x->ptr.p_complex[ix], 1, "N", ae_v_len(ja,ja+n-1)); + y->ptr.p_complex[iy+i] = v; + } + return; + } + if( opa==1 ) + { + + /* + * y = A^T*x + */ + for(i=0; i<=m-1; i++) + { + y->ptr.p_complex[iy+i] = ae_complex_from_d(0); + } + for(i=0; i<=n-1; i++) + { + v = x->ptr.p_complex[ix+i]; + ae_v_caddc(&y->ptr.p_complex[iy], 1, &a->ptr.pp_complex[ia+i][ja], 1, "N", ae_v_len(iy,iy+m-1), v); + } + return; + } + if( opa==2 ) + { + + /* + * y = A^H*x + */ + for(i=0; i<=m-1; i++) + { + y->ptr.p_complex[iy+i] = ae_complex_from_d(0); + } + for(i=0; i<=n-1; i++) + { + v = x->ptr.p_complex[ix+i]; + ae_v_caddc(&y->ptr.p_complex[iy], 1, &a->ptr.pp_complex[ia+i][ja], 1, "Conj", ae_v_len(iy,iy+m-1), v); + } + return; + } +} + + +/************************************************************************* +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 + Y - preallocated matrix, must be large enough to store result + +OUTPUT PARAMETERS: + Y - vector which stores result + +if M=0, then subroutine does nothing. +if N=0, Y is filled by zeros. + + + -- ALGLIB routine -- + + 28.01.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixmv(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t opa, + /* Real */ ae_vector* x, + ae_int_t ix, + /* Real */ ae_vector* y, + ae_int_t iy, + ae_state *_state) +{ + ae_int_t i; + double v; + + + if( m==0 ) + { + return; + } + if( n==0 ) + { + for(i=0; i<=m-1; i++) + { + y->ptr.p_double[iy+i] = 0; + } + return; + } + if( rmatrixmvf(m, n, a, ia, ja, opa, x, ix, y, iy, _state) ) + { + return; + } + if( opa==0 ) + { + + /* + * y = A*x + */ + for(i=0; i<=m-1; i++) + { + v = ae_v_dotproduct(&a->ptr.pp_double[ia+i][ja], 1, &x->ptr.p_double[ix], 1, ae_v_len(ja,ja+n-1)); + y->ptr.p_double[iy+i] = v; + } + return; + } + if( opa==1 ) + { + + /* + * y = A^T*x + */ + for(i=0; i<=m-1; i++) + { + y->ptr.p_double[iy+i] = 0; + } + for(i=0; i<=n-1; i++) + { + v = x->ptr.p_double[ix+i]; + ae_v_addd(&y->ptr.p_double[iy], 1, &a->ptr.pp_double[ia+i][ja], 1, ae_v_len(iy,iy+m-1), v); + } + return; + } +} + + +void cmatrixrighttrsm(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t bs; + + + bs = ablascomplexblocksize(a, _state); + if( m<=bs&&n<=bs ) + { + ablas_cmatrixrighttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( m>=n ) + { + + /* + * Split X: X*A = (X1 X2)^T*A + */ + ablascomplexsplitlength(a, m, &s1, &s2, _state); + cmatrixrighttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + cmatrixrighttrsm(s2, n, a, i1, j1, isupper, isunit, optype, x, i2+s1, j2, _state); + return; + } + else + { + + /* + * Split A: + * (A1 A12) + * X*op(A) = X*op( ) + * ( A2) + * + * Different variants depending on + * IsUpper/OpType combinations + */ + ablascomplexsplitlength(a, n, &s1, &s2, _state); + if( isupper&&optype==0 ) + { + + /* + * (A1 A12)-1 + * X*A^-1 = (X1 X2)*( ) + * ( A2) + */ + cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + cmatrixgemm(m, s2, s1, ae_complex_from_d(-1.0), x, i2, j2, 0, a, i1, j1+s1, 0, ae_complex_from_d(1.0), x, i2, j2+s1, _state); + cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); + return; + } + if( isupper&&optype!=0 ) + { + + /* + * (A1' )-1 + * X*A^-1 = (X1 X2)*( ) + * (A12' A2') + */ + cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); + cmatrixgemm(m, s1, s2, ae_complex_from_d(-1.0), x, i2, j2+s1, 0, a, i1, j1+s1, optype, ae_complex_from_d(1.0), x, i2, j2, _state); + cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( !isupper&&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, _state); + cmatrixgemm(m, s1, s2, ae_complex_from_d(-1.0), x, i2, j2+s1, 0, a, i1+s1, j1, 0, ae_complex_from_d(1.0), x, i2, j2, _state); + cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( !isupper&&optype!=0 ) + { + + /* + * (A1' A21')-1 + * X*A^-1 = (X1 X2)*( ) + * ( A2') + */ + cmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + cmatrixgemm(m, s2, s1, ae_complex_from_d(-1.0), x, i2, j2, 0, a, i1+s1, j1, optype, ae_complex_from_d(1.0), x, i2, j2+s1, _state); + cmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); + return; + } + } +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_cmatrixrighttrsm(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, ae_state *_state) +{ + cmatrixrighttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state); +} + + +void cmatrixlefttrsm(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t bs; + + + bs = ablascomplexblocksize(a, _state); + if( m<=bs&&n<=bs ) + { + ablas_cmatrixlefttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( n>=m ) + { + + /* + * Split X: op(A)^-1*X = op(A)^-1*(X1 X2) + */ + ablascomplexsplitlength(x, n, &s1, &s2, _state); + cmatrixlefttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + cmatrixlefttrsm(m, s2, a, i1, j1, isupper, isunit, optype, x, i2, j2+s1, _state); + return; + } + else + { + + /* + * Split A + */ + ablascomplexsplitlength(a, m, &s1, &s2, _state); + if( isupper&&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, _state); + cmatrixgemm(s1, n, s2, ae_complex_from_d(-1.0), a, i1, j1+s1, 0, x, i2+s1, j2, 0, ae_complex_from_d(1.0), x, i2, j2, _state); + cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( isupper&&optype!=0 ) + { + + /* + * (A1' )-1 ( X1 ) + * A^-1*X = ( ) *( ) + * (A12' A2') ( X2 ) + */ + cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + cmatrixgemm(s2, n, s1, ae_complex_from_d(-1.0), a, i1, j1+s1, optype, x, i2, j2, 0, ae_complex_from_d(1.0), x, i2+s1, j2, _state); + cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); + return; + } + if( !isupper&&optype==0 ) + { + + /* + * (A1 )-1 ( X1 ) + * A^-1*X = ( ) *( ) + * (A21 A2) ( X2 ) + */ + cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + cmatrixgemm(s2, n, s1, ae_complex_from_d(-1.0), a, i1+s1, j1, 0, x, i2, j2, 0, ae_complex_from_d(1.0), x, i2+s1, j2, _state); + cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); + return; + } + if( !isupper&&optype!=0 ) + { + + /* + * (A1' A21')-1 ( X1 ) + * A^-1*X = ( ) *( ) + * ( A2') ( X2 ) + */ + cmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); + cmatrixgemm(s1, n, s2, ae_complex_from_d(-1.0), a, i1+s1, j1, optype, x, i2+s1, j2, 0, ae_complex_from_d(1.0), x, i2, j2, _state); + cmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + } +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_cmatrixlefttrsm(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, ae_state *_state) +{ + cmatrixlefttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state); +} + + +void rmatrixrighttrsm(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t bs; + + + bs = ablasblocksize(a, _state); + if( m<=bs&&n<=bs ) + { + ablas_rmatrixrighttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( m>=n ) + { + + /* + * Split X: X*A = (X1 X2)^T*A + */ + ablassplitlength(a, m, &s1, &s2, _state); + rmatrixrighttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + rmatrixrighttrsm(s2, n, a, i1, j1, isupper, isunit, optype, x, i2+s1, j2, _state); + return; + } + else + { + + /* + * Split A: + * (A1 A12) + * X*op(A) = X*op( ) + * ( A2) + * + * Different variants depending on + * IsUpper/OpType combinations + */ + ablassplitlength(a, n, &s1, &s2, _state); + if( isupper&&optype==0 ) + { + + /* + * (A1 A12)-1 + * X*A^-1 = (X1 X2)*( ) + * ( A2) + */ + rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + rmatrixgemm(m, s2, s1, -1.0, x, i2, j2, 0, a, i1, j1+s1, 0, 1.0, x, i2, j2+s1, _state); + rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); + return; + } + if( isupper&&optype!=0 ) + { + + /* + * (A1' )-1 + * X*A^-1 = (X1 X2)*( ) + * (A12' A2') + */ + rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); + rmatrixgemm(m, s1, s2, -1.0, x, i2, j2+s1, 0, a, i1, j1+s1, optype, 1.0, x, i2, j2, _state); + rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( !isupper&&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, _state); + rmatrixgemm(m, s1, s2, -1.0, x, i2, j2+s1, 0, a, i1+s1, j1, 0, 1.0, x, i2, j2, _state); + rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( !isupper&&optype!=0 ) + { + + /* + * (A1' A21')-1 + * X*A^-1 = (X1 X2)*( ) + * ( A2') + */ + rmatrixrighttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + rmatrixgemm(m, s2, s1, -1.0, x, i2, j2, 0, a, i1+s1, j1, optype, 1.0, x, i2, j2+s1, _state); + rmatrixrighttrsm(m, s2, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2, j2+s1, _state); + return; + } + } +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_rmatrixrighttrsm(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, ae_state *_state) +{ + rmatrixrighttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state); +} + + +void rmatrixlefttrsm(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t bs; + + + bs = ablasblocksize(a, _state); + if( m<=bs&&n<=bs ) + { + ablas_rmatrixlefttrsm2(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + if( n>=m ) + { + + /* + * Split X: op(A)^-1*X = op(A)^-1*(X1 X2) + */ + ablassplitlength(x, n, &s1, &s2, _state); + rmatrixlefttrsm(m, s1, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + rmatrixlefttrsm(m, s2, a, i1, j1, isupper, isunit, optype, x, i2, j2+s1, _state); + } + else + { + + /* + * Split A + */ + ablassplitlength(a, m, &s1, &s2, _state); + 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, _state); + rmatrixgemm(s1, n, s2, -1.0, a, i1, j1+s1, 0, x, i2+s1, j2, 0, 1.0, x, i2, j2, _state); + rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + 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, _state); + rmatrixgemm(s2, n, s1, -1.0, a, i1, j1+s1, optype, x, i2, j2, 0, 1.0, x, i2+s1, j2, _state); + rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); + return; + } + 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, _state); + rmatrixgemm(s2, n, s1, -1.0, a, i1+s1, j1, 0, x, i2, j2, 0, 1.0, x, i2+s1, j2, _state); + rmatrixlefttrsm(s2, n, a, i1+s1, j1+s1, isupper, isunit, optype, x, i2+s1, j2, _state); + return; + } + 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, _state); + rmatrixgemm(s1, n, s2, -1.0, a, i1+s1, j1, optype, x, i2+s1, j2, 0, 1.0, x, i2, j2, _state); + rmatrixlefttrsm(s1, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state); + return; + } + } +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_rmatrixlefttrsm(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, ae_state *_state) +{ + rmatrixlefttrsm(m,n,a,i1,j1,isupper,isunit,optype,x,i2,j2, _state); +} + + +void cmatrixsyrk(ae_int_t n, + ae_int_t k, + double alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t bs; + + + bs = ablascomplexblocksize(a, _state); + if( n<=bs&&k<=bs ) + { + ablas_cmatrixsyrk2(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + return; + } + if( k>=n ) + { + + /* + * Split K + */ + ablascomplexsplitlength(a, k, &s1, &s2, _state); + if( optypea==0 ) + { + cmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + cmatrixsyrk(n, s2, alpha, a, ia, ja+s1, optypea, 1.0, c, ic, jc, isupper, _state); + } + else + { + cmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + cmatrixsyrk(n, s2, alpha, a, ia+s1, ja, optypea, 1.0, c, ic, jc, isupper, _state); + } + } + else + { + + /* + * Split N + */ + ablascomplexsplitlength(a, n, &s1, &s2, _state); + if( optypea==0&&isupper ) + { + cmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + cmatrixgemm(s1, s2, k, ae_complex_from_d(alpha), a, ia, ja, 0, a, ia+s1, ja, 2, ae_complex_from_d(beta), c, ic, jc+s1, _state); + cmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state); + return; + } + if( optypea==0&&!isupper ) + { + cmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + cmatrixgemm(s2, s1, k, ae_complex_from_d(alpha), a, ia+s1, ja, 0, a, ia, ja, 2, ae_complex_from_d(beta), c, ic+s1, jc, _state); + cmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state); + return; + } + if( optypea!=0&&isupper ) + { + cmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + cmatrixgemm(s1, s2, k, ae_complex_from_d(alpha), a, ia, ja, 2, a, ia, ja+s1, 0, ae_complex_from_d(beta), c, ic, jc+s1, _state); + cmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state); + return; + } + if( optypea!=0&&!isupper ) + { + cmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + cmatrixgemm(s2, s1, k, ae_complex_from_d(alpha), a, ia, ja+s1, 2, a, ia, ja, 0, ae_complex_from_d(beta), c, ic+s1, jc, _state); + cmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state); + return; + } + } +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_cmatrixsyrk(ae_int_t n, + ae_int_t k, + double alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, ae_state *_state) +{ + cmatrixsyrk(n,k,alpha,a,ia,ja,optypea,beta,c,ic,jc,isupper, _state); +} + + +void rmatrixsyrk(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t bs; + + + bs = ablasblocksize(a, _state); + + /* + * Use MKL or generic basecase code + */ + if( rmatrixsyrkmkl(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) ) + { + return; + } + if( n<=bs&&k<=bs ) + { + ablas_rmatrixsyrk2(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + return; + } + + /* + * Recursive subdivision of the problem + */ + if( k>=n ) + { + + /* + * Split K + */ + ablassplitlength(a, k, &s1, &s2, _state); + if( optypea==0 ) + { + rmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + rmatrixsyrk(n, s2, alpha, a, ia, ja+s1, optypea, 1.0, c, ic, jc, isupper, _state); + } + else + { + rmatrixsyrk(n, s1, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + rmatrixsyrk(n, s2, alpha, a, ia+s1, ja, optypea, 1.0, c, ic, jc, isupper, _state); + } + } + else + { + + /* + * Split N + */ + ablassplitlength(a, n, &s1, &s2, _state); + if( optypea==0&&isupper ) + { + rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + rmatrixgemm(s1, s2, k, alpha, a, ia, ja, 0, a, ia+s1, ja, 1, beta, c, ic, jc+s1, _state); + rmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state); + return; + } + if( optypea==0&&!isupper ) + { + rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + rmatrixgemm(s2, s1, k, alpha, a, ia+s1, ja, 0, a, ia, ja, 1, beta, c, ic+s1, jc, _state); + rmatrixsyrk(s2, k, alpha, a, ia+s1, ja, optypea, beta, c, ic+s1, jc+s1, isupper, _state); + return; + } + if( optypea!=0&&isupper ) + { + rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + rmatrixgemm(s1, s2, k, alpha, a, ia, ja, 1, a, ia, ja+s1, 0, beta, c, ic, jc+s1, _state); + rmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state); + return; + } + if( optypea!=0&&!isupper ) + { + rmatrixsyrk(s1, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + rmatrixgemm(s2, s1, k, alpha, a, ia, ja+s1, 1, a, ia, ja, 0, beta, c, ic+s1, jc, _state); + rmatrixsyrk(s2, k, alpha, a, ia, ja+s1, optypea, beta, c, ic+s1, jc+s1, isupper, _state); + return; + } + } +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_rmatrixsyrk(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, ae_state *_state) +{ + rmatrixsyrk(n,k,alpha,a,ia,ja,optypea,beta,c,ic,jc,isupper, _state); +} + + +void cmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t bs; + + + bs = ablascomplexblocksize(a, _state); + if( (m<=bs&&n<=bs)&&k<=bs ) + { + cmatrixgemmk(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + return; + } + + /* + * SMP support is turned on when M or N are larger than some boundary value. + * Magnitude of K is not taken into account because splitting on K does not + * allow us to spawn child tasks. + */ + + /* + * Recursive algorithm: parallel splitting on M/N + */ + if( m>=n&&m>=k ) + { + + /* + * A*B = (A1 A2)^T*B + */ + ablascomplexsplitlength(a, m, &s1, &s2, _state); + cmatrixgemm(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + if( optypea==0 ) + { + cmatrixgemm(s2, n, k, alpha, a, ia+s1, ja, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state); + } + else + { + cmatrixgemm(s2, n, k, alpha, a, ia, ja+s1, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state); + } + return; + } + if( n>=m&&n>=k ) + { + + /* + * A*B = A*(B1 B2) + */ + ablascomplexsplitlength(a, n, &s1, &s2, _state); + if( optypeb==0 ) + { + cmatrixgemm(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + cmatrixgemm(m, s2, k, alpha, a, ia, ja, optypea, b, ib, jb+s1, optypeb, beta, c, ic, jc+s1, _state); + } + else + { + cmatrixgemm(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + cmatrixgemm(m, s2, k, alpha, a, ia, ja, optypea, b, ib+s1, jb, optypeb, beta, c, ic, jc+s1, _state); + } + return; + } + + /* + * Recursive algorithm: serial splitting on K + */ + + /* + * A*B = (A1 A2)*(B1 B2)^T + */ + ablascomplexsplitlength(a, k, &s1, &s2, _state); + if( optypea==0&&optypeb==0 ) + { + cmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + cmatrixgemm(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib+s1, jb, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state); + } + if( optypea==0&&optypeb!=0 ) + { + cmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + cmatrixgemm(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib, jb+s1, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state); + } + if( optypea!=0&&optypeb==0 ) + { + cmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + cmatrixgemm(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib+s1, jb, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state); + } + if( optypea!=0&&optypeb!=0 ) + { + cmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + cmatrixgemm(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib, jb+s1, optypeb, ae_complex_from_d(1.0), c, ic, jc, _state); + } + return; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_cmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, ae_state *_state) +{ + cmatrixgemm(m,n,k,alpha,a,ia,ja,optypea,b,ib,jb,optypeb,beta,c,ic,jc, _state); +} + + +void rmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state) +{ + ae_int_t s1; + ae_int_t s2; + ae_int_t bs; + + + bs = ablasblocksize(a, _state); + + /* + * Check input sizes for correctness + */ + ae_assert(optypea==0||optypea==1, "RMatrixGEMM: incorrect OpTypeA (must be 0 or 1)", _state); + ae_assert(optypeb==0||optypeb==1, "RMatrixGEMM: incorrect OpTypeB (must be 0 or 1)", _state); + ae_assert(ic+m<=c->rows, "RMatrixGEMM: incorect size of output matrix C", _state); + ae_assert(jc+n<=c->cols, "RMatrixGEMM: incorect size of output matrix C", _state); + + /* + * Use MKL or ALGLIB basecase code + */ + if( rmatrixgemmmkl(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state) ) + { + return; + } + if( (m<=bs&&n<=bs)&&k<=bs ) + { + rmatrixgemmk(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + return; + } + + /* + * SMP support is turned on when M or N are larger than some boundary value. + * Magnitude of K is not taken into account because splitting on K does not + * allow us to spawn child tasks. + */ + + /* + * Recursive algorithm: split on M or N + */ + if( m>=n&&m>=k ) + { + + /* + * A*B = (A1 A2)^T*B + */ + ablassplitlength(a, m, &s1, &s2, _state); + if( optypea==0 ) + { + rmatrixgemm(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + rmatrixgemm(s2, n, k, alpha, a, ia+s1, ja, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state); + } + else + { + rmatrixgemm(s1, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + rmatrixgemm(s2, n, k, alpha, a, ia, ja+s1, optypea, b, ib, jb, optypeb, beta, c, ic+s1, jc, _state); + } + return; + } + if( n>=m&&n>=k ) + { + + /* + * A*B = A*(B1 B2) + */ + ablassplitlength(a, n, &s1, &s2, _state); + if( optypeb==0 ) + { + rmatrixgemm(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + rmatrixgemm(m, s2, k, alpha, a, ia, ja, optypea, b, ib, jb+s1, optypeb, beta, c, ic, jc+s1, _state); + } + else + { + rmatrixgemm(m, s1, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + rmatrixgemm(m, s2, k, alpha, a, ia, ja, optypea, b, ib+s1, jb, optypeb, beta, c, ic, jc+s1, _state); + } + return; + } + + /* + * Recursive algorithm: split on K + */ + + /* + * A*B = (A1 A2)*(B1 B2)^T + */ + ablassplitlength(a, k, &s1, &s2, _state); + if( optypea==0&&optypeb==0 ) + { + rmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + rmatrixgemm(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib+s1, jb, optypeb, 1.0, c, ic, jc, _state); + } + if( optypea==0&&optypeb!=0 ) + { + rmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + rmatrixgemm(m, n, s2, alpha, a, ia, ja+s1, optypea, b, ib, jb+s1, optypeb, 1.0, c, ic, jc, _state); + } + if( optypea!=0&&optypeb==0 ) + { + rmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + rmatrixgemm(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib+s1, jb, optypeb, 1.0, c, ic, jc, _state); + } + if( optypea!=0&&optypeb!=0 ) + { + rmatrixgemm(m, n, s1, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + rmatrixgemm(m, n, s2, alpha, a, ia+s1, ja, optypea, b, ib, jb+s1, optypeb, 1.0, c, ic, jc, _state); + } + return; +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_rmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, ae_state *_state) +{ + rmatrixgemm(m,n,k,alpha,a,ia,ja,optypea,b,ib,jb,optypeb,beta,c,ic,jc, _state); +} + + +/************************************************************************* +Complex ABLASSplitLength + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +static void ablas_ablasinternalsplitlength(ae_int_t n, + ae_int_t nb, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state) +{ + ae_int_t r; + + *n1 = 0; + *n2 = 0; + + 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); + if( *n1%nb==0 ) + { + return; + } + r = nb-*n1%nb; + *n1 = *n1+r; + *n2 = *n2-r; + } + } +} + + +/************************************************************************* +Level 2 variant of CMatrixRightTRSM +*************************************************************************/ +static void ablas_cmatrixrighttrsm2(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_complex vc; + ae_complex vd; + + + + /* + * Special case + */ + if( n*m==0 ) + { + return; + } + + /* + * Try to call fast TRSM + */ + if( cmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) ) + { + return; + } + + /* + * General case + */ + if( isupper ) + { + + /* + * Upper triangular matrix + */ + if( optype==0 ) + { + + /* + * X*A^(-1) + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( isunit ) + { + vd = ae_complex_from_d(1); + } + else + { + vd = a->ptr.pp_complex[i1+j][j1+j]; + } + x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(x->ptr.pp_complex[i2+i][j2+j],vd); + if( jptr.pp_complex[i2+i][j2+j]; + ae_v_csubc(&x->ptr.pp_complex[i2+i][j2+j+1], 1, &a->ptr.pp_complex[i1+j][j1+j+1], 1, "N", ae_v_len(j2+j+1,j2+n-1), vc); + } + } + } + return; + } + if( optype==1 ) + { + + /* + * X*A^(-T) + */ + for(i=0; i<=m-1; i++) + { + for(j=n-1; j>=0; j--) + { + vc = ae_complex_from_d(0); + vd = ae_complex_from_d(1); + if( jptr.pp_complex[i2+i][j2+j+1], 1, "N", &a->ptr.pp_complex[i1+j][j1+j+1], 1, "N", ae_v_len(j2+j+1,j2+n-1)); + } + if( !isunit ) + { + vd = a->ptr.pp_complex[i1+j][j1+j]; + } + x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd); + } + } + return; + } + if( optype==2 ) + { + + /* + * X*A^(-H) + */ + for(i=0; i<=m-1; i++) + { + for(j=n-1; j>=0; j--) + { + vc = ae_complex_from_d(0); + vd = ae_complex_from_d(1); + if( jptr.pp_complex[i2+i][j2+j+1], 1, "N", &a->ptr.pp_complex[i1+j][j1+j+1], 1, "Conj", ae_v_len(j2+j+1,j2+n-1)); + } + if( !isunit ) + { + vd = ae_c_conj(a->ptr.pp_complex[i1+j][j1+j], _state); + } + x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd); + } + } + return; + } + } + else + { + + /* + * Lower triangular matrix + */ + if( optype==0 ) + { + + /* + * X*A^(-1) + */ + for(i=0; i<=m-1; i++) + { + for(j=n-1; j>=0; j--) + { + if( isunit ) + { + vd = ae_complex_from_d(1); + } + else + { + vd = a->ptr.pp_complex[i1+j][j1+j]; + } + x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(x->ptr.pp_complex[i2+i][j2+j],vd); + if( j>0 ) + { + vc = x->ptr.pp_complex[i2+i][j2+j]; + ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &a->ptr.pp_complex[i1+j][j1], 1, "N", ae_v_len(j2,j2+j-1), vc); + } + } + } + return; + } + if( optype==1 ) + { + + /* + * X*A^(-T) + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + vc = ae_complex_from_d(0); + vd = ae_complex_from_d(1); + if( j>0 ) + { + vc = ae_v_cdotproduct(&x->ptr.pp_complex[i2+i][j2], 1, "N", &a->ptr.pp_complex[i1+j][j1], 1, "N", ae_v_len(j2,j2+j-1)); + } + if( !isunit ) + { + vd = a->ptr.pp_complex[i1+j][j1+j]; + } + x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd); + } + } + return; + } + if( optype==2 ) + { + + /* + * X*A^(-H) + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + vc = ae_complex_from_d(0); + vd = ae_complex_from_d(1); + if( j>0 ) + { + vc = ae_v_cdotproduct(&x->ptr.pp_complex[i2+i][j2], 1, "N", &a->ptr.pp_complex[i1+j][j1], 1, "Conj", ae_v_len(j2,j2+j-1)); + } + if( !isunit ) + { + vd = ae_c_conj(a->ptr.pp_complex[i1+j][j1+j], _state); + } + x->ptr.pp_complex[i2+i][j2+j] = ae_c_div(ae_c_sub(x->ptr.pp_complex[i2+i][j2+j],vc),vd); + } + } + return; + } + } +} + + +/************************************************************************* +Level-2 subroutine +*************************************************************************/ +static void ablas_cmatrixlefttrsm2(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_complex vc; + ae_complex vd; + + + + /* + * Special case + */ + if( n*m==0 ) + { + return; + } + + /* + * Try to call fast TRSM + */ + if( cmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) ) + { + return; + } + + /* + * General case + */ + if( isupper ) + { + + /* + * Upper triangular matrix + */ + if( optype==0 ) + { + + /* + * A^(-1)*X + */ + for(i=m-1; i>=0; i--) + { + for(j=i+1; j<=m-1; j++) + { + vc = a->ptr.pp_complex[i1+i][j1+j]; + ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &x->ptr.pp_complex[i2+j][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); + } + if( !isunit ) + { + vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]); + ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + } + } + return; + } + if( optype==1 ) + { + + /* + * A^(-T)*X + */ + for(i=0; i<=m-1; i++) + { + if( isunit ) + { + vd = ae_complex_from_d(1); + } + else + { + vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]); + } + ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + for(j=i+1; j<=m-1; j++) + { + vc = a->ptr.pp_complex[i1+i][j1+j]; + ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); + } + } + return; + } + if( optype==2 ) + { + + /* + * A^(-H)*X + */ + for(i=0; i<=m-1; i++) + { + if( isunit ) + { + vd = ae_complex_from_d(1); + } + else + { + vd = ae_c_d_div(1,ae_c_conj(a->ptr.pp_complex[i1+i][j1+i], _state)); + } + ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + for(j=i+1; j<=m-1; j++) + { + vc = ae_c_conj(a->ptr.pp_complex[i1+i][j1+j], _state); + ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); + } + } + return; + } + } + else + { + + /* + * Lower triangular matrix + */ + if( optype==0 ) + { + + /* + * A^(-1)*X + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=i-1; j++) + { + vc = a->ptr.pp_complex[i1+i][j1+j]; + ae_v_csubc(&x->ptr.pp_complex[i2+i][j2], 1, &x->ptr.pp_complex[i2+j][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); + } + if( isunit ) + { + vd = ae_complex_from_d(1); + } + else + { + vd = ae_c_d_div(1,a->ptr.pp_complex[i1+j][j1+j]); + } + ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + } + return; + } + if( optype==1 ) + { + + /* + * A^(-T)*X + */ + for(i=m-1; i>=0; i--) + { + if( isunit ) + { + vd = ae_complex_from_d(1); + } + else + { + vd = ae_c_d_div(1,a->ptr.pp_complex[i1+i][j1+i]); + } + ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + for(j=i-1; j>=0; j--) + { + vc = a->ptr.pp_complex[i1+i][j1+j]; + ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); + } + } + return; + } + if( optype==2 ) + { + + /* + * A^(-H)*X + */ + for(i=m-1; i>=0; i--) + { + if( isunit ) + { + vd = ae_complex_from_d(1); + } + else + { + vd = ae_c_d_div(1,ae_c_conj(a->ptr.pp_complex[i1+i][j1+i], _state)); + } + ae_v_cmulc(&x->ptr.pp_complex[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + for(j=i-1; j>=0; j--) + { + vc = ae_c_conj(a->ptr.pp_complex[i1+i][j1+j], _state); + ae_v_csubc(&x->ptr.pp_complex[i2+j][j2], 1, &x->ptr.pp_complex[i2+i][j2], 1, "N", ae_v_len(j2,j2+n-1), vc); + } + } + return; + } + } +} + + +/************************************************************************* +Level 2 subroutine + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +static void ablas_rmatrixrighttrsm2(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double vr; + double vd; + + + + /* + * Special case + */ + if( n*m==0 ) + { + return; + } + + /* + * Try to use "fast" code + */ + if( rmatrixrighttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) ) + { + return; + } + + /* + * General case + */ + if( isupper ) + { + + /* + * Upper triangular matrix + */ + if( optype==0 ) + { + + /* + * X*A^(-1) + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( isunit ) + { + vd = 1; + } + else + { + vd = a->ptr.pp_double[i1+j][j1+j]; + } + x->ptr.pp_double[i2+i][j2+j] = x->ptr.pp_double[i2+i][j2+j]/vd; + if( jptr.pp_double[i2+i][j2+j]; + ae_v_subd(&x->ptr.pp_double[i2+i][j2+j+1], 1, &a->ptr.pp_double[i1+j][j1+j+1], 1, ae_v_len(j2+j+1,j2+n-1), vr); + } + } + } + return; + } + if( optype==1 ) + { + + /* + * X*A^(-T) + */ + for(i=0; i<=m-1; i++) + { + for(j=n-1; j>=0; j--) + { + vr = 0; + vd = 1; + if( jptr.pp_double[i2+i][j2+j+1], 1, &a->ptr.pp_double[i1+j][j1+j+1], 1, ae_v_len(j2+j+1,j2+n-1)); + } + if( !isunit ) + { + vd = a->ptr.pp_double[i1+j][j1+j]; + } + x->ptr.pp_double[i2+i][j2+j] = (x->ptr.pp_double[i2+i][j2+j]-vr)/vd; + } + } + return; + } + } + else + { + + /* + * Lower triangular matrix + */ + if( optype==0 ) + { + + /* + * X*A^(-1) + */ + for(i=0; i<=m-1; i++) + { + for(j=n-1; j>=0; j--) + { + if( isunit ) + { + vd = 1; + } + else + { + vd = a->ptr.pp_double[i1+j][j1+j]; + } + x->ptr.pp_double[i2+i][j2+j] = x->ptr.pp_double[i2+i][j2+j]/vd; + if( j>0 ) + { + vr = x->ptr.pp_double[i2+i][j2+j]; + ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &a->ptr.pp_double[i1+j][j1], 1, ae_v_len(j2,j2+j-1), vr); + } + } + } + return; + } + if( optype==1 ) + { + + /* + * X*A^(-T) + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + vr = 0; + vd = 1; + if( j>0 ) + { + vr = ae_v_dotproduct(&x->ptr.pp_double[i2+i][j2], 1, &a->ptr.pp_double[i1+j][j1], 1, ae_v_len(j2,j2+j-1)); + } + if( !isunit ) + { + vd = a->ptr.pp_double[i1+j][j1+j]; + } + x->ptr.pp_double[i2+i][j2+j] = (x->ptr.pp_double[i2+i][j2+j]-vr)/vd; + } + } + return; + } + } +} + + +/************************************************************************* +Level 2 subroutine +*************************************************************************/ +static void ablas_rmatrixlefttrsm2(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double vr; + double vd; + + + + /* + * Special case + */ + if( n==0||m==0 ) + { + return; + } + + /* + * Try fast code + */ + if( rmatrixlefttrsmf(m, n, a, i1, j1, isupper, isunit, optype, x, i2, j2, _state) ) + { + return; + } + + /* + * General case + */ + if( isupper ) + { + + /* + * Upper triangular matrix + */ + if( optype==0 ) + { + + /* + * A^(-1)*X + */ + for(i=m-1; i>=0; i--) + { + for(j=i+1; j<=m-1; j++) + { + vr = a->ptr.pp_double[i1+i][j1+j]; + ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &x->ptr.pp_double[i2+j][j2], 1, ae_v_len(j2,j2+n-1), vr); + } + if( !isunit ) + { + vd = 1/a->ptr.pp_double[i1+i][j1+i]; + ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + } + } + return; + } + if( optype==1 ) + { + + /* + * A^(-T)*X + */ + for(i=0; i<=m-1; i++) + { + if( isunit ) + { + vd = 1; + } + else + { + vd = 1/a->ptr.pp_double[i1+i][j1+i]; + } + ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + for(j=i+1; j<=m-1; j++) + { + vr = a->ptr.pp_double[i1+i][j1+j]; + ae_v_subd(&x->ptr.pp_double[i2+j][j2], 1, &x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vr); + } + } + return; + } + } + else + { + + /* + * Lower triangular matrix + */ + if( optype==0 ) + { + + /* + * A^(-1)*X + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=i-1; j++) + { + vr = a->ptr.pp_double[i1+i][j1+j]; + ae_v_subd(&x->ptr.pp_double[i2+i][j2], 1, &x->ptr.pp_double[i2+j][j2], 1, ae_v_len(j2,j2+n-1), vr); + } + if( isunit ) + { + vd = 1; + } + else + { + vd = 1/a->ptr.pp_double[i1+j][j1+j]; + } + ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + } + return; + } + if( optype==1 ) + { + + /* + * A^(-T)*X + */ + for(i=m-1; i>=0; i--) + { + if( isunit ) + { + vd = 1; + } + else + { + vd = 1/a->ptr.pp_double[i1+i][j1+i]; + } + ae_v_muld(&x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vd); + for(j=i-1; j>=0; j--) + { + vr = a->ptr.pp_double[i1+i][j1+j]; + ae_v_subd(&x->ptr.pp_double[i2+j][j2], 1, &x->ptr.pp_double[i2+i][j2], 1, ae_v_len(j2,j2+n-1), vr); + } + } + return; + } + } +} + + +/************************************************************************* +Level 2 subroutine +*************************************************************************/ +static void ablas_cmatrixsyrk2(ae_int_t n, + ae_int_t k, + double alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + ae_complex v; + + + + /* + * Fast exit (nothing to be done) + */ + if( (ae_fp_eq(alpha,0)||k==0)&&ae_fp_eq(beta,1) ) + { + return; + } + + /* + * Try to call fast SYRK + */ + if( cmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) ) + { + return; + } + + /* + * SYRK + */ + if( optypea==0 ) + { + + /* + * C=alpha*A*A^H+beta*C + */ + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + if( ae_fp_neq(alpha,0)&&k>0 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+i][ja], 1, "N", &a->ptr.pp_complex[ia+j][ja], 1, "Conj", ae_v_len(ja,ja+k-1)); + } + else + { + v = ae_complex_from_d(0); + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_complex[ic+i][jc+j] = ae_c_mul_d(v,alpha); + } + else + { + c->ptr.pp_complex[ic+i][jc+j] = ae_c_add(ae_c_mul_d(c->ptr.pp_complex[ic+i][jc+j],beta),ae_c_mul_d(v,alpha)); + } + } + } + return; + } + else + { + + /* + * C=alpha*A^H*A+beta*C + */ + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + if( ae_fp_eq(beta,0) ) + { + for(j=j1; j<=j2; j++) + { + c->ptr.pp_complex[ic+i][jc+j] = ae_complex_from_d(0); + } + } + else + { + ae_v_cmuld(&c->ptr.pp_complex[ic+i][jc+j1], 1, ae_v_len(jc+j1,jc+j2), beta); + } + } + for(i=0; i<=k-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( isupper ) + { + j1 = j; + j2 = n-1; + } + else + { + j1 = 0; + j2 = j; + } + v = ae_c_mul_d(ae_c_conj(a->ptr.pp_complex[ia+i][ja+j], _state),alpha); + ae_v_caddc(&c->ptr.pp_complex[ic+j][jc+j1], 1, &a->ptr.pp_complex[ia+i][ja+j1], 1, "N", ae_v_len(jc+j1,jc+j2), v); + } + } + return; + } +} + + +/************************************************************************* +Level 2 subrotuine +*************************************************************************/ +static void ablas_rmatrixsyrk2(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + double v; + + + + /* + * Fast exit (nothing to be done) + */ + if( (ae_fp_eq(alpha,0)||k==0)&&ae_fp_eq(beta,1) ) + { + return; + } + + /* + * Try to call fast SYRK + */ + if( rmatrixsyrkf(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state) ) + { + return; + } + + /* + * SYRK + */ + if( optypea==0 ) + { + + /* + * C=alpha*A*A^H+beta*C + */ + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + if( ae_fp_neq(alpha,0)&&k>0 ) + { + v = ae_v_dotproduct(&a->ptr.pp_double[ia+i][ja], 1, &a->ptr.pp_double[ia+j][ja], 1, ae_v_len(ja,ja+k-1)); + } + else + { + v = 0; + } + if( ae_fp_eq(beta,0) ) + { + c->ptr.pp_double[ic+i][jc+j] = alpha*v; + } + else + { + c->ptr.pp_double[ic+i][jc+j] = beta*c->ptr.pp_double[ic+i][jc+j]+alpha*v; + } + } + } + return; + } + else + { + + /* + * C=alpha*A^H*A+beta*C + */ + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + if( ae_fp_eq(beta,0) ) + { + for(j=j1; j<=j2; j++) + { + c->ptr.pp_double[ic+i][jc+j] = 0; + } + } + else + { + ae_v_muld(&c->ptr.pp_double[ic+i][jc+j1], 1, ae_v_len(jc+j1,jc+j2), beta); + } + } + for(i=0; i<=k-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( isupper ) + { + j1 = j; + j2 = n-1; + } + else + { + j1 = 0; + j2 = j; + } + v = alpha*a->ptr.pp_double[ia+i][ja+j]; + ae_v_addd(&c->ptr.pp_double[ic+j][jc+j1], 1, &a->ptr.pp_double[ia+i][ja+j1], 1, ae_v_len(jc+j1,jc+j2), v); + } + } + return; + } +} + + + + +/************************************************************************* +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). + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqr(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_vector taubuf; + ae_int_t minmn; + ae_matrix tmpa; + ae_matrix tmpt; + ae_matrix tmpr; + ae_int_t blockstart; + ae_int_t blocksize; + ae_int_t rowscount; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tau); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true); + + if( m<=0||n<=0 ) + { + ae_frame_leave(_state); + return; + } + minmn = ae_minint(m, n, _state); + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(tau, minmn, _state); + ae_vector_set_length(&taubuf, minmn, _state); + ae_matrix_set_length(&tmpa, m, ablasblocksize(a, _state), _state); + ae_matrix_set_length(&tmpt, ablasblocksize(a, _state), 2*ablasblocksize(a, _state), _state); + ae_matrix_set_length(&tmpr, 2*ablasblocksize(a, _state), n, _state); + + /* + * Blocked code + */ + blockstart = 0; + while(blockstart!=minmn) + { + + /* + * Determine block size + */ + blocksize = minmn-blockstart; + if( blocksize>ablasblocksize(a, _state) ) + { + blocksize = ablasblocksize(a, _state); + } + 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. + */ + rmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state); + rmatrixqrbasecase(&tmpa, rowscount, blocksize, &work, &t, &taubuf, _state); + rmatrixcopy(rowscount, blocksize, &tmpa, 0, 0, a, blockstart, blockstart, _state); + ae_v_move(&tau->ptr.p_double[blockstart], 1, &taubuf.ptr.p_double[0], 1, ae_v_len(blockstart,blockstart+blocksize-1)); + + /* + * 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 ) + { + if( n-blockstart-blocksize>=2*ablasblocksize(a, _state)||rowscount>=4*ablasblocksize(a, _state) ) + { + + /* + * Prepare block reflector + */ + ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state); + + /* + * 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' + */ + rmatrixgemm(blocksize, n-blockstart-blocksize, rowscount, 1.0, &tmpa, 0, 0, 1, a, blockstart, blockstart+blocksize, 0, 0.0, &tmpr, 0, 0, _state); + rmatrixgemm(blocksize, n-blockstart-blocksize, blocksize, 1.0, &tmpt, 0, 0, 1, &tmpr, 0, 0, 0, 0.0, &tmpr, blocksize, 0, _state); + rmatrixgemm(rowscount, n-blockstart-blocksize, blocksize, 1.0, &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, 1.0, a, blockstart, blockstart+blocksize, _state); + } + else + { + + /* + * Level 2 algorithm + */ + for(i=0; i<=blocksize-1; i++) + { + ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], tmpa.stride, ae_v_len(1,rowscount-i)); + t.ptr.p_double[1] = 1; + applyreflectionfromtheleft(a, taubuf.ptr.p_double[i], &t, blockstart+i, m-1, blockstart+blocksize, n-1, &work, _state); + } + } + } + + /* + * Advance + */ + blockstart = blockstart+blocksize; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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). + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlq(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_vector taubuf; + ae_int_t minmn; + ae_matrix tmpa; + ae_matrix tmpt; + ae_matrix tmpr; + ae_int_t blockstart; + ae_int_t blocksize; + ae_int_t columnscount; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tau); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true); + + if( m<=0||n<=0 ) + { + ae_frame_leave(_state); + return; + } + minmn = ae_minint(m, n, _state); + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(tau, minmn, _state); + ae_vector_set_length(&taubuf, minmn, _state); + ae_matrix_set_length(&tmpa, ablasblocksize(a, _state), n, _state); + ae_matrix_set_length(&tmpt, ablasblocksize(a, _state), 2*ablasblocksize(a, _state), _state); + ae_matrix_set_length(&tmpr, m, 2*ablasblocksize(a, _state), _state); + + /* + * Blocked code + */ + blockstart = 0; + while(blockstart!=minmn) + { + + /* + * Determine block size + */ + blocksize = minmn-blockstart; + if( blocksize>ablasblocksize(a, _state) ) + { + blocksize = ablasblocksize(a, _state); + } + 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. + */ + rmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state); + rmatrixlqbasecase(&tmpa, blocksize, columnscount, &work, &t, &taubuf, _state); + rmatrixcopy(blocksize, columnscount, &tmpa, 0, 0, a, blockstart, blockstart, _state); + ae_v_move(&tau->ptr.p_double[blockstart], 1, &taubuf.ptr.p_double[0], 1, ae_v_len(blockstart,blockstart+blocksize-1)); + + /* + * 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 ) + { + if( m-blockstart-blocksize>=2*ablasblocksize(a, _state) ) + { + + /* + * Prepare block reflector + */ + ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state); + + /* + * Multiply the rest of A by Q. + * + * Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA + */ + rmatrixgemm(m-blockstart-blocksize, blocksize, columnscount, 1.0, a, blockstart+blocksize, blockstart, 0, &tmpa, 0, 0, 1, 0.0, &tmpr, 0, 0, _state); + rmatrixgemm(m-blockstart-blocksize, blocksize, blocksize, 1.0, &tmpr, 0, 0, 0, &tmpt, 0, 0, 0, 0.0, &tmpr, 0, blocksize, _state); + rmatrixgemm(m-blockstart-blocksize, columnscount, blocksize, 1.0, &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, 1.0, a, blockstart+blocksize, blockstart, _state); + } + else + { + + /* + * Level 2 algorithm + */ + for(i=0; i<=blocksize-1; i++) + { + ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], 1, ae_v_len(1,columnscount-i)); + t.ptr.p_double[1] = 1; + applyreflectionfromtheright(a, taubuf.ptr.p_double[i], &t, blockstart+blocksize, m-1, blockstart+i, n-1, &work, _state); + } + } + } + + /* + * Advance + */ + blockstart = blockstart+blocksize; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 cmatrixqr(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* tau, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_vector taubuf; + ae_int_t minmn; + ae_matrix tmpa; + ae_matrix tmpt; + ae_matrix tmpr; + ae_int_t blockstart; + ae_int_t blocksize; + ae_int_t rowscount; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tau); + ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true); + + if( m<=0||n<=0 ) + { + ae_frame_leave(_state); + return; + } + minmn = ae_minint(m, n, _state); + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(tau, minmn, _state); + ae_vector_set_length(&taubuf, minmn, _state); + ae_matrix_set_length(&tmpa, m, ablascomplexblocksize(a, _state), _state); + ae_matrix_set_length(&tmpt, ablascomplexblocksize(a, _state), ablascomplexblocksize(a, _state), _state); + ae_matrix_set_length(&tmpr, 2*ablascomplexblocksize(a, _state), n, _state); + + /* + * Blocked code + */ + blockstart = 0; + while(blockstart!=minmn) + { + + /* + * Determine block size + */ + blocksize = minmn-blockstart; + if( blocksize>ablascomplexblocksize(a, _state) ) + { + blocksize = ablascomplexblocksize(a, _state); + } + 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. + */ + cmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state); + ortfac_cmatrixqrbasecase(&tmpa, rowscount, blocksize, &work, &t, &taubuf, _state); + cmatrixcopy(rowscount, blocksize, &tmpa, 0, 0, a, blockstart, blockstart, _state); + ae_v_cmove(&tau->ptr.p_complex[blockstart], 1, &taubuf.ptr.p_complex[0], 1, "N", ae_v_len(blockstart,blockstart+blocksize-1)); + + /* + * 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 ) + { + if( n-blockstart-blocksize>=2*ablascomplexblocksize(a, _state) ) + { + + /* + * Prepare block reflector + */ + ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state); + + /* + * 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' + */ + cmatrixgemm(blocksize, n-blockstart-blocksize, rowscount, ae_complex_from_d(1.0), &tmpa, 0, 0, 2, a, blockstart, blockstart+blocksize, 0, ae_complex_from_d(0.0), &tmpr, 0, 0, _state); + cmatrixgemm(blocksize, n-blockstart-blocksize, blocksize, ae_complex_from_d(1.0), &tmpt, 0, 0, 2, &tmpr, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, blocksize, 0, _state); + cmatrixgemm(rowscount, n-blockstart-blocksize, blocksize, ae_complex_from_d(1.0), &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, ae_complex_from_d(1.0), a, blockstart, blockstart+blocksize, _state); + } + else + { + + /* + * Level 2 algorithm + */ + for(i=0; i<=blocksize-1; i++) + { + ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], tmpa.stride, "N", ae_v_len(1,rowscount-i)); + t.ptr.p_complex[1] = ae_complex_from_d(1); + complexapplyreflectionfromtheleft(a, ae_c_conj(taubuf.ptr.p_complex[i], _state), &t, blockstart+i, m-1, blockstart+blocksize, n-1, &work, _state); + } + } + } + + /* + * Advance + */ + blockstart = blockstart+blocksize; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 cmatrixlq(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* tau, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_vector taubuf; + ae_int_t minmn; + ae_matrix tmpa; + ae_matrix tmpt; + ae_matrix tmpr; + ae_int_t blockstart; + ae_int_t blocksize; + ae_int_t columnscount; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tau); + ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true); + + if( m<=0||n<=0 ) + { + ae_frame_leave(_state); + return; + } + minmn = ae_minint(m, n, _state); + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(tau, minmn, _state); + ae_vector_set_length(&taubuf, minmn, _state); + ae_matrix_set_length(&tmpa, ablascomplexblocksize(a, _state), n, _state); + ae_matrix_set_length(&tmpt, ablascomplexblocksize(a, _state), ablascomplexblocksize(a, _state), _state); + ae_matrix_set_length(&tmpr, m, 2*ablascomplexblocksize(a, _state), _state); + + /* + * Blocked code + */ + blockstart = 0; + while(blockstart!=minmn) + { + + /* + * Determine block size + */ + blocksize = minmn-blockstart; + if( blocksize>ablascomplexblocksize(a, _state) ) + { + blocksize = ablascomplexblocksize(a, _state); + } + 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. + */ + cmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state); + ortfac_cmatrixlqbasecase(&tmpa, blocksize, columnscount, &work, &t, &taubuf, _state); + cmatrixcopy(blocksize, columnscount, &tmpa, 0, 0, a, blockstart, blockstart, _state); + ae_v_cmove(&tau->ptr.p_complex[blockstart], 1, &taubuf.ptr.p_complex[0], 1, "N", ae_v_len(blockstart,blockstart+blocksize-1)); + + /* + * 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 ) + { + if( m-blockstart-blocksize>=2*ablascomplexblocksize(a, _state) ) + { + + /* + * Prepare block reflector + */ + ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state); + + /* + * Multiply the rest of A by Q. + * + * Q = E + Y*T*Y' = E + TmpA'*TmpT*TmpA + */ + cmatrixgemm(m-blockstart-blocksize, blocksize, columnscount, ae_complex_from_d(1.0), a, blockstart+blocksize, blockstart, 0, &tmpa, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, 0, _state); + cmatrixgemm(m-blockstart-blocksize, blocksize, blocksize, ae_complex_from_d(1.0), &tmpr, 0, 0, 0, &tmpt, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, 0, blocksize, _state); + cmatrixgemm(m-blockstart-blocksize, columnscount, blocksize, ae_complex_from_d(1.0), &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, ae_complex_from_d(1.0), a, blockstart+blocksize, blockstart, _state); + } + else + { + + /* + * Level 2 algorithm + */ + for(i=0; i<=blocksize-1; i++) + { + ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,columnscount-i)); + t.ptr.p_complex[1] = ae_complex_from_d(1); + complexapplyreflectionfromtheright(a, taubuf.ptr.p_complex[i], &t, blockstart+blocksize, m-1, blockstart+i, n-1, &work, _state); + } + } + } + + /* + * Advance + */ + blockstart = blockstart+blocksize; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqrunpackq(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_int_t qcolumns, + /* Real */ ae_matrix* q, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_vector taubuf; + ae_int_t minmn; + ae_int_t refcnt; + ae_matrix tmpa; + ae_matrix tmpt; + ae_matrix tmpr; + ae_int_t blockstart; + ae_int_t blocksize; + ae_int_t rowscount; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(q); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true); + + ae_assert(qcolumns<=m, "UnpackQFromQR: QColumns>M!", _state); + if( (m<=0||n<=0)||qcolumns<=0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * init + */ + minmn = ae_minint(m, n, _state); + refcnt = ae_minint(minmn, qcolumns, _state); + ae_matrix_set_length(q, m, qcolumns, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=qcolumns-1; j++) + { + if( i==j ) + { + q->ptr.pp_double[i][j] = 1; + } + else + { + q->ptr.pp_double[i][j] = 0; + } + } + } + ae_vector_set_length(&work, ae_maxint(m, qcolumns, _state)+1, _state); + ae_vector_set_length(&t, ae_maxint(m, qcolumns, _state)+1, _state); + ae_vector_set_length(&taubuf, minmn, _state); + ae_matrix_set_length(&tmpa, m, ablasblocksize(a, _state), _state); + ae_matrix_set_length(&tmpt, ablasblocksize(a, _state), 2*ablasblocksize(a, _state), _state); + ae_matrix_set_length(&tmpr, 2*ablasblocksize(a, _state), qcolumns, _state); + + /* + * Blocked code + */ + blockstart = ablasblocksize(a, _state)*(refcnt/ablasblocksize(a, _state)); + blocksize = refcnt-blockstart; + while(blockstart>=0) + { + rowscount = m-blockstart; + if( blocksize>0 ) + { + + /* + * Copy current block + */ + rmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state); + ae_v_move(&taubuf.ptr.p_double[0], 1, &tau->ptr.p_double[blockstart], 1, ae_v_len(0,blocksize-1)); + + /* + * 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*ablasblocksize(a, _state) ) + { + + /* + * Prepare block reflector + */ + ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state); + + /* + * Multiply matrix by Q. + * + * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA' + */ + rmatrixgemm(blocksize, qcolumns, rowscount, 1.0, &tmpa, 0, 0, 1, q, blockstart, 0, 0, 0.0, &tmpr, 0, 0, _state); + rmatrixgemm(blocksize, qcolumns, blocksize, 1.0, &tmpt, 0, 0, 0, &tmpr, 0, 0, 0, 0.0, &tmpr, blocksize, 0, _state); + rmatrixgemm(rowscount, qcolumns, blocksize, 1.0, &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, 1.0, q, blockstart, 0, _state); + } + else + { + + /* + * Level 2 algorithm + */ + for(i=blocksize-1; i>=0; i--) + { + ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], tmpa.stride, ae_v_len(1,rowscount-i)); + t.ptr.p_double[1] = 1; + applyreflectionfromtheleft(q, taubuf.ptr.p_double[i], &t, blockstart+i, m-1, 0, qcolumns-1, &work, _state); + } + } + } + + /* + * Advance + */ + blockstart = blockstart-ablasblocksize(a, _state); + blocksize = ablasblocksize(a, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqrunpackr(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* r, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + ae_matrix_clear(r); + + if( m<=0||n<=0 ) + { + return; + } + k = ae_minint(m, n, _state); + ae_matrix_set_length(r, m, n, _state); + for(i=0; i<=n-1; i++) + { + r->ptr.pp_double[0][i] = 0; + } + for(i=1; i<=m-1; i++) + { + ae_v_move(&r->ptr.pp_double[i][0], 1, &r->ptr.pp_double[0][0], 1, ae_v_len(0,n-1)); + } + for(i=0; i<=k-1; i++) + { + ae_v_move(&r->ptr.pp_double[i][i], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); + } +} + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlqunpackq(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_int_t qrows, + /* Real */ ae_matrix* q, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_vector taubuf; + ae_int_t minmn; + ae_int_t refcnt; + ae_matrix tmpa; + ae_matrix tmpt; + ae_matrix tmpr; + ae_int_t blockstart; + ae_int_t blocksize; + ae_int_t columnscount; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(q); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&taubuf, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpa, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpt, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&tmpr, 0, 0, DT_REAL, _state, ae_true); + + ae_assert(qrows<=n, "RMatrixLQUnpackQ: QRows>N!", _state); + if( (m<=0||n<=0)||qrows<=0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * init + */ + minmn = ae_minint(m, n, _state); + refcnt = ae_minint(minmn, qrows, _state); + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&taubuf, minmn, _state); + ae_matrix_set_length(&tmpa, ablasblocksize(a, _state), n, _state); + ae_matrix_set_length(&tmpt, ablasblocksize(a, _state), 2*ablasblocksize(a, _state), _state); + ae_matrix_set_length(&tmpr, qrows, 2*ablasblocksize(a, _state), _state); + ae_matrix_set_length(q, qrows, n, _state); + for(i=0; i<=qrows-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( i==j ) + { + q->ptr.pp_double[i][j] = 1; + } + else + { + q->ptr.pp_double[i][j] = 0; + } + } + } + + /* + * Blocked code + */ + blockstart = ablasblocksize(a, _state)*(refcnt/ablasblocksize(a, _state)); + blocksize = refcnt-blockstart; + while(blockstart>=0) + { + columnscount = n-blockstart; + if( blocksize>0 ) + { + + /* + * Copy submatrix + */ + rmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state); + ae_v_move(&taubuf.ptr.p_double[0], 1, &tau->ptr.p_double[blockstart], 1, ae_v_len(0,blocksize-1)); + + /* + * 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*ablasblocksize(a, _state) ) + { + + /* + * Prepare block reflector + */ + ortfac_rmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state); + + /* + * Multiply the rest of A by Q'. + * + * Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA + */ + rmatrixgemm(qrows, blocksize, columnscount, 1.0, q, 0, blockstart, 0, &tmpa, 0, 0, 1, 0.0, &tmpr, 0, 0, _state); + rmatrixgemm(qrows, blocksize, blocksize, 1.0, &tmpr, 0, 0, 0, &tmpt, 0, 0, 1, 0.0, &tmpr, 0, blocksize, _state); + rmatrixgemm(qrows, columnscount, blocksize, 1.0, &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, 1.0, q, 0, blockstart, _state); + } + else + { + + /* + * Level 2 algorithm + */ + for(i=blocksize-1; i>=0; i--) + { + ae_v_move(&t.ptr.p_double[1], 1, &tmpa.ptr.pp_double[i][i], 1, ae_v_len(1,columnscount-i)); + t.ptr.p_double[1] = 1; + applyreflectionfromtheright(q, taubuf.ptr.p_double[i], &t, 0, qrows-1, blockstart+i, n-1, &work, _state); + } + } + } + + /* + * Advance + */ + blockstart = blockstart-ablasblocksize(a, _state); + blocksize = ablasblocksize(a, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlqunpackl(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* l, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + ae_matrix_clear(l); + + if( m<=0||n<=0 ) + { + return; + } + ae_matrix_set_length(l, m, n, _state); + for(i=0; i<=n-1; i++) + { + l->ptr.pp_double[0][i] = 0; + } + for(i=1; i<=m-1; i++) + { + ae_v_move(&l->ptr.pp_double[i][0], 1, &l->ptr.pp_double[0][0], 1, ae_v_len(0,n-1)); + } + for(i=0; i<=m-1; i++) + { + k = ae_minint(i, n-1, _state); + ae_v_move(&l->ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k)); + } +} + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixqrunpackq(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* tau, + ae_int_t qcolumns, + /* Complex */ ae_matrix* q, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_vector taubuf; + ae_int_t minmn; + ae_int_t refcnt; + ae_matrix tmpa; + ae_matrix tmpt; + ae_matrix tmpr; + ae_int_t blockstart; + ae_int_t blocksize; + ae_int_t rowscount; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(q); + ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(qcolumns<=m, "UnpackQFromQR: QColumns>M!", _state); + if( m<=0||n<=0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * init + */ + minmn = ae_minint(m, n, _state); + refcnt = ae_minint(minmn, qcolumns, _state); + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&taubuf, minmn, _state); + ae_matrix_set_length(&tmpa, m, ablascomplexblocksize(a, _state), _state); + ae_matrix_set_length(&tmpt, ablascomplexblocksize(a, _state), ablascomplexblocksize(a, _state), _state); + ae_matrix_set_length(&tmpr, 2*ablascomplexblocksize(a, _state), qcolumns, _state); + ae_matrix_set_length(q, m, qcolumns, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=qcolumns-1; j++) + { + if( i==j ) + { + q->ptr.pp_complex[i][j] = ae_complex_from_d(1); + } + else + { + q->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + } + + /* + * Blocked code + */ + blockstart = ablascomplexblocksize(a, _state)*(refcnt/ablascomplexblocksize(a, _state)); + blocksize = refcnt-blockstart; + 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. + */ + cmatrixcopy(rowscount, blocksize, a, blockstart, blockstart, &tmpa, 0, 0, _state); + ae_v_cmove(&taubuf.ptr.p_complex[0], 1, &tau->ptr.p_complex[blockstart], 1, "N", ae_v_len(0,blocksize-1)); + + /* + * 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*ablascomplexblocksize(a, _state) ) + { + + /* + * Prepare block reflector + */ + ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_true, rowscount, blocksize, &tmpt, &work, _state); + + /* + * Multiply the rest of A by Q. + * + * Q = E + Y*T*Y' = E + TmpA*TmpT*TmpA' + */ + cmatrixgemm(blocksize, qcolumns, rowscount, ae_complex_from_d(1.0), &tmpa, 0, 0, 2, q, blockstart, 0, 0, ae_complex_from_d(0.0), &tmpr, 0, 0, _state); + cmatrixgemm(blocksize, qcolumns, blocksize, ae_complex_from_d(1.0), &tmpt, 0, 0, 0, &tmpr, 0, 0, 0, ae_complex_from_d(0.0), &tmpr, blocksize, 0, _state); + cmatrixgemm(rowscount, qcolumns, blocksize, ae_complex_from_d(1.0), &tmpa, 0, 0, 0, &tmpr, blocksize, 0, 0, ae_complex_from_d(1.0), q, blockstart, 0, _state); + } + else + { + + /* + * Level 2 algorithm + */ + for(i=blocksize-1; i>=0; i--) + { + ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], tmpa.stride, "N", ae_v_len(1,rowscount-i)); + t.ptr.p_complex[1] = ae_complex_from_d(1); + complexapplyreflectionfromtheleft(q, taubuf.ptr.p_complex[i], &t, blockstart+i, m-1, 0, qcolumns-1, &work, _state); + } + } + } + + /* + * Advance + */ + blockstart = blockstart-ablascomplexblocksize(a, _state); + blocksize = ablascomplexblocksize(a, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixqrunpackr(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* r, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + ae_matrix_clear(r); + + if( m<=0||n<=0 ) + { + return; + } + k = ae_minint(m, n, _state); + ae_matrix_set_length(r, m, n, _state); + for(i=0; i<=n-1; i++) + { + r->ptr.pp_complex[0][i] = ae_complex_from_d(0); + } + for(i=1; i<=m-1; i++) + { + ae_v_cmove(&r->ptr.pp_complex[i][0], 1, &r->ptr.pp_complex[0][0], 1, "N", ae_v_len(0,n-1)); + } + for(i=0; i<=k-1; i++) + { + ae_v_cmove(&r->ptr.pp_complex[i][i], 1, &a->ptr.pp_complex[i][i], 1, "N", ae_v_len(i,n-1)); + } +} + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlqunpackq(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* tau, + ae_int_t qrows, + /* Complex */ ae_matrix* q, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_vector taubuf; + ae_int_t minmn; + ae_int_t refcnt; + ae_matrix tmpa; + ae_matrix tmpt; + ae_matrix tmpr; + ae_int_t blockstart; + ae_int_t blocksize; + ae_int_t columnscount; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(q); + ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&taubuf, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpa, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpt, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&tmpr, 0, 0, DT_COMPLEX, _state, ae_true); + + if( m<=0||n<=0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Init + */ + minmn = ae_minint(m, n, _state); + refcnt = ae_minint(minmn, qrows, _state); + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&t, ae_maxint(m, n, _state)+1, _state); + ae_vector_set_length(&taubuf, minmn, _state); + ae_matrix_set_length(&tmpa, ablascomplexblocksize(a, _state), n, _state); + ae_matrix_set_length(&tmpt, ablascomplexblocksize(a, _state), ablascomplexblocksize(a, _state), _state); + ae_matrix_set_length(&tmpr, qrows, 2*ablascomplexblocksize(a, _state), _state); + ae_matrix_set_length(q, qrows, n, _state); + for(i=0; i<=qrows-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( i==j ) + { + q->ptr.pp_complex[i][j] = ae_complex_from_d(1); + } + else + { + q->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + } + + /* + * Blocked code + */ + blockstart = ablascomplexblocksize(a, _state)*(refcnt/ablascomplexblocksize(a, _state)); + blocksize = refcnt-blockstart; + 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. + */ + cmatrixcopy(blocksize, columnscount, a, blockstart, blockstart, &tmpa, 0, 0, _state); + ae_v_cmove(&taubuf.ptr.p_complex[0], 1, &tau->ptr.p_complex[blockstart], 1, "N", ae_v_len(0,blocksize-1)); + + /* + * 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*ablascomplexblocksize(a, _state) ) + { + + /* + * Prepare block reflector + */ + ortfac_cmatrixblockreflector(&tmpa, &taubuf, ae_false, columnscount, blocksize, &tmpt, &work, _state); + + /* + * Multiply the rest of A by Q'. + * + * Q' = E + Y*T'*Y' = E + TmpA'*TmpT'*TmpA + */ + cmatrixgemm(qrows, blocksize, columnscount, ae_complex_from_d(1.0), q, 0, blockstart, 0, &tmpa, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, 0, _state); + cmatrixgemm(qrows, blocksize, blocksize, ae_complex_from_d(1.0), &tmpr, 0, 0, 0, &tmpt, 0, 0, 2, ae_complex_from_d(0.0), &tmpr, 0, blocksize, _state); + cmatrixgemm(qrows, columnscount, blocksize, ae_complex_from_d(1.0), &tmpr, 0, blocksize, 0, &tmpa, 0, 0, 0, ae_complex_from_d(1.0), q, 0, blockstart, _state); + } + else + { + + /* + * Level 2 algorithm + */ + for(i=blocksize-1; i>=0; i--) + { + ae_v_cmove(&t.ptr.p_complex[1], 1, &tmpa.ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,columnscount-i)); + t.ptr.p_complex[1] = ae_complex_from_d(1); + complexapplyreflectionfromtheright(q, ae_c_conj(taubuf.ptr.p_complex[i], _state), &t, 0, qrows-1, blockstart+i, n-1, &work, _state); + } + } + } + + /* + * Advance + */ + blockstart = blockstart-ablascomplexblocksize(a, _state); + blocksize = ablascomplexblocksize(a, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlqunpackl(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* l, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + + ae_matrix_clear(l); + + if( m<=0||n<=0 ) + { + return; + } + ae_matrix_set_length(l, m, n, _state); + for(i=0; i<=n-1; i++) + { + l->ptr.pp_complex[0][i] = ae_complex_from_d(0); + } + for(i=1; i<=m-1; i++) + { + ae_v_cmove(&l->ptr.pp_complex[i][0], 1, &l->ptr.pp_complex[0][0], 1, "N", ae_v_len(0,n-1)); + } + for(i=0; i<=m-1; i++) + { + k = ae_minint(i, n-1, _state); + ae_v_cmove(&l->ptr.pp_complex[i][0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,k)); + } +} + + +/************************************************************************* +Base case for real QR + + -- 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. + Sergey Bochkanov, ALGLIB project, translation from FORTRAN to + pseudocode, 2007-2010. +*************************************************************************/ +void rmatrixqrbasecase(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* work, + /* Real */ ae_vector* t, + /* Real */ ae_vector* tau, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + ae_int_t minmn; + double tmp; + + + minmn = ae_minint(m, n, _state); + + /* + * Test the input arguments + */ + k = minmn; + for(i=0; i<=k-1; i++) + { + + /* + * Generate elementary reflector H(i) to annihilate A(i+1:m,i) + */ + ae_v_move(&t->ptr.p_double[1], 1, &a->ptr.pp_double[i][i], a->stride, ae_v_len(1,m-i)); + generatereflection(t, m-i, &tmp, _state); + tau->ptr.p_double[i] = tmp; + ae_v_move(&a->ptr.pp_double[i][i], a->stride, &t->ptr.p_double[1], 1, ae_v_len(i,m-1)); + t->ptr.p_double[1] = 1; + if( iptr.p_double[i], t, i, m-1, i+1, n-1, work, _state); + } + } +} + + +/************************************************************************* +Base case for real LQ + + -- 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. + Sergey Bochkanov, ALGLIB project, translation from FORTRAN to + pseudocode, 2007-2010. +*************************************************************************/ +void rmatrixlqbasecase(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* work, + /* Real */ ae_vector* t, + /* Real */ ae_vector* tau, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + double tmp; + + + k = ae_minint(m, n, _state); + for(i=0; i<=k-1; i++) + { + + /* + * Generate elementary reflector H(i) to annihilate A(i,i+1:n-1) + */ + ae_v_move(&t->ptr.p_double[1], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(1,n-i)); + generatereflection(t, n-i, &tmp, _state); + tau->ptr.p_double[i] = tmp; + ae_v_move(&a->ptr.pp_double[i][i], 1, &t->ptr.p_double[1], 1, ae_v_len(i,n-1)); + t->ptr.p_double[1] = 1; + if( iptr.p_double[i], t, i+1, m-1, i, n-1, work, _state); + } + } +} + + +/************************************************************************* +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): 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. + + -- 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. + Sergey Bochkanov, ALGLIB project, translation from FORTRAN to + pseudocode, 2007-2010. +*************************************************************************/ +void rmatrixbd(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tauq, + /* Real */ ae_vector* taup, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_vector t; + ae_int_t maxmn; + ae_int_t i; + double ltau; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tauq); + ae_vector_clear(taup); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + + /* + * Prepare + */ + if( n<=0||m<=0 ) + { + ae_frame_leave(_state); + return; + } + maxmn = ae_maxint(m, n, _state); + ae_vector_set_length(&work, maxmn+1, _state); + ae_vector_set_length(&t, maxmn+1, _state); + if( m>=n ) + { + ae_vector_set_length(tauq, n, _state); + ae_vector_set_length(taup, n, _state); + } + else + { + ae_vector_set_length(tauq, m, _state); + ae_vector_set_length(taup, m, _state); + } + if( m>=n ) + { + + /* + * Reduce to upper bidiagonal form + */ + for(i=0; i<=n-1; i++) + { + + /* + * Generate elementary reflector H(i) to annihilate A(i+1:m-1,i) + */ + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i][i], a->stride, ae_v_len(1,m-i)); + generatereflection(&t, m-i, <au, _state); + tauq->ptr.p_double[i] = ltau; + ae_v_move(&a->ptr.pp_double[i][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i,m-1)); + t.ptr.p_double[1] = 1; + + /* + * Apply H(i) to A(i:m-1,i+1:n-1) from the left + */ + applyreflectionfromtheleft(a, ltau, &t, i, m-1, i+1, n-1, &work, _state); + if( iptr.pp_double[i][i+1], 1, ae_v_len(1,n-i-1)); + generatereflection(&t, n-1-i, <au, _state); + taup->ptr.p_double[i] = ltau; + ae_v_move(&a->ptr.pp_double[i][i+1], 1, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1)); + t.ptr.p_double[1] = 1; + + /* + * Apply G(i) to A(i+1:m-1,i+1:n-1) from the right + */ + applyreflectionfromtheright(a, ltau, &t, i+1, m-1, i+1, n-1, &work, _state); + } + else + { + taup->ptr.p_double[i] = 0; + } + } + } + else + { + + /* + * Reduce to lower bidiagonal form + */ + for(i=0; i<=m-1; i++) + { + + /* + * Generate elementary reflector G(i) to annihilate A(i,i+1:n-1) + */ + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i][i], 1, ae_v_len(1,n-i)); + generatereflection(&t, n-i, <au, _state); + taup->ptr.p_double[i] = ltau; + ae_v_move(&a->ptr.pp_double[i][i], 1, &t.ptr.p_double[1], 1, ae_v_len(i,n-1)); + t.ptr.p_double[1] = 1; + + /* + * Apply G(i) to A(i+1:m-1,i:n-1) from the right + */ + applyreflectionfromtheright(a, ltau, &t, i+1, m-1, i, n-1, &work, _state); + if( iptr.pp_double[i+1][i], a->stride, ae_v_len(1,m-1-i)); + generatereflection(&t, m-1-i, <au, _state); + tauq->ptr.p_double[i] = ltau; + ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,m-1)); + t.ptr.p_double[1] = 1; + + /* + * Apply H(i) to A(i+1:m-1,i+1:n-1) from the left + */ + applyreflectionfromtheleft(a, ltau, &t, i+1, m-1, i+1, n-1, &work, _state); + } + else + { + tauq->ptr.p_double[i] = 0; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackq(/* Real */ ae_matrix* qp, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tauq, + ae_int_t qcolumns, + /* Real */ ae_matrix* q, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + ae_matrix_clear(q); + + ae_assert(qcolumns<=m, "RMatrixBDUnpackQ: QColumns>M!", _state); + ae_assert(qcolumns>=0, "RMatrixBDUnpackQ: QColumns<0!", _state); + if( (m==0||n==0)||qcolumns==0 ) + { + return; + } + + /* + * prepare Q + */ + ae_matrix_set_length(q, m, qcolumns, _state); + for(i=0; i<=m-1; i++) + { + for(j=0; j<=qcolumns-1; j++) + { + if( i==j ) + { + q->ptr.pp_double[i][j] = 1; + } + else + { + q->ptr.pp_double[i][j] = 0; + } + } + } + + /* + * Calculate + */ + rmatrixbdmultiplybyq(qp, m, n, tauq, q, m, qcolumns, ae_false, ae_false, _state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdmultiplybyq(/* Real */ ae_matrix* qp, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tauq, + /* Real */ ae_matrix* z, + ae_int_t zrows, + ae_int_t zcolumns, + ae_bool fromtheright, + ae_bool dotranspose, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t i1; + ae_int_t i2; + ae_int_t istep; + ae_vector v; + ae_vector work; + ae_int_t mx; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + if( ((m<=0||n<=0)||zrows<=0)||zcolumns<=0 ) + { + ae_frame_leave(_state); + return; + } + ae_assert((fromtheright&&zcolumns==m)||(!fromtheright&&zrows==m), "RMatrixBDMultiplyByQ: incorrect Z size!", _state); + + /* + * init + */ + mx = ae_maxint(m, n, _state); + mx = ae_maxint(mx, zrows, _state); + mx = ae_maxint(mx, zcolumns, _state); + ae_vector_set_length(&v, mx+1, _state); + ae_vector_set_length(&work, mx+1, _state); + if( m>=n ) + { + + /* + * setup + */ + if( fromtheright ) + { + i1 = 0; + i2 = n-1; + istep = 1; + } + else + { + i1 = n-1; + i2 = 0; + istep = -1; + } + if( dotranspose ) + { + i = i1; + i1 = i2; + i2 = i; + istep = -istep; + } + + /* + * Process + */ + i = i1; + do + { + ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i], qp->stride, ae_v_len(1,m-i)); + v.ptr.p_double[1] = 1; + if( fromtheright ) + { + applyreflectionfromtheright(z, tauq->ptr.p_double[i], &v, 0, zrows-1, i, m-1, &work, _state); + } + else + { + applyreflectionfromtheleft(z, tauq->ptr.p_double[i], &v, i, m-1, 0, zcolumns-1, &work, _state); + } + 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; + } + if( dotranspose ) + { + i = i1; + i1 = i2; + i2 = i; + istep = -istep; + } + + /* + * Process + */ + if( m-1>0 ) + { + i = i1; + do + { + ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i+1][i], qp->stride, ae_v_len(1,m-i-1)); + v.ptr.p_double[1] = 1; + if( fromtheright ) + { + applyreflectionfromtheright(z, tauq->ptr.p_double[i], &v, 0, zrows-1, i+1, m-1, &work, _state); + } + else + { + applyreflectionfromtheleft(z, tauq->ptr.p_double[i], &v, i+1, m-1, 0, zcolumns-1, &work, _state); + } + i = i+istep; + } + while(i!=i2+istep); + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackpt(/* Real */ ae_matrix* qp, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* taup, + ae_int_t ptrows, + /* Real */ ae_matrix* pt, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + ae_matrix_clear(pt); + + ae_assert(ptrows<=n, "RMatrixBDUnpackPT: PTRows>N!", _state); + ae_assert(ptrows>=0, "RMatrixBDUnpackPT: PTRows<0!", _state); + if( (m==0||n==0)||ptrows==0 ) + { + return; + } + + /* + * prepare PT + */ + ae_matrix_set_length(pt, ptrows, n, _state); + for(i=0; i<=ptrows-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( i==j ) + { + pt->ptr.pp_double[i][j] = 1; + } + else + { + pt->ptr.pp_double[i][j] = 0; + } + } + } + + /* + * Calculate + */ + rmatrixbdmultiplybyp(qp, m, n, taup, pt, ptrows, n, ae_true, ae_true, _state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdmultiplybyp(/* Real */ ae_matrix* qp, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* taup, + /* Real */ ae_matrix* z, + ae_int_t zrows, + ae_int_t zcolumns, + ae_bool fromtheright, + ae_bool dotranspose, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector v; + ae_vector work; + ae_int_t mx; + ae_int_t i1; + ae_int_t i2; + ae_int_t istep; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + if( ((m<=0||n<=0)||zrows<=0)||zcolumns<=0 ) + { + ae_frame_leave(_state); + return; + } + ae_assert((fromtheright&&zcolumns==n)||(!fromtheright&&zrows==n), "RMatrixBDMultiplyByP: incorrect Z size!", _state); + + /* + * init + */ + mx = ae_maxint(m, n, _state); + mx = ae_maxint(mx, zrows, _state); + mx = ae_maxint(mx, zcolumns, _state); + ae_vector_set_length(&v, mx+1, _state); + ae_vector_set_length(&work, mx+1, _state); + if( m>=n ) + { + + /* + * setup + */ + if( fromtheright ) + { + i1 = n-2; + i2 = 0; + istep = -1; + } + else + { + i1 = 0; + i2 = n-2; + istep = 1; + } + if( !dotranspose ) + { + i = i1; + i1 = i2; + i2 = i; + istep = -istep; + } + + /* + * Process + */ + if( n-1>0 ) + { + i = i1; + do + { + ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i+1], 1, ae_v_len(1,n-1-i)); + v.ptr.p_double[1] = 1; + if( fromtheright ) + { + applyreflectionfromtheright(z, taup->ptr.p_double[i], &v, 0, zrows-1, i+1, n-1, &work, _state); + } + else + { + applyreflectionfromtheleft(z, taup->ptr.p_double[i], &v, i+1, n-1, 0, zcolumns-1, &work, _state); + } + 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; + } + if( !dotranspose ) + { + i = i1; + i1 = i2; + i2 = i; + istep = -istep; + } + + /* + * Process + */ + i = i1; + do + { + ae_v_move(&v.ptr.p_double[1], 1, &qp->ptr.pp_double[i][i], 1, ae_v_len(1,n-i)); + v.ptr.p_double[1] = 1; + if( fromtheright ) + { + applyreflectionfromtheright(z, taup->ptr.p_double[i], &v, 0, zrows-1, i, n-1, &work, _state); + } + else + { + applyreflectionfromtheleft(z, taup->ptr.p_double[i], &v, i, n-1, 0, zcolumns-1, &work, _state); + } + i = i+istep; + } + while(i!=i2+istep); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackdiagonals(/* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t n, + ae_bool* isupper, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_state *_state) +{ + ae_int_t i; + + *isupper = ae_false; + ae_vector_clear(d); + ae_vector_clear(e); + + *isupper = m>=n; + if( m<=0||n<=0 ) + { + return; + } + if( *isupper ) + { + ae_vector_set_length(d, n, _state); + ae_vector_set_length(e, n, _state); + for(i=0; i<=n-2; i++) + { + d->ptr.p_double[i] = b->ptr.pp_double[i][i]; + e->ptr.p_double[i] = b->ptr.pp_double[i][i+1]; + } + d->ptr.p_double[n-1] = b->ptr.pp_double[n-1][n-1]; + } + else + { + ae_vector_set_length(d, m, _state); + ae_vector_set_length(e, m, _state); + for(i=0; i<=m-2; i++) + { + d->ptr.p_double[i] = b->ptr.pp_double[i][i]; + e->ptr.p_double[i] = b->ptr.pp_double[i+1][i]; + } + d->ptr.p_double[m-1] = b->ptr.pp_double[m-1][m-1]; + } +} + + +/************************************************************************* +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 rmatrixhessenberg(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + double v; + ae_vector t; + ae_vector work; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tau); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=0, "RMatrixHessenberg: incorrect N!", _state); + + /* + * Quick return if possible + */ + if( n<=1 ) + { + ae_frame_leave(_state); + return; + } + ae_vector_set_length(tau, n-2+1, _state); + ae_vector_set_length(&t, n+1, _state); + ae_vector_set_length(&work, n-1+1, _state); + for(i=0; i<=n-2; i++) + { + + /* + * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) + */ + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); + generatereflection(&t, n-i-1, &v, _state); + ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1)); + tau->ptr.p_double[i] = v; + t.ptr.p_double[1] = 1; + + /* + * Apply H(i) to A(1:ihi,i+1:ihi) from the right + */ + applyreflectionfromtheright(a, v, &t, 0, n-1, i+1, n-1, &work, _state); + + /* + * Apply H(i) to A(i+1:ihi,i+1:n) from the left + */ + applyreflectionfromtheleft(a, v, &t, i+1, n-1, i+1, n-1, &work, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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]. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixhessenbergunpackq(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* tau, + /* Real */ ae_matrix* q, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector v; + ae_vector work; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(q); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + if( n==0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * init + */ + ae_matrix_set_length(q, n-1+1, n-1+1, _state); + ae_vector_set_length(&v, n-1+1, _state); + ae_vector_set_length(&work, n-1+1, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( i==j ) + { + q->ptr.pp_double[i][j] = 1; + } + else + { + q->ptr.pp_double[i][j] = 0; + } + } + } + + /* + * unpack Q + */ + for(i=0; i<=n-2; i++) + { + + /* + * Apply H(i) + */ + ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); + v.ptr.p_double[1] = 1; + applyreflectionfromtheright(q, tau->ptr.p_double[i], &v, 0, n-1, i+1, n-1, &work, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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]. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixhessenbergunpackh(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_matrix* h, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector v; + ae_vector work; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(h); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + if( n==0 ) + { + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(h, n-1+1, n-1+1, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i-2; j++) + { + h->ptr.pp_double[i][j] = 0; + } + j = ae_maxint(0, i-1, _state); + ae_v_move(&h->ptr.pp_double[i][j], 1, &a->ptr.pp_double[i][j], 1, ae_v_len(j,n-1)); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 smatrixtd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tau, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + double alpha; + double taui; + double v; + ae_vector t; + ae_vector t2; + ae_vector t3; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tau); + ae_vector_clear(d); + ae_vector_clear(e); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t3, 0, DT_REAL, _state, ae_true); + + if( n<=0 ) + { + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&t, n+1, _state); + ae_vector_set_length(&t2, n+1, _state); + ae_vector_set_length(&t3, n+1, _state); + if( n>1 ) + { + ae_vector_set_length(tau, n-2+1, _state); + } + ae_vector_set_length(d, n-1+1, _state); + if( n>1 ) + { + ae_vector_set_length(e, n-2+1, _state); + } + 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 ) + { + ae_v_move(&t.ptr.p_double[2], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(2,i+1)); + } + t.ptr.p_double[1] = a->ptr.pp_double[i][i+1]; + generatereflection(&t, i+1, &taui, _state); + if( i>=1 ) + { + ae_v_move(&a->ptr.pp_double[0][i+1], a->stride, &t.ptr.p_double[2], 1, ae_v_len(0,i-1)); + } + a->ptr.pp_double[i][i+1] = t.ptr.p_double[1]; + e->ptr.p_double[i] = a->ptr.pp_double[i][i+1]; + if( ae_fp_neq(taui,0) ) + { + + /* + * Apply H from both sides to A + */ + a->ptr.pp_double[i][i+1] = 1; + + /* + * Compute x := tau * A * v storing x in TAU + */ + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1)); + symmetricmatrixvectormultiply(a, isupper, 0, i, &t, taui, &t3, _state); + ae_v_move(&tau->ptr.p_double[0], 1, &t3.ptr.p_double[1], 1, ae_v_len(0,i)); + + /* + * Compute w := x - 1/2 * tau * (x'*v) * v + */ + v = ae_v_dotproduct(&tau->ptr.p_double[0], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(0,i)); + alpha = -0.5*taui*v; + ae_v_addd(&tau->ptr.p_double[0], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(0,i), alpha); + + /* + * Apply the transformation as a rank-2 update: + * A := A - v * w' - w * v' + */ + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1)); + ae_v_move(&t3.ptr.p_double[1], 1, &tau->ptr.p_double[0], 1, ae_v_len(1,i+1)); + symmetricrank2update(a, isupper, 0, i, &t, &t3, &t2, -1, _state); + a->ptr.pp_double[i][i+1] = e->ptr.p_double[i]; + } + d->ptr.p_double[i+1] = a->ptr.pp_double[i+1][i+1]; + tau->ptr.p_double[i] = taui; + } + d->ptr.p_double[0] = a->ptr.pp_double[0][0]; + } + else + { + + /* + * Reduce the lower triangle of A + */ + for(i=0; i<=n-2; i++) + { + + /* + * Generate elementary reflector H = E - tau * v * v' + */ + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); + generatereflection(&t, n-i-1, &taui, _state); + ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(i+1,n-1)); + e->ptr.p_double[i] = a->ptr.pp_double[i+1][i]; + if( ae_fp_neq(taui,0) ) + { + + /* + * Apply H from both sides to A + */ + a->ptr.pp_double[i+1][i] = 1; + + /* + * Compute x := tau * A * v storing y in TAU + */ + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); + symmetricmatrixvectormultiply(a, isupper, i+1, n-1, &t, taui, &t2, _state); + ae_v_move(&tau->ptr.p_double[i], 1, &t2.ptr.p_double[1], 1, ae_v_len(i,n-2)); + + /* + * Compute w := x - 1/2 * tau * (x'*v) * v + */ + v = ae_v_dotproduct(&tau->ptr.p_double[i], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(i,n-2)); + alpha = -0.5*taui*v; + ae_v_addd(&tau->ptr.p_double[i], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(i,n-2), alpha); + + /* + * Apply the transformation as a rank-2 update: + * A := A - v * w' - w * v' + * + */ + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); + ae_v_move(&t2.ptr.p_double[1], 1, &tau->ptr.p_double[i], 1, ae_v_len(1,n-i-1)); + symmetricrank2update(a, isupper, i+1, n-1, &t, &t2, &t3, -1, _state); + a->ptr.pp_double[i+1][i] = e->ptr.p_double[i]; + } + d->ptr.p_double[i] = a->ptr.pp_double[i][i]; + tau->ptr.p_double[i] = taui; + } + d->ptr.p_double[n-1] = a->ptr.pp_double[n-1][n-1]; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void smatrixtdunpackq(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tau, + /* Real */ ae_matrix* q, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector v; + ae_vector work; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(q); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + if( n==0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * init + */ + ae_matrix_set_length(q, n-1+1, n-1+1, _state); + ae_vector_set_length(&v, n+1, _state); + ae_vector_set_length(&work, n-1+1, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( i==j ) + { + q->ptr.pp_double[i][j] = 1; + } + else + { + q->ptr.pp_double[i][j] = 0; + } + } + } + + /* + * unpack Q + */ + if( isupper ) + { + for(i=0; i<=n-2; i++) + { + + /* + * Apply H(i) + */ + ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[0][i+1], a->stride, ae_v_len(1,i+1)); + v.ptr.p_double[i+1] = 1; + applyreflectionfromtheleft(q, tau->ptr.p_double[i], &v, 0, i, 0, n-1, &work, _state); + } + } + else + { + for(i=n-2; i>=0; i--) + { + + /* + * Apply H(i) + */ + ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[i+1][i], a->stride, ae_v_len(1,n-i-1)); + v.ptr.p_double[1] = 1; + applyreflectionfromtheleft(q, tau->ptr.p_double[i], &v, i+1, n-1, 0, n-1, &work, _state); + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 hmatrixtd(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tau, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_complex alpha; + ae_complex taui; + ae_complex v; + ae_vector t; + ae_vector t2; + ae_vector t3; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tau); + ae_vector_clear(d); + ae_vector_clear(e); + ae_vector_init(&t, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&t2, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&t3, 0, DT_COMPLEX, _state, ae_true); + + if( n<=0 ) + { + ae_frame_leave(_state); + return; + } + for(i=0; i<=n-1; i++) + { + ae_assert(ae_fp_eq(a->ptr.pp_complex[i][i].y,0), "Assertion failed", _state); + } + if( n>1 ) + { + ae_vector_set_length(tau, n-2+1, _state); + ae_vector_set_length(e, n-2+1, _state); + } + ae_vector_set_length(d, n-1+1, _state); + ae_vector_set_length(&t, n-1+1, _state); + ae_vector_set_length(&t2, n-1+1, _state); + ae_vector_set_length(&t3, n-1+1, _state); + if( isupper ) + { + + /* + * Reduce the upper triangle of A + */ + a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(a->ptr.pp_complex[n-1][n-1].x); + for(i=n-2; i>=0; i--) + { + + /* + * Generate elementary reflector H = I+1 - tau * v * v' + */ + alpha = a->ptr.pp_complex[i][i+1]; + t.ptr.p_complex[1] = alpha; + if( i>=1 ) + { + ae_v_cmove(&t.ptr.p_complex[2], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(2,i+1)); + } + complexgeneratereflection(&t, i+1, &taui, _state); + if( i>=1 ) + { + ae_v_cmove(&a->ptr.pp_complex[0][i+1], a->stride, &t.ptr.p_complex[2], 1, "N", ae_v_len(0,i-1)); + } + alpha = t.ptr.p_complex[1]; + e->ptr.p_double[i] = alpha.x; + if( ae_c_neq_d(taui,0) ) + { + + /* + * Apply H(I+1) from both sides to A + */ + a->ptr.pp_complex[i][i+1] = ae_complex_from_d(1); + + /* + * Compute x := tau * A * v storing x in TAU + */ + ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1)); + hermitianmatrixvectormultiply(a, isupper, 0, i, &t, taui, &t2, _state); + ae_v_cmove(&tau->ptr.p_complex[0], 1, &t2.ptr.p_complex[1], 1, "N", ae_v_len(0,i)); + + /* + * Compute w := x - 1/2 * tau * (x'*v) * v + */ + v = ae_v_cdotproduct(&tau->ptr.p_complex[0], 1, "Conj", &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(0,i)); + alpha = ae_c_neg(ae_c_mul(ae_c_mul_d(taui,0.5),v)); + ae_v_caddc(&tau->ptr.p_complex[0], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(0,i), alpha); + + /* + * Apply the transformation as a rank-2 update: + * A := A - v * w' - w * v' + */ + ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1)); + ae_v_cmove(&t3.ptr.p_complex[1], 1, &tau->ptr.p_complex[0], 1, "N", ae_v_len(1,i+1)); + hermitianrank2update(a, isupper, 0, i, &t, &t3, &t2, ae_complex_from_d(-1), _state); + } + else + { + a->ptr.pp_complex[i][i] = ae_complex_from_d(a->ptr.pp_complex[i][i].x); + } + a->ptr.pp_complex[i][i+1] = ae_complex_from_d(e->ptr.p_double[i]); + d->ptr.p_double[i+1] = a->ptr.pp_complex[i+1][i+1].x; + tau->ptr.p_complex[i] = taui; + } + d->ptr.p_double[0] = a->ptr.pp_complex[0][0].x; + } + else + { + + /* + * Reduce the lower triangle of A + */ + a->ptr.pp_complex[0][0] = ae_complex_from_d(a->ptr.pp_complex[0][0].x); + for(i=0; i<=n-2; i++) + { + + /* + * Generate elementary reflector H = I - tau * v * v' + */ + ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1)); + complexgeneratereflection(&t, n-i-1, &taui, _state); + ae_v_cmove(&a->ptr.pp_complex[i+1][i], a->stride, &t.ptr.p_complex[1], 1, "N", ae_v_len(i+1,n-1)); + e->ptr.p_double[i] = a->ptr.pp_complex[i+1][i].x; + if( ae_c_neq_d(taui,0) ) + { + + /* + * Apply H(i) from both sides to A(i+1:n,i+1:n) + */ + a->ptr.pp_complex[i+1][i] = ae_complex_from_d(1); + + /* + * Compute x := tau * A * v storing y in TAU + */ + ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1)); + hermitianmatrixvectormultiply(a, isupper, i+1, n-1, &t, taui, &t2, _state); + ae_v_cmove(&tau->ptr.p_complex[i], 1, &t2.ptr.p_complex[1], 1, "N", ae_v_len(i,n-2)); + + /* + * Compute w := x - 1/2 * tau * (x'*v) * v + */ + v = ae_v_cdotproduct(&tau->ptr.p_complex[i], 1, "Conj", &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(i,n-2)); + alpha = ae_c_neg(ae_c_mul(ae_c_mul_d(taui,0.5),v)); + ae_v_caddc(&tau->ptr.p_complex[i], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(i,n-2), alpha); + + /* + * Apply the transformation as a rank-2 update: + * A := A - v * w' - w * v' + */ + ae_v_cmove(&t.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1)); + ae_v_cmove(&t2.ptr.p_complex[1], 1, &tau->ptr.p_complex[i], 1, "N", ae_v_len(1,n-i-1)); + hermitianrank2update(a, isupper, i+1, n-1, &t, &t2, &t3, ae_complex_from_d(-1), _state); + } + else + { + a->ptr.pp_complex[i+1][i+1] = ae_complex_from_d(a->ptr.pp_complex[i+1][i+1].x); + } + a->ptr.pp_complex[i+1][i] = ae_complex_from_d(e->ptr.p_double[i]); + d->ptr.p_double[i] = a->ptr.pp_complex[i][i].x; + tau->ptr.p_complex[i] = taui; + } + d->ptr.p_double[n-1] = a->ptr.pp_complex[n-1][n-1].x; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void hmatrixtdunpackq(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tau, + /* Complex */ ae_matrix* q, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector v; + ae_vector work; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(q); + ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&work, 0, DT_COMPLEX, _state, ae_true); + + if( n==0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * init + */ + ae_matrix_set_length(q, n-1+1, n-1+1, _state); + ae_vector_set_length(&v, n+1, _state); + ae_vector_set_length(&work, n-1+1, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( i==j ) + { + q->ptr.pp_complex[i][j] = ae_complex_from_d(1); + } + else + { + q->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + } + + /* + * unpack Q + */ + if( isupper ) + { + for(i=0; i<=n-2; i++) + { + + /* + * Apply H(i) + */ + ae_v_cmove(&v.ptr.p_complex[1], 1, &a->ptr.pp_complex[0][i+1], a->stride, "N", ae_v_len(1,i+1)); + v.ptr.p_complex[i+1] = ae_complex_from_d(1); + complexapplyreflectionfromtheleft(q, tau->ptr.p_complex[i], &v, 0, i, 0, n-1, &work, _state); + } + } + else + { + for(i=n-2; i>=0; i--) + { + + /* + * Apply H(i) + */ + ae_v_cmove(&v.ptr.p_complex[1], 1, &a->ptr.pp_complex[i+1][i], a->stride, "N", ae_v_len(1,n-i-1)); + v.ptr.p_complex[1] = ae_complex_from_d(1); + complexapplyreflectionfromtheleft(q, tau->ptr.p_complex[i], &v, i+1, n-1, 0, n-1, &work, _state); + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Base case for complex QR + + -- 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. + Sergey Bochkanov, ALGLIB project, translation from FORTRAN to + pseudocode, 2007-2010. +*************************************************************************/ +static void ortfac_cmatrixqrbasecase(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* work, + /* Complex */ ae_vector* t, + /* Complex */ ae_vector* tau, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + ae_int_t mmi; + ae_int_t minmn; + ae_complex tmp; + + + minmn = ae_minint(m, n, _state); + if( minmn<=0 ) + { + return; + } + + /* + * Test the input arguments + */ + k = ae_minint(m, n, _state); + for(i=0; i<=k-1; i++) + { + + /* + * Generate elementary reflector H(i) to annihilate A(i+1:m,i) + */ + mmi = m-i; + ae_v_cmove(&t->ptr.p_complex[1], 1, &a->ptr.pp_complex[i][i], a->stride, "N", ae_v_len(1,mmi)); + complexgeneratereflection(t, mmi, &tmp, _state); + tau->ptr.p_complex[i] = tmp; + ae_v_cmove(&a->ptr.pp_complex[i][i], a->stride, &t->ptr.p_complex[1], 1, "N", ae_v_len(i,m-1)); + t->ptr.p_complex[1] = ae_complex_from_d(1); + if( iptr.p_complex[i], _state), t, i, m-1, i+1, n-1, work, _state); + } + } +} + + +/************************************************************************* +Base case for complex LQ + + -- 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. + Sergey Bochkanov, ALGLIB project, translation from FORTRAN to + pseudocode, 2007-2010. +*************************************************************************/ +static void ortfac_cmatrixlqbasecase(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* work, + /* Complex */ ae_vector* t, + /* Complex */ ae_vector* tau, + ae_state *_state) +{ + ae_int_t i; + ae_int_t minmn; + ae_complex tmp; + + + minmn = ae_minint(m, n, _state); + if( minmn<=0 ) + { + return; + } + + /* + * Test the input arguments + */ + for(i=0; i<=minmn-1; 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). + */ + ae_v_cmove(&t->ptr.p_complex[1], 1, &a->ptr.pp_complex[i][i], 1, "Conj", ae_v_len(1,n-i)); + complexgeneratereflection(t, n-i, &tmp, _state); + tau->ptr.p_complex[i] = tmp; + ae_v_cmove(&a->ptr.pp_complex[i][i], 1, &t->ptr.p_complex[1], 1, "Conj", ae_v_len(i,n-1)); + t->ptr.p_complex[1] = ae_complex_from_d(1); + if( iptr.p_complex[i], t, i+1, m-1, i, n-1, work, _state); + } + } +} + + +/************************************************************************* +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] + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +static void ortfac_rmatrixblockreflector(/* Real */ ae_matrix* a, + /* Real */ ae_vector* tau, + ae_bool columnwisea, + ae_int_t lengtha, + ae_int_t blocksize, + /* Real */ ae_matrix* t, + /* Real */ ae_vector* work, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + double v; + + + + /* + * fill beginning of new column with zeros, + * load 1.0 in the first non-zero element + */ + for(k=0; k<=blocksize-1; k++) + { + if( columnwisea ) + { + for(i=0; i<=k-1; i++) + { + a->ptr.pp_double[i][k] = 0; + } + } + else + { + for(i=0; i<=k-1; i++) + { + a->ptr.pp_double[k][i] = 0; + } + } + a->ptr.pp_double[k][k] = 1; + } + + /* + * Calculate Gram matrix of A + */ + for(i=0; i<=blocksize-1; i++) + { + for(j=0; j<=blocksize-1; j++) + { + t->ptr.pp_double[i][blocksize+j] = 0; + } + } + for(k=0; k<=lengtha-1; k++) + { + for(j=1; j<=blocksize-1; j++) + { + if( columnwisea ) + { + v = a->ptr.pp_double[k][j]; + if( ae_fp_neq(v,0) ) + { + ae_v_addd(&t->ptr.pp_double[j][blocksize], 1, &a->ptr.pp_double[k][0], 1, ae_v_len(blocksize,blocksize+j-1), v); + } + } + else + { + v = a->ptr.pp_double[j][k]; + if( ae_fp_neq(v,0) ) + { + ae_v_addd(&t->ptr.pp_double[j][blocksize], 1, &a->ptr.pp_double[0][k], a->stride, ae_v_len(blocksize,blocksize+j-1), v); + } + } + } + } + + /* + * Prepare Y (stored in TmpA) and T (stored in TmpT) + */ + for(k=0; k<=blocksize-1; k++) + { + + /* + * fill non-zero part of T, use pre-calculated Gram matrix + */ + ae_v_move(&work->ptr.p_double[0], 1, &t->ptr.pp_double[k][blocksize], 1, ae_v_len(0,k-1)); + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&t->ptr.pp_double[i][i], 1, &work->ptr.p_double[i], 1, ae_v_len(i,k-1)); + t->ptr.pp_double[i][k] = -tau->ptr.p_double[k]*v; + } + t->ptr.pp_double[k][k] = -tau->ptr.p_double[k]; + + /* + * Rest of T is filled by zeros + */ + for(i=k+1; i<=blocksize-1; i++) + { + t->ptr.pp_double[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 + + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +static void ortfac_cmatrixblockreflector(/* Complex */ ae_matrix* a, + /* Complex */ ae_vector* tau, + ae_bool columnwisea, + ae_int_t lengtha, + ae_int_t blocksize, + /* Complex */ ae_matrix* t, + /* Complex */ ae_vector* work, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + ae_complex v; + + + + /* + * Prepare Y (stored in TmpA) and T (stored in TmpT) + */ + for(k=0; k<=blocksize-1; k++) + { + + /* + * fill beginning of new column with zeros, + * load 1.0 in the first non-zero element + */ + if( columnwisea ) + { + for(i=0; i<=k-1; i++) + { + a->ptr.pp_complex[i][k] = ae_complex_from_d(0); + } + } + else + { + for(i=0; i<=k-1; i++) + { + a->ptr.pp_complex[k][i] = ae_complex_from_d(0); + } + } + a->ptr.pp_complex[k][k] = ae_complex_from_d(1); + + /* + * fill non-zero part of T, + */ + for(i=0; i<=k-1; i++) + { + if( columnwisea ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[k][i], a->stride, "Conj", &a->ptr.pp_complex[k][k], a->stride, "N", ae_v_len(k,lengtha-1)); + } + else + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[i][k], 1, "N", &a->ptr.pp_complex[k][k], 1, "Conj", ae_v_len(k,lengtha-1)); + } + work->ptr.p_complex[i] = v; + } + for(i=0; i<=k-1; i++) + { + v = ae_v_cdotproduct(&t->ptr.pp_complex[i][i], 1, "N", &work->ptr.p_complex[i], 1, "N", ae_v_len(i,k-1)); + t->ptr.pp_complex[i][k] = ae_c_neg(ae_c_mul(tau->ptr.p_complex[k],v)); + } + t->ptr.pp_complex[k][k] = ae_c_neg(tau->ptr.p_complex[k]); + + /* + * Rest of T is filled by zeros + */ + for(i=k+1; i<=blocksize-1; i++) + { + t->ptr.pp_complex[i][k] = ae_complex_from_d(0); + } + } +} + + + + +/************************************************************************* +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 - + THIS PARAMETER IS IGNORED SINCE ALGLIB 3.5.0 + SINGULAR VALUES ARE ALWAYS SEARCHED WITH HIGH ACCURACY. + 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. +*************************************************************************/ +ae_bool rmatrixbdsvd(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_bool isupper, + ae_bool isfractionalaccuracyrequired, + /* Real */ ae_matrix* u, + ae_int_t nru, + /* Real */ ae_matrix* c, + ae_int_t ncc, + /* Real */ ae_matrix* vt, + ae_int_t ncvt, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _e; + ae_vector d1; + ae_vector e1; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_e, e, _state, ae_true); + e = &_e; + ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e1, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&d1, n+1, _state); + ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n)); + if( n>1 ) + { + ae_vector_set_length(&e1, n-1+1, _state); + ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1)); + } + result = bdsvd_bidiagonalsvddecompositioninternal(&d1, &e1, n, isupper, isfractionalaccuracyrequired, u, 0, nru, c, 0, ncc, vt, 0, ncvt, _state); + ae_v_move(&d->ptr.p_double[0], 1, &d1.ptr.p_double[1], 1, ae_v_len(0,n-1)); + ae_frame_leave(_state); + return result; +} + + +ae_bool bidiagonalsvddecomposition(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_bool isupper, + ae_bool isfractionalaccuracyrequired, + /* Real */ ae_matrix* u, + ae_int_t nru, + /* Real */ ae_matrix* c, + ae_int_t ncc, + /* Real */ ae_matrix* vt, + ae_int_t ncvt, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _e; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_e, e, _state, ae_true); + e = &_e; + + result = bdsvd_bidiagonalsvddecompositioninternal(d, e, n, isupper, isfractionalaccuracyrequired, u, 1, nru, c, 1, ncc, vt, 1, ncvt, _state); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Internal working subroutine for bidiagonal decomposition +*************************************************************************/ +static ae_bool bdsvd_bidiagonalsvddecompositioninternal(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_bool isupper, + ae_bool isfractionalaccuracyrequired, + /* Real */ ae_matrix* u, + ae_int_t ustart, + ae_int_t nru, + /* Real */ ae_matrix* c, + ae_int_t cstart, + ae_int_t ncc, + /* Real */ ae_matrix* vt, + ae_int_t vstart, + ae_int_t ncvt, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _e; + ae_int_t i; + ae_int_t idir; + ae_int_t isub; + ae_int_t iter; + ae_int_t j; + ae_int_t ll; + ae_int_t lll; + ae_int_t m; + ae_int_t maxit; + ae_int_t oldll; + ae_int_t oldm; + double abse; + double abss; + double cosl; + double cosr; + double cs; + double eps; + double f; + double g; + double h; + double mu; + double oldcs; + double oldsn; + double r; + double shift; + double sigmn; + double sigmx; + double sinl; + double sinr; + double sll; + double smax; + double smin; + double sminl; + double sminoa; + double sn; + double thresh; + double tol; + double tolmul; + double unfl; + ae_vector work0; + ae_vector work1; + ae_vector work2; + ae_vector work3; + ae_int_t maxitr; + ae_bool matrixsplitflag; + ae_bool iterflag; + ae_vector utemp; + ae_vector vttemp; + ae_vector ctemp; + ae_vector etemp; + ae_bool fwddir; + double tmp; + ae_int_t mm1; + ae_int_t mm0; + ae_bool bchangedir; + ae_int_t uend; + ae_int_t cend; + ae_int_t vend; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_e, e, _state, ae_true); + e = &_e; + ae_vector_init(&work0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&utemp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&vttemp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ctemp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&etemp, 0, DT_REAL, _state, ae_true); + + result = ae_true; + if( n==0 ) + { + ae_frame_leave(_state); + return result; + } + if( n==1 ) + { + if( ae_fp_less(d->ptr.p_double[1],0) ) + { + d->ptr.p_double[1] = -d->ptr.p_double[1]; + if( ncvt>0 ) + { + ae_v_muld(&vt->ptr.pp_double[vstart][vstart], 1, ae_v_len(vstart,vstart+ncvt-1), -1); + } + } + ae_frame_leave(_state); + return result; + } + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + ll = 0; + oldsn = 0; + + /* + * init + */ + ae_vector_set_length(&work0, n-1+1, _state); + ae_vector_set_length(&work1, n-1+1, _state); + ae_vector_set_length(&work2, n-1+1, _state); + ae_vector_set_length(&work3, n-1+1, _state); + uend = ustart+ae_maxint(nru-1, 0, _state); + vend = vstart+ae_maxint(ncvt-1, 0, _state); + cend = cstart+ae_maxint(ncc-1, 0, _state); + ae_vector_set_length(&utemp, uend+1, _state); + ae_vector_set_length(&vttemp, vend+1, _state); + ae_vector_set_length(&ctemp, cend+1, _state); + maxitr = 12; + fwddir = ae_true; + + /* + * resize E from N-1 to N + */ + ae_vector_set_length(&etemp, n+1, _state); + for(i=1; i<=n-1; i++) + { + etemp.ptr.p_double[i] = e->ptr.p_double[i]; + } + ae_vector_set_length(e, n+1, _state); + for(i=1; i<=n-1; i++) + { + e->ptr.p_double[i] = etemp.ptr.p_double[i]; + } + e->ptr.p_double[n] = 0; + idir = 0; + + /* + * Get machine constants + */ + eps = ae_machineepsilon; + unfl = ae_minrealnumber; + + /* + * If matrix lower bidiagonal, rotate to be upper bidiagonal + * by applying Givens rotations on the left + */ + if( !isupper ) + { + for(i=1; i<=n-1; i++) + { + generaterotation(d->ptr.p_double[i], e->ptr.p_double[i], &cs, &sn, &r, _state); + d->ptr.p_double[i] = r; + e->ptr.p_double[i] = sn*d->ptr.p_double[i+1]; + d->ptr.p_double[i+1] = cs*d->ptr.p_double[i+1]; + work0.ptr.p_double[i] = cs; + work1.ptr.p_double[i] = sn; + } + + /* + * Update singular vectors if desired + */ + if( nru>0 ) + { + applyrotationsfromtheright(fwddir, ustart, uend, 1+ustart-1, n+ustart-1, &work0, &work1, u, &utemp, _state); + } + if( ncc>0 ) + { + applyrotationsfromtheleft(fwddir, 1+cstart-1, n+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state); + } + } + + /* + * 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 = ae_maxreal(10, ae_minreal(100, ae_pow(eps, -0.125, _state), _state), _state); + tol = tolmul*eps; + + /* + * Compute approximate maximum, minimum singular values + */ + smax = 0; + for(i=1; i<=n; i++) + { + smax = ae_maxreal(smax, ae_fabs(d->ptr.p_double[i], _state), _state); + } + for(i=1; i<=n-1; i++) + { + smax = ae_maxreal(smax, ae_fabs(e->ptr.p_double[i], _state), _state); + } + sminl = 0; + if( ae_fp_greater_eq(tol,0) ) + { + + /* + * Relative accuracy desired + */ + sminoa = ae_fabs(d->ptr.p_double[1], _state); + if( ae_fp_neq(sminoa,0) ) + { + mu = sminoa; + for(i=2; i<=n; i++) + { + mu = ae_fabs(d->ptr.p_double[i], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[i-1], _state))); + sminoa = ae_minreal(sminoa, mu, _state); + if( ae_fp_eq(sminoa,0) ) + { + break; + } + } + } + sminoa = sminoa/ae_sqrt(n, _state); + thresh = ae_maxreal(tol*sminoa, maxitr*n*n*unfl, _state); + } + else + { + + /* + * Absolute accuracy desired + */ + thresh = ae_maxreal(ae_fabs(tol, _state)*smax, maxitr*n*n*unfl, _state); + } + + /* + * 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 + */ + for(;;) + { + + /* + * Check for convergence or exceeding iteration count + */ + if( m<=1 ) + { + break; + } + if( iter>maxit ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Find diagonal block of matrix to work on + */ + if( ae_fp_less(tol,0)&&ae_fp_less_eq(ae_fabs(d->ptr.p_double[m], _state),thresh) ) + { + d->ptr.p_double[m] = 0; + } + smax = ae_fabs(d->ptr.p_double[m], _state); + smin = smax; + matrixsplitflag = ae_false; + for(lll=1; lll<=m-1; lll++) + { + ll = m-lll; + abss = ae_fabs(d->ptr.p_double[ll], _state); + abse = ae_fabs(e->ptr.p_double[ll], _state); + if( ae_fp_less(tol,0)&&ae_fp_less_eq(abss,thresh) ) + { + d->ptr.p_double[ll] = 0; + } + if( ae_fp_less_eq(abse,thresh) ) + { + matrixsplitflag = ae_true; + break; + } + smin = ae_minreal(smin, abss, _state); + smax = ae_maxreal(smax, ae_maxreal(abss, abse, _state), _state); + } + if( !matrixsplitflag ) + { + ll = 0; + } + else + { + + /* + * Matrix splits since E(LL) = 0 + */ + e->ptr.p_double[ll] = 0; + if( ll==m-1 ) + { + + /* + * Convergence of bottom singular value, return to top of loop + */ + m = m-1; + continue; + } + } + ll = ll+1; + + /* + * E(LL) through E(M-1) are nonzero, E(LL-1) is zero + */ + if( ll==m-1 ) + { + + /* + * 2 by 2 block, handle separately + */ + bdsvd_svdv2x2(d->ptr.p_double[m-1], e->ptr.p_double[m-1], d->ptr.p_double[m], &sigmn, &sigmx, &sinr, &cosr, &sinl, &cosl, _state); + d->ptr.p_double[m-1] = sigmx; + e->ptr.p_double[m-1] = 0; + d->ptr.p_double[m] = sigmn; + + /* + * Compute singular vectors, if desired + */ + if( ncvt>0 ) + { + mm0 = m+(vstart-1); + mm1 = m-1+(vstart-1); + ae_v_moved(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[mm1][vstart], 1, ae_v_len(vstart,vend), cosr); + ae_v_addd(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[mm0][vstart], 1, ae_v_len(vstart,vend), sinr); + ae_v_muld(&vt->ptr.pp_double[mm0][vstart], 1, ae_v_len(vstart,vend), cosr); + ae_v_subd(&vt->ptr.pp_double[mm0][vstart], 1, &vt->ptr.pp_double[mm1][vstart], 1, ae_v_len(vstart,vend), sinr); + ae_v_move(&vt->ptr.pp_double[mm1][vstart], 1, &vttemp.ptr.p_double[vstart], 1, ae_v_len(vstart,vend)); + } + if( nru>0 ) + { + mm0 = m+ustart-1; + mm1 = m-1+ustart-1; + ae_v_moved(&utemp.ptr.p_double[ustart], 1, &u->ptr.pp_double[ustart][mm1], u->stride, ae_v_len(ustart,uend), cosl); + ae_v_addd(&utemp.ptr.p_double[ustart], 1, &u->ptr.pp_double[ustart][mm0], u->stride, ae_v_len(ustart,uend), sinl); + ae_v_muld(&u->ptr.pp_double[ustart][mm0], u->stride, ae_v_len(ustart,uend), cosl); + ae_v_subd(&u->ptr.pp_double[ustart][mm0], u->stride, &u->ptr.pp_double[ustart][mm1], u->stride, ae_v_len(ustart,uend), sinl); + ae_v_move(&u->ptr.pp_double[ustart][mm1], u->stride, &utemp.ptr.p_double[ustart], 1, ae_v_len(ustart,uend)); + } + if( ncc>0 ) + { + mm0 = m+cstart-1; + mm1 = m-1+cstart-1; + ae_v_moved(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[mm1][cstart], 1, ae_v_len(cstart,cend), cosl); + ae_v_addd(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[mm0][cstart], 1, ae_v_len(cstart,cend), sinl); + ae_v_muld(&c->ptr.pp_double[mm0][cstart], 1, ae_v_len(cstart,cend), cosl); + ae_v_subd(&c->ptr.pp_double[mm0][cstart], 1, &c->ptr.pp_double[mm1][cstart], 1, ae_v_len(cstart,cend), sinl); + ae_v_move(&c->ptr.pp_double[mm1][cstart], 1, &ctemp.ptr.p_double[cstart], 1, ae_v_len(cstart,cend)); + } + m = 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 + * Very strange that LAPACK still contains it. + */ + bchangedir = ae_false; + if( idir==1&&ae_fp_less(ae_fabs(d->ptr.p_double[ll], _state),1.0E-3*ae_fabs(d->ptr.p_double[m], _state)) ) + { + bchangedir = ae_true; + } + if( idir==2&&ae_fp_less(ae_fabs(d->ptr.p_double[m], _state),1.0E-3*ae_fabs(d->ptr.p_double[ll], _state)) ) + { + bchangedir = ae_true; + } + if( (ll!=oldll||m!=oldm)||bchangedir ) + { + if( ae_fp_greater_eq(ae_fabs(d->ptr.p_double[ll], _state),ae_fabs(d->ptr.p_double[m], _state)) ) + { + + /* + * 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( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),ae_fabs(tol, _state)*ae_fabs(d->ptr.p_double[m], _state))||(ae_fp_less(tol,0)&&ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh)) ) + { + e->ptr.p_double[m-1] = 0; + continue; + } + if( ae_fp_greater_eq(tol,0) ) + { + + /* + * If relative accuracy desired, + * apply convergence criterion forward + */ + mu = ae_fabs(d->ptr.p_double[ll], _state); + sminl = mu; + iterflag = ae_false; + for(lll=ll; lll<=m-1; lll++) + { + if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[lll], _state),tol*mu) ) + { + e->ptr.p_double[lll] = 0; + iterflag = ae_true; + break; + } + mu = ae_fabs(d->ptr.p_double[lll+1], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[lll], _state))); + sminl = ae_minreal(sminl, mu, _state); + } + if( iterflag ) + { + continue; + } + } + } + else + { + + /* + * Run convergence test in backward direction + * First apply standard test to top of matrix + */ + if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),ae_fabs(tol, _state)*ae_fabs(d->ptr.p_double[ll], _state))||(ae_fp_less(tol,0)&&ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh)) ) + { + e->ptr.p_double[ll] = 0; + continue; + } + if( ae_fp_greater_eq(tol,0) ) + { + + /* + * If relative accuracy desired, + * apply convergence criterion backward + */ + mu = ae_fabs(d->ptr.p_double[m], _state); + sminl = mu; + iterflag = ae_false; + for(lll=m-1; lll>=ll; lll--) + { + if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[lll], _state),tol*mu) ) + { + e->ptr.p_double[lll] = 0; + iterflag = ae_true; + break; + } + mu = ae_fabs(d->ptr.p_double[lll], _state)*(mu/(mu+ae_fabs(e->ptr.p_double[lll], _state))); + sminl = ae_minreal(sminl, mu, _state); + } + if( iterflag ) + { + continue; + } + } + } + oldll = ll; + oldm = m; + + /* + * Compute shift. First, test if shifting would ruin relative + * accuracy, and if so set the shift to zero. + */ + if( ae_fp_greater_eq(tol,0)&&ae_fp_less_eq(n*tol*(sminl/smax),ae_maxreal(eps, 0.01*tol, _state)) ) + { + + /* + * 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 = ae_fabs(d->ptr.p_double[ll], _state); + bdsvd_svd2x2(d->ptr.p_double[m-1], e->ptr.p_double[m-1], d->ptr.p_double[m], &shift, &r, _state); + } + else + { + sll = ae_fabs(d->ptr.p_double[m], _state); + bdsvd_svd2x2(d->ptr.p_double[ll], e->ptr.p_double[ll], d->ptr.p_double[ll+1], &shift, &r, _state); + } + + /* + * Test if shift negligible, and if so set to zero + */ + if( ae_fp_greater(sll,0) ) + { + if( ae_fp_less(ae_sqr(shift/sll, _state),eps) ) + { + shift = 0; + } + } + } + + /* + * Increment iteration count + */ + iter = iter+m-ll; + + /* + * If SHIFT = 0, do simplified QR iteration + */ + if( ae_fp_eq(shift,0) ) + { + 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-1; i++) + { + generaterotation(d->ptr.p_double[i]*cs, e->ptr.p_double[i], &cs, &sn, &r, _state); + if( i>ll ) + { + e->ptr.p_double[i-1] = oldsn*r; + } + generaterotation(oldcs*r, d->ptr.p_double[i+1]*sn, &oldcs, &oldsn, &tmp, _state); + d->ptr.p_double[i] = tmp; + work0.ptr.p_double[i-ll+1] = cs; + work1.ptr.p_double[i-ll+1] = sn; + work2.ptr.p_double[i-ll+1] = oldcs; + work3.ptr.p_double[i-ll+1] = oldsn; + } + h = d->ptr.p_double[m]*cs; + d->ptr.p_double[m] = h*oldcs; + e->ptr.p_double[m-1] = h*oldsn; + + /* + * Update singular vectors + */ + if( ncvt>0 ) + { + applyrotationsfromtheleft(fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work0, &work1, vt, &vttemp, _state); + } + if( nru>0 ) + { + applyrotationsfromtheright(fwddir, ustart, uend, ll+ustart-1, m+ustart-1, &work2, &work3, u, &utemp, _state); + } + if( ncc>0 ) + { + applyrotationsfromtheleft(fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work2, &work3, c, &ctemp, _state); + } + + /* + * Test convergence + */ + if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh) ) + { + e->ptr.p_double[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+1; i--) + { + generaterotation(d->ptr.p_double[i]*cs, e->ptr.p_double[i-1], &cs, &sn, &r, _state); + if( iptr.p_double[i] = oldsn*r; + } + generaterotation(oldcs*r, d->ptr.p_double[i-1]*sn, &oldcs, &oldsn, &tmp, _state); + d->ptr.p_double[i] = tmp; + work0.ptr.p_double[i-ll] = cs; + work1.ptr.p_double[i-ll] = -sn; + work2.ptr.p_double[i-ll] = oldcs; + work3.ptr.p_double[i-ll] = -oldsn; + } + h = d->ptr.p_double[ll]*cs; + d->ptr.p_double[ll] = h*oldcs; + e->ptr.p_double[ll] = h*oldsn; + + /* + * Update singular vectors + */ + if( ncvt>0 ) + { + applyrotationsfromtheleft(!fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work2, &work3, vt, &vttemp, _state); + } + if( nru>0 ) + { + applyrotationsfromtheright(!fwddir, ustart, uend, ll+ustart-1, m+ustart-1, &work0, &work1, u, &utemp, _state); + } + if( ncc>0 ) + { + applyrotationsfromtheleft(!fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state); + } + + /* + * Test convergence + */ + if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh) ) + { + e->ptr.p_double[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 = (ae_fabs(d->ptr.p_double[ll], _state)-shift)*(bdsvd_extsignbdsqr(1, d->ptr.p_double[ll], _state)+shift/d->ptr.p_double[ll]); + g = e->ptr.p_double[ll]; + for(i=ll; i<=m-1; i++) + { + generaterotation(f, g, &cosr, &sinr, &r, _state); + if( i>ll ) + { + e->ptr.p_double[i-1] = r; + } + f = cosr*d->ptr.p_double[i]+sinr*e->ptr.p_double[i]; + e->ptr.p_double[i] = cosr*e->ptr.p_double[i]-sinr*d->ptr.p_double[i]; + g = sinr*d->ptr.p_double[i+1]; + d->ptr.p_double[i+1] = cosr*d->ptr.p_double[i+1]; + generaterotation(f, g, &cosl, &sinl, &r, _state); + d->ptr.p_double[i] = r; + f = cosl*e->ptr.p_double[i]+sinl*d->ptr.p_double[i+1]; + d->ptr.p_double[i+1] = cosl*d->ptr.p_double[i+1]-sinl*e->ptr.p_double[i]; + if( iptr.p_double[i+1]; + e->ptr.p_double[i+1] = cosl*e->ptr.p_double[i+1]; + } + work0.ptr.p_double[i-ll+1] = cosr; + work1.ptr.p_double[i-ll+1] = sinr; + work2.ptr.p_double[i-ll+1] = cosl; + work3.ptr.p_double[i-ll+1] = sinl; + } + e->ptr.p_double[m-1] = f; + + /* + * Update singular vectors + */ + if( ncvt>0 ) + { + applyrotationsfromtheleft(fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work0, &work1, vt, &vttemp, _state); + } + if( nru>0 ) + { + applyrotationsfromtheright(fwddir, ustart, uend, ll+ustart-1, m+ustart-1, &work2, &work3, u, &utemp, _state); + } + if( ncc>0 ) + { + applyrotationsfromtheleft(fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work2, &work3, c, &ctemp, _state); + } + + /* + * Test convergence + */ + if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[m-1], _state),thresh) ) + { + e->ptr.p_double[m-1] = 0; + } + } + else + { + + /* + * Chase bulge from bottom to top + * Save cosines and sines for later singular vector updates + */ + f = (ae_fabs(d->ptr.p_double[m], _state)-shift)*(bdsvd_extsignbdsqr(1, d->ptr.p_double[m], _state)+shift/d->ptr.p_double[m]); + g = e->ptr.p_double[m-1]; + for(i=m; i>=ll+1; i--) + { + generaterotation(f, g, &cosr, &sinr, &r, _state); + if( iptr.p_double[i] = r; + } + f = cosr*d->ptr.p_double[i]+sinr*e->ptr.p_double[i-1]; + e->ptr.p_double[i-1] = cosr*e->ptr.p_double[i-1]-sinr*d->ptr.p_double[i]; + g = sinr*d->ptr.p_double[i-1]; + d->ptr.p_double[i-1] = cosr*d->ptr.p_double[i-1]; + generaterotation(f, g, &cosl, &sinl, &r, _state); + d->ptr.p_double[i] = r; + f = cosl*e->ptr.p_double[i-1]+sinl*d->ptr.p_double[i-1]; + d->ptr.p_double[i-1] = cosl*d->ptr.p_double[i-1]-sinl*e->ptr.p_double[i-1]; + if( i>ll+1 ) + { + g = sinl*e->ptr.p_double[i-2]; + e->ptr.p_double[i-2] = cosl*e->ptr.p_double[i-2]; + } + work0.ptr.p_double[i-ll] = cosr; + work1.ptr.p_double[i-ll] = -sinr; + work2.ptr.p_double[i-ll] = cosl; + work3.ptr.p_double[i-ll] = -sinl; + } + e->ptr.p_double[ll] = f; + + /* + * Test convergence + */ + if( ae_fp_less_eq(ae_fabs(e->ptr.p_double[ll], _state),thresh) ) + { + e->ptr.p_double[ll] = 0; + } + + /* + * Update singular vectors if desired + */ + if( ncvt>0 ) + { + applyrotationsfromtheleft(!fwddir, ll+vstart-1, m+vstart-1, vstart, vend, &work2, &work3, vt, &vttemp, _state); + } + if( nru>0 ) + { + applyrotationsfromtheright(!fwddir, ustart, uend, ll+ustart-1, m+ustart-1, &work0, &work1, u, &utemp, _state); + } + if( ncc>0 ) + { + applyrotationsfromtheleft(!fwddir, ll+cstart-1, m+cstart-1, cstart, cend, &work0, &work1, c, &ctemp, _state); + } + } + } + + /* + * QR iteration finished, go back and check convergence + */ + continue; + } + + /* + * All singular values converged, so make them positive + */ + for(i=1; i<=n; i++) + { + if( ae_fp_less(d->ptr.p_double[i],0) ) + { + d->ptr.p_double[i] = -d->ptr.p_double[i]; + + /* + * Change sign of singular vectors, if desired + */ + if( ncvt>0 ) + { + ae_v_muld(&vt->ptr.pp_double[i+vstart-1][vstart], 1, ae_v_len(vstart,vend), -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-1; i++) + { + + /* + * Scan for smallest D(I) + */ + isub = 1; + smin = d->ptr.p_double[1]; + for(j=2; j<=n+1-i; j++) + { + if( ae_fp_less_eq(d->ptr.p_double[j],smin) ) + { + isub = j; + smin = d->ptr.p_double[j]; + } + } + if( isub!=n+1-i ) + { + + /* + * Swap singular values and vectors + */ + d->ptr.p_double[isub] = d->ptr.p_double[n+1-i]; + d->ptr.p_double[n+1-i] = smin; + if( ncvt>0 ) + { + j = n+1-i; + ae_v_move(&vttemp.ptr.p_double[vstart], 1, &vt->ptr.pp_double[isub+vstart-1][vstart], 1, ae_v_len(vstart,vend)); + ae_v_move(&vt->ptr.pp_double[isub+vstart-1][vstart], 1, &vt->ptr.pp_double[j+vstart-1][vstart], 1, ae_v_len(vstart,vend)); + ae_v_move(&vt->ptr.pp_double[j+vstart-1][vstart], 1, &vttemp.ptr.p_double[vstart], 1, ae_v_len(vstart,vend)); + } + if( nru>0 ) + { + j = n+1-i; + ae_v_move(&utemp.ptr.p_double[ustart], 1, &u->ptr.pp_double[ustart][isub+ustart-1], u->stride, ae_v_len(ustart,uend)); + ae_v_move(&u->ptr.pp_double[ustart][isub+ustart-1], u->stride, &u->ptr.pp_double[ustart][j+ustart-1], u->stride, ae_v_len(ustart,uend)); + ae_v_move(&u->ptr.pp_double[ustart][j+ustart-1], u->stride, &utemp.ptr.p_double[ustart], 1, ae_v_len(ustart,uend)); + } + if( ncc>0 ) + { + j = n+1-i; + ae_v_move(&ctemp.ptr.p_double[cstart], 1, &c->ptr.pp_double[isub+cstart-1][cstart], 1, ae_v_len(cstart,cend)); + ae_v_move(&c->ptr.pp_double[isub+cstart-1][cstart], 1, &c->ptr.pp_double[j+cstart-1][cstart], 1, ae_v_len(cstart,cend)); + ae_v_move(&c->ptr.pp_double[j+cstart-1][cstart], 1, &ctemp.ptr.p_double[cstart], 1, ae_v_len(cstart,cend)); + } + } + } + ae_frame_leave(_state); + return result; +} + + +static double bdsvd_extsignbdsqr(double a, double b, ae_state *_state) +{ + double result; + + + if( ae_fp_greater_eq(b,0) ) + { + result = ae_fabs(a, _state); + } + else + { + result = -ae_fabs(a, _state); + } + return result; +} + + +static void bdsvd_svd2x2(double f, + double g, + double h, + double* ssmin, + double* ssmax, + ae_state *_state) +{ + double aas; + double at; + double au; + double c; + double fa; + double fhmn; + double fhmx; + double ga; + double ha; + + *ssmin = 0; + *ssmax = 0; + + fa = ae_fabs(f, _state); + ga = ae_fabs(g, _state); + ha = ae_fabs(h, _state); + fhmn = ae_minreal(fa, ha, _state); + fhmx = ae_maxreal(fa, ha, _state); + if( ae_fp_eq(fhmn,0) ) + { + *ssmin = 0; + if( ae_fp_eq(fhmx,0) ) + { + *ssmax = ga; + } + else + { + *ssmax = ae_maxreal(fhmx, ga, _state)*ae_sqrt(1+ae_sqr(ae_minreal(fhmx, ga, _state)/ae_maxreal(fhmx, ga, _state), _state), _state); + } + } + else + { + if( ae_fp_less(ga,fhmx) ) + { + aas = 1+fhmn/fhmx; + at = (fhmx-fhmn)/fhmx; + au = ae_sqr(ga/fhmx, _state); + c = 2/(ae_sqrt(aas*aas+au, _state)+ae_sqrt(at*at+au, _state)); + *ssmin = fhmn*c; + *ssmax = fhmx/c; + } + else + { + au = fhmx/ga; + if( ae_fp_eq(au,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 + { + aas = 1+fhmn/fhmx; + at = (fhmx-fhmn)/fhmx; + c = 1/(ae_sqrt(1+ae_sqr(aas*au, _state), _state)+ae_sqrt(1+ae_sqr(at*au, _state), _state)); + *ssmin = fhmn*c*au; + *ssmin = *ssmin+(*ssmin); + *ssmax = ga/(c+c); + } + } + } +} + + +static void bdsvd_svdv2x2(double f, + double g, + double h, + double* ssmin, + double* ssmax, + double* snr, + double* csr, + double* snl, + double* csl, + ae_state *_state) +{ + ae_bool gasmal; + ae_bool swp; + ae_int_t pmax; + double a; + double clt; + double crt; + double d; + double fa; + double ft; + double ga; + double gt; + double ha; + double ht; + double l; + double m; + double mm; + double r; + double s; + double slt; + double srt; + double t; + double temp; + double tsign; + double tt; + double v; + + *ssmin = 0; + *ssmax = 0; + *snr = 0; + *csr = 0; + *snl = 0; + *csl = 0; + + ft = f; + fa = ae_fabs(ft, _state); + ht = h; + ha = ae_fabs(h, _state); + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + clt = 0; + crt = 0; + slt = 0; + srt = 0; + tsign = 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 = ae_fp_greater(ha,fa); + if( swp ) + { + + /* + * Now FA .ge. HA + */ + pmax = 3; + temp = ft; + ft = ht; + ht = temp; + temp = fa; + fa = ha; + ha = temp; + } + gt = g; + ga = ae_fabs(gt, _state); + if( ae_fp_eq(ga,0) ) + { + + /* + * Diagonal matrix + */ + *ssmin = ha; + *ssmax = fa; + clt = 1; + crt = 1; + slt = 0; + srt = 0; + } + else + { + gasmal = ae_true; + if( ae_fp_greater(ga,fa) ) + { + pmax = 2; + if( ae_fp_less(fa/ga,ae_machineepsilon) ) + { + + /* + * Case of very large GA + */ + gasmal = ae_false; + *ssmax = ga; + if( ae_fp_greater(ha,1) ) + { + v = ga/ha; + *ssmin = fa/v; + } + else + { + v = fa/ga; + *ssmin = v*ha; + } + clt = 1; + slt = ht/gt; + srt = 1; + crt = ft/gt; + } + } + if( gasmal ) + { + + /* + * Normal case + */ + d = fa-ha; + if( ae_fp_eq(d,fa) ) + { + l = 1; + } + else + { + l = d/fa; + } + m = gt/ft; + t = 2-l; + mm = m*m; + tt = t*t; + s = ae_sqrt(tt+mm, _state); + if( ae_fp_eq(l,0) ) + { + r = ae_fabs(m, _state); + } + else + { + r = ae_sqrt(l*l+mm, _state); + } + a = 0.5*(s+r); + *ssmin = ha/a; + *ssmax = fa*a; + if( ae_fp_eq(mm,0) ) + { + + /* + * Note that M is very tiny + */ + if( ae_fp_eq(l,0) ) + { + t = bdsvd_extsignbdsqr(2, ft, _state)*bdsvd_extsignbdsqr(1, gt, _state); + } + else + { + t = gt/bdsvd_extsignbdsqr(d, ft, _state)+m/t; + } + } + else + { + t = (m/(s+t)+m/(r+l))*(1+a); + } + l = ae_sqrt(t*t+4, _state); + crt = 2/l; + srt = t/l; + clt = (crt+srt*m)/a; + v = ht/ft; + slt = v*srt/a; + } + } + 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 = bdsvd_extsignbdsqr(1, *csr, _state)*bdsvd_extsignbdsqr(1, *csl, _state)*bdsvd_extsignbdsqr(1, f, _state); + } + if( pmax==2 ) + { + tsign = bdsvd_extsignbdsqr(1, *snr, _state)*bdsvd_extsignbdsqr(1, *csl, _state)*bdsvd_extsignbdsqr(1, g, _state); + } + if( pmax==3 ) + { + tsign = bdsvd_extsignbdsqr(1, *snr, _state)*bdsvd_extsignbdsqr(1, *snl, _state)*bdsvd_extsignbdsqr(1, h, _state); + } + *ssmax = bdsvd_extsignbdsqr(*ssmax, tsign, _state); + *ssmin = bdsvd_extsignbdsqr(*ssmin, tsign*bdsvd_extsignbdsqr(1, f, _state)*bdsvd_extsignbdsqr(1, h, _state), _state); +} + + + + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +ae_bool rmatrixsvd(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_int_t uneeded, + ae_int_t vtneeded, + ae_int_t additionalmemory, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* u, + /* Real */ ae_matrix* vt, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_vector tauq; + ae_vector taup; + ae_vector tau; + ae_vector e; + ae_vector work; + ae_matrix t2; + ae_bool isupper; + ae_int_t minmn; + ae_int_t ncu; + ae_int_t nrvt; + ae_int_t nru; + ae_int_t ncvt; + ae_int_t i; + ae_int_t j; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_clear(w); + ae_matrix_clear(u); + ae_matrix_clear(vt); + ae_vector_init(&tauq, 0, DT_REAL, _state, ae_true); + ae_vector_init(&taup, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&t2, 0, 0, DT_REAL, _state, ae_true); + + result = ae_true; + if( m==0||n==0 ) + { + ae_frame_leave(_state); + return result; + } + ae_assert(uneeded>=0&&uneeded<=2, "SVDDecomposition: wrong parameters!", _state); + ae_assert(vtneeded>=0&&vtneeded<=2, "SVDDecomposition: wrong parameters!", _state); + ae_assert(additionalmemory>=0&&additionalmemory<=2, "SVDDecomposition: wrong parameters!", _state); + + /* + * initialize + */ + minmn = ae_minint(m, n, _state); + ae_vector_set_length(w, minmn+1, _state); + ncu = 0; + nru = 0; + if( uneeded==1 ) + { + nru = m; + ncu = minmn; + ae_matrix_set_length(u, nru-1+1, ncu-1+1, _state); + } + if( uneeded==2 ) + { + nru = m; + ncu = m; + ae_matrix_set_length(u, nru-1+1, ncu-1+1, _state); + } + nrvt = 0; + ncvt = 0; + if( vtneeded==1 ) + { + nrvt = minmn; + ncvt = n; + ae_matrix_set_length(vt, nrvt-1+1, ncvt-1+1, _state); + } + if( vtneeded==2 ) + { + nrvt = n; + ncvt = n; + ae_matrix_set_length(vt, nrvt-1+1, ncvt-1+1, _state); + } + + /* + * M much larger than N + * Use bidiagonal reduction with QR-decomposition + */ + if( ae_fp_greater(m,1.6*n) ) + { + if( uneeded==0 ) + { + + /* + * No left singular vectors to be computed + */ + rmatrixqr(a, m, n, &tau, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + rmatrixbd(a, n, n, &tauq, &taup, _state); + rmatrixbdunpackpt(a, n, n, &taup, nrvt, vt, _state); + rmatrixbdunpackdiagonals(a, n, n, &isupper, w, &e, _state); + result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, 0, a, 0, vt, ncvt, _state); + ae_frame_leave(_state); + return result; + } + else + { + + /* + * Left singular vectors (may be full matrix U) to be computed + */ + rmatrixqr(a, m, n, &tau, _state); + rmatrixqrunpackq(a, m, n, &tau, ncu, u, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + rmatrixbd(a, n, n, &tauq, &taup, _state); + rmatrixbdunpackpt(a, n, n, &taup, nrvt, vt, _state); + rmatrixbdunpackdiagonals(a, n, n, &isupper, w, &e, _state); + if( additionalmemory<1 ) + { + + /* + * No additional memory can be used + */ + rmatrixbdmultiplybyq(a, n, n, &tauq, u, m, n, ae_true, ae_false, _state); + result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, m, a, 0, vt, ncvt, _state); + } + else + { + + /* + * Large U. Transforming intermediate matrix T2 + */ + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + rmatrixbdunpackq(a, n, n, &tauq, n, &t2, _state); + copymatrix(u, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1, _state); + inplacetranspose(&t2, 0, n-1, 0, n-1, &work, _state); + result = rmatrixbdsvd(w, &e, n, isupper, ae_false, u, 0, &t2, n, vt, ncvt, _state); + matrixmatrixmultiply(a, 0, m-1, 0, n-1, ae_false, &t2, 0, n-1, 0, n-1, ae_true, 1.0, u, 0, m-1, 0, n-1, 0.0, &work, _state); + } + ae_frame_leave(_state); + return result; + } + } + + /* + * N much larger than M + * Use bidiagonal reduction with LQ-decomposition + */ + if( ae_fp_greater(n,1.6*m) ) + { + if( vtneeded==0 ) + { + + /* + * No right singular vectors to be computed + */ + rmatrixlq(a, m, n, &tau, _state); + for(i=0; i<=m-1; i++) + { + for(j=i+1; j<=m-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + rmatrixbd(a, m, m, &tauq, &taup, _state); + rmatrixbdunpackq(a, m, m, &tauq, ncu, u, _state); + rmatrixbdunpackdiagonals(a, m, m, &isupper, w, &e, _state); + ae_vector_set_length(&work, m+1, _state); + inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); + result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, vt, 0, _state); + inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); + ae_frame_leave(_state); + return result; + } + else + { + + /* + * Right singular vectors (may be full matrix VT) to be computed + */ + rmatrixlq(a, m, n, &tau, _state); + rmatrixlqunpackq(a, m, n, &tau, nrvt, vt, _state); + for(i=0; i<=m-1; i++) + { + for(j=i+1; j<=m-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + rmatrixbd(a, m, m, &tauq, &taup, _state); + rmatrixbdunpackq(a, m, m, &tauq, ncu, u, _state); + rmatrixbdunpackdiagonals(a, m, m, &isupper, w, &e, _state); + ae_vector_set_length(&work, ae_maxint(m, n, _state)+1, _state); + inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); + if( additionalmemory<1 ) + { + + /* + * No additional memory available + */ + rmatrixbdmultiplybyp(a, m, m, &taup, vt, m, n, ae_false, ae_true, _state); + result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, vt, n, _state); + } + else + { + + /* + * Large VT. Transforming intermediate matrix T2 + */ + rmatrixbdunpackpt(a, m, m, &taup, m, &t2, _state); + result = rmatrixbdsvd(w, &e, m, isupper, ae_false, a, 0, u, nru, &t2, m, _state); + copymatrix(vt, 0, m-1, 0, n-1, a, 0, m-1, 0, n-1, _state); + matrixmatrixmultiply(&t2, 0, m-1, 0, m-1, ae_false, a, 0, m-1, 0, n-1, ae_false, 1.0, vt, 0, m-1, 0, n-1, 0.0, &work, _state); + } + inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); + ae_frame_leave(_state); + return result; + } + } + + /* + * M<=N + * We can use inplace transposition of U to get rid of columnwise operations + */ + if( m<=n ) + { + rmatrixbd(a, m, n, &tauq, &taup, _state); + rmatrixbdunpackq(a, m, n, &tauq, ncu, u, _state); + rmatrixbdunpackpt(a, m, n, &taup, nrvt, vt, _state); + rmatrixbdunpackdiagonals(a, m, n, &isupper, w, &e, _state); + ae_vector_set_length(&work, m+1, _state); + inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); + result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, a, 0, u, nru, vt, ncvt, _state); + inplacetranspose(u, 0, nru-1, 0, ncu-1, &work, _state); + ae_frame_leave(_state); + return result; + } + + /* + * Simple bidiagonal reduction + */ + rmatrixbd(a, m, n, &tauq, &taup, _state); + rmatrixbdunpackq(a, m, n, &tauq, ncu, u, _state); + rmatrixbdunpackpt(a, m, n, &taup, nrvt, vt, _state); + rmatrixbdunpackdiagonals(a, m, n, &isupper, w, &e, _state); + if( additionalmemory<2||uneeded==0 ) + { + + /* + * We cant use additional memory or there is no need in such operations + */ + result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, u, nru, a, 0, vt, ncvt, _state); + } + else + { + + /* + * We can use additional memory + */ + ae_matrix_set_length(&t2, minmn-1+1, m-1+1, _state); + copyandtranspose(u, 0, m-1, 0, minmn-1, &t2, 0, minmn-1, 0, m-1, _state); + result = rmatrixbdsvd(w, &e, minmn, isupper, ae_false, u, 0, &t2, m, vt, ncvt, _state); + copyandtranspose(&t2, 0, minmn-1, 0, m-1, u, 0, m-1, 0, minmn-1, _state); + } + ae_frame_leave(_state); + 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). + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +ae_bool smatrixevd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + /* Real */ ae_vector* d, + /* Real */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_vector tau; + ae_vector e; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_clear(d); + ae_matrix_clear(z); + ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + + ae_assert(zneeded==0||zneeded==1, "SMatrixEVD: incorrect ZNeeded", _state); + smatrixtd(a, n, isupper, &tau, d, &e, _state); + if( zneeded==1 ) + { + smatrixtdunpackq(a, n, isupper, &tau, z, _state); + } + result = smatrixtdevd(d, &e, n, zneeded, z, _state); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 07.01.2006 by Bochkanov Sergey +*************************************************************************/ +ae_bool smatrixevdr(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + double b1, + double b2, + ae_int_t* m, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_vector tau; + ae_vector e; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + *m = 0; + ae_vector_clear(w); + ae_matrix_clear(z); + ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + + ae_assert(zneeded==0||zneeded==1, "SMatrixTDEVDR: incorrect ZNeeded", _state); + smatrixtd(a, n, isupper, &tau, w, &e, _state); + if( zneeded==1 ) + { + smatrixtdunpackq(a, n, isupper, &tau, z, _state); + } + result = smatrixtdevdr(w, &e, n, zneeded, b1, b2, m, z, _state); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 07.01.2006 by Bochkanov Sergey +*************************************************************************/ +ae_bool smatrixevdi(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_vector tau; + ae_vector e; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_clear(w); + ae_matrix_clear(z); + ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + + ae_assert(zneeded==0||zneeded==1, "SMatrixEVDI: incorrect ZNeeded", _state); + smatrixtd(a, n, isupper, &tau, w, &e, _state); + if( zneeded==1 ) + { + smatrixtdunpackq(a, n, isupper, &tau, z, _state); + } + result = smatrixtdevdi(w, &e, n, zneeded, i1, i2, z, _state); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005, 23 March 2007 by Bochkanov Sergey +*************************************************************************/ +ae_bool hmatrixevd(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + /* Real */ ae_vector* d, + /* Complex */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_vector tau; + ae_vector e; + ae_vector work; + ae_matrix t; + ae_matrix q; + ae_int_t i; + ae_int_t k; + double v; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_clear(d); + ae_matrix_clear(z); + ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(zneeded==0||zneeded==1, "HermitianEVD: incorrect ZNeeded", _state); + + /* + * Reduce to tridiagonal form + */ + hmatrixtd(a, n, isupper, &tau, d, &e, _state); + if( zneeded==1 ) + { + hmatrixtdunpackq(a, n, isupper, &tau, &q, _state); + zneeded = 2; + } + + /* + * TDEVD + */ + result = smatrixtdevd(d, &e, n, zneeded, &t, _state); + + /* + * Eigenvectors are needed + * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T + */ + if( result&&zneeded!=0 ) + { + ae_vector_set_length(&work, n-1+1, _state); + ae_matrix_set_length(z, n-1+1, n-1+1, _state); + for(i=0; i<=n-1; i++) + { + + /* + * Calculate real part + */ + for(k=0; k<=n-1; k++) + { + work.ptr.p_double[k] = 0; + } + for(k=0; k<=n-1; k++) + { + v = q.ptr.pp_complex[i][k].x; + ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,n-1), v); + } + for(k=0; k<=n-1; k++) + { + z->ptr.pp_complex[i][k].x = work.ptr.p_double[k]; + } + + /* + * Calculate imaginary part + */ + for(k=0; k<=n-1; k++) + { + work.ptr.p_double[k] = 0; + } + for(k=0; k<=n-1; k++) + { + v = q.ptr.pp_complex[i][k].y; + ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,n-1), v); + } + for(k=0; k<=n-1; k++) + { + z->ptr.pp_complex[i][k].y = work.ptr.p_double[k]; + } + } + } + ae_frame_leave(_state); + 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. + + -- ALGLIB -- + Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. +*************************************************************************/ +ae_bool hmatrixevdr(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + double b1, + double b2, + ae_int_t* m, + /* Real */ ae_vector* w, + /* Complex */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_matrix q; + ae_matrix t; + ae_vector tau; + ae_vector e; + ae_vector work; + ae_int_t i; + ae_int_t k; + double v; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + *m = 0; + ae_vector_clear(w); + ae_matrix_clear(z); + ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + ae_assert(zneeded==0||zneeded==1, "HermitianEigenValuesAndVectorsInInterval: incorrect ZNeeded", _state); + + /* + * Reduce to tridiagonal form + */ + hmatrixtd(a, n, isupper, &tau, w, &e, _state); + if( zneeded==1 ) + { + hmatrixtdunpackq(a, n, isupper, &tau, &q, _state); + zneeded = 2; + } + + /* + * Bisection and inverse iteration + */ + result = smatrixtdevdr(w, &e, n, zneeded, b1, b2, m, &t, _state); + + /* + * Eigenvectors are needed + * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T + */ + if( (result&&zneeded!=0)&&*m!=0 ) + { + ae_vector_set_length(&work, *m-1+1, _state); + ae_matrix_set_length(z, n-1+1, *m-1+1, _state); + for(i=0; i<=n-1; i++) + { + + /* + * Calculate real part + */ + for(k=0; k<=*m-1; k++) + { + work.ptr.p_double[k] = 0; + } + for(k=0; k<=n-1; k++) + { + v = q.ptr.pp_complex[i][k].x; + ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,*m-1), v); + } + for(k=0; k<=*m-1; k++) + { + z->ptr.pp_complex[i][k].x = work.ptr.p_double[k]; + } + + /* + * Calculate imaginary part + */ + for(k=0; k<=*m-1; k++) + { + work.ptr.p_double[k] = 0; + } + for(k=0; k<=n-1; k++) + { + v = q.ptr.pp_complex[i][k].y; + ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,*m-1), v); + } + for(k=0; k<=*m-1; k++) + { + z->ptr.pp_complex[i][k].y = work.ptr.p_double[k]; + } + } + } + ae_frame_leave(_state); + 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 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. + + -- ALGLIB -- + Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. +*************************************************************************/ +ae_bool hmatrixevdi(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_vector* w, + /* Complex */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_matrix q; + ae_matrix t; + ae_vector tau; + ae_vector e; + ae_vector work; + ae_int_t i; + ae_int_t k; + double v; + ae_int_t m; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_clear(w); + ae_matrix_clear(z); + ae_matrix_init(&q, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tau, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&e, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + ae_assert(zneeded==0||zneeded==1, "HermitianEigenValuesAndVectorsByIndexes: incorrect ZNeeded", _state); + + /* + * Reduce to tridiagonal form + */ + hmatrixtd(a, n, isupper, &tau, w, &e, _state); + if( zneeded==1 ) + { + hmatrixtdunpackq(a, n, isupper, &tau, &q, _state); + zneeded = 2; + } + + /* + * Bisection and inverse iteration + */ + result = smatrixtdevdi(w, &e, n, zneeded, i1, i2, &t, _state); + + /* + * Eigenvectors are needed + * Calculate Z = Q*T = Re(Q)*T + i*Im(Q)*T + */ + m = i2-i1+1; + if( result&&zneeded!=0 ) + { + ae_vector_set_length(&work, m-1+1, _state); + ae_matrix_set_length(z, n-1+1, m-1+1, _state); + for(i=0; i<=n-1; i++) + { + + /* + * Calculate real part + */ + for(k=0; k<=m-1; k++) + { + work.ptr.p_double[k] = 0; + } + for(k=0; k<=n-1; k++) + { + v = q.ptr.pp_complex[i][k].x; + ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,m-1), v); + } + for(k=0; k<=m-1; k++) + { + z->ptr.pp_complex[i][k].x = work.ptr.p_double[k]; + } + + /* + * Calculate imaginary part + */ + for(k=0; k<=m-1; k++) + { + work.ptr.p_double[k] = 0; + } + for(k=0; k<=n-1; k++) + { + v = q.ptr.pp_complex[i][k].y; + ae_v_addd(&work.ptr.p_double[0], 1, &t.ptr.pp_double[k][0], 1, ae_v_len(0,m-1), v); + } + for(k=0; k<=m-1; k++) + { + z->ptr.pp_complex[i][k].y = work.ptr.p_double[k]; + } + } + } + ae_frame_leave(_state); + 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 +*************************************************************************/ +ae_bool smatrixtdevd(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t zneeded, + /* Real */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _e; + ae_vector d1; + ae_vector e1; + ae_matrix z1; + ae_int_t i; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_e, e, _state, ae_true); + e = &_e; + ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e1, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z1, 0, 0, DT_REAL, _state, ae_true); + + + /* + * Prepare 1-based task + */ + ae_vector_set_length(&d1, n+1, _state); + ae_vector_set_length(&e1, n+1, _state); + ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n)); + if( n>1 ) + { + ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1)); + } + if( zneeded==1 ) + { + ae_matrix_set_length(&z1, n+1, n+1, _state); + for(i=1; i<=n; i++) + { + ae_v_move(&z1.ptr.pp_double[i][1], 1, &z->ptr.pp_double[i-1][0], 1, ae_v_len(1,n)); + } + } + + /* + * Solve 1-based task + */ + result = evd_tridiagonalevd(&d1, &e1, n, zneeded, &z1, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + + /* + * Convert back to 0-based result + */ + ae_v_move(&d->ptr.p_double[0], 1, &d1.ptr.p_double[1], 1, ae_v_len(0,n-1)); + if( zneeded!=0 ) + { + if( zneeded==1 ) + { + for(i=1; i<=n; i++) + { + ae_v_move(&z->ptr.pp_double[i-1][0], 1, &z1.ptr.pp_double[i][1], 1, ae_v_len(0,n-1)); + } + ae_frame_leave(_state); + return result; + } + if( zneeded==2 ) + { + ae_matrix_set_length(z, n-1+1, n-1+1, _state); + for(i=1; i<=n; i++) + { + ae_v_move(&z->ptr.pp_double[i-1][0], 1, &z1.ptr.pp_double[i][1], 1, ae_v_len(0,n-1)); + } + ae_frame_leave(_state); + return result; + } + if( zneeded==3 ) + { + ae_matrix_set_length(z, 0+1, n-1+1, _state); + ae_v_move(&z->ptr.pp_double[0][0], 1, &z1.ptr.pp_double[1][1], 1, ae_v_len(0,n-1)); + ae_frame_leave(_state); + return result; + } + ae_assert(ae_false, "SMatrixTDEVD: Incorrect ZNeeded!", _state); + } + ae_frame_leave(_state); + 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. + + -- ALGLIB -- + Copyright 31.03.2008 by Bochkanov Sergey +*************************************************************************/ +ae_bool smatrixtdevdr(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t zneeded, + double a, + double b, + ae_int_t* m, + /* Real */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t errorcode; + ae_int_t nsplit; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t cr; + ae_vector iblock; + ae_vector isplit; + ae_vector ifail; + ae_vector d1; + ae_vector e1; + ae_vector w; + ae_matrix z2; + ae_matrix z3; + double v; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + *m = 0; + ae_vector_init(&iblock, 0, DT_INT, _state, ae_true); + ae_vector_init(&isplit, 0, DT_INT, _state, ae_true); + ae_vector_init(&ifail, 0, DT_INT, _state, ae_true); + ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z2, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z3, 0, 0, DT_REAL, _state, ae_true); + + ae_assert(zneeded>=0&&zneeded<=2, "SMatrixTDEVDR: incorrect ZNeeded!", _state); + + /* + * Special cases + */ + if( ae_fp_less_eq(b,a) ) + { + *m = 0; + result = ae_true; + ae_frame_leave(_state); + return result; + } + if( n<=0 ) + { + *m = 0; + result = ae_true; + ae_frame_leave(_state); + return result; + } + + /* + * Copy D,E to D1, E1 + */ + ae_vector_set_length(&d1, n+1, _state); + ae_v_move(&d1.ptr.p_double[1], 1, &d->ptr.p_double[0], 1, ae_v_len(1,n)); + if( n>1 ) + { + ae_vector_set_length(&e1, n-1+1, _state); + ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1)); + } + + /* + * No eigen vectors + */ + if( zneeded==0 ) + { + result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 1, a, b, 0, 0, -1, &w, m, &nsplit, &iblock, &isplit, &errorcode, _state); + if( !result||*m==0 ) + { + *m = 0; + ae_frame_leave(_state); + return result; + } + ae_vector_set_length(d, *m-1+1, _state); + ae_v_move(&d->ptr.p_double[0], 1, &w.ptr.p_double[1], 1, ae_v_len(0,*m-1)); + ae_frame_leave(_state); + return result; + } + + /* + * Eigen vectors are multiplied by Z + */ + if( zneeded==1 ) + { + + /* + * Find eigen pairs + */ + result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 2, a, b, 0, 0, -1, &w, m, &nsplit, &iblock, &isplit, &errorcode, _state); + if( !result||*m==0 ) + { + *m = 0; + ae_frame_leave(_state); + return result; + } + evd_internaldstein(n, &d1, &e1, *m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state); + if( cr!=0 ) + { + *m = 0; + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Sort eigen values and vectors + */ + for(i=1; i<=*m; i++) + { + k = i; + for(j=i; j<=*m; j++) + { + if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) ) + { + k = j; + } + } + v = w.ptr.p_double[i]; + w.ptr.p_double[i] = w.ptr.p_double[k]; + w.ptr.p_double[k] = v; + for(j=1; j<=n; j++) + { + v = z2.ptr.pp_double[j][i]; + z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k]; + z2.ptr.pp_double[j][k] = v; + } + } + + /* + * Transform Z2 and overwrite Z + */ + ae_matrix_set_length(&z3, *m+1, n+1, _state); + for(i=1; i<=*m; i++) + { + ae_v_move(&z3.ptr.pp_double[i][1], 1, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(1,n)); + } + for(i=1; i<=n; i++) + { + for(j=1; j<=*m; j++) + { + v = ae_v_dotproduct(&z->ptr.pp_double[i-1][0], 1, &z3.ptr.pp_double[j][1], 1, ae_v_len(0,n-1)); + z2.ptr.pp_double[i][j] = v; + } + } + ae_matrix_set_length(z, n-1+1, *m-1+1, _state); + for(i=1; i<=*m; i++) + { + ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1)); + } + + /* + * Store W + */ + ae_vector_set_length(d, *m-1+1, _state); + for(i=1; i<=*m; i++) + { + d->ptr.p_double[i-1] = w.ptr.p_double[i]; + } + ae_frame_leave(_state); + return result; + } + + /* + * Eigen vectors are stored in Z + */ + if( zneeded==2 ) + { + + /* + * Find eigen pairs + */ + result = evd_internalbisectioneigenvalues(&d1, &e1, n, 2, 2, a, b, 0, 0, -1, &w, m, &nsplit, &iblock, &isplit, &errorcode, _state); + if( !result||*m==0 ) + { + *m = 0; + ae_frame_leave(_state); + return result; + } + evd_internaldstein(n, &d1, &e1, *m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state); + if( cr!=0 ) + { + *m = 0; + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Sort eigen values and vectors + */ + for(i=1; i<=*m; i++) + { + k = i; + for(j=i; j<=*m; j++) + { + if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) ) + { + k = j; + } + } + v = w.ptr.p_double[i]; + w.ptr.p_double[i] = w.ptr.p_double[k]; + w.ptr.p_double[k] = v; + for(j=1; j<=n; j++) + { + v = z2.ptr.pp_double[j][i]; + z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k]; + z2.ptr.pp_double[j][k] = v; + } + } + + /* + * Store W + */ + ae_vector_set_length(d, *m-1+1, _state); + for(i=1; i<=*m; i++) + { + d->ptr.p_double[i-1] = w.ptr.p_double[i]; + } + ae_matrix_set_length(z, n-1+1, *m-1+1, _state); + for(i=1; i<=*m; i++) + { + ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1)); + } + ae_frame_leave(_state); + return result; + } + result = ae_false; + ae_frame_leave(_state); + 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. + + -- ALGLIB -- + Copyright 25.12.2005 by Bochkanov Sergey +*************************************************************************/ +ae_bool smatrixtdevdi(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t zneeded, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t errorcode; + ae_int_t nsplit; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t m; + ae_int_t cr; + ae_vector iblock; + ae_vector isplit; + ae_vector ifail; + ae_vector w; + ae_vector d1; + ae_vector e1; + ae_matrix z2; + ae_matrix z3; + double v; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&iblock, 0, DT_INT, _state, ae_true); + ae_vector_init(&isplit, 0, DT_INT, _state, ae_true); + ae_vector_init(&ifail, 0, DT_INT, _state, ae_true); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&d1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&e1, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z2, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&z3, 0, 0, DT_REAL, _state, ae_true); + + ae_assert((0<=i1&&i1<=i2)&&i2ptr.p_double[0], 1, ae_v_len(1,n)); + if( n>1 ) + { + ae_vector_set_length(&e1, n-1+1, _state); + ae_v_move(&e1.ptr.p_double[1], 1, &e->ptr.p_double[0], 1, ae_v_len(1,n-1)); + } + + /* + * No eigen vectors + */ + if( zneeded==0 ) + { + result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 1, 0, 0, i1+1, i2+1, -1, &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + if( m!=i2-i1+1 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + ae_vector_set_length(d, m-1+1, _state); + for(i=1; i<=m; i++) + { + d->ptr.p_double[i-1] = w.ptr.p_double[i]; + } + ae_frame_leave(_state); + return result; + } + + /* + * Eigen vectors are multiplied by Z + */ + if( zneeded==1 ) + { + + /* + * Find eigen pairs + */ + result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 2, 0, 0, i1+1, i2+1, -1, &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + if( m!=i2-i1+1 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + evd_internaldstein(n, &d1, &e1, m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state); + if( cr!=0 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Sort eigen values and vectors + */ + for(i=1; i<=m; i++) + { + k = i; + for(j=i; j<=m; j++) + { + if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) ) + { + k = j; + } + } + v = w.ptr.p_double[i]; + w.ptr.p_double[i] = w.ptr.p_double[k]; + w.ptr.p_double[k] = v; + for(j=1; j<=n; j++) + { + v = z2.ptr.pp_double[j][i]; + z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k]; + z2.ptr.pp_double[j][k] = v; + } + } + + /* + * Transform Z2 and overwrite Z + */ + ae_matrix_set_length(&z3, m+1, n+1, _state); + for(i=1; i<=m; i++) + { + ae_v_move(&z3.ptr.pp_double[i][1], 1, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(1,n)); + } + for(i=1; i<=n; i++) + { + for(j=1; j<=m; j++) + { + v = ae_v_dotproduct(&z->ptr.pp_double[i-1][0], 1, &z3.ptr.pp_double[j][1], 1, ae_v_len(0,n-1)); + z2.ptr.pp_double[i][j] = v; + } + } + ae_matrix_set_length(z, n-1+1, m-1+1, _state); + for(i=1; i<=m; i++) + { + ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1)); + } + + /* + * Store W + */ + ae_vector_set_length(d, m-1+1, _state); + for(i=1; i<=m; i++) + { + d->ptr.p_double[i-1] = w.ptr.p_double[i]; + } + ae_frame_leave(_state); + return result; + } + + /* + * Eigen vectors are stored in Z + */ + if( zneeded==2 ) + { + + /* + * Find eigen pairs + */ + result = evd_internalbisectioneigenvalues(&d1, &e1, n, 3, 2, 0, 0, i1+1, i2+1, -1, &w, &m, &nsplit, &iblock, &isplit, &errorcode, _state); + if( !result ) + { + ae_frame_leave(_state); + return result; + } + if( m!=i2-i1+1 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + evd_internaldstein(n, &d1, &e1, m, &w, &iblock, &isplit, &z2, &ifail, &cr, _state); + if( cr!=0 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Sort eigen values and vectors + */ + for(i=1; i<=m; i++) + { + k = i; + for(j=i; j<=m; j++) + { + if( ae_fp_less(w.ptr.p_double[j],w.ptr.p_double[k]) ) + { + k = j; + } + } + v = w.ptr.p_double[i]; + w.ptr.p_double[i] = w.ptr.p_double[k]; + w.ptr.p_double[k] = v; + for(j=1; j<=n; j++) + { + v = z2.ptr.pp_double[j][i]; + z2.ptr.pp_double[j][i] = z2.ptr.pp_double[j][k]; + z2.ptr.pp_double[j][k] = v; + } + } + + /* + * Store Z + */ + ae_matrix_set_length(z, n-1+1, m-1+1, _state); + for(i=1; i<=m; i++) + { + ae_v_move(&z->ptr.pp_double[0][i-1], z->stride, &z2.ptr.pp_double[1][i], z2.stride, ae_v_len(0,n-1)); + } + + /* + * Store W + */ + ae_vector_set_length(d, m-1+1, _state); + for(i=1; i<=m; i++) + { + d->ptr.p_double[i-1] = w.ptr.p_double[i]; + } + ae_frame_leave(_state); + return result; + } + result = ae_false; + ae_frame_leave(_state); + 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]. + WR - 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. +*************************************************************************/ +ae_bool rmatrixevd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t vneeded, + /* Real */ ae_vector* wr, + /* Real */ ae_vector* wi, + /* Real */ ae_matrix* vl, + /* Real */ ae_matrix* vr, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_matrix a1; + ae_matrix vl1; + ae_matrix vr1; + ae_vector wr1; + ae_vector wi1; + ae_int_t i; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_clear(wr); + ae_vector_clear(wi); + ae_matrix_clear(vl); + ae_matrix_clear(vr); + ae_matrix_init(&a1, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&vl1, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&vr1, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wr1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wi1, 0, DT_REAL, _state, ae_true); + + ae_assert(vneeded>=0&&vneeded<=3, "RMatrixEVD: incorrect VNeeded!", _state); + ae_matrix_set_length(&a1, n+1, n+1, _state); + for(i=1; i<=n; i++) + { + ae_v_move(&a1.ptr.pp_double[i][1], 1, &a->ptr.pp_double[i-1][0], 1, ae_v_len(1,n)); + } + result = evd_nonsymmetricevd(&a1, n, vneeded, &wr1, &wi1, &vl1, &vr1, _state); + if( result ) + { + ae_vector_set_length(wr, n-1+1, _state); + ae_vector_set_length(wi, n-1+1, _state); + ae_v_move(&wr->ptr.p_double[0], 1, &wr1.ptr.p_double[1], 1, ae_v_len(0,n-1)); + ae_v_move(&wi->ptr.p_double[0], 1, &wi1.ptr.p_double[1], 1, ae_v_len(0,n-1)); + if( vneeded==2||vneeded==3 ) + { + ae_matrix_set_length(vl, n-1+1, n-1+1, _state); + for(i=0; i<=n-1; i++) + { + ae_v_move(&vl->ptr.pp_double[i][0], 1, &vl1.ptr.pp_double[i+1][1], 1, ae_v_len(0,n-1)); + } + } + if( vneeded==1||vneeded==3 ) + { + ae_matrix_set_length(vr, n-1+1, n-1+1, _state); + for(i=0; i<=n-1; i++) + { + ae_v_move(&vr->ptr.pp_double[i][0], 1, &vr1.ptr.pp_double[i+1][1], 1, ae_v_len(0,n-1)); + } + } + } + ae_frame_leave(_state); + return result; +} + + +static ae_bool evd_tridiagonalevd(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t zneeded, + /* Real */ ae_matrix* z, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _e; + ae_int_t maxit; + ae_int_t i; + ae_int_t ii; + ae_int_t iscale; + ae_int_t j; + ae_int_t jtot; + ae_int_t k; + ae_int_t t; + ae_int_t l; + ae_int_t l1; + ae_int_t lend; + ae_int_t lendm1; + ae_int_t lendp1; + ae_int_t lendsv; + ae_int_t lm1; + ae_int_t lsv; + ae_int_t m; + ae_int_t mm1; + ae_int_t nm1; + ae_int_t nmaxit; + ae_int_t tmpint; + double anorm; + double b; + double c; + double eps; + double eps2; + double f; + double g; + double p; + double r; + double rt1; + double rt2; + double s; + double safmax; + double safmin; + double ssfmax; + double ssfmin; + double tst; + double tmp; + ae_vector work1; + ae_vector work2; + ae_vector workc; + ae_vector works; + ae_vector wtemp; + ae_bool gotoflag; + ae_int_t zrows; + ae_bool wastranspose; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_e, e, _state, ae_true); + e = &_e; + ae_vector_init(&work1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&workc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&works, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wtemp, 0, DT_REAL, _state, ae_true); + + ae_assert(zneeded>=0&&zneeded<=3, "TridiagonalEVD: Incorrent ZNeeded", _state); + + /* + * Quick return if possible + */ + if( zneeded<0||zneeded>3 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + result = ae_true; + if( n==0 ) + { + ae_frame_leave(_state); + return result; + } + if( n==1 ) + { + if( zneeded==2||zneeded==3 ) + { + ae_matrix_set_length(z, 1+1, 1+1, _state); + z->ptr.pp_double[1][1] = 1; + } + ae_frame_leave(_state); + return result; + } + maxit = 30; + + /* + * Initialize arrays + */ + ae_vector_set_length(&wtemp, n+1, _state); + ae_vector_set_length(&work1, n-1+1, _state); + ae_vector_set_length(&work2, n-1+1, _state); + ae_vector_set_length(&workc, n+1, _state); + ae_vector_set_length(&works, n+1, _state); + + /* + * Determine the unit roundoff and over/underflow thresholds. + */ + eps = ae_machineepsilon; + eps2 = ae_sqr(eps, _state); + safmin = ae_minrealnumber; + safmax = ae_maxrealnumber; + ssfmax = ae_sqrt(safmax, _state)/3; + ssfmin = ae_sqrt(safmin, _state)/eps2; + + /* + * Prepare Z + * + * Here we are using transposition to get rid of column operations + * + */ + wastranspose = ae_false; + zrows = 0; + if( zneeded==1 ) + { + zrows = n; + } + if( zneeded==2 ) + { + zrows = n; + } + if( zneeded==3 ) + { + zrows = 1; + } + if( zneeded==1 ) + { + wastranspose = ae_true; + inplacetranspose(z, 1, n, 1, n, &wtemp, _state); + } + if( zneeded==2 ) + { + wastranspose = ae_true; + ae_matrix_set_length(z, n+1, n+1, _state); + for(i=1; i<=n; i++) + { + for(j=1; j<=n; j++) + { + if( i==j ) + { + z->ptr.pp_double[i][j] = 1; + } + else + { + z->ptr.pp_double[i][j] = 0; + } + } + } + } + if( zneeded==3 ) + { + wastranspose = ae_false; + ae_matrix_set_length(z, 1+1, n+1, _state); + for(j=1; j<=n; j++) + { + if( j==1 ) + { + z->ptr.pp_double[1][j] = 1; + } + else + { + z->ptr.pp_double[1][j] = 0; + } + } + } + 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; + for(;;) + { + if( l1>n ) + { + break; + } + if( l1>1 ) + { + e->ptr.p_double[l1-1] = 0; + } + gotoflag = ae_false; + m = l1; + if( l1<=nm1 ) + { + for(m=l1; m<=nm1; m++) + { + tst = ae_fabs(e->ptr.p_double[m], _state); + if( ae_fp_eq(tst,0) ) + { + gotoflag = ae_true; + break; + } + if( ae_fp_less_eq(tst,ae_sqrt(ae_fabs(d->ptr.p_double[m], _state), _state)*ae_sqrt(ae_fabs(d->ptr.p_double[m+1], _state), _state)*eps) ) + { + e->ptr.p_double[m] = 0; + gotoflag = ae_true; + break; + } + } + } + if( !gotoflag ) + { + m = n; + } + + /* + * label 30: + */ + l = l1; + lsv = l; + lend = m; + lendsv = lend; + l1 = m+1; + if( lend==l ) + { + continue; + } + + /* + * Scale submatrix in rows and columns L to LEND + */ + if( l==lend ) + { + anorm = ae_fabs(d->ptr.p_double[l], _state); + } + else + { + anorm = ae_maxreal(ae_fabs(d->ptr.p_double[l], _state)+ae_fabs(e->ptr.p_double[l], _state), ae_fabs(e->ptr.p_double[lend-1], _state)+ae_fabs(d->ptr.p_double[lend], _state), _state); + for(i=l+1; i<=lend-1; i++) + { + anorm = ae_maxreal(anorm, ae_fabs(d->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i-1], _state), _state); + } + } + iscale = 0; + if( ae_fp_eq(anorm,0) ) + { + continue; + } + if( ae_fp_greater(anorm,ssfmax) ) + { + iscale = 1; + tmp = ssfmax/anorm; + tmpint = lend-1; + ae_v_muld(&d->ptr.p_double[l], 1, ae_v_len(l,lend), tmp); + ae_v_muld(&e->ptr.p_double[l], 1, ae_v_len(l,tmpint), tmp); + } + if( ae_fp_less(anorm,ssfmin) ) + { + iscale = 2; + tmp = ssfmin/anorm; + tmpint = lend-1; + ae_v_muld(&d->ptr.p_double[l], 1, ae_v_len(l,lend), tmp); + ae_v_muld(&e->ptr.p_double[l], 1, ae_v_len(l,tmpint), tmp); + } + + /* + * Choose between QL and QR iteration + */ + if( ae_fp_less(ae_fabs(d->ptr.p_double[lend], _state),ae_fabs(d->ptr.p_double[l], _state)) ) + { + lend = lsv; + l = lendsv; + } + if( lend>l ) + { + + /* + * QL Iteration + * + * Look for small subdiagonal element. + */ + for(;;) + { + gotoflag = ae_false; + if( l!=lend ) + { + lendm1 = lend-1; + for(m=l; m<=lendm1; m++) + { + tst = ae_sqr(ae_fabs(e->ptr.p_double[m], _state), _state); + if( ae_fp_less_eq(tst,eps2*ae_fabs(d->ptr.p_double[m], _state)*ae_fabs(d->ptr.p_double[m+1], _state)+safmin) ) + { + gotoflag = ae_true; + break; + } + } + } + if( !gotoflag ) + { + m = lend; + } + if( mptr.p_double[m] = 0; + } + p = d->ptr.p_double[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 ) + { + evd_tdevdev2(d->ptr.p_double[l], e->ptr.p_double[l], d->ptr.p_double[l+1], &rt1, &rt2, &c, &s, _state); + work1.ptr.p_double[l] = c; + work2.ptr.p_double[l] = s; + workc.ptr.p_double[1] = work1.ptr.p_double[l]; + works.ptr.p_double[1] = work2.ptr.p_double[l]; + if( !wastranspose ) + { + applyrotationsfromtheright(ae_false, 1, zrows, l, l+1, &workc, &works, z, &wtemp, _state); + } + else + { + applyrotationsfromtheleft(ae_false, l, l+1, 1, zrows, &workc, &works, z, &wtemp, _state); + } + } + else + { + evd_tdevde2(d->ptr.p_double[l], e->ptr.p_double[l], d->ptr.p_double[l+1], &rt1, &rt2, _state); + } + d->ptr.p_double[l] = rt1; + d->ptr.p_double[l+1] = rt2; + e->ptr.p_double[l] = 0; + l = l+2; + if( l<=lend ) + { + continue; + } + + /* + * GOTO 140 + */ + break; + } + if( jtot==nmaxit ) + { + + /* + * GOTO 140 + */ + break; + } + jtot = jtot+1; + + /* + * Form shift. + */ + g = (d->ptr.p_double[l+1]-p)/(2*e->ptr.p_double[l]); + r = evd_tdevdpythag(g, 1, _state); + g = d->ptr.p_double[m]-p+e->ptr.p_double[l]/(g+evd_tdevdextsign(r, g, _state)); + s = 1; + c = 1; + p = 0; + + /* + * Inner loop + */ + mm1 = m-1; + for(i=mm1; i>=l; i--) + { + f = s*e->ptr.p_double[i]; + b = c*e->ptr.p_double[i]; + generaterotation(g, f, &c, &s, &r, _state); + if( i!=m-1 ) + { + e->ptr.p_double[i+1] = r; + } + g = d->ptr.p_double[i+1]-p; + r = (d->ptr.p_double[i]-g)*s+2*c*b; + p = s*r; + d->ptr.p_double[i+1] = g+p; + g = c*r-b; + + /* + * If eigenvectors are desired, then save rotations. + */ + if( zneeded>0 ) + { + work1.ptr.p_double[i] = c; + work2.ptr.p_double[i] = -s; + } + } + + /* + * If eigenvectors are desired, then apply saved rotations. + */ + if( zneeded>0 ) + { + for(i=l; i<=m-1; i++) + { + workc.ptr.p_double[i-l+1] = work1.ptr.p_double[i]; + works.ptr.p_double[i-l+1] = work2.ptr.p_double[i]; + } + if( !wastranspose ) + { + applyrotationsfromtheright(ae_false, 1, zrows, l, m, &workc, &works, z, &wtemp, _state); + } + else + { + applyrotationsfromtheleft(ae_false, l, m, 1, zrows, &workc, &works, z, &wtemp, _state); + } + } + d->ptr.p_double[l] = d->ptr.p_double[l]-p; + e->ptr.p_double[l] = g; + continue; + } + + /* + * Eigenvalue found. + */ + d->ptr.p_double[l] = p; + l = l+1; + if( l<=lend ) + { + continue; + } + break; + } + } + else + { + + /* + * QR Iteration + * + * Look for small superdiagonal element. + */ + for(;;) + { + gotoflag = ae_false; + if( l!=lend ) + { + lendp1 = lend+1; + for(m=l; m>=lendp1; m--) + { + tst = ae_sqr(ae_fabs(e->ptr.p_double[m-1], _state), _state); + if( ae_fp_less_eq(tst,eps2*ae_fabs(d->ptr.p_double[m], _state)*ae_fabs(d->ptr.p_double[m-1], _state)+safmin) ) + { + gotoflag = ae_true; + break; + } + } + } + if( !gotoflag ) + { + m = lend; + } + if( m>lend ) + { + e->ptr.p_double[m-1] = 0; + } + p = d->ptr.p_double[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 ) + { + evd_tdevdev2(d->ptr.p_double[l-1], e->ptr.p_double[l-1], d->ptr.p_double[l], &rt1, &rt2, &c, &s, _state); + work1.ptr.p_double[m] = c; + work2.ptr.p_double[m] = s; + workc.ptr.p_double[1] = c; + works.ptr.p_double[1] = s; + if( !wastranspose ) + { + applyrotationsfromtheright(ae_true, 1, zrows, l-1, l, &workc, &works, z, &wtemp, _state); + } + else + { + applyrotationsfromtheleft(ae_true, l-1, l, 1, zrows, &workc, &works, z, &wtemp, _state); + } + } + else + { + evd_tdevde2(d->ptr.p_double[l-1], e->ptr.p_double[l-1], d->ptr.p_double[l], &rt1, &rt2, _state); + } + d->ptr.p_double[l-1] = rt1; + d->ptr.p_double[l] = rt2; + e->ptr.p_double[l-1] = 0; + l = l-2; + if( l>=lend ) + { + continue; + } + break; + } + if( jtot==nmaxit ) + { + break; + } + jtot = jtot+1; + + /* + * Form shift. + */ + g = (d->ptr.p_double[l-1]-p)/(2*e->ptr.p_double[l-1]); + r = evd_tdevdpythag(g, 1, _state); + g = d->ptr.p_double[m]-p+e->ptr.p_double[l-1]/(g+evd_tdevdextsign(r, g, _state)); + s = 1; + c = 1; + p = 0; + + /* + * Inner loop + */ + lm1 = l-1; + for(i=m; i<=lm1; i++) + { + f = s*e->ptr.p_double[i]; + b = c*e->ptr.p_double[i]; + generaterotation(g, f, &c, &s, &r, _state); + if( i!=m ) + { + e->ptr.p_double[i-1] = r; + } + g = d->ptr.p_double[i]-p; + r = (d->ptr.p_double[i+1]-g)*s+2*c*b; + p = s*r; + d->ptr.p_double[i] = g+p; + g = c*r-b; + + /* + * If eigenvectors are desired, then save rotations. + */ + if( zneeded>0 ) + { + work1.ptr.p_double[i] = c; + work2.ptr.p_double[i] = s; + } + } + + /* + * If eigenvectors are desired, then apply saved rotations. + */ + if( zneeded>0 ) + { + for(i=m; i<=l-1; i++) + { + workc.ptr.p_double[i-m+1] = work1.ptr.p_double[i]; + works.ptr.p_double[i-m+1] = work2.ptr.p_double[i]; + } + if( !wastranspose ) + { + applyrotationsfromtheright(ae_true, 1, zrows, m, l, &workc, &works, z, &wtemp, _state); + } + else + { + applyrotationsfromtheleft(ae_true, m, l, 1, zrows, &workc, &works, z, &wtemp, _state); + } + } + d->ptr.p_double[l] = d->ptr.p_double[l]-p; + e->ptr.p_double[lm1] = g; + continue; + } + + /* + * Eigenvalue found. + */ + d->ptr.p_double[l] = p; + l = l-1; + if( l>=lend ) + { + continue; + } + break; + } + } + + /* + * Undo scaling if necessary + */ + if( iscale==1 ) + { + tmp = anorm/ssfmax; + tmpint = lendsv-1; + ae_v_muld(&d->ptr.p_double[lsv], 1, ae_v_len(lsv,lendsv), tmp); + ae_v_muld(&e->ptr.p_double[lsv], 1, ae_v_len(lsv,tmpint), tmp); + } + if( iscale==2 ) + { + tmp = anorm/ssfmin; + tmpint = lendsv-1; + ae_v_muld(&d->ptr.p_double[lsv], 1, ae_v_len(lsv,lendsv), tmp); + ae_v_muld(&e->ptr.p_double[lsv], 1, ae_v_len(lsv,tmpint), tmp); + } + + /* + * Check for no convergence to an eigenvalue after a total + * of N*MAXIT iterations. + */ + if( jtot>=nmaxit ) + { + result = ae_false; + if( wastranspose ) + { + inplacetranspose(z, 1, n, 1, n, &wtemp, _state); + } + ae_frame_leave(_state); + return result; + } + } + + /* + * Order eigenvalues and eigenvectors. + */ + if( zneeded==0 ) + { + + /* + * Sort + */ + if( n==1 ) + { + ae_frame_leave(_state); + return result; + } + if( n==2 ) + { + if( ae_fp_greater(d->ptr.p_double[1],d->ptr.p_double[2]) ) + { + tmp = d->ptr.p_double[1]; + d->ptr.p_double[1] = d->ptr.p_double[2]; + d->ptr.p_double[2] = tmp; + } + ae_frame_leave(_state); + return result; + } + i = 2; + do + { + t = i; + while(t!=1) + { + k = t/2; + if( ae_fp_greater_eq(d->ptr.p_double[k],d->ptr.p_double[t]) ) + { + t = 1; + } + else + { + tmp = d->ptr.p_double[k]; + d->ptr.p_double[k] = d->ptr.p_double[t]; + d->ptr.p_double[t] = tmp; + t = k; + } + } + i = i+1; + } + while(i<=n); + i = n-1; + do + { + tmp = d->ptr.p_double[i+1]; + d->ptr.p_double[i+1] = d->ptr.p_double[1]; + d->ptr.p_double[1] = tmp; + t = 1; + while(t!=0) + { + k = 2*t; + if( k>i ) + { + t = 0; + } + else + { + if( kptr.p_double[k+1],d->ptr.p_double[k]) ) + { + k = k+1; + } + } + if( ae_fp_greater_eq(d->ptr.p_double[t],d->ptr.p_double[k]) ) + { + t = 0; + } + else + { + tmp = d->ptr.p_double[k]; + d->ptr.p_double[k] = d->ptr.p_double[t]; + d->ptr.p_double[t] = tmp; + t = k; + } + } + } + i = i-1; + } + 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->ptr.p_double[i]; + for(j=ii; j<=n; j++) + { + if( ae_fp_less(d->ptr.p_double[j],p) ) + { + k = j; + p = d->ptr.p_double[j]; + } + } + if( k!=i ) + { + d->ptr.p_double[k] = d->ptr.p_double[i]; + d->ptr.p_double[i] = p; + if( wastranspose ) + { + ae_v_move(&wtemp.ptr.p_double[1], 1, &z->ptr.pp_double[i][1], 1, ae_v_len(1,n)); + ae_v_move(&z->ptr.pp_double[i][1], 1, &z->ptr.pp_double[k][1], 1, ae_v_len(1,n)); + ae_v_move(&z->ptr.pp_double[k][1], 1, &wtemp.ptr.p_double[1], 1, ae_v_len(1,n)); + } + else + { + ae_v_move(&wtemp.ptr.p_double[1], 1, &z->ptr.pp_double[1][i], z->stride, ae_v_len(1,zrows)); + ae_v_move(&z->ptr.pp_double[1][i], z->stride, &z->ptr.pp_double[1][k], z->stride, ae_v_len(1,zrows)); + ae_v_move(&z->ptr.pp_double[1][k], z->stride, &wtemp.ptr.p_double[1], 1, ae_v_len(1,zrows)); + } + } + } + if( wastranspose ) + { + inplacetranspose(z, 1, n, 1, n, &wtemp, _state); + } + } + ae_frame_leave(_state); + 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 +*************************************************************************/ +static void evd_tdevde2(double a, + double b, + double c, + double* rt1, + double* rt2, + ae_state *_state) +{ + double ab; + double acmn; + double acmx; + double adf; + double df; + double rt; + double sm; + double tb; + + *rt1 = 0; + *rt2 = 0; + + sm = a+c; + df = a-c; + adf = ae_fabs(df, _state); + tb = b+b; + ab = ae_fabs(tb, _state); + if( ae_fp_greater(ae_fabs(a, _state),ae_fabs(c, _state)) ) + { + acmx = a; + acmn = c; + } + else + { + acmx = c; + acmn = a; + } + if( ae_fp_greater(adf,ab) ) + { + rt = adf*ae_sqrt(1+ae_sqr(ab/adf, _state), _state); + } + else + { + if( ae_fp_less(adf,ab) ) + { + rt = ab*ae_sqrt(1+ae_sqr(adf/ab, _state), _state); + } + else + { + + /* + * Includes case AB=ADF=0 + */ + rt = ab*ae_sqrt(2, _state); + } + } + if( ae_fp_less(sm,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 + { + if( ae_fp_greater(sm,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 +*************************************************************************/ +static void evd_tdevdev2(double a, + double b, + double c, + double* rt1, + double* rt2, + double* cs1, + double* sn1, + ae_state *_state) +{ + ae_int_t sgn1; + ae_int_t sgn2; + double ab; + double acmn; + double acmx; + double acs; + double adf; + double cs; + double ct; + double df; + double rt; + double sm; + double tb; + double tn; + + *rt1 = 0; + *rt2 = 0; + *cs1 = 0; + *sn1 = 0; + + + /* + * Compute the eigenvalues + */ + sm = a+c; + df = a-c; + adf = ae_fabs(df, _state); + tb = b+b; + ab = ae_fabs(tb, _state); + if( ae_fp_greater(ae_fabs(a, _state),ae_fabs(c, _state)) ) + { + acmx = a; + acmn = c; + } + else + { + acmx = c; + acmn = a; + } + if( ae_fp_greater(adf,ab) ) + { + rt = adf*ae_sqrt(1+ae_sqr(ab/adf, _state), _state); + } + else + { + if( ae_fp_less(adf,ab) ) + { + rt = ab*ae_sqrt(1+ae_sqr(adf/ab, _state), _state); + } + else + { + + /* + * Includes case AB=ADF=0 + */ + rt = ab*ae_sqrt(2, _state); + } + } + if( ae_fp_less(sm,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 + { + if( ae_fp_greater(sm,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( ae_fp_greater_eq(df,0) ) + { + cs = df+rt; + sgn2 = 1; + } + else + { + cs = df-rt; + sgn2 = -1; + } + acs = ae_fabs(cs, _state); + if( ae_fp_greater(acs,ab) ) + { + ct = -tb/cs; + *sn1 = 1/ae_sqrt(1+ct*ct, _state); + *cs1 = ct*(*sn1); + } + else + { + if( ae_fp_eq(ab,0) ) + { + *cs1 = 1; + *sn1 = 0; + } + else + { + tn = -cs/tb; + *cs1 = 1/ae_sqrt(1+tn*tn, _state); + *sn1 = tn*(*cs1); + } + } + if( sgn1==sgn2 ) + { + tn = *cs1; + *cs1 = -*sn1; + *sn1 = tn; + } +} + + +/************************************************************************* +Internal routine +*************************************************************************/ +static double evd_tdevdpythag(double a, double b, ae_state *_state) +{ + double result; + + + if( ae_fp_less(ae_fabs(a, _state),ae_fabs(b, _state)) ) + { + result = ae_fabs(b, _state)*ae_sqrt(1+ae_sqr(a/b, _state), _state); + } + else + { + result = ae_fabs(a, _state)*ae_sqrt(1+ae_sqr(b/a, _state), _state); + } + return result; +} + + +/************************************************************************* +Internal routine +*************************************************************************/ +static double evd_tdevdextsign(double a, double b, ae_state *_state) +{ + double result; + + + if( ae_fp_greater_eq(b,0) ) + { + result = ae_fabs(a, _state); + } + else + { + result = -ae_fabs(a, _state); + } + return result; +} + + +static ae_bool evd_internalbisectioneigenvalues(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t irange, + ae_int_t iorder, + double vl, + double vu, + ae_int_t il, + ae_int_t iu, + double abstol, + /* Real */ ae_vector* w, + ae_int_t* m, + ae_int_t* nsplit, + /* Integer */ ae_vector* iblock, + /* Integer */ ae_vector* isplit, + ae_int_t* errorcode, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _d; + ae_vector _e; + double fudge; + double relfac; + ae_bool ncnvrg; + ae_bool toofew; + ae_int_t ib; + ae_int_t ibegin; + ae_int_t idiscl; + ae_int_t idiscu; + ae_int_t ie; + ae_int_t iend; + ae_int_t iinfo; + ae_int_t im; + ae_int_t iin; + ae_int_t ioff; + ae_int_t iout; + ae_int_t itmax; + ae_int_t iw; + ae_int_t iwoff; + ae_int_t j; + ae_int_t itmp1; + ae_int_t jb; + ae_int_t jdisc; + ae_int_t je; + ae_int_t nwl; + ae_int_t nwu; + double atoli; + double bnorm; + double gl; + double gu; + double pivmin; + double rtoli; + double safemn; + double tmp1; + double tmp2; + double tnorm; + double ulp; + double wkill; + double wl; + double wlu; + double wu; + double wul; + double scalefactor; + double t; + ae_vector idumma; + ae_vector work; + ae_vector iwork; + ae_vector ia1s2; + ae_vector ra1s2; + ae_matrix ra1s2x2; + ae_matrix ia1s2x2; + ae_vector ra1siin; + ae_vector ra2siin; + ae_vector ra3siin; + ae_vector ra4siin; + ae_matrix ra1siinx2; + ae_matrix ia1siinx2; + ae_vector iworkspace; + ae_vector rworkspace; + ae_int_t tmpi; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_d, d, _state, ae_true); + d = &_d; + ae_vector_init_copy(&_e, e, _state, ae_true); + e = &_e; + ae_vector_clear(w); + *m = 0; + *nsplit = 0; + ae_vector_clear(iblock); + ae_vector_clear(isplit); + *errorcode = 0; + ae_vector_init(&idumma, 0, DT_INT, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); + ae_vector_init(&ia1s2, 0, DT_INT, _state, ae_true); + ae_vector_init(&ra1s2, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&ra1s2x2, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&ia1s2x2, 0, 0, DT_INT, _state, ae_true); + ae_vector_init(&ra1siin, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ra2siin, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ra3siin, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ra4siin, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&ra1siinx2, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&ia1siinx2, 0, 0, DT_INT, _state, ae_true); + ae_vector_init(&iworkspace, 0, DT_INT, _state, ae_true); + ae_vector_init(&rworkspace, 0, DT_REAL, _state, ae_true); + + + /* + * Quick return if possible + */ + *m = 0; + if( n==0 ) + { + result = ae_true; + ae_frame_leave(_state); + return result; + } + + /* + * 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 = ae_minrealnumber; + ulp = 2*ae_machineepsilon; + rtoli = ulp*relfac; + ae_vector_set_length(&idumma, 1+1, _state); + ae_vector_set_length(&work, 4*n+1, _state); + ae_vector_set_length(&iwork, 3*n+1, _state); + ae_vector_set_length(w, n+1, _state); + ae_vector_set_length(iblock, n+1, _state); + ae_vector_set_length(isplit, n+1, _state); + ae_vector_set_length(&ia1s2, 2+1, _state); + ae_vector_set_length(&ra1s2, 2+1, _state); + ae_matrix_set_length(&ra1s2x2, 2+1, 2+1, _state); + ae_matrix_set_length(&ia1s2x2, 2+1, 2+1, _state); + ae_vector_set_length(&ra1siin, n+1, _state); + ae_vector_set_length(&ra2siin, n+1, _state); + ae_vector_set_length(&ra3siin, n+1, _state); + ae_vector_set_length(&ra4siin, n+1, _state); + ae_matrix_set_length(&ra1siinx2, n+1, 2+1, _state); + ae_matrix_set_length(&ia1siinx2, n+1, 2+1, _state); + ae_vector_set_length(&iworkspace, n+1, _state); + ae_vector_set_length(&rworkspace, n+1, _state); + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + wlu = 0; + wul = 0; + + /* + * Check for Errors + */ + result = ae_false; + *errorcode = 0; + if( irange<=0||irange>=4 ) + { + *errorcode = -4; + } + if( iorder<=0||iorder>=3 ) + { + *errorcode = -5; + } + if( n<0 ) + { + *errorcode = -3; + } + if( irange==2&&ae_fp_greater_eq(vl,vu) ) + { + *errorcode = -6; + } + if( irange==3&&(il<1||il>ae_maxint(1, n, _state)) ) + { + *errorcode = -8; + } + if( irange==3&&(iun) ) + { + *errorcode = -9; + } + if( *errorcode!=0 ) + { + ae_frame_leave(_state); + return result; + } + + /* + * Initialize error flags + */ + ncnvrg = ae_false; + toofew = ae_false; + + /* + * Simplifications: + */ + if( (irange==3&&il==1)&&iu==n ) + { + irange = 1; + } + + /* + * Special Case when N=1 + */ + if( n==1 ) + { + *nsplit = 1; + isplit->ptr.p_int[1] = 1; + if( irange==2&&(ae_fp_greater_eq(vl,d->ptr.p_double[1])||ae_fp_less(vu,d->ptr.p_double[1])) ) + { + *m = 0; + } + else + { + w->ptr.p_double[1] = d->ptr.p_double[1]; + iblock->ptr.p_int[1] = 1; + *m = 1; + } + result = ae_true; + ae_frame_leave(_state); + return result; + } + + /* + * Scaling + */ + t = ae_fabs(d->ptr.p_double[n], _state); + for(j=1; j<=n-1; j++) + { + t = ae_maxreal(t, ae_fabs(d->ptr.p_double[j], _state), _state); + t = ae_maxreal(t, ae_fabs(e->ptr.p_double[j], _state), _state); + } + scalefactor = 1; + if( ae_fp_neq(t,0) ) + { + if( ae_fp_greater(t,ae_sqrt(ae_sqrt(ae_minrealnumber, _state), _state)*ae_sqrt(ae_maxrealnumber, _state)) ) + { + scalefactor = t; + } + if( ae_fp_less(t,ae_sqrt(ae_sqrt(ae_maxrealnumber, _state), _state)*ae_sqrt(ae_minrealnumber, _state)) ) + { + scalefactor = t; + } + for(j=1; j<=n-1; j++) + { + d->ptr.p_double[j] = d->ptr.p_double[j]/scalefactor; + e->ptr.p_double[j] = e->ptr.p_double[j]/scalefactor; + } + d->ptr.p_double[n] = d->ptr.p_double[n]/scalefactor; + } + + /* + * Compute Splitting Points + */ + *nsplit = 1; + work.ptr.p_double[n] = 0; + pivmin = 1; + for(j=2; j<=n; j++) + { + tmp1 = ae_sqr(e->ptr.p_double[j-1], _state); + if( ae_fp_greater(ae_fabs(d->ptr.p_double[j]*d->ptr.p_double[j-1], _state)*ae_sqr(ulp, _state)+safemn,tmp1) ) + { + isplit->ptr.p_int[*nsplit] = j-1; + *nsplit = *nsplit+1; + work.ptr.p_double[j-1] = 0; + } + else + { + work.ptr.p_double[j-1] = tmp1; + pivmin = ae_maxreal(pivmin, tmp1, _state); + } + } + isplit->ptr.p_int[*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->ptr.p_double[1]; + gl = d->ptr.p_double[1]; + tmp1 = 0; + for(j=1; j<=n-1; j++) + { + tmp2 = ae_sqrt(work.ptr.p_double[j], _state); + gu = ae_maxreal(gu, d->ptr.p_double[j]+tmp1+tmp2, _state); + gl = ae_minreal(gl, d->ptr.p_double[j]-tmp1-tmp2, _state); + tmp1 = tmp2; + } + gu = ae_maxreal(gu, d->ptr.p_double[n]+tmp1, _state); + gl = ae_minreal(gl, d->ptr.p_double[n]-tmp1, _state); + tnorm = ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state); + gl = gl-fudge*tnorm*ulp*n-fudge*2*pivmin; + gu = gu+fudge*tnorm*ulp*n+fudge*pivmin; + + /* + * Compute Iteration parameters + */ + itmax = ae_iceil((ae_log(tnorm+pivmin, _state)-ae_log(pivmin, _state))/ae_log(2, _state), _state)+2; + if( ae_fp_less_eq(abstol,0) ) + { + atoli = ulp*tnorm; + } + else + { + atoli = abstol; + } + work.ptr.p_double[n+1] = gl; + work.ptr.p_double[n+2] = gl; + work.ptr.p_double[n+3] = gu; + work.ptr.p_double[n+4] = gu; + work.ptr.p_double[n+5] = gl; + work.ptr.p_double[n+6] = gu; + iwork.ptr.p_int[1] = -1; + iwork.ptr.p_int[2] = -1; + iwork.ptr.p_int[3] = n+1; + iwork.ptr.p_int[4] = n+1; + iwork.ptr.p_int[5] = il-1; + iwork.ptr.p_int[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.ptr.p_int[1] = iwork.ptr.p_int[5]; + ia1s2.ptr.p_int[2] = iwork.ptr.p_int[6]; + ra1s2.ptr.p_double[1] = work.ptr.p_double[n+5]; + ra1s2.ptr.p_double[2] = work.ptr.p_double[n+6]; + ra1s2x2.ptr.pp_double[1][1] = work.ptr.p_double[n+1]; + ra1s2x2.ptr.pp_double[2][1] = work.ptr.p_double[n+2]; + ra1s2x2.ptr.pp_double[1][2] = work.ptr.p_double[n+3]; + ra1s2x2.ptr.pp_double[2][2] = work.ptr.p_double[n+4]; + ia1s2x2.ptr.pp_int[1][1] = iwork.ptr.p_int[1]; + ia1s2x2.ptr.pp_int[2][1] = iwork.ptr.p_int[2]; + ia1s2x2.ptr.pp_int[1][2] = iwork.ptr.p_int[3]; + ia1s2x2.ptr.pp_int[2][2] = iwork.ptr.p_int[4]; + evd_internaldlaebz(3, itmax, n, 2, 2, atoli, rtoli, pivmin, d, e, &work, &ia1s2, &ra1s2x2, &ra1s2, &iout, &ia1s2x2, w, iblock, &iinfo, _state); + iwork.ptr.p_int[5] = ia1s2.ptr.p_int[1]; + iwork.ptr.p_int[6] = ia1s2.ptr.p_int[2]; + work.ptr.p_double[n+5] = ra1s2.ptr.p_double[1]; + work.ptr.p_double[n+6] = ra1s2.ptr.p_double[2]; + work.ptr.p_double[n+1] = ra1s2x2.ptr.pp_double[1][1]; + work.ptr.p_double[n+2] = ra1s2x2.ptr.pp_double[2][1]; + work.ptr.p_double[n+3] = ra1s2x2.ptr.pp_double[1][2]; + work.ptr.p_double[n+4] = ra1s2x2.ptr.pp_double[2][2]; + iwork.ptr.p_int[1] = ia1s2x2.ptr.pp_int[1][1]; + iwork.ptr.p_int[2] = ia1s2x2.ptr.pp_int[2][1]; + iwork.ptr.p_int[3] = ia1s2x2.ptr.pp_int[1][2]; + iwork.ptr.p_int[4] = ia1s2x2.ptr.pp_int[2][2]; + if( iwork.ptr.p_int[6]==iu ) + { + wl = work.ptr.p_double[n+1]; + wlu = work.ptr.p_double[n+3]; + nwl = iwork.ptr.p_int[1]; + wu = work.ptr.p_double[n+4]; + wul = work.ptr.p_double[n+2]; + nwu = iwork.ptr.p_int[4]; + } + else + { + wl = work.ptr.p_double[n+2]; + wlu = work.ptr.p_double[n+4]; + nwl = iwork.ptr.p_int[2]; + wu = work.ptr.p_double[n+3]; + wul = work.ptr.p_double[n+1]; + nwu = iwork.ptr.p_int[3]; + } + if( ((nwl<0||nwl>=n)||nwu<1)||nwu>n ) + { + *errorcode = 4; + result = ae_false; + ae_frame_leave(_state); + return result; + } + } + else + { + + /* + * RANGE='A' or 'V' -- Set ATOLI + */ + tnorm = ae_maxreal(ae_fabs(d->ptr.p_double[1], _state)+ae_fabs(e->ptr.p_double[1], _state), ae_fabs(d->ptr.p_double[n], _state)+ae_fabs(e->ptr.p_double[n-1], _state), _state); + for(j=2; j<=n-1; j++) + { + tnorm = ae_maxreal(tnorm, ae_fabs(d->ptr.p_double[j], _state)+ae_fabs(e->ptr.p_double[j-1], _state)+ae_fabs(e->ptr.p_double[j], _state), _state); + } + if( ae_fp_less_eq(abstol,0) ) + { + atoli = ulp*tnorm; + } + else + { + atoli = abstol; + } + 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->ptr.p_int[jb]; + iin = iend-ioff; + if( iin==1 ) + { + + /* + * Special Case -- IIN=1 + */ + if( irange==1||ae_fp_greater_eq(wl,d->ptr.p_double[ibegin]-pivmin) ) + { + nwl = nwl+1; + } + if( irange==1||ae_fp_greater_eq(wu,d->ptr.p_double[ibegin]-pivmin) ) + { + nwu = nwu+1; + } + if( irange==1||(ae_fp_less(wl,d->ptr.p_double[ibegin]-pivmin)&&ae_fp_greater_eq(wu,d->ptr.p_double[ibegin]-pivmin)) ) + { + *m = *m+1; + w->ptr.p_double[*m] = d->ptr.p_double[ibegin]; + iblock->ptr.p_int[*m] = jb; + } + } + else + { + + /* + * General Case -- IIN > 1 + * + * Compute Gershgorin Interval + * and use it as the initial interval + */ + gu = d->ptr.p_double[ibegin]; + gl = d->ptr.p_double[ibegin]; + tmp1 = 0; + for(j=ibegin; j<=iend-1; j++) + { + tmp2 = ae_fabs(e->ptr.p_double[j], _state); + gu = ae_maxreal(gu, d->ptr.p_double[j]+tmp1+tmp2, _state); + gl = ae_minreal(gl, d->ptr.p_double[j]-tmp1-tmp2, _state); + tmp1 = tmp2; + } + gu = ae_maxreal(gu, d->ptr.p_double[iend]+tmp1, _state); + gl = ae_minreal(gl, d->ptr.p_double[iend]-tmp1, _state); + bnorm = ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state); + gl = gl-fudge*bnorm*ulp*iin-fudge*pivmin; + gu = gu+fudge*bnorm*ulp*iin+fudge*pivmin; + + /* + * Compute ATOLI for the current submatrix + */ + if( ae_fp_less_eq(abstol,0) ) + { + atoli = ulp*ae_maxreal(ae_fabs(gl, _state), ae_fabs(gu, _state), _state); + } + else + { + atoli = abstol; + } + if( irange>1 ) + { + if( ae_fp_less(gu,wl) ) + { + nwl = nwl+iin; + nwu = nwu+iin; + continue; + } + gl = ae_maxreal(gl, wl, _state); + gu = ae_minreal(gu, wu, _state); + if( ae_fp_greater_eq(gl,gu) ) + { + continue; + } + } + + /* + * Set Up Initial Interval + */ + work.ptr.p_double[n+1] = gl; + work.ptr.p_double[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.ptr.p_double[tmpi] = d->ptr.p_double[ibegin-1+tmpi]; + if( ibegin-1+tmpiptr.p_double[ibegin-1+tmpi]; + } + ra3siin.ptr.p_double[tmpi] = work.ptr.p_double[ibegin-1+tmpi]; + ra1siinx2.ptr.pp_double[tmpi][1] = work.ptr.p_double[n+tmpi]; + ra1siinx2.ptr.pp_double[tmpi][2] = work.ptr.p_double[n+tmpi+iin]; + ra4siin.ptr.p_double[tmpi] = work.ptr.p_double[n+2*iin+tmpi]; + rworkspace.ptr.p_double[tmpi] = w->ptr.p_double[*m+tmpi]; + iworkspace.ptr.p_int[tmpi] = iblock->ptr.p_int[*m+tmpi]; + ia1siinx2.ptr.pp_int[tmpi][1] = iwork.ptr.p_int[tmpi]; + ia1siinx2.ptr.pp_int[tmpi][2] = iwork.ptr.p_int[tmpi+iin]; + } + evd_internaldlaebz(1, 0, iin, iin, 1, atoli, rtoli, pivmin, &ra1siin, &ra2siin, &ra3siin, &idumma, &ra1siinx2, &ra4siin, &im, &ia1siinx2, &rworkspace, &iworkspace, &iinfo, _state); + for(tmpi=1; tmpi<=iin; tmpi++) + { + work.ptr.p_double[n+tmpi] = ra1siinx2.ptr.pp_double[tmpi][1]; + work.ptr.p_double[n+tmpi+iin] = ra1siinx2.ptr.pp_double[tmpi][2]; + work.ptr.p_double[n+2*iin+tmpi] = ra4siin.ptr.p_double[tmpi]; + w->ptr.p_double[*m+tmpi] = rworkspace.ptr.p_double[tmpi]; + iblock->ptr.p_int[*m+tmpi] = iworkspace.ptr.p_int[tmpi]; + iwork.ptr.p_int[tmpi] = ia1siinx2.ptr.pp_int[tmpi][1]; + iwork.ptr.p_int[tmpi+iin] = ia1siinx2.ptr.pp_int[tmpi][2]; + } + nwl = nwl+iwork.ptr.p_int[1]; + nwu = nwu+iwork.ptr.p_int[iin+1]; + iwoff = *m-iwork.ptr.p_int[1]; + + /* + * Compute Eigenvalues + */ + itmax = ae_iceil((ae_log(gu-gl+pivmin, _state)-ae_log(pivmin, _state))/ae_log(2, _state), _state)+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.ptr.p_double[tmpi] = d->ptr.p_double[ibegin-1+tmpi]; + if( ibegin-1+tmpiptr.p_double[ibegin-1+tmpi]; + } + ra3siin.ptr.p_double[tmpi] = work.ptr.p_double[ibegin-1+tmpi]; + ra1siinx2.ptr.pp_double[tmpi][1] = work.ptr.p_double[n+tmpi]; + ra1siinx2.ptr.pp_double[tmpi][2] = work.ptr.p_double[n+tmpi+iin]; + ra4siin.ptr.p_double[tmpi] = work.ptr.p_double[n+2*iin+tmpi]; + rworkspace.ptr.p_double[tmpi] = w->ptr.p_double[*m+tmpi]; + iworkspace.ptr.p_int[tmpi] = iblock->ptr.p_int[*m+tmpi]; + ia1siinx2.ptr.pp_int[tmpi][1] = iwork.ptr.p_int[tmpi]; + ia1siinx2.ptr.pp_int[tmpi][2] = iwork.ptr.p_int[tmpi+iin]; + } + evd_internaldlaebz(2, itmax, iin, iin, 1, atoli, rtoli, pivmin, &ra1siin, &ra2siin, &ra3siin, &idumma, &ra1siinx2, &ra4siin, &iout, &ia1siinx2, &rworkspace, &iworkspace, &iinfo, _state); + for(tmpi=1; tmpi<=iin; tmpi++) + { + work.ptr.p_double[n+tmpi] = ra1siinx2.ptr.pp_double[tmpi][1]; + work.ptr.p_double[n+tmpi+iin] = ra1siinx2.ptr.pp_double[tmpi][2]; + work.ptr.p_double[n+2*iin+tmpi] = ra4siin.ptr.p_double[tmpi]; + w->ptr.p_double[*m+tmpi] = rworkspace.ptr.p_double[tmpi]; + iblock->ptr.p_int[*m+tmpi] = iworkspace.ptr.p_int[tmpi]; + iwork.ptr.p_int[tmpi] = ia1siinx2.ptr.pp_int[tmpi][1]; + iwork.ptr.p_int[tmpi+iin] = ia1siinx2.ptr.pp_int[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.ptr.p_double[j+n]+work.ptr.p_double[j+iin+n]); + + /* + * Flag non-convergence. + */ + if( j>iout-iinfo ) + { + ncnvrg = ae_true; + ib = -jb; + } + else + { + ib = jb; + } + for(je=iwork.ptr.p_int[j]+1+iwoff; je<=iwork.ptr.p_int[j+iin]+iwoff; je++) + { + w->ptr.p_double[je] = tmp1; + iblock->ptr.p_int[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; + if( idiscl>0||idiscu>0 ) + { + for(je=1; je<=*m; je++) + { + if( ae_fp_less_eq(w->ptr.p_double[je],wlu)&&idiscl>0 ) + { + idiscl = idiscl-1; + } + else + { + if( ae_fp_greater_eq(w->ptr.p_double[je],wul)&&idiscu>0 ) + { + idiscu = idiscu-1; + } + else + { + im = im+1; + w->ptr.p_double[im] = w->ptr.p_double[je]; + iblock->ptr.p_int[im] = iblock->ptr.p_int[je]; + } + } + } + *m = im; + } + 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++) + { + if( iblock->ptr.p_int[je]!=0&&(ae_fp_less(w->ptr.p_double[je],wkill)||iw==0) ) + { + iw = je; + wkill = w->ptr.p_double[je]; + } + } + iblock->ptr.p_int[iw] = 0; + } + } + if( idiscu>0 ) + { + wkill = wl; + for(jdisc=1; jdisc<=idiscu; jdisc++) + { + iw = 0; + for(je=1; je<=*m; je++) + { + if( iblock->ptr.p_int[je]!=0&&(ae_fp_greater(w->ptr.p_double[je],wkill)||iw==0) ) + { + iw = je; + wkill = w->ptr.p_double[je]; + } + } + iblock->ptr.p_int[iw] = 0; + } + } + im = 0; + for(je=1; je<=*m; je++) + { + if( iblock->ptr.p_int[je]!=0 ) + { + im = im+1; + w->ptr.p_double[im] = w->ptr.p_double[je]; + iblock->ptr.p_int[im] = iblock->ptr.p_int[je]; + } + } + *m = im; + } + if( idiscl<0||idiscu<0 ) + { + toofew = ae_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->ptr.p_double[je]; + for(j=je+1; j<=*m; j++) + { + if( ae_fp_less(w->ptr.p_double[j],tmp1) ) + { + ie = j; + tmp1 = w->ptr.p_double[j]; + } + } + if( ie!=0 ) + { + itmp1 = iblock->ptr.p_int[ie]; + w->ptr.p_double[ie] = w->ptr.p_double[je]; + iblock->ptr.p_int[ie] = iblock->ptr.p_int[je]; + w->ptr.p_double[je] = tmp1; + iblock->ptr.p_int[je] = itmp1; + } + } + } + for(j=1; j<=*m; j++) + { + w->ptr.p_double[j] = w->ptr.p_double[j]*scalefactor; + } + *errorcode = 0; + if( ncnvrg ) + { + *errorcode = *errorcode+1; + } + if( toofew ) + { + *errorcode = *errorcode+2; + } + result = *errorcode==0; + ae_frame_leave(_state); + return result; +} + + +static void evd_internaldstein(ae_int_t n, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t m, + /* Real */ ae_vector* w, + /* Integer */ ae_vector* iblock, + /* Integer */ ae_vector* isplit, + /* Real */ ae_matrix* z, + /* Integer */ ae_vector* ifail, + ae_int_t* info, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _e; + ae_vector _w; + ae_int_t maxits; + ae_int_t extra; + ae_int_t b1; + ae_int_t blksiz; + ae_int_t bn; + ae_int_t gpind; + ae_int_t i; + ae_int_t iinfo; + ae_int_t its; + ae_int_t j; + ae_int_t j1; + ae_int_t jblk; + ae_int_t jmax; + ae_int_t nblk; + ae_int_t nrmchk; + double dtpcrt; + double eps; + double eps1; + double nrm; + double onenrm; + double ortol; + double pertol; + double scl; + double sep; + double tol; + double xj; + double xjm; + double ztr; + ae_vector work1; + ae_vector work2; + ae_vector work3; + ae_vector work4; + ae_vector work5; + ae_vector iwork; + ae_bool tmpcriterion; + ae_int_t ti; + ae_int_t i1; + ae_int_t i2; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_e, e, _state, ae_true); + e = &_e; + ae_vector_init_copy(&_w, w, _state, ae_true); + w = &_w; + ae_matrix_clear(z); + ae_vector_clear(ifail); + *info = 0; + ae_vector_init(&work1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work3, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work4, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work5, 0, DT_REAL, _state, ae_true); + ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); + + maxits = 5; + extra = 2; + ae_vector_set_length(&work1, ae_maxint(n, 1, _state)+1, _state); + ae_vector_set_length(&work2, ae_maxint(n-1, 1, _state)+1, _state); + ae_vector_set_length(&work3, ae_maxint(n, 1, _state)+1, _state); + ae_vector_set_length(&work4, ae_maxint(n, 1, _state)+1, _state); + ae_vector_set_length(&work5, ae_maxint(n, 1, _state)+1, _state); + ae_vector_set_length(&iwork, ae_maxint(n, 1, _state)+1, _state); + ae_vector_set_length(ifail, ae_maxint(m, 1, _state)+1, _state); + ae_matrix_set_length(z, ae_maxint(n, 1, _state)+1, ae_maxint(m, 1, _state)+1, _state); + + /* + * these initializers are not really necessary, + * but without them compiler complains about uninitialized locals + */ + gpind = 0; + onenrm = 0; + ortol = 0; + dtpcrt = 0; + xjm = 0; + + /* + * Test the input parameters. + */ + *info = 0; + for(i=1; i<=m; i++) + { + ifail->ptr.p_int[i] = 0; + } + if( n<0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( m<0||m>n ) + { + *info = -4; + ae_frame_leave(_state); + return; + } + for(j=2; j<=m; j++) + { + if( iblock->ptr.p_int[j]ptr.p_int[j-1] ) + { + *info = -6; + break; + } + if( iblock->ptr.p_int[j]==iblock->ptr.p_int[j-1]&&ae_fp_less(w->ptr.p_double[j],w->ptr.p_double[j-1]) ) + { + *info = -5; + break; + } + } + if( *info!=0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Quick return if possible + */ + if( n==0||m==0 ) + { + ae_frame_leave(_state); + return; + } + if( n==1 ) + { + z->ptr.pp_double[1][1] = 1; + ae_frame_leave(_state); + return; + } + + /* + * Some preparations + */ + ti = n-1; + ae_v_move(&work1.ptr.p_double[1], 1, &e->ptr.p_double[1], 1, ae_v_len(1,ti)); + ae_vector_set_length(e, n+1, _state); + ae_v_move(&e->ptr.p_double[1], 1, &work1.ptr.p_double[1], 1, ae_v_len(1,ti)); + ae_v_move(&work1.ptr.p_double[1], 1, &w->ptr.p_double[1], 1, ae_v_len(1,m)); + ae_vector_set_length(w, n+1, _state); + ae_v_move(&w->ptr.p_double[1], 1, &work1.ptr.p_double[1], 1, ae_v_len(1,m)); + + /* + * Get machine constants. + */ + eps = ae_machineepsilon; + + /* + * Compute eigenvectors of matrix blocks. + */ + j1 = 1; + for(nblk=1; nblk<=iblock->ptr.p_int[m]; nblk++) + { + + /* + * Find starting and ending indices of block nblk. + */ + if( nblk==1 ) + { + b1 = 1; + } + else + { + b1 = isplit->ptr.p_int[nblk-1]+1; + } + bn = isplit->ptr.p_int[nblk]; + blksiz = bn-b1+1; + if( blksiz!=1 ) + { + + /* + * Compute reorthogonalization criterion and stopping criterion. + */ + gpind = b1; + onenrm = ae_fabs(d->ptr.p_double[b1], _state)+ae_fabs(e->ptr.p_double[b1], _state); + onenrm = ae_maxreal(onenrm, ae_fabs(d->ptr.p_double[bn], _state)+ae_fabs(e->ptr.p_double[bn-1], _state), _state); + for(i=b1+1; i<=bn-1; i++) + { + onenrm = ae_maxreal(onenrm, ae_fabs(d->ptr.p_double[i], _state)+ae_fabs(e->ptr.p_double[i-1], _state)+ae_fabs(e->ptr.p_double[i], _state), _state); + } + ortol = 0.001*onenrm; + dtpcrt = ae_sqrt(0.1/blksiz, _state); + } + + /* + * Loop through eigenvalues of block nblk. + */ + jblk = 0; + for(j=j1; j<=m; j++) + { + if( iblock->ptr.p_int[j]!=nblk ) + { + j1 = j; + break; + } + jblk = jblk+1; + xj = w->ptr.p_double[j]; + if( blksiz==1 ) + { + + /* + * Skip all the work if the block size is one. + */ + work1.ptr.p_double[1] = 1; + } + else + { + + /* + * If eigenvalues j and j-1 are too close, add a relatively + * small perturbation. + */ + if( jblk>1 ) + { + eps1 = ae_fabs(eps*xj, _state); + pertol = 10*eps1; + sep = xj-xjm; + if( ae_fp_less(sep,pertol) ) + { + xj = xjm+pertol; + } + } + its = 0; + nrmchk = 0; + + /* + * Get random starting vector. + */ + for(ti=1; ti<=blksiz; ti++) + { + work1.ptr.p_double[ti] = 2*ae_randomreal(_state)-1; + } + + /* + * Copy the matrix T so it won't be destroyed in factorization. + */ + for(ti=1; ti<=blksiz-1; ti++) + { + work2.ptr.p_double[ti] = e->ptr.p_double[b1+ti-1]; + work3.ptr.p_double[ti] = e->ptr.p_double[b1+ti-1]; + work4.ptr.p_double[ti] = d->ptr.p_double[b1+ti-1]; + } + work4.ptr.p_double[blksiz] = d->ptr.p_double[b1+blksiz-1]; + + /* + * Compute LU factors with partial pivoting ( PT = LU ) + */ + tol = 0; + evd_tdininternaldlagtf(blksiz, &work4, xj, &work2, &work3, tol, &work5, &iwork, &iinfo, _state); + + /* + * Update iteration count. + */ + do + { + its = its+1; + if( its>maxits ) + { + + /* + * If stopping criterion was not satisfied, update info and + * store eigenvector number in array ifail. + */ + *info = *info+1; + ifail->ptr.p_int[*info] = j; + break; + } + + /* + * Normalize and scale the righthand side vector Pb. + */ + v = 0; + for(ti=1; ti<=blksiz; ti++) + { + v = v+ae_fabs(work1.ptr.p_double[ti], _state); + } + scl = blksiz*onenrm*ae_maxreal(eps, ae_fabs(work4.ptr.p_double[blksiz], _state), _state)/v; + ae_v_muld(&work1.ptr.p_double[1], 1, ae_v_len(1,blksiz), scl); + + /* + * Solve the system LU = Pb. + */ + evd_tdininternaldlagts(blksiz, &work4, &work2, &work3, &work5, &iwork, &work1, &tol, &iinfo, _state); + + /* + * Reorthogonalize by modified Gram-Schmidt if eigenvalues are + * close enough. + */ + if( jblk!=1 ) + { + if( ae_fp_greater(ae_fabs(xj-xjm, _state),ortol) ) + { + gpind = j; + } + if( gpind!=j ) + { + for(i=gpind; i<=j-1; i++) + { + i1 = b1; + i2 = b1+blksiz-1; + ztr = ae_v_dotproduct(&work1.ptr.p_double[1], 1, &z->ptr.pp_double[i1][i], z->stride, ae_v_len(1,blksiz)); + ae_v_subd(&work1.ptr.p_double[1], 1, &z->ptr.pp_double[i1][i], z->stride, ae_v_len(1,blksiz), ztr); + touchint(&i2, _state); + } + } + } + + /* + * Check the infinity norm of the iterate. + */ + jmax = vectoridxabsmax(&work1, 1, blksiz, _state); + nrm = ae_fabs(work1.ptr.p_double[jmax], _state); + + /* + * Continue for additional iterations after norm reaches + * stopping criterion. + */ + tmpcriterion = ae_false; + if( ae_fp_less(nrm,dtpcrt) ) + { + tmpcriterion = ae_true; + } + else + { + nrmchk = nrmchk+1; + if( nrmchkptr.pp_double[i][j] = 0; + } + for(i=1; i<=blksiz; i++) + { + z->ptr.pp_double[b1+i-1][j] = work1.ptr.p_double[i]; + } + + /* + * Save the shift to check eigenvalue spacing at next + * iteration. + */ + xjm = xj; + } + } + ae_frame_leave(_state); +} + + +static void evd_tdininternaldlagtf(ae_int_t n, + /* Real */ ae_vector* a, + double lambdav, + /* Real */ ae_vector* b, + /* Real */ ae_vector* c, + double tol, + /* Real */ ae_vector* d, + /* Integer */ ae_vector* iin, + ae_int_t* info, + ae_state *_state) +{ + ae_int_t k; + double eps; + double mult; + double piv1; + double piv2; + double scale1; + double scale2; + double temp; + double tl; + + *info = 0; + + *info = 0; + if( n<0 ) + { + *info = -1; + return; + } + if( n==0 ) + { + return; + } + a->ptr.p_double[1] = a->ptr.p_double[1]-lambdav; + iin->ptr.p_int[n] = 0; + if( n==1 ) + { + if( ae_fp_eq(a->ptr.p_double[1],0) ) + { + iin->ptr.p_int[1] = 1; + } + return; + } + eps = ae_machineepsilon; + tl = ae_maxreal(tol, eps, _state); + scale1 = ae_fabs(a->ptr.p_double[1], _state)+ae_fabs(b->ptr.p_double[1], _state); + for(k=1; k<=n-1; k++) + { + a->ptr.p_double[k+1] = a->ptr.p_double[k+1]-lambdav; + scale2 = ae_fabs(c->ptr.p_double[k], _state)+ae_fabs(a->ptr.p_double[k+1], _state); + if( kptr.p_double[k+1], _state); + } + if( ae_fp_eq(a->ptr.p_double[k],0) ) + { + piv1 = 0; + } + else + { + piv1 = ae_fabs(a->ptr.p_double[k], _state)/scale1; + } + if( ae_fp_eq(c->ptr.p_double[k],0) ) + { + iin->ptr.p_int[k] = 0; + piv2 = 0; + scale1 = scale2; + if( kptr.p_double[k] = 0; + } + } + else + { + piv2 = ae_fabs(c->ptr.p_double[k], _state)/scale2; + if( ae_fp_less_eq(piv2,piv1) ) + { + iin->ptr.p_int[k] = 0; + scale1 = scale2; + c->ptr.p_double[k] = c->ptr.p_double[k]/a->ptr.p_double[k]; + a->ptr.p_double[k+1] = a->ptr.p_double[k+1]-c->ptr.p_double[k]*b->ptr.p_double[k]; + if( kptr.p_double[k] = 0; + } + } + else + { + iin->ptr.p_int[k] = 1; + mult = a->ptr.p_double[k]/c->ptr.p_double[k]; + a->ptr.p_double[k] = c->ptr.p_double[k]; + temp = a->ptr.p_double[k+1]; + a->ptr.p_double[k+1] = b->ptr.p_double[k]-mult*temp; + if( kptr.p_double[k] = b->ptr.p_double[k+1]; + b->ptr.p_double[k+1] = -mult*d->ptr.p_double[k]; + } + b->ptr.p_double[k] = temp; + c->ptr.p_double[k] = mult; + } + } + if( ae_fp_less_eq(ae_maxreal(piv1, piv2, _state),tl)&&iin->ptr.p_int[n]==0 ) + { + iin->ptr.p_int[n] = k; + } + } + if( ae_fp_less_eq(ae_fabs(a->ptr.p_double[n], _state),scale1*tl)&&iin->ptr.p_int[n]==0 ) + { + iin->ptr.p_int[n] = n; + } +} + + +static void evd_tdininternaldlagts(ae_int_t n, + /* Real */ ae_vector* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* c, + /* Real */ ae_vector* d, + /* Integer */ ae_vector* iin, + /* Real */ ae_vector* y, + double* tol, + ae_int_t* info, + ae_state *_state) +{ + ae_int_t k; + double absak; + double ak; + double bignum; + double eps; + double pert; + double sfmin; + double temp; + + *info = 0; + + *info = 0; + if( n<0 ) + { + *info = -1; + return; + } + if( n==0 ) + { + return; + } + eps = ae_machineepsilon; + sfmin = ae_minrealnumber; + bignum = 1/sfmin; + if( ae_fp_less_eq(*tol,0) ) + { + *tol = ae_fabs(a->ptr.p_double[1], _state); + if( n>1 ) + { + *tol = ae_maxreal(*tol, ae_maxreal(ae_fabs(a->ptr.p_double[2], _state), ae_fabs(b->ptr.p_double[1], _state), _state), _state); + } + for(k=3; k<=n; k++) + { + *tol = ae_maxreal(*tol, ae_maxreal(ae_fabs(a->ptr.p_double[k], _state), ae_maxreal(ae_fabs(b->ptr.p_double[k-1], _state), ae_fabs(d->ptr.p_double[k-2], _state), _state), _state), _state); + } + *tol = *tol*eps; + if( ae_fp_eq(*tol,0) ) + { + *tol = eps; + } + } + for(k=2; k<=n; k++) + { + if( iin->ptr.p_int[k-1]==0 ) + { + y->ptr.p_double[k] = y->ptr.p_double[k]-c->ptr.p_double[k-1]*y->ptr.p_double[k-1]; + } + else + { + temp = y->ptr.p_double[k-1]; + y->ptr.p_double[k-1] = y->ptr.p_double[k]; + y->ptr.p_double[k] = temp-c->ptr.p_double[k-1]*y->ptr.p_double[k]; + } + } + for(k=n; k>=1; k--) + { + if( k<=n-2 ) + { + temp = y->ptr.p_double[k]-b->ptr.p_double[k]*y->ptr.p_double[k+1]-d->ptr.p_double[k]*y->ptr.p_double[k+2]; + } + else + { + if( k==n-1 ) + { + temp = y->ptr.p_double[k]-b->ptr.p_double[k]*y->ptr.p_double[k+1]; + } + else + { + temp = y->ptr.p_double[k]; + } + } + ak = a->ptr.p_double[k]; + pert = ae_fabs(*tol, _state); + if( ae_fp_less(ak,0) ) + { + pert = -pert; + } + for(;;) + { + absak = ae_fabs(ak, _state); + if( ae_fp_less(absak,1) ) + { + if( ae_fp_less(absak,sfmin) ) + { + if( ae_fp_eq(absak,0)||ae_fp_greater(ae_fabs(temp, _state)*sfmin,absak) ) + { + ak = ak+pert; + pert = 2*pert; + continue; + } + else + { + temp = temp*bignum; + ak = ak*bignum; + } + } + else + { + if( ae_fp_greater(ae_fabs(temp, _state),absak*bignum) ) + { + ak = ak+pert; + pert = 2*pert; + continue; + } + } + } + break; + } + y->ptr.p_double[k] = temp/ak; + } +} + + +static void evd_internaldlaebz(ae_int_t ijob, + ae_int_t nitmax, + ae_int_t n, + ae_int_t mmax, + ae_int_t minp, + double abstol, + double reltol, + double pivmin, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + /* Real */ ae_vector* e2, + /* Integer */ ae_vector* nval, + /* Real */ ae_matrix* ab, + /* Real */ ae_vector* c, + ae_int_t* mout, + /* Integer */ ae_matrix* nab, + /* Real */ ae_vector* work, + /* Integer */ ae_vector* iwork, + ae_int_t* info, + ae_state *_state) +{ + ae_int_t itmp1; + ae_int_t itmp2; + ae_int_t j; + ae_int_t ji; + ae_int_t jit; + ae_int_t jp; + ae_int_t kf; + ae_int_t kfnew; + ae_int_t kl; + ae_int_t klnew; + double tmp1; + double tmp2; + + *mout = 0; + *info = 0; + + *info = 0; + if( ijob<1||ijob>3 ) + { + *info = -1; + 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->ptr.p_double[1]-ab->ptr.pp_double[ji][jp]; + if( ae_fp_less(ae_fabs(tmp1, _state),pivmin) ) + { + tmp1 = -pivmin; + } + nab->ptr.pp_int[ji][jp] = 0; + if( ae_fp_less_eq(tmp1,0) ) + { + nab->ptr.pp_int[ji][jp] = 1; + } + for(j=2; j<=n; j++) + { + tmp1 = d->ptr.p_double[j]-e2->ptr.p_double[j-1]/tmp1-ab->ptr.pp_double[ji][jp]; + if( ae_fp_less(ae_fabs(tmp1, _state),pivmin) ) + { + tmp1 = -pivmin; + } + if( ae_fp_less_eq(tmp1,0) ) + { + nab->ptr.pp_int[ji][jp] = nab->ptr.pp_int[ji][jp]+1; + } + } + } + *mout = *mout+nab->ptr.pp_int[ji][2]-nab->ptr.pp_int[ji][1]; + } + 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->ptr.p_double[ji] = 0.5*(ab->ptr.pp_double[ji][1]+ab->ptr.pp_double[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->ptr.p_double[ji]; + tmp2 = d->ptr.p_double[1]-tmp1; + itmp1 = 0; + if( ae_fp_less_eq(tmp2,pivmin) ) + { + itmp1 = 1; + tmp2 = ae_minreal(tmp2, -pivmin, _state); + } + + /* + * 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->ptr.p_double[j]-e2->ptr.p_double[j-1]/tmp2-tmp1; + if( ae_fp_less_eq(tmp2,pivmin) ) + { + itmp1 = itmp1+1; + tmp2 = ae_minreal(tmp2, -pivmin, _state); + } + } + if( ijob<=2 ) + { + + /* + * IJOB=2: Choose all intervals containing eigenvalues. + * + * Insure that N(w) is monotone + */ + itmp1 = ae_minint(nab->ptr.pp_int[ji][2], ae_maxint(nab->ptr.pp_int[ji][1], itmp1, _state), _state); + + /* + * Update the Queue -- add intervals if both halves + * contain eigenvalues. + */ + if( itmp1==nab->ptr.pp_int[ji][2] ) + { + + /* + * No eigenvalue in the upper interval: + * just use the lower interval. + */ + ab->ptr.pp_double[ji][2] = tmp1; + } + else + { + if( itmp1==nab->ptr.pp_int[ji][1] ) + { + + /* + * No eigenvalue in the lower interval: + * just use the upper interval. + */ + ab->ptr.pp_double[ji][1] = tmp1; + } + else + { + if( klnewptr.pp_double[klnew][2] = ab->ptr.pp_double[ji][2]; + nab->ptr.pp_int[klnew][2] = nab->ptr.pp_int[ji][2]; + ab->ptr.pp_double[klnew][1] = tmp1; + nab->ptr.pp_int[klnew][1] = itmp1; + ab->ptr.pp_double[ji][2] = tmp1; + nab->ptr.pp_int[ji][2] = itmp1; + } + else + { + *info = mmax+1; + return; + } + } + } + } + else + { + + /* + * IJOB=3: Binary search. Keep only the interval + * containing w s.t. N(w) = NVAL + */ + if( itmp1<=nval->ptr.p_int[ji] ) + { + ab->ptr.pp_double[ji][1] = tmp1; + nab->ptr.pp_int[ji][1] = itmp1; + } + if( itmp1>=nval->ptr.p_int[ji] ) + { + ab->ptr.pp_double[ji][2] = tmp1; + nab->ptr.pp_int[ji][2] = itmp1; + } + } + } + kl = klnew; + + /* + * Check for convergence + */ + kfnew = kf; + for(ji=kf; ji<=kl; ji++) + { + tmp1 = ae_fabs(ab->ptr.pp_double[ji][2]-ab->ptr.pp_double[ji][1], _state); + tmp2 = ae_maxreal(ae_fabs(ab->ptr.pp_double[ji][2], _state), ae_fabs(ab->ptr.pp_double[ji][1], _state), _state); + if( ae_fp_less(tmp1,ae_maxreal(abstol, ae_maxreal(pivmin, reltol*tmp2, _state), _state))||nab->ptr.pp_int[ji][1]>=nab->ptr.pp_int[ji][2] ) + { + + /* + * Converged -- Swap with position KFNEW, + * then increment KFNEW + */ + if( ji>kfnew ) + { + tmp1 = ab->ptr.pp_double[ji][1]; + tmp2 = ab->ptr.pp_double[ji][2]; + itmp1 = nab->ptr.pp_int[ji][1]; + itmp2 = nab->ptr.pp_int[ji][2]; + ab->ptr.pp_double[ji][1] = ab->ptr.pp_double[kfnew][1]; + ab->ptr.pp_double[ji][2] = ab->ptr.pp_double[kfnew][2]; + nab->ptr.pp_int[ji][1] = nab->ptr.pp_int[kfnew][1]; + nab->ptr.pp_int[ji][2] = nab->ptr.pp_int[kfnew][2]; + ab->ptr.pp_double[kfnew][1] = tmp1; + ab->ptr.pp_double[kfnew][2] = tmp2; + nab->ptr.pp_int[kfnew][1] = itmp1; + nab->ptr.pp_int[kfnew][2] = itmp2; + if( ijob==3 ) + { + itmp1 = nval->ptr.p_int[ji]; + nval->ptr.p_int[ji] = nval->ptr.p_int[kfnew]; + nval->ptr.p_int[kfnew] = itmp1; + } + } + kfnew = kfnew+1; + } + } + kf = kfnew; + + /* + * Choose Midpoints + */ + for(ji=kf; ji<=kl; ji++) + { + c->ptr.p_double[ji] = 0.5*(ab->ptr.pp_double[ji][1]+ab->ptr.pp_double[ji][2]); + } + + /* + * If no more intervals to refine, quit. + */ + if( kf>kl ) + { + break; + } + } + + /* + * Converged + */ + *info = ae_maxint(kl+1-kf, 0, _state); + *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 +*************************************************************************/ +static void evd_internaltrevc(/* Real */ ae_matrix* t, + ae_int_t n, + ae_int_t side, + ae_int_t howmny, + /* Boolean */ ae_vector* vselect, + /* Real */ ae_matrix* vl, + /* Real */ ae_matrix* vr, + ae_int_t* m, + ae_int_t* info, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _vselect; + ae_bool allv; + ae_bool bothv; + ae_bool leftv; + ae_bool over; + ae_bool pair; + ae_bool rightv; + ae_bool somev; + ae_int_t i; + ae_int_t ierr; + ae_int_t ii; + ae_int_t ip; + ae_int_t iis; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + ae_int_t jnxt; + ae_int_t k; + ae_int_t ki; + ae_int_t n2; + double beta; + double bignum; + double emax; + double rec; + double remax; + double scl; + double smin; + double smlnum; + double ulp; + double unfl; + double vcrit; + double vmax; + double wi; + double wr; + double xnorm; + ae_matrix x; + ae_vector work; + ae_vector temp; + ae_matrix temp11; + ae_matrix temp22; + ae_matrix temp11b; + ae_matrix temp21b; + ae_matrix temp12b; + ae_matrix temp22b; + ae_bool skipflag; + ae_int_t k1; + ae_int_t k2; + ae_int_t k3; + ae_int_t k4; + double vt; + ae_vector rswap4; + ae_vector zswap4; + ae_matrix ipivot44; + ae_vector civ4; + ae_vector crv4; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_vselect, vselect, _state, ae_true); + vselect = &_vselect; + *m = 0; + *info = 0; + ae_matrix_init(&x, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + ae_vector_init(&temp, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&temp11, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&temp22, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&temp11b, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&temp21b, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&temp12b, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&temp22b, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&rswap4, 0, DT_BOOL, _state, ae_true); + ae_vector_init(&zswap4, 0, DT_BOOL, _state, ae_true); + ae_matrix_init(&ipivot44, 0, 0, DT_INT, _state, ae_true); + ae_vector_init(&civ4, 0, DT_REAL, _state, ae_true); + ae_vector_init(&crv4, 0, DT_REAL, _state, ae_true); + + ae_matrix_set_length(&x, 2+1, 2+1, _state); + ae_matrix_set_length(&temp11, 1+1, 1+1, _state); + ae_matrix_set_length(&temp11b, 1+1, 1+1, _state); + ae_matrix_set_length(&temp21b, 2+1, 1+1, _state); + ae_matrix_set_length(&temp12b, 1+1, 2+1, _state); + ae_matrix_set_length(&temp22b, 2+1, 2+1, _state); + ae_matrix_set_length(&temp22, 2+1, 2+1, _state); + ae_vector_set_length(&work, 3*n+1, _state); + ae_vector_set_length(&temp, n+1, _state); + ae_vector_set_length(&rswap4, 4+1, _state); + ae_vector_set_length(&zswap4, 4+1, _state); + ae_matrix_set_length(&ipivot44, 4+1, 4+1, _state); + ae_vector_set_length(&civ4, 4+1, _state); + ae_vector_set_length(&crv4, 4+1, _state); + if( howmny!=1 ) + { + if( side==1||side==3 ) + { + ae_matrix_set_length(vr, n+1, n+1, _state); + } + if( side==2||side==3 ) + { + ae_matrix_set_length(vl, n+1, n+1, _state); + } + } + + /* + * 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; + if( n<0 ) + { + *info = -2; + ae_frame_leave(_state); + return; + } + if( !rightv&&!leftv ) + { + *info = -3; + ae_frame_leave(_state); + return; + } + if( (!allv&&!over)&&!somev ) + { + *info = -4; + ae_frame_leave(_state); + 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 = ae_false; + for(j=1; j<=n; j++) + { + if( pair ) + { + pair = ae_false; + vselect->ptr.p_bool[j] = ae_false; + } + else + { + if( jptr.pp_double[j+1][j],0) ) + { + if( vselect->ptr.p_bool[j] ) + { + *m = *m+1; + } + } + else + { + pair = ae_true; + if( vselect->ptr.p_bool[j]||vselect->ptr.p_bool[j+1] ) + { + vselect->ptr.p_bool[j] = ae_true; + *m = *m+2; + } + } + } + else + { + if( vselect->ptr.p_bool[n] ) + { + *m = *m+1; + } + } + } + } + } + else + { + *m = n; + } + + /* + * Quick return if possible. + */ + if( n==0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Set the constants to control overflow. + */ + unfl = ae_minrealnumber; + ulp = ae_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.ptr.p_double[1] = 0; + for(j=2; j<=n; j++) + { + work.ptr.p_double[j] = 0; + for(i=1; i<=j-1; i++) + { + work.ptr.p_double[j] = work.ptr.p_double[j]+ae_fabs(t->ptr.pp_double[i][j], _state); + } + } + + /* + * 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; + if( rightv ) + { + + /* + * Compute right eigenvectors. + */ + ip = 0; + iis = *m; + for(ki=n; ki>=1; ki--) + { + skipflag = ae_false; + if( ip==1 ) + { + skipflag = ae_true; + } + else + { + if( ki!=1 ) + { + if( ae_fp_neq(t->ptr.pp_double[ki][ki-1],0) ) + { + ip = -1; + } + } + if( somev ) + { + if( ip==0 ) + { + if( !vselect->ptr.p_bool[ki] ) + { + skipflag = ae_true; + } + } + else + { + if( !vselect->ptr.p_bool[ki-1] ) + { + skipflag = ae_true; + } + } + } + } + if( !skipflag ) + { + + /* + * Compute the KI-th eigenvalue (WR,WI). + */ + wr = t->ptr.pp_double[ki][ki]; + wi = 0; + if( ip!=0 ) + { + wi = ae_sqrt(ae_fabs(t->ptr.pp_double[ki][ki-1], _state), _state)*ae_sqrt(ae_fabs(t->ptr.pp_double[ki-1][ki], _state), _state); + } + smin = ae_maxreal(ulp*(ae_fabs(wr, _state)+ae_fabs(wi, _state)), smlnum, _state); + if( ip==0 ) + { + + /* + * Real right eigenvector + */ + work.ptr.p_double[ki+n] = 1; + + /* + * Form right-hand side + */ + for(k=1; k<=ki-1; k++) + { + work.ptr.p_double[k+n] = -t->ptr.pp_double[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--) + { + if( j>jnxt ) + { + continue; + } + j1 = j; + j2 = j; + jnxt = j-1; + if( j>1 ) + { + if( ae_fp_neq(t->ptr.pp_double[j][j-1],0) ) + { + j1 = j-1; + jnxt = j-2; + } + } + if( j1==j2 ) + { + + /* + * 1-by-1 diagonal block + */ + temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; + temp11b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; + evd_internalhsevdlaln2(ae_false, 1, 1, smin, 1, &temp11, 1.0, 1.0, &temp11b, wr, 0.0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); + + /* + * Scale X(1,1) to avoid overflow when updating + * the right-hand side. + */ + if( ae_fp_greater(xnorm,1) ) + { + if( ae_fp_greater(work.ptr.p_double[j],bignum/xnorm) ) + { + x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm; + scl = scl/xnorm; + } + } + + /* + * Scale if necessary + */ + if( ae_fp_neq(scl,1) ) + { + k1 = n+1; + k2 = n+ki; + ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl); + } + work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; + + /* + * Update right-hand side + */ + k1 = 1+n; + k2 = j-1+n; + k3 = j-1; + vt = -x.ptr.pp_double[1][1]; + ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(k1,k2), vt); + } + else + { + + /* + * 2-by-2 diagonal block + */ + temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j-1][j-1]; + temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j-1][j]; + temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j][j-1]; + temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j][j]; + temp21b.ptr.pp_double[1][1] = work.ptr.p_double[j-1+n]; + temp21b.ptr.pp_double[2][1] = work.ptr.p_double[j+n]; + evd_internalhsevdlaln2(ae_false, 2, 1, smin, 1.0, &temp22, 1.0, 1.0, &temp21b, wr, 0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); + + /* + * Scale X(1,1) and X(2,1) to avoid overflow when + * updating the right-hand side. + */ + if( ae_fp_greater(xnorm,1) ) + { + beta = ae_maxreal(work.ptr.p_double[j-1], work.ptr.p_double[j], _state); + if( ae_fp_greater(beta,bignum/xnorm) ) + { + x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm; + x.ptr.pp_double[2][1] = x.ptr.pp_double[2][1]/xnorm; + scl = scl/xnorm; + } + } + + /* + * Scale if necessary + */ + if( ae_fp_neq(scl,1) ) + { + k1 = 1+n; + k2 = ki+n; + ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl); + } + work.ptr.p_double[j-1+n] = x.ptr.pp_double[1][1]; + work.ptr.p_double[j+n] = x.ptr.pp_double[2][1]; + + /* + * Update right-hand side + */ + k1 = 1+n; + k2 = j-2+n; + k3 = j-2; + k4 = j-1; + vt = -x.ptr.pp_double[1][1]; + ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][k4], t->stride, ae_v_len(k1,k2), vt); + vt = -x.ptr.pp_double[2][1]; + ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(k1,k2), vt); + } + } + + /* + * Copy the vector x or Q*x to VR and normalize. + */ + if( !over ) + { + k1 = 1+n; + k2 = ki+n; + ae_v_move(&vr->ptr.pp_double[1][iis], vr->stride, &work.ptr.p_double[k1], 1, ae_v_len(1,ki)); + ii = columnidxabsmax(vr, 1, ki, iis, _state); + remax = 1/ae_fabs(vr->ptr.pp_double[ii][iis], _state); + ae_v_muld(&vr->ptr.pp_double[1][iis], vr->stride, ae_v_len(1,ki), remax); + for(k=ki+1; k<=n; k++) + { + vr->ptr.pp_double[k][iis] = 0; + } + } + else + { + if( ki>1 ) + { + ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n)); + matrixvectormultiply(vr, 1, n, 1, ki-1, ae_false, &work, 1+n, ki-1+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state); + ae_v_move(&vr->ptr.pp_double[1][ki], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); + } + ii = columnidxabsmax(vr, 1, n, ki, _state); + remax = 1/ae_fabs(vr->ptr.pp_double[ii][ki], _state); + ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), 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( ae_fp_greater_eq(ae_fabs(t->ptr.pp_double[ki-1][ki], _state),ae_fabs(t->ptr.pp_double[ki][ki-1], _state)) ) + { + work.ptr.p_double[ki-1+n] = 1; + work.ptr.p_double[ki+n2] = wi/t->ptr.pp_double[ki-1][ki]; + } + else + { + work.ptr.p_double[ki-1+n] = -wi/t->ptr.pp_double[ki][ki-1]; + work.ptr.p_double[ki+n2] = 1; + } + work.ptr.p_double[ki+n] = 0; + work.ptr.p_double[ki-1+n2] = 0; + + /* + * Form right-hand side + */ + for(k=1; k<=ki-2; k++) + { + work.ptr.p_double[k+n] = -work.ptr.p_double[ki-1+n]*t->ptr.pp_double[k][ki-1]; + work.ptr.p_double[k+n2] = -work.ptr.p_double[ki+n2]*t->ptr.pp_double[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--) + { + if( j>jnxt ) + { + continue; + } + j1 = j; + j2 = j; + jnxt = j-1; + if( j>1 ) + { + if( ae_fp_neq(t->ptr.pp_double[j][j-1],0) ) + { + j1 = j-1; + jnxt = j-2; + } + } + if( j1==j2 ) + { + + /* + * 1-by-1 diagonal block + */ + temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; + temp12b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; + temp12b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n]; + evd_internalhsevdlaln2(ae_false, 1, 2, smin, 1.0, &temp11, 1.0, 1.0, &temp12b, wr, wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); + + /* + * Scale X(1,1) and X(1,2) to avoid overflow when + * updating the right-hand side. + */ + if( ae_fp_greater(xnorm,1) ) + { + if( ae_fp_greater(work.ptr.p_double[j],bignum/xnorm) ) + { + x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]/xnorm; + x.ptr.pp_double[1][2] = x.ptr.pp_double[1][2]/xnorm; + scl = scl/xnorm; + } + } + + /* + * Scale if necessary + */ + if( ae_fp_neq(scl,1) ) + { + k1 = 1+n; + k2 = ki+n; + ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl); + k1 = 1+n2; + k2 = ki+n2; + ae_v_muld(&work.ptr.p_double[k1], 1, ae_v_len(k1,k2), scl); + } + work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; + work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2]; + + /* + * Update the right-hand side + */ + k1 = 1+n; + k2 = j-1+n; + k3 = 1; + k4 = j-1; + vt = -x.ptr.pp_double[1][1]; + ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[k3][j], t->stride, ae_v_len(k1,k2), vt); + k1 = 1+n2; + k2 = j-1+n2; + k3 = 1; + k4 = j-1; + vt = -x.ptr.pp_double[1][2]; + ae_v_addd(&work.ptr.p_double[k1], 1, &t->ptr.pp_double[k3][j], t->stride, ae_v_len(k1,k2), vt); + } + else + { + + /* + * 2-by-2 diagonal block + */ + temp22.ptr.pp_double[1][1] = t->ptr.pp_double[j-1][j-1]; + temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j-1][j]; + temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j][j-1]; + temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j][j]; + temp22b.ptr.pp_double[1][1] = work.ptr.p_double[j-1+n]; + temp22b.ptr.pp_double[1][2] = work.ptr.p_double[j-1+n+n]; + temp22b.ptr.pp_double[2][1] = work.ptr.p_double[j+n]; + temp22b.ptr.pp_double[2][2] = work.ptr.p_double[j+n+n]; + evd_internalhsevdlaln2(ae_false, 2, 2, smin, 1.0, &temp22, 1.0, 1.0, &temp22b, wr, wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); + + /* + * Scale X to avoid overflow when updating + * the right-hand side. + */ + if( ae_fp_greater(xnorm,1) ) + { + beta = ae_maxreal(work.ptr.p_double[j-1], work.ptr.p_double[j], _state); + if( ae_fp_greater(beta,bignum/xnorm) ) + { + rec = 1/xnorm; + x.ptr.pp_double[1][1] = x.ptr.pp_double[1][1]*rec; + x.ptr.pp_double[1][2] = x.ptr.pp_double[1][2]*rec; + x.ptr.pp_double[2][1] = x.ptr.pp_double[2][1]*rec; + x.ptr.pp_double[2][2] = x.ptr.pp_double[2][2]*rec; + scl = scl*rec; + } + } + + /* + * Scale if necessary + */ + if( ae_fp_neq(scl,1) ) + { + ae_v_muld(&work.ptr.p_double[1+n], 1, ae_v_len(1+n,ki+n), scl); + ae_v_muld(&work.ptr.p_double[1+n2], 1, ae_v_len(1+n2,ki+n2), scl); + } + work.ptr.p_double[j-1+n] = x.ptr.pp_double[1][1]; + work.ptr.p_double[j+n] = x.ptr.pp_double[2][1]; + work.ptr.p_double[j-1+n2] = x.ptr.pp_double[1][2]; + work.ptr.p_double[j+n2] = x.ptr.pp_double[2][2]; + + /* + * Update the right-hand side + */ + vt = -x.ptr.pp_double[1][1]; + ae_v_addd(&work.ptr.p_double[n+1], 1, &t->ptr.pp_double[1][j-1], t->stride, ae_v_len(n+1,n+j-2), vt); + vt = -x.ptr.pp_double[2][1]; + ae_v_addd(&work.ptr.p_double[n+1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(n+1,n+j-2), vt); + vt = -x.ptr.pp_double[1][2]; + ae_v_addd(&work.ptr.p_double[n2+1], 1, &t->ptr.pp_double[1][j-1], t->stride, ae_v_len(n2+1,n2+j-2), vt); + vt = -x.ptr.pp_double[2][2]; + ae_v_addd(&work.ptr.p_double[n2+1], 1, &t->ptr.pp_double[1][j], t->stride, ae_v_len(n2+1,n2+j-2), vt); + } + } + + /* + * Copy the vector x or Q*x to VR and normalize. + */ + if( !over ) + { + ae_v_move(&vr->ptr.pp_double[1][iis-1], vr->stride, &work.ptr.p_double[n+1], 1, ae_v_len(1,ki)); + ae_v_move(&vr->ptr.pp_double[1][iis], vr->stride, &work.ptr.p_double[n2+1], 1, ae_v_len(1,ki)); + emax = 0; + for(k=1; k<=ki; k++) + { + emax = ae_maxreal(emax, ae_fabs(vr->ptr.pp_double[k][iis-1], _state)+ae_fabs(vr->ptr.pp_double[k][iis], _state), _state); + } + remax = 1/emax; + ae_v_muld(&vr->ptr.pp_double[1][iis-1], vr->stride, ae_v_len(1,ki), remax); + ae_v_muld(&vr->ptr.pp_double[1][iis], vr->stride, ae_v_len(1,ki), remax); + for(k=ki+1; k<=n; k++) + { + vr->ptr.pp_double[k][iis-1] = 0; + vr->ptr.pp_double[k][iis] = 0; + } + } + else + { + if( ki>2 ) + { + ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n)); + matrixvectormultiply(vr, 1, n, 1, ki-2, ae_false, &work, 1+n, ki-2+n, 1.0, &temp, 1, n, work.ptr.p_double[ki-1+n], _state); + ae_v_move(&vr->ptr.pp_double[1][ki-1], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); + ae_v_move(&temp.ptr.p_double[1], 1, &vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n)); + matrixvectormultiply(vr, 1, n, 1, ki-2, ae_false, &work, 1+n2, ki-2+n2, 1.0, &temp, 1, n, work.ptr.p_double[ki+n2], _state); + ae_v_move(&vr->ptr.pp_double[1][ki], vr->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); + } + else + { + vt = work.ptr.p_double[ki-1+n]; + ae_v_muld(&vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n), vt); + vt = work.ptr.p_double[ki+n2]; + ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), vt); + } + emax = 0; + for(k=1; k<=n; k++) + { + emax = ae_maxreal(emax, ae_fabs(vr->ptr.pp_double[k][ki-1], _state)+ae_fabs(vr->ptr.pp_double[k][ki], _state), _state); + } + remax = 1/emax; + ae_v_muld(&vr->ptr.pp_double[1][ki-1], vr->stride, ae_v_len(1,n), remax); + ae_v_muld(&vr->ptr.pp_double[1][ki], vr->stride, ae_v_len(1,n), remax); + } + } + iis = iis-1; + if( ip!=0 ) + { + iis = iis-1; + } + } + if( ip==1 ) + { + ip = 0; + } + if( ip==-1 ) + { + ip = 1; + } + } + } + if( leftv ) + { + + /* + * Compute left eigenvectors. + */ + ip = 0; + iis = 1; + for(ki=1; ki<=n; ki++) + { + skipflag = ae_false; + if( ip==-1 ) + { + skipflag = ae_true; + } + else + { + if( ki!=n ) + { + if( ae_fp_neq(t->ptr.pp_double[ki+1][ki],0) ) + { + ip = 1; + } + } + if( somev ) + { + if( !vselect->ptr.p_bool[ki] ) + { + skipflag = ae_true; + } + } + } + if( !skipflag ) + { + + /* + * Compute the KI-th eigenvalue (WR,WI). + */ + wr = t->ptr.pp_double[ki][ki]; + wi = 0; + if( ip!=0 ) + { + wi = ae_sqrt(ae_fabs(t->ptr.pp_double[ki][ki+1], _state), _state)*ae_sqrt(ae_fabs(t->ptr.pp_double[ki+1][ki], _state), _state); + } + smin = ae_maxreal(ulp*(ae_fabs(wr, _state)+ae_fabs(wi, _state)), smlnum, _state); + if( ip==0 ) + { + + /* + * Real left eigenvector. + */ + work.ptr.p_double[ki+n] = 1; + + /* + * Form right-hand side + */ + for(k=ki+1; k<=n; k++) + { + work.ptr.p_double[k+n] = -t->ptr.pp_double[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++) + { + if( jptr.pp_double[j+1][j],0) ) + { + j2 = j+1; + jnxt = j+2; + } + } + if( j1==j2 ) + { + + /* + * 1-by-1 diagonal block + * + * Scale if necessary to avoid overflow when forming + * the right-hand side. + */ + if( ae_fp_greater(work.ptr.p_double[j],vcrit) ) + { + rec = 1/vmax; + ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec); + vmax = 1; + vcrit = bignum; + } + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1)); + work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt; + + /* + * Solve (T(J,J)-WR)'*X = WORK + */ + temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; + temp11b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; + evd_internalhsevdlaln2(ae_false, 1, 1, smin, 1.0, &temp11, 1.0, 1.0, &temp11b, wr, 0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); + + /* + * Scale if necessary + */ + if( ae_fp_neq(scl,1) ) + { + ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl); + } + work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; + vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), vmax, _state); + vcrit = bignum/vmax; + } + else + { + + /* + * 2-by-2 diagonal block + * + * Scale if necessary to avoid overflow when forming + * the right-hand side. + */ + beta = ae_maxreal(work.ptr.p_double[j], work.ptr.p_double[j+1], _state); + if( ae_fp_greater(beta,vcrit) ) + { + rec = 1/vmax; + ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec); + vmax = 1; + vcrit = bignum; + } + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1)); + work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt; + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+1][j+1], t->stride, &work.ptr.p_double[ki+1+n], 1, ae_v_len(ki+1,j-1)); + work.ptr.p_double[j+1+n] = work.ptr.p_double[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.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; + temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j][j+1]; + temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j+1][j]; + temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j+1][j+1]; + temp21b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; + temp21b.ptr.pp_double[2][1] = work.ptr.p_double[j+1+n]; + evd_internalhsevdlaln2(ae_true, 2, 1, smin, 1.0, &temp22, 1.0, 1.0, &temp21b, wr, 0, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); + + /* + * Scale if necessary + */ + if( ae_fp_neq(scl,1) ) + { + ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl); + } + work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; + work.ptr.p_double[j+1+n] = x.ptr.pp_double[2][1]; + vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), ae_maxreal(ae_fabs(work.ptr.p_double[j+1+n], _state), vmax, _state), _state); + vcrit = bignum/vmax; + } + } + + /* + * Copy the vector x or Q*x to VL and normalize. + */ + if( !over ) + { + ae_v_move(&vl->ptr.pp_double[ki][iis], vl->stride, &work.ptr.p_double[ki+n], 1, ae_v_len(ki,n)); + ii = columnidxabsmax(vl, ki, n, iis, _state); + remax = 1/ae_fabs(vl->ptr.pp_double[ii][iis], _state); + ae_v_muld(&vl->ptr.pp_double[ki][iis], vl->stride, ae_v_len(ki,n), remax); + for(k=1; k<=ki-1; k++) + { + vl->ptr.pp_double[k][iis] = 0; + } + } + else + { + if( kiptr.pp_double[1][ki], vl->stride, ae_v_len(1,n)); + matrixvectormultiply(vl, 1, n, ki+1, n, ae_false, &work, ki+1+n, n+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state); + ae_v_move(&vl->ptr.pp_double[1][ki], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); + } + ii = columnidxabsmax(vl, 1, n, ki, _state); + remax = 1/ae_fabs(vl->ptr.pp_double[ii][ki], _state); + ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), 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( ae_fp_greater_eq(ae_fabs(t->ptr.pp_double[ki][ki+1], _state),ae_fabs(t->ptr.pp_double[ki+1][ki], _state)) ) + { + work.ptr.p_double[ki+n] = wi/t->ptr.pp_double[ki][ki+1]; + work.ptr.p_double[ki+1+n2] = 1; + } + else + { + work.ptr.p_double[ki+n] = 1; + work.ptr.p_double[ki+1+n2] = -wi/t->ptr.pp_double[ki+1][ki]; + } + work.ptr.p_double[ki+1+n] = 0; + work.ptr.p_double[ki+n2] = 0; + + /* + * Form right-hand side + */ + for(k=ki+2; k<=n; k++) + { + work.ptr.p_double[k+n] = -work.ptr.p_double[ki+n]*t->ptr.pp_double[ki][k]; + work.ptr.p_double[k+n2] = -work.ptr.p_double[ki+1+n2]*t->ptr.pp_double[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++) + { + if( jptr.pp_double[j+1][j],0) ) + { + j2 = j+1; + jnxt = j+2; + } + } + if( j1==j2 ) + { + + /* + * 1-by-1 diagonal block + * + * Scale if necessary to avoid overflow when + * forming the right-hand side elements. + */ + if( ae_fp_greater(work.ptr.p_double[j],vcrit) ) + { + rec = 1/vmax; + ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec); + ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), rec); + vmax = 1; + vcrit = bignum; + } + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1)); + work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt; + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1)); + work.ptr.p_double[j+n2] = work.ptr.p_double[j+n2]-vt; + + /* + * Solve (T(J,J)-(WR-i*WI))*(X11+i*X12)= WK+I*WK2 + */ + temp11.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; + temp12b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; + temp12b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n]; + evd_internalhsevdlaln2(ae_false, 1, 2, smin, 1.0, &temp11, 1.0, 1.0, &temp12b, wr, -wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); + + /* + * Scale if necessary + */ + if( ae_fp_neq(scl,1) ) + { + ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl); + ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), scl); + } + work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; + work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2]; + vmax = ae_maxreal(ae_fabs(work.ptr.p_double[j+n], _state), ae_maxreal(ae_fabs(work.ptr.p_double[j+n2], _state), vmax, _state), _state); + vcrit = bignum/vmax; + } + else + { + + /* + * 2-by-2 diagonal block + * + * Scale if necessary to avoid overflow when forming + * the right-hand side elements. + */ + beta = ae_maxreal(work.ptr.p_double[j], work.ptr.p_double[j+1], _state); + if( ae_fp_greater(beta,vcrit) ) + { + rec = 1/vmax; + ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), rec); + ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), rec); + vmax = 1; + vcrit = bignum; + } + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1)); + work.ptr.p_double[j+n] = work.ptr.p_double[j+n]-vt; + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1)); + work.ptr.p_double[j+n2] = work.ptr.p_double[j+n2]-vt; + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j+1], t->stride, &work.ptr.p_double[ki+2+n], 1, ae_v_len(ki+2,j-1)); + work.ptr.p_double[j+1+n] = work.ptr.p_double[j+1+n]-vt; + vt = ae_v_dotproduct(&t->ptr.pp_double[ki+2][j+1], t->stride, &work.ptr.p_double[ki+2+n2], 1, ae_v_len(ki+2,j-1)); + work.ptr.p_double[j+1+n2] = work.ptr.p_double[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.ptr.pp_double[1][1] = t->ptr.pp_double[j][j]; + temp22.ptr.pp_double[1][2] = t->ptr.pp_double[j][j+1]; + temp22.ptr.pp_double[2][1] = t->ptr.pp_double[j+1][j]; + temp22.ptr.pp_double[2][2] = t->ptr.pp_double[j+1][j+1]; + temp22b.ptr.pp_double[1][1] = work.ptr.p_double[j+n]; + temp22b.ptr.pp_double[1][2] = work.ptr.p_double[j+n+n]; + temp22b.ptr.pp_double[2][1] = work.ptr.p_double[j+1+n]; + temp22b.ptr.pp_double[2][2] = work.ptr.p_double[j+1+n+n]; + evd_internalhsevdlaln2(ae_true, 2, 2, smin, 1.0, &temp22, 1.0, 1.0, &temp22b, wr, -wi, &rswap4, &zswap4, &ipivot44, &civ4, &crv4, &x, &scl, &xnorm, &ierr, _state); + + /* + * Scale if necessary + */ + if( ae_fp_neq(scl,1) ) + { + ae_v_muld(&work.ptr.p_double[ki+n], 1, ae_v_len(ki+n,n+n), scl); + ae_v_muld(&work.ptr.p_double[ki+n2], 1, ae_v_len(ki+n2,n+n2), scl); + } + work.ptr.p_double[j+n] = x.ptr.pp_double[1][1]; + work.ptr.p_double[j+n2] = x.ptr.pp_double[1][2]; + work.ptr.p_double[j+1+n] = x.ptr.pp_double[2][1]; + work.ptr.p_double[j+1+n2] = x.ptr.pp_double[2][2]; + vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[1][1], _state), vmax, _state); + vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[1][2], _state), vmax, _state); + vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[2][1], _state), vmax, _state); + vmax = ae_maxreal(ae_fabs(x.ptr.pp_double[2][2], _state), vmax, _state); + vcrit = bignum/vmax; + } + } + + /* + * Copy the vector x or Q*x to VL and normalize. + */ + if( !over ) + { + ae_v_move(&vl->ptr.pp_double[ki][iis], vl->stride, &work.ptr.p_double[ki+n], 1, ae_v_len(ki,n)); + ae_v_move(&vl->ptr.pp_double[ki][iis+1], vl->stride, &work.ptr.p_double[ki+n2], 1, ae_v_len(ki,n)); + emax = 0; + for(k=ki; k<=n; k++) + { + emax = ae_maxreal(emax, ae_fabs(vl->ptr.pp_double[k][iis], _state)+ae_fabs(vl->ptr.pp_double[k][iis+1], _state), _state); + } + remax = 1/emax; + ae_v_muld(&vl->ptr.pp_double[ki][iis], vl->stride, ae_v_len(ki,n), remax); + ae_v_muld(&vl->ptr.pp_double[ki][iis+1], vl->stride, ae_v_len(ki,n), remax); + for(k=1; k<=ki-1; k++) + { + vl->ptr.pp_double[k][iis] = 0; + vl->ptr.pp_double[k][iis+1] = 0; + } + } + else + { + if( kiptr.pp_double[1][ki], vl->stride, ae_v_len(1,n)); + matrixvectormultiply(vl, 1, n, ki+2, n, ae_false, &work, ki+2+n, n+n, 1.0, &temp, 1, n, work.ptr.p_double[ki+n], _state); + ae_v_move(&vl->ptr.pp_double[1][ki], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); + ae_v_move(&temp.ptr.p_double[1], 1, &vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n)); + matrixvectormultiply(vl, 1, n, ki+2, n, ae_false, &work, ki+2+n2, n+n2, 1.0, &temp, 1, n, work.ptr.p_double[ki+1+n2], _state); + ae_v_move(&vl->ptr.pp_double[1][ki+1], vl->stride, &temp.ptr.p_double[1], 1, ae_v_len(1,n)); + } + else + { + vt = work.ptr.p_double[ki+n]; + ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), vt); + vt = work.ptr.p_double[ki+1+n2]; + ae_v_muld(&vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n), vt); + } + emax = 0; + for(k=1; k<=n; k++) + { + emax = ae_maxreal(emax, ae_fabs(vl->ptr.pp_double[k][ki], _state)+ae_fabs(vl->ptr.pp_double[k][ki+1], _state), _state); + } + remax = 1/emax; + ae_v_muld(&vl->ptr.pp_double[1][ki], vl->stride, ae_v_len(1,n), remax); + ae_v_muld(&vl->ptr.pp_double[1][ki+1], vl->stride, ae_v_len(1,n), remax); + } + } + iis = iis+1; + if( ip!=0 ) + { + iis = iis+1; + } + } + if( ip==-1 ) + { + ip = 0; + } + if( ip==1 ) + { + ip = -1; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 +*************************************************************************/ +static void evd_internalhsevdlaln2(ae_bool ltrans, + ae_int_t na, + ae_int_t nw, + double smin, + double ca, + /* Real */ ae_matrix* a, + double d1, + double d2, + /* Real */ ae_matrix* b, + double wr, + double wi, + /* Boolean */ ae_vector* rswap4, + /* Boolean */ ae_vector* zswap4, + /* Integer */ ae_matrix* ipivot44, + /* Real */ ae_vector* civ4, + /* Real */ ae_vector* crv4, + /* Real */ ae_matrix* x, + double* scl, + double* xnorm, + ae_int_t* info, + ae_state *_state) +{ + ae_int_t icmax; + ae_int_t j; + double bbnd; + double bi1; + double bi2; + double bignum; + double bnorm; + double br1; + double br2; + double ci21; + double ci22; + double cmax; + double cnorm; + double cr21; + double cr22; + double csi; + double csr; + double li21; + double lr21; + double smini; + double smlnum; + double temp; + double u22abs; + double ui11; + double ui11r; + double ui12; + double ui12s; + double ui22; + double ur11; + double ur11r; + double ur12; + double ur12s; + double ur22; + double xi1; + double xi2; + double xr1; + double xr2; + double tmp1; + double tmp2; + + *scl = 0; + *xnorm = 0; + *info = 0; + + zswap4->ptr.p_bool[1] = ae_false; + zswap4->ptr.p_bool[2] = ae_false; + zswap4->ptr.p_bool[3] = ae_true; + zswap4->ptr.p_bool[4] = ae_true; + rswap4->ptr.p_bool[1] = ae_false; + rswap4->ptr.p_bool[2] = ae_true; + rswap4->ptr.p_bool[3] = ae_false; + rswap4->ptr.p_bool[4] = ae_true; + ipivot44->ptr.pp_int[1][1] = 1; + ipivot44->ptr.pp_int[2][1] = 2; + ipivot44->ptr.pp_int[3][1] = 3; + ipivot44->ptr.pp_int[4][1] = 4; + ipivot44->ptr.pp_int[1][2] = 2; + ipivot44->ptr.pp_int[2][2] = 1; + ipivot44->ptr.pp_int[3][2] = 4; + ipivot44->ptr.pp_int[4][2] = 3; + ipivot44->ptr.pp_int[1][3] = 3; + ipivot44->ptr.pp_int[2][3] = 4; + ipivot44->ptr.pp_int[3][3] = 1; + ipivot44->ptr.pp_int[4][3] = 2; + ipivot44->ptr.pp_int[1][4] = 4; + ipivot44->ptr.pp_int[2][4] = 3; + ipivot44->ptr.pp_int[3][4] = 2; + ipivot44->ptr.pp_int[4][4] = 1; + smlnum = 2*ae_minrealnumber; + bignum = 1/smlnum; + smini = ae_maxreal(smin, smlnum, _state); + + /* + * Don't check for input errors + */ + *info = 0; + + /* + * Standard Initializations + */ + *scl = 1; + 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->ptr.pp_double[1][1]-wr*d1; + cnorm = ae_fabs(csr, _state); + + /* + * If | C | < SMINI, use C = SMINI + */ + if( ae_fp_less(cnorm,smini) ) + { + csr = smini; + cnorm = smini; + *info = 1; + } + + /* + * Check scaling for X = B / C + */ + bnorm = ae_fabs(b->ptr.pp_double[1][1], _state); + if( ae_fp_less(cnorm,1)&&ae_fp_greater(bnorm,1) ) + { + if( ae_fp_greater(bnorm,bignum*cnorm) ) + { + *scl = 1/bnorm; + } + } + + /* + * Compute X + */ + x->ptr.pp_double[1][1] = b->ptr.pp_double[1][1]*(*scl)/csr; + *xnorm = ae_fabs(x->ptr.pp_double[1][1], _state); + } + else + { + + /* + * Complex 1x1 system (w is complex) + * + * C = ca A - w D + */ + csr = ca*a->ptr.pp_double[1][1]-wr*d1; + csi = -wi*d1; + cnorm = ae_fabs(csr, _state)+ae_fabs(csi, _state); + + /* + * If | C | < SMINI, use C = SMINI + */ + if( ae_fp_less(cnorm,smini) ) + { + csr = smini; + csi = 0; + cnorm = smini; + *info = 1; + } + + /* + * Check scaling for X = B / C + */ + bnorm = ae_fabs(b->ptr.pp_double[1][1], _state)+ae_fabs(b->ptr.pp_double[1][2], _state); + if( ae_fp_less(cnorm,1)&&ae_fp_greater(bnorm,1) ) + { + if( ae_fp_greater(bnorm,bignum*cnorm) ) + { + *scl = 1/bnorm; + } + } + + /* + * Compute X + */ + evd_internalhsevdladiv(*scl*b->ptr.pp_double[1][1], *scl*b->ptr.pp_double[1][2], csr, csi, &tmp1, &tmp2, _state); + x->ptr.pp_double[1][1] = tmp1; + x->ptr.pp_double[1][2] = tmp2; + *xnorm = ae_fabs(x->ptr.pp_double[1][1], _state)+ae_fabs(x->ptr.pp_double[1][2], _state); + } + } + else + { + + /* + * 2x2 System + * + * Compute the real part of C = ca A - w D (or ca A' - w D ) + */ + crv4->ptr.p_double[1+0] = ca*a->ptr.pp_double[1][1]-wr*d1; + crv4->ptr.p_double[2+2] = ca*a->ptr.pp_double[2][2]-wr*d2; + if( ltrans ) + { + crv4->ptr.p_double[1+2] = ca*a->ptr.pp_double[2][1]; + crv4->ptr.p_double[2+0] = ca*a->ptr.pp_double[1][2]; + } + else + { + crv4->ptr.p_double[2+0] = ca*a->ptr.pp_double[2][1]; + crv4->ptr.p_double[1+2] = ca*a->ptr.pp_double[1][2]; + } + 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++) + { + if( ae_fp_greater(ae_fabs(crv4->ptr.p_double[j], _state),cmax) ) + { + cmax = ae_fabs(crv4->ptr.p_double[j], _state); + icmax = j; + } + } + + /* + * If norm(C) < SMINI, use SMINI*identity. + */ + if( ae_fp_less(cmax,smini) ) + { + bnorm = ae_maxreal(ae_fabs(b->ptr.pp_double[1][1], _state), ae_fabs(b->ptr.pp_double[2][1], _state), _state); + if( ae_fp_less(smini,1)&&ae_fp_greater(bnorm,1) ) + { + if( ae_fp_greater(bnorm,bignum*smini) ) + { + *scl = 1/bnorm; + } + } + temp = *scl/smini; + x->ptr.pp_double[1][1] = temp*b->ptr.pp_double[1][1]; + x->ptr.pp_double[2][1] = temp*b->ptr.pp_double[2][1]; + *xnorm = temp*bnorm; + *info = 1; + return; + } + + /* + * Gaussian elimination with complete pivoting. + */ + ur11 = crv4->ptr.p_double[icmax]; + cr21 = crv4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]]; + ur12 = crv4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]]; + cr22 = crv4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]]; + ur11r = 1/ur11; + lr21 = ur11r*cr21; + ur22 = cr22-ur12*lr21; + + /* + * If smaller pivot < SMINI, use SMINI + */ + if( ae_fp_less(ae_fabs(ur22, _state),smini) ) + { + ur22 = smini; + *info = 1; + } + if( rswap4->ptr.p_bool[icmax] ) + { + br1 = b->ptr.pp_double[2][1]; + br2 = b->ptr.pp_double[1][1]; + } + else + { + br1 = b->ptr.pp_double[1][1]; + br2 = b->ptr.pp_double[2][1]; + } + br2 = br2-lr21*br1; + bbnd = ae_maxreal(ae_fabs(br1*(ur22*ur11r), _state), ae_fabs(br2, _state), _state); + if( ae_fp_greater(bbnd,1)&&ae_fp_less(ae_fabs(ur22, _state),1) ) + { + if( ae_fp_greater_eq(bbnd,bignum*ae_fabs(ur22, _state)) ) + { + *scl = 1/bbnd; + } + } + xr2 = br2*(*scl)/ur22; + xr1 = *scl*br1*ur11r-xr2*(ur11r*ur12); + if( zswap4->ptr.p_bool[icmax] ) + { + x->ptr.pp_double[1][1] = xr2; + x->ptr.pp_double[2][1] = xr1; + } + else + { + x->ptr.pp_double[1][1] = xr1; + x->ptr.pp_double[2][1] = xr2; + } + *xnorm = ae_maxreal(ae_fabs(xr1, _state), ae_fabs(xr2, _state), _state); + + /* + * Further scaling if norm(A) norm(X) > overflow + */ + if( ae_fp_greater(*xnorm,1)&&ae_fp_greater(cmax,1) ) + { + if( ae_fp_greater(*xnorm,bignum/cmax) ) + { + temp = cmax/bignum; + x->ptr.pp_double[1][1] = temp*x->ptr.pp_double[1][1]; + x->ptr.pp_double[2][1] = temp*x->ptr.pp_double[2][1]; + *xnorm = temp*(*xnorm); + *scl = temp*(*scl); + } + } + } + else + { + + /* + * Complex 2x2 system (w is complex) + * + * Find the largest element in C + */ + civ4->ptr.p_double[1+0] = -wi*d1; + civ4->ptr.p_double[2+0] = 0; + civ4->ptr.p_double[1+2] = 0; + civ4->ptr.p_double[2+2] = -wi*d2; + cmax = 0; + icmax = 0; + for(j=1; j<=4; j++) + { + if( ae_fp_greater(ae_fabs(crv4->ptr.p_double[j], _state)+ae_fabs(civ4->ptr.p_double[j], _state),cmax) ) + { + cmax = ae_fabs(crv4->ptr.p_double[j], _state)+ae_fabs(civ4->ptr.p_double[j], _state); + icmax = j; + } + } + + /* + * If norm(C) < SMINI, use SMINI*identity. + */ + if( ae_fp_less(cmax,smini) ) + { + bnorm = ae_maxreal(ae_fabs(b->ptr.pp_double[1][1], _state)+ae_fabs(b->ptr.pp_double[1][2], _state), ae_fabs(b->ptr.pp_double[2][1], _state)+ae_fabs(b->ptr.pp_double[2][2], _state), _state); + if( ae_fp_less(smini,1)&&ae_fp_greater(bnorm,1) ) + { + if( ae_fp_greater(bnorm,bignum*smini) ) + { + *scl = 1/bnorm; + } + } + temp = *scl/smini; + x->ptr.pp_double[1][1] = temp*b->ptr.pp_double[1][1]; + x->ptr.pp_double[2][1] = temp*b->ptr.pp_double[2][1]; + x->ptr.pp_double[1][2] = temp*b->ptr.pp_double[1][2]; + x->ptr.pp_double[2][2] = temp*b->ptr.pp_double[2][2]; + *xnorm = temp*bnorm; + *info = 1; + return; + } + + /* + * Gaussian elimination with complete pivoting. + */ + ur11 = crv4->ptr.p_double[icmax]; + ui11 = civ4->ptr.p_double[icmax]; + cr21 = crv4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]]; + ci21 = civ4->ptr.p_double[ipivot44->ptr.pp_int[2][icmax]]; + ur12 = crv4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]]; + ui12 = civ4->ptr.p_double[ipivot44->ptr.pp_int[3][icmax]]; + cr22 = crv4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]]; + ci22 = civ4->ptr.p_double[ipivot44->ptr.pp_int[4][icmax]]; + if( icmax==1||icmax==4 ) + { + + /* + * Code when off-diagonals of pivoted C are real + */ + if( ae_fp_greater(ae_fabs(ur11, _state),ae_fabs(ui11, _state)) ) + { + temp = ui11/ur11; + ur11r = 1/(ur11*(1+ae_sqr(temp, _state))); + ui11r = -temp*ur11r; + } + else + { + temp = ur11/ui11; + ui11r = -1/(ui11*(1+ae_sqr(temp, _state))); + ur11r = -temp*ui11r; + } + 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 = ae_fabs(ur22, _state)+ae_fabs(ui22, _state); + + /* + * If smaller pivot < SMINI, use SMINI + */ + if( ae_fp_less(u22abs,smini) ) + { + ur22 = smini; + ui22 = 0; + *info = 1; + } + if( rswap4->ptr.p_bool[icmax] ) + { + br2 = b->ptr.pp_double[1][1]; + br1 = b->ptr.pp_double[2][1]; + bi2 = b->ptr.pp_double[1][2]; + bi1 = b->ptr.pp_double[2][2]; + } + else + { + br1 = b->ptr.pp_double[1][1]; + br2 = b->ptr.pp_double[2][1]; + bi1 = b->ptr.pp_double[1][2]; + bi2 = b->ptr.pp_double[2][2]; + } + br2 = br2-lr21*br1+li21*bi1; + bi2 = bi2-li21*br1-lr21*bi1; + bbnd = ae_maxreal((ae_fabs(br1, _state)+ae_fabs(bi1, _state))*(u22abs*(ae_fabs(ur11r, _state)+ae_fabs(ui11r, _state))), ae_fabs(br2, _state)+ae_fabs(bi2, _state), _state); + if( ae_fp_greater(bbnd,1)&&ae_fp_less(u22abs,1) ) + { + if( ae_fp_greater_eq(bbnd,bignum*u22abs) ) + { + *scl = 1/bbnd; + br1 = *scl*br1; + bi1 = *scl*bi1; + br2 = *scl*br2; + bi2 = *scl*bi2; + } + } + evd_internalhsevdladiv(br2, bi2, ur22, ui22, &xr2, &xi2, _state); + xr1 = ur11r*br1-ui11r*bi1-ur12s*xr2+ui12s*xi2; + xi1 = ui11r*br1+ur11r*bi1-ui12s*xr2-ur12s*xi2; + if( zswap4->ptr.p_bool[icmax] ) + { + x->ptr.pp_double[1][1] = xr2; + x->ptr.pp_double[2][1] = xr1; + x->ptr.pp_double[1][2] = xi2; + x->ptr.pp_double[2][2] = xi1; + } + else + { + x->ptr.pp_double[1][1] = xr1; + x->ptr.pp_double[2][1] = xr2; + x->ptr.pp_double[1][2] = xi1; + x->ptr.pp_double[2][2] = xi2; + } + *xnorm = ae_maxreal(ae_fabs(xr1, _state)+ae_fabs(xi1, _state), ae_fabs(xr2, _state)+ae_fabs(xi2, _state), _state); + + /* + * Further scaling if norm(A) norm(X) > overflow + */ + if( ae_fp_greater(*xnorm,1)&&ae_fp_greater(cmax,1) ) + { + if( ae_fp_greater(*xnorm,bignum/cmax) ) + { + temp = cmax/bignum; + x->ptr.pp_double[1][1] = temp*x->ptr.pp_double[1][1]; + x->ptr.pp_double[2][1] = temp*x->ptr.pp_double[2][1]; + x->ptr.pp_double[1][2] = temp*x->ptr.pp_double[1][2]; + x->ptr.pp_double[2][2] = temp*x->ptr.pp_double[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 +*************************************************************************/ +static void evd_internalhsevdladiv(double a, + double b, + double c, + double d, + double* p, + double* q, + ae_state *_state) +{ + double e; + double f; + + *p = 0; + *q = 0; + + if( ae_fp_less(ae_fabs(d, _state),ae_fabs(c, _state)) ) + { + e = d/c; + f = c+d*e; + *p = (a+b*e)/f; + *q = (b-a*e)/f; + } + else + { + e = c/d; + f = d+c*e; + *p = (b+a*e)/f; + *q = (-a+b*e)/f; + } +} + + +static ae_bool evd_nonsymmetricevd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t vneeded, + /* Real */ ae_vector* wr, + /* Real */ ae_vector* wi, + /* Real */ ae_matrix* vl, + /* Real */ ae_matrix* vr, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_matrix s; + ae_vector tau; + ae_vector sel; + ae_int_t i; + ae_int_t info; + ae_int_t m; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_clear(wr); + ae_vector_clear(wi); + ae_matrix_clear(vl); + ae_matrix_clear(vr); + ae_matrix_init(&s, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sel, 0, DT_BOOL, _state, ae_true); + + ae_assert(vneeded>=0&&vneeded<=3, "NonSymmetricEVD: incorrect VNeeded!", _state); + if( vneeded==0 ) + { + + /* + * Eigen values only + */ + evd_toupperhessenberg(a, n, &tau, _state); + internalschurdecomposition(a, n, 0, 0, wr, wi, &s, &info, _state); + result = info==0; + ae_frame_leave(_state); + return result; + } + + /* + * Eigen values and vectors + */ + evd_toupperhessenberg(a, n, &tau, _state); + evd_unpackqfromupperhessenberg(a, n, &tau, &s, _state); + internalschurdecomposition(a, n, 1, 1, wr, wi, &s, &info, _state); + result = info==0; + if( !result ) + { + ae_frame_leave(_state); + return result; + } + if( vneeded==1||vneeded==3 ) + { + ae_matrix_set_length(vr, n+1, n+1, _state); + for(i=1; i<=n; i++) + { + ae_v_move(&vr->ptr.pp_double[i][1], 1, &s.ptr.pp_double[i][1], 1, ae_v_len(1,n)); + } + } + if( vneeded==2||vneeded==3 ) + { + ae_matrix_set_length(vl, n+1, n+1, _state); + for(i=1; i<=n; i++) + { + ae_v_move(&vl->ptr.pp_double[i][1], 1, &s.ptr.pp_double[i][1], 1, ae_v_len(1,n)); + } + } + evd_internaltrevc(a, n, vneeded, 1, &sel, vl, vr, &m, &info, _state); + result = info==0; + ae_frame_leave(_state); + return result; +} + + +static void evd_toupperhessenberg(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t ip1; + ae_int_t nmi; + double v; + ae_vector t; + ae_vector work; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(tau); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=0, "ToUpperHessenberg: incorrect N!", _state); + + /* + * Quick return if possible + */ + if( n<=1 ) + { + ae_frame_leave(_state); + return; + } + ae_vector_set_length(tau, n-1+1, _state); + ae_vector_set_length(&t, n+1, _state); + ae_vector_set_length(&work, n+1, _state); + for(i=1; i<=n-1; i++) + { + + /* + * Compute elementary reflector H(i) to annihilate A(i+2:ihi,i) + */ + ip1 = i+1; + nmi = n-i; + ae_v_move(&t.ptr.p_double[1], 1, &a->ptr.pp_double[ip1][i], a->stride, ae_v_len(1,nmi)); + generatereflection(&t, nmi, &v, _state); + ae_v_move(&a->ptr.pp_double[ip1][i], a->stride, &t.ptr.p_double[1], 1, ae_v_len(ip1,n)); + tau->ptr.p_double[i] = v; + t.ptr.p_double[1] = 1; + + /* + * Apply H(i) to A(1:ihi,i+1:ihi) from the right + */ + applyreflectionfromtheright(a, v, &t, 1, n, i+1, n, &work, _state); + + /* + * Apply H(i) to A(i+1:ihi,i+1:n) from the left + */ + applyreflectionfromtheleft(a, v, &t, i+1, n, i+1, n, &work, _state); + } + ae_frame_leave(_state); +} + + +static void evd_unpackqfromupperhessenberg(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* tau, + /* Real */ ae_matrix* q, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector v; + ae_vector work; + ae_int_t ip1; + ae_int_t nmi; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(q); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + if( n==0 ) + { + ae_frame_leave(_state); + return; + } + + /* + * init + */ + ae_matrix_set_length(q, n+1, n+1, _state); + ae_vector_set_length(&v, n+1, _state); + ae_vector_set_length(&work, n+1, _state); + for(i=1; i<=n; i++) + { + for(j=1; j<=n; j++) + { + if( i==j ) + { + q->ptr.pp_double[i][j] = 1; + } + else + { + q->ptr.pp_double[i][j] = 0; + } + } + } + + /* + * unpack Q + */ + for(i=1; i<=n-1; i++) + { + + /* + * Apply H(i) + */ + ip1 = i+1; + nmi = n-i; + ae_v_move(&v.ptr.p_double[1], 1, &a->ptr.pp_double[ip1][i], a->stride, ae_v_len(1,nmi)); + v.ptr.p_double[1] = 1; + applyreflectionfromtheright(q, tau->ptr.p_double[i], &v, 1, n, i+1, n, &work, _state); + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +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] + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonal(ae_int_t n, + /* Real */ ae_matrix* a, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + ae_matrix_clear(a); + + ae_assert(n>=1, "RMatrixRndOrthogonal: N<1!", _state); + ae_matrix_set_length(a, n, n, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( i==j ) + { + a->ptr.pp_double[i][j] = 1; + } + else + { + a->ptr.pp_double[i][j] = 0; + } + } + } + rmatrixrndorthogonalfromtheright(a, n, n, _state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndcond(ae_int_t n, + double c, + /* Real */ ae_matrix* a, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double l1; + double l2; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(a); + _hqrndstate_init(&rs, _state, ae_true); + + ae_assert(n>=1&&ae_fp_greater_eq(c,1), "RMatrixRndCond: N<1 or C<1!", _state); + ae_matrix_set_length(a, n, n, _state); + if( n==1 ) + { + + /* + * special case + */ + a->ptr.pp_double[0][0] = 2*ae_randominteger(2, _state)-1; + ae_frame_leave(_state); + return; + } + hqrndrandomize(&rs, _state); + l1 = 0; + l2 = ae_log(1/c, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + a->ptr.pp_double[0][0] = ae_exp(l1, _state); + for(i=1; i<=n-2; i++) + { + a->ptr.pp_double[i][i] = ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state); + } + a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state); + rmatrixrndorthogonalfromtheleft(a, n, n, _state); + rmatrixrndorthogonalfromtheright(a, n, n, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +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] + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonal(ae_int_t n, + /* Complex */ ae_matrix* a, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + ae_matrix_clear(a); + + ae_assert(n>=1, "CMatrixRndOrthogonal: N<1!", _state); + ae_matrix_set_length(a, n, n, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( i==j ) + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(1); + } + else + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + } + cmatrixrndorthogonalfromtheright(a, n, n, _state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndcond(ae_int_t n, + double c, + /* Complex */ ae_matrix* a, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double l1; + double l2; + hqrndstate state; + ae_complex v; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(a); + _hqrndstate_init(&state, _state, ae_true); + + ae_assert(n>=1&&ae_fp_greater_eq(c,1), "CMatrixRndCond: N<1 or C<1!", _state); + ae_matrix_set_length(a, n, n, _state); + if( n==1 ) + { + + /* + * special case + */ + hqrndrandomize(&state, _state); + hqrndunit2(&state, &v.x, &v.y, _state); + a->ptr.pp_complex[0][0] = v; + ae_frame_leave(_state); + return; + } + hqrndrandomize(&state, _state); + l1 = 0; + l2 = ae_log(1/c, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state)); + for(i=1; i<=n-2; i++) + { + a->ptr.pp_complex[i][i] = ae_complex_from_d(ae_exp(hqrnduniformr(&state, _state)*(l2-l1)+l1, _state)); + } + a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state)); + cmatrixrndorthogonalfromtheleft(a, n, n, _state); + cmatrixrndorthogonalfromtheright(a, n, n, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void smatrixrndcond(ae_int_t n, + double c, + /* Real */ ae_matrix* a, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double l1; + double l2; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(a); + _hqrndstate_init(&rs, _state, ae_true); + + ae_assert(n>=1&&ae_fp_greater_eq(c,1), "SMatrixRndCond: N<1 or C<1!", _state); + ae_matrix_set_length(a, n, n, _state); + if( n==1 ) + { + + /* + * special case + */ + a->ptr.pp_double[0][0] = 2*ae_randominteger(2, _state)-1; + ae_frame_leave(_state); + return; + } + + /* + * Prepare matrix + */ + hqrndrandomize(&rs, _state); + l1 = 0; + l2 = ae_log(1/c, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + a->ptr.pp_double[0][0] = ae_exp(l1, _state); + for(i=1; i<=n-2; i++) + { + a->ptr.pp_double[i][i] = (2*hqrnduniformi(&rs, 2, _state)-1)*ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state); + } + a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state); + + /* + * Multiply + */ + smatrixrndmultiply(a, n, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixrndcond(ae_int_t n, + double c, + /* Real */ ae_matrix* a, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double l1; + double l2; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(a); + _hqrndstate_init(&rs, _state, ae_true); + + + /* + * Special cases + */ + if( n<=0||ae_fp_less(c,1) ) + { + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(a, n, n, _state); + if( n==1 ) + { + a->ptr.pp_double[0][0] = 1; + ae_frame_leave(_state); + return; + } + + /* + * Prepare matrix + */ + hqrndrandomize(&rs, _state); + l1 = 0; + l2 = ae_log(1/c, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + a->ptr.pp_double[0][0] = ae_exp(l1, _state); + for(i=1; i<=n-2; i++) + { + a->ptr.pp_double[i][i] = ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state); + } + a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state); + + /* + * Multiply + */ + smatrixrndmultiply(a, n, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hmatrixrndcond(ae_int_t n, + double c, + /* Complex */ ae_matrix* a, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double l1; + double l2; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(a); + _hqrndstate_init(&rs, _state, ae_true); + + ae_assert(n>=1&&ae_fp_greater_eq(c,1), "HMatrixRndCond: N<1 or C<1!", _state); + ae_matrix_set_length(a, n, n, _state); + if( n==1 ) + { + + /* + * special case + */ + a->ptr.pp_complex[0][0] = ae_complex_from_d(2*ae_randominteger(2, _state)-1); + ae_frame_leave(_state); + return; + } + + /* + * Prepare matrix + */ + hqrndrandomize(&rs, _state); + l1 = 0; + l2 = ae_log(1/c, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state)); + for(i=1; i<=n-2; i++) + { + a->ptr.pp_complex[i][i] = ae_complex_from_d((2*hqrnduniformi(&rs, 2, _state)-1)*ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state)); + } + a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state)); + + /* + * Multiply + */ + hmatrixrndmultiply(a, n, _state); + + /* + * post-process to ensure that matrix diagonal is real + */ + for(i=0; i<=n-1; i++) + { + a->ptr.pp_complex[i][i].y = 0; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixrndcond(ae_int_t n, + double c, + /* Complex */ ae_matrix* a, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double l1; + double l2; + hqrndstate rs; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(a); + _hqrndstate_init(&rs, _state, ae_true); + + + /* + * Special cases + */ + if( n<=0||ae_fp_less(c,1) ) + { + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(a, n, n, _state); + if( n==1 ) + { + a->ptr.pp_complex[0][0] = ae_complex_from_d(1); + ae_frame_leave(_state); + return; + } + + /* + * Prepare matrix + */ + hqrndrandomize(&rs, _state); + l1 = 0; + l2 = ae_log(1/c, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + a->ptr.pp_complex[0][0] = ae_complex_from_d(ae_exp(l1, _state)); + for(i=1; i<=n-2; i++) + { + a->ptr.pp_complex[i][i] = ae_complex_from_d(ae_exp(hqrnduniformr(&rs, _state)*(l2-l1)+l1, _state)); + } + a->ptr.pp_complex[n-1][n-1] = ae_complex_from_d(ae_exp(l2, _state)); + + /* + * Multiply + */ + hmatrixrndmultiply(a, n, _state); + + /* + * post-process to ensure that matrix diagonal is real + */ + for(i=0; i<=n-1; i++) + { + a->ptr.pp_complex[i][i].y = 0; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonalfromtheright(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + double tau; + double lambdav; + ae_int_t s; + ae_int_t i; + double u1; + double u2; + ae_vector w; + ae_vector v; + hqrndstate state; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + _hqrndstate_init(&state, _state, ae_true); + + ae_assert(n>=1&&m>=1, "RMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state); + if( n==1 ) + { + + /* + * Special case + */ + tau = 2*ae_randominteger(2, _state)-1; + for(i=0; i<=m-1; i++) + { + a->ptr.pp_double[i][0] = a->ptr.pp_double[i][0]*tau; + } + ae_frame_leave(_state); + return; + } + + /* + * General case. + * First pass. + */ + ae_vector_set_length(&w, m, _state); + ae_vector_set_length(&v, n+1, _state); + hqrndrandomize(&state, _state); + for(s=2; s<=n; s++) + { + + /* + * Prepare random normal v + */ + do + { + i = 1; + while(i<=s) + { + hqrndnormal2(&state, &u1, &u2, _state); + v.ptr.p_double[i] = u1; + if( i+1<=s ) + { + v.ptr.p_double[i+1] = u2; + } + i = i+2; + } + lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s)); + } + while(ae_fp_eq(lambdav,0)); + + /* + * Prepare and apply reflection + */ + generatereflection(&v, s, &tau, _state); + v.ptr.p_double[1] = 1; + applyreflectionfromtheright(a, tau, &v, 0, m-1, n-s, n-1, &w, _state); + } + + /* + * Second pass. + */ + for(i=0; i<=n-1; i++) + { + tau = 2*hqrnduniformi(&state, 2, _state)-1; + ae_v_muld(&a->ptr.pp_double[0][i], a->stride, ae_v_len(0,m-1), tau); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonalfromtheleft(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + double tau; + double lambdav; + ae_int_t s; + ae_int_t i; + ae_int_t j; + double u1; + double u2; + ae_vector w; + ae_vector v; + hqrndstate state; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + _hqrndstate_init(&state, _state, ae_true); + + ae_assert(n>=1&&m>=1, "RMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state); + if( m==1 ) + { + + /* + * special case + */ + tau = 2*ae_randominteger(2, _state)-1; + for(j=0; j<=n-1; j++) + { + a->ptr.pp_double[0][j] = a->ptr.pp_double[0][j]*tau; + } + ae_frame_leave(_state); + return; + } + + /* + * General case. + * First pass. + */ + ae_vector_set_length(&w, n, _state); + ae_vector_set_length(&v, m+1, _state); + hqrndrandomize(&state, _state); + for(s=2; s<=m; s++) + { + + /* + * Prepare random normal v + */ + do + { + i = 1; + while(i<=s) + { + hqrndnormal2(&state, &u1, &u2, _state); + v.ptr.p_double[i] = u1; + if( i+1<=s ) + { + v.ptr.p_double[i+1] = u2; + } + i = i+2; + } + lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s)); + } + while(ae_fp_eq(lambdav,0)); + + /* + * Prepare and apply reflection + */ + generatereflection(&v, s, &tau, _state); + v.ptr.p_double[1] = 1; + applyreflectionfromtheleft(a, tau, &v, m-s, m-1, 0, n-1, &w, _state); + } + + /* + * Second pass. + */ + for(i=0; i<=m-1; i++) + { + tau = 2*hqrnduniformi(&state, 2, _state)-1; + ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), tau); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonalfromtheright(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_complex lambdav; + ae_complex tau; + ae_int_t s; + ae_int_t i; + ae_vector w; + ae_vector v; + hqrndstate state; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true); + _hqrndstate_init(&state, _state, ae_true); + + ae_assert(n>=1&&m>=1, "CMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state); + if( n==1 ) + { + + /* + * Special case + */ + hqrndrandomize(&state, _state); + hqrndunit2(&state, &tau.x, &tau.y, _state); + for(i=0; i<=m-1; i++) + { + a->ptr.pp_complex[i][0] = ae_c_mul(a->ptr.pp_complex[i][0],tau); + } + ae_frame_leave(_state); + return; + } + + /* + * General case. + * First pass. + */ + ae_vector_set_length(&w, m, _state); + ae_vector_set_length(&v, n+1, _state); + hqrndrandomize(&state, _state); + for(s=2; s<=n; s++) + { + + /* + * Prepare random normal v + */ + do + { + for(i=1; i<=s; i++) + { + hqrndnormal2(&state, &tau.x, &tau.y, _state); + v.ptr.p_complex[i] = tau; + } + lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s)); + } + while(ae_c_eq_d(lambdav,0)); + + /* + * Prepare and apply reflection + */ + complexgeneratereflection(&v, s, &tau, _state); + v.ptr.p_complex[1] = ae_complex_from_d(1); + complexapplyreflectionfromtheright(a, tau, &v, 0, m-1, n-s, n-1, &w, _state); + } + + /* + * Second pass. + */ + for(i=0; i<=n-1; i++) + { + hqrndunit2(&state, &tau.x, &tau.y, _state); + ae_v_cmulc(&a->ptr.pp_complex[0][i], a->stride, ae_v_len(0,m-1), tau); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonalfromtheleft(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_complex tau; + ae_complex lambdav; + ae_int_t s; + ae_int_t i; + ae_int_t j; + ae_vector w; + ae_vector v; + hqrndstate state; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true); + _hqrndstate_init(&state, _state, ae_true); + + ae_assert(n>=1&&m>=1, "CMatrixRndOrthogonalFromTheRight: N<1 or M<1!", _state); + if( m==1 ) + { + + /* + * special case + */ + hqrndrandomize(&state, _state); + hqrndunit2(&state, &tau.x, &tau.y, _state); + for(j=0; j<=n-1; j++) + { + a->ptr.pp_complex[0][j] = ae_c_mul(a->ptr.pp_complex[0][j],tau); + } + ae_frame_leave(_state); + return; + } + + /* + * General case. + * First pass. + */ + ae_vector_set_length(&w, n, _state); + ae_vector_set_length(&v, m+1, _state); + hqrndrandomize(&state, _state); + for(s=2; s<=m; s++) + { + + /* + * Prepare random normal v + */ + do + { + for(i=1; i<=s; i++) + { + hqrndnormal2(&state, &tau.x, &tau.y, _state); + v.ptr.p_complex[i] = tau; + } + lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s)); + } + while(ae_c_eq_d(lambdav,0)); + + /* + * Prepare and apply reflection + */ + complexgeneratereflection(&v, s, &tau, _state); + v.ptr.p_complex[1] = ae_complex_from_d(1); + complexapplyreflectionfromtheleft(a, tau, &v, m-s, m-1, 0, n-1, &w, _state); + } + + /* + * Second pass. + */ + for(i=0; i<=m-1; i++) + { + hqrndunit2(&state, &tau.x, &tau.y, _state); + ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), tau); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void smatrixrndmultiply(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + double tau; + double lambdav; + ae_int_t s; + ae_int_t i; + double u1; + double u2; + ae_vector w; + ae_vector v; + hqrndstate state; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&v, 0, DT_REAL, _state, ae_true); + _hqrndstate_init(&state, _state, ae_true); + + + /* + * General case. + */ + ae_vector_set_length(&w, n, _state); + ae_vector_set_length(&v, n+1, _state); + hqrndrandomize(&state, _state); + for(s=2; s<=n; s++) + { + + /* + * Prepare random normal v + */ + do + { + i = 1; + while(i<=s) + { + hqrndnormal2(&state, &u1, &u2, _state); + v.ptr.p_double[i] = u1; + if( i+1<=s ) + { + v.ptr.p_double[i+1] = u2; + } + i = i+2; + } + lambdav = ae_v_dotproduct(&v.ptr.p_double[1], 1, &v.ptr.p_double[1], 1, ae_v_len(1,s)); + } + while(ae_fp_eq(lambdav,0)); + + /* + * Prepare and apply reflection + */ + generatereflection(&v, s, &tau, _state); + v.ptr.p_double[1] = 1; + applyreflectionfromtheright(a, tau, &v, 0, n-1, n-s, n-1, &w, _state); + applyreflectionfromtheleft(a, tau, &v, n-s, n-1, 0, n-1, &w, _state); + } + + /* + * Second pass. + */ + for(i=0; i<=n-1; i++) + { + tau = 2*hqrnduniformi(&state, 2, _state)-1; + ae_v_muld(&a->ptr.pp_double[0][i], a->stride, ae_v_len(0,n-1), tau); + ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), tau); + } + + /* + * Copy upper triangle to lower + */ + for(i=0; i<=n-2; i++) + { + ae_v_move(&a->ptr.pp_double[i+1][i], a->stride, &a->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1)); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hmatrixrndmultiply(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_complex tau; + ae_complex lambdav; + ae_int_t s; + ae_int_t i; + ae_vector w; + ae_vector v; + hqrndstate state; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&w, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&v, 0, DT_COMPLEX, _state, ae_true); + _hqrndstate_init(&state, _state, ae_true); + + + /* + * General case. + */ + ae_vector_set_length(&w, n, _state); + ae_vector_set_length(&v, n+1, _state); + hqrndrandomize(&state, _state); + for(s=2; s<=n; s++) + { + + /* + * Prepare random normal v + */ + do + { + for(i=1; i<=s; i++) + { + hqrndnormal2(&state, &tau.x, &tau.y, _state); + v.ptr.p_complex[i] = tau; + } + lambdav = ae_v_cdotproduct(&v.ptr.p_complex[1], 1, "N", &v.ptr.p_complex[1], 1, "Conj", ae_v_len(1,s)); + } + while(ae_c_eq_d(lambdav,0)); + + /* + * Prepare and apply reflection + */ + complexgeneratereflection(&v, s, &tau, _state); + v.ptr.p_complex[1] = ae_complex_from_d(1); + complexapplyreflectionfromtheright(a, tau, &v, 0, n-1, n-s, n-1, &w, _state); + complexapplyreflectionfromtheleft(a, ae_c_conj(tau, _state), &v, n-s, n-1, 0, n-1, &w, _state); + } + + /* + * Second pass. + */ + for(i=0; i<=n-1; i++) + { + hqrndunit2(&state, &tau.x, &tau.y, _state); + ae_v_cmulc(&a->ptr.pp_complex[0][i], a->stride, ae_v_len(0,n-1), tau); + tau = ae_c_conj(tau, _state); + ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), tau); + } + + /* + * Change all values from lower triangle by complex-conjugate values + * from upper one + */ + for(i=0; i<=n-2; i++) + { + ae_v_cmove(&a->ptr.pp_complex[i+1][i], a->stride, &a->ptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1)); + } + for(s=0; s<=n-2; s++) + { + for(i=s+1; i<=n-1; i++) + { + a->ptr.pp_complex[i][s].y = -a->ptr.pp_complex[i][s].y; + } + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +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)]. + + -- ALGLIB routine -- + 10.01.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlu(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state) +{ + + ae_vector_clear(pivots); + + ae_assert(m>0, "RMatrixLU: incorrect M!", _state); + ae_assert(n>0, "RMatrixLU: incorrect N!", _state); + rmatrixplu(a, m, n, pivots, _state); +} + + +/************************************************************************* +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)]. + + -- ALGLIB routine -- + 10.01.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlu(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state) +{ + + ae_vector_clear(pivots); + + ae_assert(m>0, "CMatrixLU: incorrect M!", _state); + ae_assert(n>0, "CMatrixLU: incorrect N!", _state); + cmatrixplu(a, m, n, pivots, _state); +} + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +ae_bool hpdmatrixcholesky(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tmp; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); + + if( n<1 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + result = trfac_hpdmatrixcholeskyrec(a, 0, n, isupper, &tmp, _state); + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +ae_bool spdmatrixcholesky(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tmp; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + if( n<1 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + result = spdmatrixcholeskyrec(a, 0, n, isupper, &tmp, _state); + ae_frame_leave(_state); + return result; +} + + +void rmatrixlup(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tmp; + ae_int_t i; + ae_int_t j; + double mx; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(pivots); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + + /* + * Internal LU decomposition subroutine. + * Never call it directly. + */ + ae_assert(m>0, "RMatrixLUP: incorrect M!", _state); + ae_assert(n>0, "RMatrixLUP: incorrect N!", _state); + + /* + * Scale matrix to avoid overflows, + * decompose it, then scale back. + */ + mx = 0; + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + mx = ae_maxreal(mx, ae_fabs(a->ptr.pp_double[i][j], _state), _state); + } + } + if( ae_fp_neq(mx,0) ) + { + v = 1/mx; + for(i=0; i<=m-1; i++) + { + ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); + } + } + ae_vector_set_length(pivots, ae_minint(m, n, _state), _state); + ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state); + trfac_rmatrixluprec(a, 0, m, n, pivots, &tmp, _state); + if( ae_fp_neq(mx,0) ) + { + v = mx; + for(i=0; i<=m-1; i++) + { + ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,ae_minint(i, n-1, _state)), v); + } + } + ae_frame_leave(_state); +} + + +void cmatrixlup(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tmp; + ae_int_t i; + ae_int_t j; + double mx; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(pivots); + ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); + + + /* + * Internal LU decomposition subroutine. + * Never call it directly. + */ + ae_assert(m>0, "CMatrixLUP: incorrect M!", _state); + ae_assert(n>0, "CMatrixLUP: incorrect N!", _state); + + /* + * Scale matrix to avoid overflows, + * decompose it, then scale back. + */ + mx = 0; + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + mx = ae_maxreal(mx, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); + } + } + if( ae_fp_neq(mx,0) ) + { + v = 1/mx; + for(i=0; i<=m-1; i++) + { + ae_v_cmuld(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), v); + } + } + ae_vector_set_length(pivots, ae_minint(m, n, _state), _state); + ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state); + trfac_cmatrixluprec(a, 0, m, n, pivots, &tmp, _state); + if( ae_fp_neq(mx,0) ) + { + v = mx; + for(i=0; i<=m-1; i++) + { + ae_v_cmuld(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,ae_minint(i, n-1, _state)), v); + } + } + ae_frame_leave(_state); +} + + +void rmatrixplu(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tmp; + ae_int_t i; + ae_int_t j; + double mx; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(pivots); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + + /* + * Internal LU decomposition subroutine. + * Never call it directly. + */ + ae_assert(m>0, "RMatrixPLU: incorrect M!", _state); + ae_assert(n>0, "RMatrixPLU: incorrect N!", _state); + ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state); + ae_vector_set_length(pivots, ae_minint(m, n, _state), _state); + + /* + * Scale matrix to avoid overflows, + * decompose it, then scale back. + */ + mx = 0; + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + mx = ae_maxreal(mx, ae_fabs(a->ptr.pp_double[i][j], _state), _state); + } + } + if( ae_fp_neq(mx,0) ) + { + v = 1/mx; + for(i=0; i<=m-1; i++) + { + ae_v_muld(&a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); + } + } + trfac_rmatrixplurec(a, 0, m, n, pivots, &tmp, _state); + if( ae_fp_neq(mx,0) ) + { + v = mx; + for(i=0; i<=ae_minint(m, n, _state)-1; i++) + { + ae_v_muld(&a->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v); + } + } + ae_frame_leave(_state); +} + + +void cmatrixplu(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tmp; + ae_int_t i; + ae_int_t j; + double mx; + ae_complex v; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(pivots); + ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); + + + /* + * Internal LU decomposition subroutine. + * Never call it directly. + */ + ae_assert(m>0, "CMatrixPLU: incorrect M!", _state); + ae_assert(n>0, "CMatrixPLU: incorrect N!", _state); + ae_vector_set_length(&tmp, 2*ae_maxint(m, n, _state), _state); + ae_vector_set_length(pivots, ae_minint(m, n, _state), _state); + + /* + * Scale matrix to avoid overflows, + * decompose it, then scale back. + */ + mx = 0; + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + mx = ae_maxreal(mx, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); + } + } + if( ae_fp_neq(mx,0) ) + { + v = ae_complex_from_d(1/mx); + for(i=0; i<=m-1; i++) + { + ae_v_cmulc(&a->ptr.pp_complex[i][0], 1, ae_v_len(0,n-1), v); + } + } + trfac_cmatrixplurec(a, 0, m, n, pivots, &tmp, _state); + if( ae_fp_neq(mx,0) ) + { + v = ae_complex_from_d(mx); + for(i=0; i<=ae_minint(m, n, _state)-1; i++) + { + ae_v_cmulc(&a->ptr.pp_complex[i][i], 1, ae_v_len(i,n-1), v); + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +ae_bool spdmatrixcholeskyrec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t n1; + ae_int_t n2; + ae_bool result; + + + + /* + * check N + */ + if( n<1 ) + { + result = ae_false; + return result; + } + + /* + * Prepare buffer + */ + if( tmp->cnt<2*n ) + { + ae_vector_set_length(tmp, 2*n, _state); + } + + /* + * special cases + */ + if( n==1 ) + { + if( ae_fp_greater(a->ptr.pp_double[offs][offs],0) ) + { + a->ptr.pp_double[offs][offs] = ae_sqrt(a->ptr.pp_double[offs][offs], _state); + result = ae_true; + } + else + { + result = ae_false; + } + return result; + } + if( n<=ablasblocksize(a, _state) ) + { + result = trfac_spdmatrixcholesky2(a, offs, n, isupper, tmp, _state); + return result; + } + + /* + * general case: split task in cache-oblivious manner + */ + result = ae_true; + ablassplitlength(a, n, &n1, &n2, _state); + result = spdmatrixcholeskyrec(a, offs, n1, isupper, tmp, _state); + if( !result ) + { + return result; + } + if( n2>0 ) + { + if( isupper ) + { + rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 1, a, offs, offs+n1, _state); + rmatrixsyrk(n2, n1, -1.0, a, offs, offs+n1, 1, 1.0, a, offs+n1, offs+n1, isupper, _state); + } + else + { + rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 1, a, offs+n1, offs, _state); + rmatrixsyrk(n2, n1, -1.0, a, offs+n1, offs, 0, 1.0, a, offs+n1, offs+n1, isupper, _state); + } + result = spdmatrixcholeskyrec(a, offs+n1, n2, isupper, tmp, _state); + if( !result ) + { + return result; + } + } + return result; +} + + +/************************************************************************* +Recurrent complex LU subroutine. +Never call it directly. + + -- ALGLIB routine -- + 04.01.2010 + Bochkanov Sergey +*************************************************************************/ +static void trfac_cmatrixluprec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t m1; + ae_int_t m2; + + + + /* + * Kernel case + */ + if( ae_minint(m, n, _state)<=ablascomplexblocksize(a, _state) ) + { + trfac_cmatrixlup2(a, offs, m, n, pivots, tmp, _state); + return; + } + + /* + * Preliminary step, make N>=M + * + * ( A1 ) + * A = ( ), where A1 is square + * ( A2 ) + * + * Factorize A1, update A2 + */ + if( m>n ) + { + trfac_cmatrixluprec(a, offs, n, n, pivots, tmp, _state); + for(i=0; i<=n-1; i++) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+n][offs+i], a->stride, "N", ae_v_len(0,m-n-1)); + ae_v_cmove(&a->ptr.pp_complex[offs+n][offs+i], a->stride, &a->ptr.pp_complex[offs+n][pivots->ptr.p_int[offs+i]], a->stride, "N", ae_v_len(offs+n,offs+m-1)); + ae_v_cmove(&a->ptr.pp_complex[offs+n][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+n,offs+m-1)); + } + cmatrixrighttrsm(m-n, n, a, offs, offs, ae_true, ae_true, 0, a, offs+n, offs, _state); + return; + } + + /* + * Non-kernel case + */ + ablascomplexsplitlength(a, m, &m1, &m2, _state); + trfac_cmatrixluprec(a, offs, m1, n, pivots, tmp, _state); + if( m2>0 ) + { + for(i=0; i<=m1-1; i++) + { + if( offs+i!=pivots->ptr.p_int[offs+i] ) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+m1][offs+i], a->stride, "N", ae_v_len(0,m2-1)); + ae_v_cmove(&a->ptr.pp_complex[offs+m1][offs+i], a->stride, &a->ptr.pp_complex[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, "N", ae_v_len(offs+m1,offs+m-1)); + ae_v_cmove(&a->ptr.pp_complex[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+m1,offs+m-1)); + } + } + cmatrixrighttrsm(m2, m1, a, offs, offs, ae_true, ae_true, 0, a, offs+m1, offs, _state); + cmatrixgemm(m-m1, n-m1, m1, ae_complex_from_d(-1.0), a, offs+m1, offs, 0, a, offs, offs+m1, 0, ae_complex_from_d(1.0), a, offs+m1, offs+m1, _state); + trfac_cmatrixluprec(a, offs+m1, m-m1, n-m1, pivots, tmp, _state); + for(i=0; i<=m2-1; i++) + { + if( offs+m1+i!=pivots->ptr.p_int[offs+m1+i] ) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+m1+i], a->stride, "N", ae_v_len(0,m1-1)); + ae_v_cmove(&a->ptr.pp_complex[offs][offs+m1+i], a->stride, &a->ptr.pp_complex[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, "N", ae_v_len(offs,offs+m1-1)); + ae_v_cmove(&a->ptr.pp_complex[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+m1-1)); + } + } + } +} + + +/************************************************************************* +Recurrent real LU subroutine. +Never call it directly. + + -- ALGLIB routine -- + 04.01.2010 + Bochkanov Sergey +*************************************************************************/ +static void trfac_rmatrixluprec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t m1; + ae_int_t m2; + + + + /* + * Kernel case + */ + if( ae_minint(m, n, _state)<=ablasblocksize(a, _state) ) + { + trfac_rmatrixlup2(a, offs, m, n, pivots, tmp, _state); + return; + } + + /* + * Preliminary step, make N>=M + * + * ( A1 ) + * A = ( ), where A1 is square + * ( A2 ) + * + * Factorize A1, update A2 + */ + if( m>n ) + { + trfac_rmatrixluprec(a, offs, n, n, pivots, tmp, _state); + for(i=0; i<=n-1; i++) + { + if( offs+i!=pivots->ptr.p_int[offs+i] ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+n][offs+i], a->stride, ae_v_len(0,m-n-1)); + ae_v_move(&a->ptr.pp_double[offs+n][offs+i], a->stride, &a->ptr.pp_double[offs+n][pivots->ptr.p_int[offs+i]], a->stride, ae_v_len(offs+n,offs+m-1)); + ae_v_move(&a->ptr.pp_double[offs+n][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs+n,offs+m-1)); + } + } + rmatrixrighttrsm(m-n, n, a, offs, offs, ae_true, ae_true, 0, a, offs+n, offs, _state); + return; + } + + /* + * Non-kernel case + */ + ablassplitlength(a, m, &m1, &m2, _state); + trfac_rmatrixluprec(a, offs, m1, n, pivots, tmp, _state); + if( m2>0 ) + { + for(i=0; i<=m1-1; i++) + { + if( offs+i!=pivots->ptr.p_int[offs+i] ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+m1][offs+i], a->stride, ae_v_len(0,m2-1)); + ae_v_move(&a->ptr.pp_double[offs+m1][offs+i], a->stride, &a->ptr.pp_double[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, ae_v_len(offs+m1,offs+m-1)); + ae_v_move(&a->ptr.pp_double[offs+m1][pivots->ptr.p_int[offs+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs+m1,offs+m-1)); + } + } + rmatrixrighttrsm(m2, m1, a, offs, offs, ae_true, ae_true, 0, a, offs+m1, offs, _state); + 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, _state); + trfac_rmatrixluprec(a, offs+m1, m-m1, n-m1, pivots, tmp, _state); + for(i=0; i<=m2-1; i++) + { + if( offs+m1+i!=pivots->ptr.p_int[offs+m1+i] ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+m1+i], a->stride, ae_v_len(0,m1-1)); + ae_v_move(&a->ptr.pp_double[offs][offs+m1+i], a->stride, &a->ptr.pp_double[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, ae_v_len(offs,offs+m1-1)); + ae_v_move(&a->ptr.pp_double[offs][pivots->ptr.p_int[offs+m1+i]], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+m1-1)); + } + } + } +} + + +/************************************************************************* +Recurrent complex LU subroutine. +Never call it directly. + + -- ALGLIB routine -- + 04.01.2010 + Bochkanov Sergey +*************************************************************************/ +static void trfac_cmatrixplurec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n1; + ae_int_t n2; + + + + /* + * Kernel case + */ + if( ae_minint(m, n, _state)<=ablascomplexblocksize(a, _state) ) + { + trfac_cmatrixplu2(a, offs, m, n, pivots, tmp, _state); + return; + } + + /* + * Preliminary step, make M>=N. + * + * A = (A1 A2), where A1 is square + * Factorize A1, update A2 + */ + if( n>m ) + { + trfac_cmatrixplurec(a, offs, m, m, pivots, tmp, _state); + for(i=0; i<=m-1; i++) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs+m], 1, "N", ae_v_len(0,n-m-1)); + ae_v_cmove(&a->ptr.pp_complex[offs+i][offs+m], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+m], 1, "N", ae_v_len(offs+m,offs+n-1)); + ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+m], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+m,offs+n-1)); + } + cmatrixlefttrsm(m, n-m, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+m, _state); + return; + } + + /* + * Non-kernel case + */ + ablascomplexsplitlength(a, n, &n1, &n2, _state); + trfac_cmatrixplurec(a, offs, m, n1, pivots, tmp, _state); + if( n2>0 ) + { + for(i=0; i<=n1-1; i++) + { + if( offs+i!=pivots->ptr.p_int[offs+i] ) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs+n1], 1, "N", ae_v_len(0,n2-1)); + ae_v_cmove(&a->ptr.pp_complex[offs+i][offs+n1], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+n1], 1, "N", ae_v_len(offs+n1,offs+n-1)); + ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+i]][offs+n1], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs+n1,offs+n-1)); + } + } + cmatrixlefttrsm(n1, n2, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+n1, _state); + cmatrixgemm(m-n1, n-n1, n1, ae_complex_from_d(-1.0), a, offs+n1, offs, 0, a, offs, offs+n1, 0, ae_complex_from_d(1.0), a, offs+n1, offs+n1, _state); + trfac_cmatrixplurec(a, offs+n1, m-n1, n-n1, pivots, tmp, _state); + for(i=0; i<=n2-1; i++) + { + if( offs+n1+i!=pivots->ptr.p_int[offs+n1+i] ) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+n1+i][offs], 1, "N", ae_v_len(0,n1-1)); + ae_v_cmove(&a->ptr.pp_complex[offs+n1+i][offs], 1, &a->ptr.pp_complex[pivots->ptr.p_int[offs+n1+i]][offs], 1, "N", ae_v_len(offs,offs+n1-1)); + ae_v_cmove(&a->ptr.pp_complex[pivots->ptr.p_int[offs+n1+i]][offs], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+n1-1)); + } + } + } +} + + +/************************************************************************* +Recurrent real LU subroutine. +Never call it directly. + + -- ALGLIB routine -- + 04.01.2010 + Bochkanov Sergey +*************************************************************************/ +static void trfac_rmatrixplurec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n1; + ae_int_t n2; + + + + /* + * Kernel case + */ + if( ae_minint(m, n, _state)<=ablasblocksize(a, _state) ) + { + trfac_rmatrixplu2(a, offs, m, n, pivots, tmp, _state); + return; + } + + /* + * Preliminary step, make M>=N. + * + * A = (A1 A2), where A1 is square + * Factorize A1, update A2 + */ + if( n>m ) + { + trfac_rmatrixplurec(a, offs, m, m, pivots, tmp, _state); + for(i=0; i<=m-1; i++) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs+m], 1, ae_v_len(0,n-m-1)); + ae_v_move(&a->ptr.pp_double[offs+i][offs+m], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+m], 1, ae_v_len(offs+m,offs+n-1)); + ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+m], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs+m,offs+n-1)); + } + rmatrixlefttrsm(m, n-m, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+m, _state); + return; + } + + /* + * Non-kernel case + */ + ablassplitlength(a, n, &n1, &n2, _state); + trfac_rmatrixplurec(a, offs, m, n1, pivots, tmp, _state); + if( n2>0 ) + { + for(i=0; i<=n1-1; i++) + { + if( offs+i!=pivots->ptr.p_int[offs+i] ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(0,n2-1)); + ae_v_move(&a->ptr.pp_double[offs+i][offs+n1], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+n1], 1, ae_v_len(offs+n1,offs+n-1)); + ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+i]][offs+n1], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs+n1,offs+n-1)); + } + } + rmatrixlefttrsm(n1, n2, a, offs, offs, ae_false, ae_true, 0, a, offs, offs+n1, _state); + 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, _state); + trfac_rmatrixplurec(a, offs+n1, m-n1, n-n1, pivots, tmp, _state); + for(i=0; i<=n2-1; i++) + { + if( offs+n1+i!=pivots->ptr.p_int[offs+n1+i] ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(0,n1-1)); + ae_v_move(&a->ptr.pp_double[offs+n1+i][offs], 1, &a->ptr.pp_double[pivots->ptr.p_int[offs+n1+i]][offs], 1, ae_v_len(offs,offs+n1-1)); + ae_v_move(&a->ptr.pp_double[pivots->ptr.p_int[offs+n1+i]][offs], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+n1-1)); + } + } + } +} + + +/************************************************************************* +Complex LUP kernel + + -- ALGLIB routine -- + 10.01.2010 + Bochkanov Sergey +*************************************************************************/ +static void trfac_cmatrixlup2(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t jp; + ae_complex s; + + + + /* + * Quick return if possible + */ + if( m==0||n==0 ) + { + return; + } + + /* + * main cycle + */ + for(j=0; j<=ae_minint(m-1, n-1, _state); j++) + { + + /* + * Find pivot, swap columns + */ + jp = j; + for(i=j+1; i<=n-1; i++) + { + if( ae_fp_greater(ae_c_abs(a->ptr.pp_complex[offs+j][offs+i], _state),ae_c_abs(a->ptr.pp_complex[offs+j][offs+jp], _state)) ) + { + jp = i; + } + } + pivots->ptr.p_int[offs+j] = offs+jp; + if( jp!=j ) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+j], a->stride, "N", ae_v_len(0,m-1)); + ae_v_cmove(&a->ptr.pp_complex[offs][offs+j], a->stride, &a->ptr.pp_complex[offs][offs+jp], a->stride, "N", ae_v_len(offs,offs+m-1)); + ae_v_cmove(&a->ptr.pp_complex[offs][offs+jp], a->stride, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+m-1)); + } + + /* + * LU decomposition of 1x(N-J) matrix + */ + if( ae_c_neq_d(a->ptr.pp_complex[offs+j][offs+j],0)&&j+1<=n-1 ) + { + s = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]); + ae_v_cmulc(&a->ptr.pp_complex[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), s); + } + + /* + * Update trailing (M-J-1)x(N-J-1) matrix + */ + if( jptr.p_complex[0], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(0,m-j-2)); + ae_v_cmoveneg(&tmp->ptr.p_complex[m], 1, &a->ptr.pp_complex[offs+j][offs+j+1], 1, "N", ae_v_len(m,m+n-j-2)); + cmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state); + } + } +} + + +/************************************************************************* +Real LUP kernel + + -- ALGLIB routine -- + 10.01.2010 + Bochkanov Sergey +*************************************************************************/ +static void trfac_rmatrixlup2(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t jp; + double s; + + + + /* + * Quick return if possible + */ + if( m==0||n==0 ) + { + return; + } + + /* + * main cycle + */ + for(j=0; j<=ae_minint(m-1, n-1, _state); j++) + { + + /* + * Find pivot, swap columns + */ + jp = j; + for(i=j+1; i<=n-1; i++) + { + if( ae_fp_greater(ae_fabs(a->ptr.pp_double[offs+j][offs+i], _state),ae_fabs(a->ptr.pp_double[offs+j][offs+jp], _state)) ) + { + jp = i; + } + } + pivots->ptr.p_int[offs+j] = offs+jp; + if( jp!=j ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+j], a->stride, ae_v_len(0,m-1)); + ae_v_move(&a->ptr.pp_double[offs][offs+j], a->stride, &a->ptr.pp_double[offs][offs+jp], a->stride, ae_v_len(offs,offs+m-1)); + ae_v_move(&a->ptr.pp_double[offs][offs+jp], a->stride, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+m-1)); + } + + /* + * LU decomposition of 1x(N-J) matrix + */ + if( ae_fp_neq(a->ptr.pp_double[offs+j][offs+j],0)&&j+1<=n-1 ) + { + s = 1/a->ptr.pp_double[offs+j][offs+j]; + ae_v_muld(&a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), s); + } + + /* + * Update trailing (M-J-1)x(N-J-1) matrix + */ + if( jptr.p_double[0], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(0,m-j-2)); + ae_v_moveneg(&tmp->ptr.p_double[m], 1, &a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(m,m+n-j-2)); + rmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state); + } + } +} + + +/************************************************************************* +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 +*************************************************************************/ +static void trfac_cmatrixplu2(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t jp; + ae_complex s; + + + + /* + * Quick return if possible + */ + if( m==0||n==0 ) + { + return; + } + for(j=0; j<=ae_minint(m-1, n-1, _state); j++) + { + + /* + * Find pivot and test for singularity. + */ + jp = j; + for(i=j+1; i<=m-1; i++) + { + if( ae_fp_greater(ae_c_abs(a->ptr.pp_complex[offs+i][offs+j], _state),ae_c_abs(a->ptr.pp_complex[offs+jp][offs+j], _state)) ) + { + jp = i; + } + } + pivots->ptr.p_int[offs+j] = offs+jp; + if( ae_c_neq_d(a->ptr.pp_complex[offs+jp][offs+j],0) ) + { + + /* + *Apply the interchange to rows + */ + if( jp!=j ) + { + for(i=0; i<=n-1; i++) + { + s = a->ptr.pp_complex[offs+j][offs+i]; + a->ptr.pp_complex[offs+j][offs+i] = a->ptr.pp_complex[offs+jp][offs+i]; + a->ptr.pp_complex[offs+jp][offs+i] = s; + } + } + + /* + *Compute elements J+1:M of J-th column. + */ + if( j+1<=m-1 ) + { + s = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]); + ae_v_cmulc(&a->ptr.pp_complex[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+m-1), s); + } + } + if( jptr.p_complex[0], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(0,m-j-2)); + ae_v_cmoveneg(&tmp->ptr.p_complex[m], 1, &a->ptr.pp_complex[offs+j][offs+j+1], 1, "N", ae_v_len(m,m+n-j-2)); + cmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state); + } + } +} + + +/************************************************************************* +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 +*************************************************************************/ +static void trfac_rmatrixplu2(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t jp; + double s; + + + + /* + * Quick return if possible + */ + if( m==0||n==0 ) + { + return; + } + for(j=0; j<=ae_minint(m-1, n-1, _state); j++) + { + + /* + * Find pivot and test for singularity. + */ + jp = j; + for(i=j+1; i<=m-1; i++) + { + if( ae_fp_greater(ae_fabs(a->ptr.pp_double[offs+i][offs+j], _state),ae_fabs(a->ptr.pp_double[offs+jp][offs+j], _state)) ) + { + jp = i; + } + } + pivots->ptr.p_int[offs+j] = offs+jp; + if( ae_fp_neq(a->ptr.pp_double[offs+jp][offs+j],0) ) + { + + /* + *Apply the interchange to rows + */ + if( jp!=j ) + { + for(i=0; i<=n-1; i++) + { + s = a->ptr.pp_double[offs+j][offs+i]; + a->ptr.pp_double[offs+j][offs+i] = a->ptr.pp_double[offs+jp][offs+i]; + a->ptr.pp_double[offs+jp][offs+i] = s; + } + } + + /* + *Compute elements J+1:M of J-th column. + */ + if( j+1<=m-1 ) + { + s = 1/a->ptr.pp_double[offs+j][offs+j]; + ae_v_muld(&a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+m-1), s); + } + } + if( jptr.p_double[0], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(0,m-j-2)); + ae_v_moveneg(&tmp->ptr.p_double[m], 1, &a->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(m,m+n-j-2)); + rmatrixrank1(m-j-1, n-j-1, a, offs+j+1, offs+j+1, tmp, 0, tmp, m, _state); + } + } +} + + +/************************************************************************* +Recursive computational subroutine for HPDMatrixCholesky + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +static ae_bool trfac_hpdmatrixcholeskyrec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t n1; + ae_int_t n2; + ae_bool result; + + + + /* + * check N + */ + if( n<1 ) + { + result = ae_false; + return result; + } + + /* + * Prepare buffer + */ + if( tmp->cnt<2*n ) + { + ae_vector_set_length(tmp, 2*n, _state); + } + + /* + * special cases + */ + if( n==1 ) + { + if( ae_fp_greater(a->ptr.pp_complex[offs][offs].x,0) ) + { + a->ptr.pp_complex[offs][offs] = ae_complex_from_d(ae_sqrt(a->ptr.pp_complex[offs][offs].x, _state)); + result = ae_true; + } + else + { + result = ae_false; + } + return result; + } + if( n<=ablascomplexblocksize(a, _state) ) + { + result = trfac_hpdmatrixcholesky2(a, offs, n, isupper, tmp, _state); + return result; + } + + /* + * general case: split task in cache-oblivious manner + */ + result = ae_true; + ablascomplexsplitlength(a, n, &n1, &n2, _state); + result = trfac_hpdmatrixcholeskyrec(a, offs, n1, isupper, tmp, _state); + if( !result ) + { + return result; + } + if( n2>0 ) + { + if( isupper ) + { + cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 2, a, offs, offs+n1, _state); + cmatrixsyrk(n2, n1, -1.0, a, offs, offs+n1, 2, 1.0, a, offs+n1, offs+n1, isupper, _state); + } + else + { + cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 2, a, offs+n1, offs, _state); + cmatrixsyrk(n2, n1, -1.0, a, offs+n1, offs, 0, 1.0, a, offs+n1, offs+n1, isupper, _state); + } + result = trfac_hpdmatrixcholeskyrec(a, offs+n1, n2, isupper, tmp, _state); + if( !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 +*************************************************************************/ +static ae_bool trfac_hpdmatrixcholesky2(/* Complex */ ae_matrix* aaa, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double ajj; + ae_complex v; + double r; + ae_bool result; + + + result = ae_true; + if( n<0 ) + { + result = ae_false; + return result; + } + + /* + * Quick return if possible + */ + if( n==0 ) + { + return result; + } + if( isupper ) + { + + /* + * Compute the Cholesky factorization A = U'*U. + */ + for(j=0; j<=n-1; j++) + { + + /* + * Compute U(J,J) and test for non-positive-definiteness. + */ + v = ae_v_cdotproduct(&aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "Conj", &aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "N", ae_v_len(offs,offs+j-1)); + ajj = ae_c_sub(aaa->ptr.pp_complex[offs+j][offs+j],v).x; + if( ae_fp_less_eq(ajj,0) ) + { + aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj); + result = ae_false; + return result; + } + ajj = ae_sqrt(ajj, _state); + aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj); + + /* + * Compute elements J+1:N-1 of row J. + */ + if( j0 ) + { + ae_v_cmoveneg(&tmp->ptr.p_complex[0], 1, &aaa->ptr.pp_complex[offs][offs+j], aaa->stride, "Conj", ae_v_len(0,j-1)); + cmatrixmv(n-j-1, j, aaa, offs, offs+j+1, 1, tmp, 0, tmp, n, _state); + ae_v_cadd(&aaa->ptr.pp_complex[offs+j][offs+j+1], 1, &tmp->ptr.p_complex[n], 1, "N", ae_v_len(offs+j+1,offs+n-1)); + } + r = 1/ajj; + ae_v_cmuld(&aaa->ptr.pp_complex[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), r); + } + } + } + else + { + + /* + * Compute the Cholesky factorization A = L*L'. + */ + for(j=0; j<=n-1; j++) + { + + /* + * Compute L(J+1,J+1) and test for non-positive-definiteness. + */ + v = ae_v_cdotproduct(&aaa->ptr.pp_complex[offs+j][offs], 1, "Conj", &aaa->ptr.pp_complex[offs+j][offs], 1, "N", ae_v_len(offs,offs+j-1)); + ajj = ae_c_sub(aaa->ptr.pp_complex[offs+j][offs+j],v).x; + if( ae_fp_less_eq(ajj,0) ) + { + aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj); + result = ae_false; + return result; + } + ajj = ae_sqrt(ajj, _state); + aaa->ptr.pp_complex[offs+j][offs+j] = ae_complex_from_d(ajj); + + /* + * Compute elements J+1:N of column J. + */ + if( j0 ) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &aaa->ptr.pp_complex[offs+j][offs], 1, "Conj", ae_v_len(0,j-1)); + cmatrixmv(n-j-1, j, aaa, offs+j+1, offs, 0, tmp, 0, tmp, n, _state); + for(i=0; i<=n-j-2; i++) + { + aaa->ptr.pp_complex[offs+j+1+i][offs+j] = ae_c_div_d(ae_c_sub(aaa->ptr.pp_complex[offs+j+1+i][offs+j],tmp->ptr.p_complex[n+i]),ajj); + } + } + else + { + for(i=0; i<=n-j-2; i++) + { + aaa->ptr.pp_complex[offs+j+1+i][offs+j] = ae_c_div_d(aaa->ptr.pp_complex[offs+j+1+i][offs+j],ajj); + } + } + } + } + } + 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 +*************************************************************************/ +static ae_bool trfac_spdmatrixcholesky2(/* Real */ ae_matrix* aaa, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double ajj; + double v; + double r; + ae_bool result; + + + result = ae_true; + if( n<0 ) + { + result = ae_false; + return result; + } + + /* + * Quick return if possible + */ + if( n==0 ) + { + return result; + } + if( isupper ) + { + + /* + * Compute the Cholesky factorization A = U'*U. + */ + for(j=0; j<=n-1; j++) + { + + /* + * Compute U(J,J) and test for non-positive-definiteness. + */ + v = ae_v_dotproduct(&aaa->ptr.pp_double[offs][offs+j], aaa->stride, &aaa->ptr.pp_double[offs][offs+j], aaa->stride, ae_v_len(offs,offs+j-1)); + ajj = aaa->ptr.pp_double[offs+j][offs+j]-v; + if( ae_fp_less_eq(ajj,0) ) + { + aaa->ptr.pp_double[offs+j][offs+j] = ajj; + result = ae_false; + return result; + } + ajj = ae_sqrt(ajj, _state); + aaa->ptr.pp_double[offs+j][offs+j] = ajj; + + /* + * Compute elements J+1:N-1 of row J. + */ + if( j0 ) + { + ae_v_moveneg(&tmp->ptr.p_double[0], 1, &aaa->ptr.pp_double[offs][offs+j], aaa->stride, ae_v_len(0,j-1)); + rmatrixmv(n-j-1, j, aaa, offs, offs+j+1, 1, tmp, 0, tmp, n, _state); + ae_v_add(&aaa->ptr.pp_double[offs+j][offs+j+1], 1, &tmp->ptr.p_double[n], 1, ae_v_len(offs+j+1,offs+n-1)); + } + r = 1/ajj; + ae_v_muld(&aaa->ptr.pp_double[offs+j][offs+j+1], 1, ae_v_len(offs+j+1,offs+n-1), r); + } + } + } + else + { + + /* + * Compute the Cholesky factorization A = L*L'. + */ + for(j=0; j<=n-1; j++) + { + + /* + * Compute L(J+1,J+1) and test for non-positive-definiteness. + */ + v = ae_v_dotproduct(&aaa->ptr.pp_double[offs+j][offs], 1, &aaa->ptr.pp_double[offs+j][offs], 1, ae_v_len(offs,offs+j-1)); + ajj = aaa->ptr.pp_double[offs+j][offs+j]-v; + if( ae_fp_less_eq(ajj,0) ) + { + aaa->ptr.pp_double[offs+j][offs+j] = ajj; + result = ae_false; + return result; + } + ajj = ae_sqrt(ajj, _state); + aaa->ptr.pp_double[offs+j][offs+j] = ajj; + + /* + * Compute elements J+1:N of column J. + */ + if( j0 ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &aaa->ptr.pp_double[offs+j][offs], 1, ae_v_len(0,j-1)); + rmatrixmv(n-j-1, j, aaa, offs+j+1, offs, 0, tmp, 0, tmp, n, _state); + for(i=0; i<=n-j-2; i++) + { + aaa->ptr.pp_double[offs+j+1+i][offs+j] = (aaa->ptr.pp_double[offs+j+1+i][offs+j]-tmp->ptr.p_double[n+i])/ajj; + } + } + else + { + for(i=0; i<=n-j-2; i++) + { + aaa->ptr.pp_double[offs+j+1+i][offs+j] = aaa->ptr.pp_double[offs+j+1+i][offs+j]/ajj; + } + } + } + } + } + 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 rmatrixrcond1(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_int_t i; + ae_int_t j; + double v; + double nrm; + ae_vector pivots; + ae_vector t; + double result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "RMatrixRCond1: N<1!", _state); + ae_vector_set_length(&t, n, _state); + for(i=0; i<=n-1; i++) + { + t.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state); + } + } + nrm = 0; + for(i=0; i<=n-1; i++) + { + nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); + } + rmatrixlu(a, n, n, &pivots, _state); + rcond_rmatrixrcondluinternal(a, n, ae_true, ae_true, nrm, &v, _state); + result = v; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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 rmatrixrcondinf(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_int_t i; + ae_int_t j; + double v; + double nrm; + ae_vector pivots; + double result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "RMatrixRCondInf: N<1!", _state); + nrm = 0; + for(i=0; i<=n-1; i++) + { + v = 0; + for(j=0; j<=n-1; j++) + { + v = v+ae_fabs(a->ptr.pp_double[i][j], _state); + } + nrm = ae_maxreal(nrm, v, _state); + } + rmatrixlu(a, n, n, &pivots, _state); + rcond_rmatrixrcondluinternal(a, n, ae_false, ae_true, nrm, &v, _state); + result = v; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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 spdmatrixrcond(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + double v; + double nrm; + ae_vector t; + double result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&t, n, _state); + for(i=0; i<=n-1; i++) + { + t.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + if( i==j ) + { + t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][i], _state); + } + else + { + t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][j], _state); + t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state); + } + } + } + nrm = 0; + for(i=0; i<=n-1; i++) + { + nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); + } + if( spdmatrixcholesky(a, n, isupper, _state) ) + { + rcond_spdmatrixrcondcholeskyinternal(a, n, isupper, ae_true, nrm, &v, _state); + result = v; + } + else + { + result = -1; + } + ae_frame_leave(_state); + 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 rmatrixtrrcond1(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double v; + double nrm; + ae_vector pivots; + ae_vector t; + ae_int_t j1; + ae_int_t j2; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "RMatrixTRRCond1: N<1!", _state); + ae_vector_set_length(&t, n, _state); + for(i=0; i<=n-1; i++) + { + t.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i+1; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i-1; + } + for(j=j1; j<=j2; j++) + { + t.ptr.p_double[j] = t.ptr.p_double[j]+ae_fabs(a->ptr.pp_double[i][j], _state); + } + if( isunit ) + { + t.ptr.p_double[i] = t.ptr.p_double[i]+1; + } + else + { + t.ptr.p_double[i] = t.ptr.p_double[i]+ae_fabs(a->ptr.pp_double[i][i], _state); + } + } + nrm = 0; + for(i=0; i<=n-1; i++) + { + nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); + } + rcond_rmatrixrcondtrinternal(a, n, isupper, isunit, ae_true, nrm, &v, _state); + result = v; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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 rmatrixtrrcondinf(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double v; + double nrm; + ae_vector pivots; + ae_int_t j1; + ae_int_t j2; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "RMatrixTRRCondInf: N<1!", _state); + nrm = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i+1; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i-1; + } + v = 0; + for(j=j1; j<=j2; j++) + { + v = v+ae_fabs(a->ptr.pp_double[i][j], _state); + } + if( isunit ) + { + v = v+1; + } + else + { + v = v+ae_fabs(a->ptr.pp_double[i][i], _state); + } + nrm = ae_maxreal(nrm, v, _state); + } + rcond_rmatrixrcondtrinternal(a, n, isupper, isunit, ae_false, nrm, &v, _state); + result = v; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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 hpdmatrixrcond(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + double v; + double nrm; + ae_vector t; + double result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&t, n, _state); + for(i=0; i<=n-1; i++) + { + t.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + if( i==j ) + { + t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][i], _state); + } + else + { + t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][j], _state); + t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state); + } + } + } + nrm = 0; + for(i=0; i<=n-1; i++) + { + nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); + } + if( hpdmatrixcholesky(a, n, isupper, _state) ) + { + rcond_hpdmatrixrcondcholeskyinternal(a, n, isupper, ae_true, nrm, &v, _state); + result = v; + } + else + { + result = -1; + } + ae_frame_leave(_state); + 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 cmatrixrcond1(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_int_t i; + ae_int_t j; + double v; + double nrm; + ae_vector pivots; + ae_vector t; + double result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "CMatrixRCond1: N<1!", _state); + ae_vector_set_length(&t, n, _state); + for(i=0; i<=n-1; i++) + { + t.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state); + } + } + nrm = 0; + for(i=0; i<=n-1; i++) + { + nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); + } + cmatrixlu(a, n, n, &pivots, _state); + rcond_cmatrixrcondluinternal(a, n, ae_true, ae_true, nrm, &v, _state); + result = v; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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 cmatrixrcondinf(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_int_t i; + ae_int_t j; + double v; + double nrm; + ae_vector pivots; + double result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "CMatrixRCondInf: N<1!", _state); + nrm = 0; + for(i=0; i<=n-1; i++) + { + v = 0; + for(j=0; j<=n-1; j++) + { + v = v+ae_c_abs(a->ptr.pp_complex[i][j], _state); + } + nrm = ae_maxreal(nrm, v, _state); + } + cmatrixlu(a, n, n, &pivots, _state); + rcond_cmatrixrcondluinternal(a, n, ae_false, ae_true, nrm, &v, _state); + result = v; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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 rmatrixlurcond1(/* Real */ ae_matrix* lua, + ae_int_t n, + ae_state *_state) +{ + double v; + double result; + + + rcond_rmatrixrcondluinternal(lua, n, ae_true, ae_false, 0, &v, _state); + result = v; + return result; +} + + +/************************************************************************* +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 rmatrixlurcondinf(/* Real */ ae_matrix* lua, + ae_int_t n, + ae_state *_state) +{ + double v; + double result; + + + rcond_rmatrixrcondluinternal(lua, n, ae_false, ae_false, 0, &v, _state); + result = v; + return result; +} + + +/************************************************************************* +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 spdmatrixcholeskyrcond(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + double v; + double result; + + + rcond_spdmatrixrcondcholeskyinternal(a, n, isupper, ae_false, 0, &v, _state); + result = v; + return result; +} + + +/************************************************************************* +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 hpdmatrixcholeskyrcond(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + double v; + double result; + + + rcond_hpdmatrixrcondcholeskyinternal(a, n, isupper, ae_false, 0, &v, _state); + result = v; + return result; +} + + +/************************************************************************* +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 cmatrixlurcond1(/* Complex */ ae_matrix* lua, + ae_int_t n, + ae_state *_state) +{ + double v; + double result; + + + ae_assert(n>=1, "CMatrixLURCond1: N<1!", _state); + rcond_cmatrixrcondluinternal(lua, n, ae_true, ae_false, 0.0, &v, _state); + result = v; + return result; +} + + +/************************************************************************* +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 cmatrixlurcondinf(/* Complex */ ae_matrix* lua, + ae_int_t n, + ae_state *_state) +{ + double v; + double result; + + + ae_assert(n>=1, "CMatrixLURCondInf: N<1!", _state); + rcond_cmatrixrcondluinternal(lua, n, ae_false, ae_false, 0.0, &v, _state); + result = v; + 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 cmatrixtrrcond1(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double v; + double nrm; + ae_vector pivots; + ae_vector t; + ae_int_t j1; + ae_int_t j2; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=1, "RMatrixTRRCond1: N<1!", _state); + ae_vector_set_length(&t, n, _state); + for(i=0; i<=n-1; i++) + { + t.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i+1; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i-1; + } + for(j=j1; j<=j2; j++) + { + t.ptr.p_double[j] = t.ptr.p_double[j]+ae_c_abs(a->ptr.pp_complex[i][j], _state); + } + if( isunit ) + { + t.ptr.p_double[i] = t.ptr.p_double[i]+1; + } + else + { + t.ptr.p_double[i] = t.ptr.p_double[i]+ae_c_abs(a->ptr.pp_complex[i][i], _state); + } + } + nrm = 0; + for(i=0; i<=n-1; i++) + { + nrm = ae_maxreal(nrm, t.ptr.p_double[i], _state); + } + rcond_cmatrixrcondtrinternal(a, n, isupper, isunit, ae_true, nrm, &v, _state); + result = v; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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 cmatrixtrrcondinf(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double v; + double nrm; + ae_vector pivots; + ae_int_t j1; + ae_int_t j2; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "RMatrixTRRCondInf: N<1!", _state); + nrm = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i+1; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i-1; + } + v = 0; + for(j=j1; j<=j2; j++) + { + v = v+ae_c_abs(a->ptr.pp_complex[i][j], _state); + } + if( isunit ) + { + v = v+1; + } + else + { + v = v+ae_c_abs(a->ptr.pp_complex[i][i], _state); + } + nrm = ae_maxreal(nrm, v, _state); + } + rcond_cmatrixrcondtrinternal(a, n, isupper, isunit, ae_false, nrm, &v, _state); + result = v; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +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 rcondthreshold(ae_state *_state) +{ + double result; + + + result = ae_sqrt(ae_sqrt(ae_minrealnumber, _state), _state); + return result; +} + + +/************************************************************************* +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 +*************************************************************************/ +static void rcond_rmatrixrcondtrinternal(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_bool onenorm, + double anorm, + double* rc, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector ex; + ae_vector ev; + ae_vector iwork; + ae_vector tmp; + ae_int_t i; + ae_int_t j; + ae_int_t kase; + ae_int_t kase1; + ae_int_t j1; + ae_int_t j2; + double ainvnm; + double maxgrowth; + double s; + + ae_frame_make(_state, &_frame_block); + *rc = 0; + ae_vector_init(&ex, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ev, 0, DT_REAL, _state, ae_true); + ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + + /* + * RC=0 if something happens + */ + *rc = 0; + + /* + * init + */ + if( onenorm ) + { + kase1 = 1; + } + else + { + kase1 = 2; + } + ae_vector_set_length(&iwork, n+1, _state); + ae_vector_set_length(&tmp, n, _state); + + /* + * prepare parameters for triangular solver + */ + maxgrowth = 1/rcondthreshold(_state); + s = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i+1; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i-1; + } + for(j=j1; j<=j2; j++) + { + s = ae_maxreal(s, ae_fabs(a->ptr.pp_double[i][j], _state), _state); + } + if( isunit ) + { + s = ae_maxreal(s, 1, _state); + } + else + { + s = ae_maxreal(s, ae_fabs(a->ptr.pp_double[i][i], _state), _state); + } + } + if( ae_fp_eq(s,0) ) + { + s = 1; + } + s = 1/s; + + /* + * Scale according to S + */ + anorm = anorm*s; + + /* + * Quick return if possible + * We assume that ANORM<>0 after this block + */ + if( ae_fp_eq(anorm,0) ) + { + ae_frame_leave(_state); + return; + } + if( n==1 ) + { + *rc = 1; + ae_frame_leave(_state); + return; + } + + /* + * Estimate the norm of inv(A). + */ + ainvnm = 0; + kase = 0; + for(;;) + { + rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state); + if( kase==0 ) + { + break; + } + + /* + * from 1-based array to 0-based + */ + for(i=0; i<=n-1; i++) + { + ex.ptr.p_double[i] = ex.ptr.p_double[i+1]; + } + + /* + * multiply by inv(A) or inv(A') + */ + if( kase==kase1 ) + { + + /* + * multiply by inv(A) + */ + if( !rmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 0, isunit, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + else + { + + /* + * multiply by inv(A') + */ + if( !rmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 1, isunit, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + + /* + * from 0-based array to 1-based + */ + for(i=n-1; i>=0; i--) + { + ex.ptr.p_double[i+1] = ex.ptr.p_double[i]; + } + } + + /* + * Compute the estimate of the reciprocal condition number. + */ + if( ae_fp_neq(ainvnm,0) ) + { + *rc = 1/ainvnm; + *rc = *rc/anorm; + if( ae_fp_less(*rc,rcondthreshold(_state)) ) + { + *rc = 0; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 +*************************************************************************/ +static void rcond_cmatrixrcondtrinternal(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_bool onenorm, + double anorm, + double* rc, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector ex; + ae_vector cwork2; + ae_vector cwork3; + ae_vector cwork4; + ae_vector isave; + ae_vector rsave; + ae_int_t kase; + ae_int_t kase1; + double ainvnm; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + double s; + double maxgrowth; + + ae_frame_make(_state, &_frame_block); + *rc = 0; + ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&cwork2, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&cwork3, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&cwork4, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&isave, 0, DT_INT, _state, ae_true); + ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true); + + + /* + * RC=0 if something happens + */ + *rc = 0; + + /* + * init + */ + if( n<=0 ) + { + ae_frame_leave(_state); + return; + } + if( n==0 ) + { + *rc = 1; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&cwork2, n+1, _state); + + /* + * prepare parameters for triangular solver + */ + maxgrowth = 1/rcondthreshold(_state); + s = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i+1; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i-1; + } + for(j=j1; j<=j2; j++) + { + s = ae_maxreal(s, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); + } + if( isunit ) + { + s = ae_maxreal(s, 1, _state); + } + else + { + s = ae_maxreal(s, ae_c_abs(a->ptr.pp_complex[i][i], _state), _state); + } + } + if( ae_fp_eq(s,0) ) + { + s = 1; + } + s = 1/s; + + /* + * Scale according to S + */ + anorm = anorm*s; + + /* + * Quick return if possible + */ + if( ae_fp_eq(anorm,0) ) + { + ae_frame_leave(_state); + return; + } + + /* + * Estimate the norm of inv(A). + */ + ainvnm = 0; + if( onenorm ) + { + kase1 = 1; + } + else + { + kase1 = 2; + } + kase = 0; + for(;;) + { + rcond_cmatrixestimatenorm(n, &cwork4, &ex, &ainvnm, &kase, &isave, &rsave, _state); + if( kase==0 ) + { + break; + } + + /* + * From 1-based to 0-based + */ + for(i=0; i<=n-1; i++) + { + ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1]; + } + + /* + * multiply by inv(A) or inv(A') + */ + if( kase==kase1 ) + { + + /* + * multiply by inv(A) + */ + if( !cmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 0, isunit, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + else + { + + /* + * multiply by inv(A') + */ + if( !cmatrixscaledtrsafesolve(a, s, n, &ex, isupper, 2, isunit, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + + /* + * from 0-based to 1-based + */ + for(i=n-1; i>=0; i--) + { + ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i]; + } + } + + /* + * Compute the estimate of the reciprocal condition number. + */ + if( ae_fp_neq(ainvnm,0) ) + { + *rc = 1/ainvnm; + *rc = *rc/anorm; + if( ae_fp_less(*rc,rcondthreshold(_state)) ) + { + *rc = 0; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 +*************************************************************************/ +static void rcond_spdmatrixrcondcholeskyinternal(/* Real */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + ae_bool isnormprovided, + double anorm, + double* rc, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t kase; + double ainvnm; + ae_vector ex; + ae_vector ev; + ae_vector tmp; + ae_vector iwork; + double sa; + double v; + double maxgrowth; + + ae_frame_make(_state, &_frame_block); + *rc = 0; + ae_vector_init(&ex, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ev, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "Assertion failed", _state); + ae_vector_set_length(&tmp, n, _state); + + /* + * RC=0 if something happens + */ + *rc = 0; + + /* + * prepare parameters for triangular solver + */ + maxgrowth = 1/rcondthreshold(_state); + sa = 0; + if( isupper ) + { + for(i=0; i<=n-1; i++) + { + for(j=i; j<=n-1; j++) + { + sa = ae_maxreal(sa, ae_c_abs(ae_complex_from_d(cha->ptr.pp_double[i][j]), _state), _state); + } + } + } + else + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i; j++) + { + sa = ae_maxreal(sa, ae_c_abs(ae_complex_from_d(cha->ptr.pp_double[i][j]), _state), _state); + } + } + } + if( ae_fp_eq(sa,0) ) + { + sa = 1; + } + sa = 1/sa; + + /* + * Estimate the norm of A. + */ + if( !isnormprovided ) + { + kase = 0; + anorm = 0; + for(;;) + { + rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &anorm, &kase, _state); + if( kase==0 ) + { + break; + } + if( isupper ) + { + + /* + * Multiply by U + */ + for(i=1; i<=n; i++) + { + v = ae_v_dotproduct(&cha->ptr.pp_double[i-1][i-1], 1, &ex.ptr.p_double[i], 1, ae_v_len(i-1,n-1)); + ex.ptr.p_double[i] = v; + } + ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa); + + /* + * Multiply by U' + */ + for(i=0; i<=n-1; i++) + { + tmp.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + v = ex.ptr.p_double[i+1]; + ae_v_addd(&tmp.ptr.p_double[i], 1, &cha->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v); + } + ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n)); + ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa); + } + else + { + + /* + * Multiply by L' + */ + for(i=0; i<=n-1; i++) + { + tmp.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + v = ex.ptr.p_double[i+1]; + ae_v_addd(&tmp.ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i), v); + } + ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n)); + ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa); + + /* + * Multiply by L + */ + for(i=n; i>=1; i--) + { + v = ae_v_dotproduct(&cha->ptr.pp_double[i-1][0], 1, &ex.ptr.p_double[1], 1, ae_v_len(0,i-1)); + ex.ptr.p_double[i] = v; + } + ae_v_muld(&ex.ptr.p_double[1], 1, ae_v_len(1,n), sa); + } + } + } + + /* + * Quick return if possible + */ + if( ae_fp_eq(anorm,0) ) + { + ae_frame_leave(_state); + return; + } + if( n==1 ) + { + *rc = 1; + ae_frame_leave(_state); + return; + } + + /* + * Estimate the 1-norm of inv(A). + */ + kase = 0; + for(;;) + { + rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state); + if( kase==0 ) + { + break; + } + for(i=0; i<=n-1; i++) + { + ex.ptr.p_double[i] = ex.ptr.p_double[i+1]; + } + if( isupper ) + { + + /* + * Multiply by inv(U'). + */ + if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 1, ae_false, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + + /* + * Multiply by inv(U). + */ + if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + else + { + + /* + * Multiply by inv(L). + */ + if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + + /* + * Multiply by inv(L'). + */ + if( !rmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 1, ae_false, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + for(i=n-1; i>=0; i--) + { + ex.ptr.p_double[i+1] = ex.ptr.p_double[i]; + } + } + + /* + * Compute the estimate of the reciprocal condition number. + */ + if( ae_fp_neq(ainvnm,0) ) + { + v = 1/ainvnm; + *rc = v/anorm; + if( ae_fp_less(*rc,rcondthreshold(_state)) ) + { + *rc = 0; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 +*************************************************************************/ +static void rcond_hpdmatrixrcondcholeskyinternal(/* Complex */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + ae_bool isnormprovided, + double anorm, + double* rc, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector isave; + ae_vector rsave; + ae_vector ex; + ae_vector ev; + ae_vector tmp; + ae_int_t kase; + double ainvnm; + ae_complex v; + ae_int_t i; + ae_int_t j; + double sa; + double maxgrowth; + + ae_frame_make(_state, &_frame_block); + *rc = 0; + ae_vector_init(&isave, 0, DT_INT, _state, ae_true); + ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&ev, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(n>=1, "Assertion failed", _state); + ae_vector_set_length(&tmp, n, _state); + + /* + * RC=0 if something happens + */ + *rc = 0; + + /* + * prepare parameters for triangular solver + */ + maxgrowth = 1/rcondthreshold(_state); + sa = 0; + if( isupper ) + { + for(i=0; i<=n-1; i++) + { + for(j=i; j<=n-1; j++) + { + sa = ae_maxreal(sa, ae_c_abs(cha->ptr.pp_complex[i][j], _state), _state); + } + } + } + else + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i; j++) + { + sa = ae_maxreal(sa, ae_c_abs(cha->ptr.pp_complex[i][j], _state), _state); + } + } + } + if( ae_fp_eq(sa,0) ) + { + sa = 1; + } + sa = 1/sa; + + /* + * Estimate the norm of A + */ + if( !isnormprovided ) + { + anorm = 0; + kase = 0; + for(;;) + { + rcond_cmatrixestimatenorm(n, &ev, &ex, &anorm, &kase, &isave, &rsave, _state); + if( kase==0 ) + { + break; + } + if( isupper ) + { + + /* + * Multiply by U + */ + for(i=1; i<=n; i++) + { + v = ae_v_cdotproduct(&cha->ptr.pp_complex[i-1][i-1], 1, "N", &ex.ptr.p_complex[i], 1, "N", ae_v_len(i-1,n-1)); + ex.ptr.p_complex[i] = v; + } + ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa); + + /* + * Multiply by U' + */ + for(i=0; i<=n-1; i++) + { + tmp.ptr.p_complex[i] = ae_complex_from_d(0); + } + for(i=0; i<=n-1; i++) + { + v = ex.ptr.p_complex[i+1]; + ae_v_caddc(&tmp.ptr.p_complex[i], 1, &cha->ptr.pp_complex[i][i], 1, "Conj", ae_v_len(i,n-1), v); + } + ae_v_cmove(&ex.ptr.p_complex[1], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(1,n)); + ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa); + } + else + { + + /* + * Multiply by L' + */ + for(i=0; i<=n-1; i++) + { + tmp.ptr.p_complex[i] = ae_complex_from_d(0); + } + for(i=0; i<=n-1; i++) + { + v = ex.ptr.p_complex[i+1]; + ae_v_caddc(&tmp.ptr.p_complex[0], 1, &cha->ptr.pp_complex[i][0], 1, "Conj", ae_v_len(0,i), v); + } + ae_v_cmove(&ex.ptr.p_complex[1], 1, &tmp.ptr.p_complex[0], 1, "N", ae_v_len(1,n)); + ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa); + + /* + * Multiply by L + */ + for(i=n; i>=1; i--) + { + v = ae_v_cdotproduct(&cha->ptr.pp_complex[i-1][0], 1, "N", &ex.ptr.p_complex[1], 1, "N", ae_v_len(0,i-1)); + ex.ptr.p_complex[i] = v; + } + ae_v_cmuld(&ex.ptr.p_complex[1], 1, ae_v_len(1,n), sa); + } + } + } + + /* + * Quick return if possible + * After this block we assume that ANORM<>0 + */ + if( ae_fp_eq(anorm,0) ) + { + ae_frame_leave(_state); + return; + } + if( n==1 ) + { + *rc = 1; + ae_frame_leave(_state); + return; + } + + /* + * Estimate the norm of inv(A). + */ + ainvnm = 0; + kase = 0; + for(;;) + { + rcond_cmatrixestimatenorm(n, &ev, &ex, &ainvnm, &kase, &isave, &rsave, _state); + if( kase==0 ) + { + break; + } + for(i=0; i<=n-1; i++) + { + ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1]; + } + if( isupper ) + { + + /* + * Multiply by inv(U'). + */ + if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 2, ae_false, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + + /* + * Multiply by inv(U). + */ + if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + else + { + + /* + * Multiply by inv(L). + */ + if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 0, ae_false, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + + /* + * Multiply by inv(L'). + */ + if( !cmatrixscaledtrsafesolve(cha, sa, n, &ex, isupper, 2, ae_false, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + for(i=n-1; i>=0; i--) + { + ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i]; + } + } + + /* + * Compute the estimate of the reciprocal condition number. + */ + if( ae_fp_neq(ainvnm,0) ) + { + *rc = 1/ainvnm; + *rc = *rc/anorm; + if( ae_fp_less(*rc,rcondthreshold(_state)) ) + { + *rc = 0; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 +*************************************************************************/ +static void rcond_rmatrixrcondluinternal(/* Real */ ae_matrix* lua, + ae_int_t n, + ae_bool onenorm, + ae_bool isanormprovided, + double anorm, + double* rc, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector ex; + ae_vector ev; + ae_vector iwork; + ae_vector tmp; + double v; + ae_int_t i; + ae_int_t j; + ae_int_t kase; + ae_int_t kase1; + double ainvnm; + double maxgrowth; + double su; + double sl; + ae_bool mupper; + ae_bool munit; + + ae_frame_make(_state, &_frame_block); + *rc = 0; + ae_vector_init(&ex, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ev, 0, DT_REAL, _state, ae_true); + ae_vector_init(&iwork, 0, DT_INT, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + + /* + * RC=0 if something happens + */ + *rc = 0; + + /* + * init + */ + if( onenorm ) + { + kase1 = 1; + } + else + { + kase1 = 2; + } + mupper = ae_true; + munit = ae_true; + ae_vector_set_length(&iwork, n+1, _state); + ae_vector_set_length(&tmp, n, _state); + + /* + * prepare parameters for triangular solver + */ + maxgrowth = 1/rcondthreshold(_state); + su = 0; + sl = 1; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i-1; j++) + { + sl = ae_maxreal(sl, ae_fabs(lua->ptr.pp_double[i][j], _state), _state); + } + for(j=i; j<=n-1; j++) + { + su = ae_maxreal(su, ae_fabs(lua->ptr.pp_double[i][j], _state), _state); + } + } + if( ae_fp_eq(su,0) ) + { + su = 1; + } + su = 1/su; + sl = 1/sl; + + /* + * Estimate the norm of A. + */ + if( !isanormprovided ) + { + kase = 0; + anorm = 0; + for(;;) + { + rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &anorm, &kase, _state); + if( kase==0 ) + { + break; + } + if( kase==kase1 ) + { + + /* + * Multiply by U + */ + for(i=1; i<=n; i++) + { + v = ae_v_dotproduct(&lua->ptr.pp_double[i-1][i-1], 1, &ex.ptr.p_double[i], 1, ae_v_len(i-1,n-1)); + ex.ptr.p_double[i] = v; + } + + /* + * Multiply by L + */ + for(i=n; i>=1; i--) + { + if( i>1 ) + { + v = ae_v_dotproduct(&lua->ptr.pp_double[i-1][0], 1, &ex.ptr.p_double[1], 1, ae_v_len(0,i-2)); + } + else + { + v = 0; + } + ex.ptr.p_double[i] = ex.ptr.p_double[i]+v; + } + } + else + { + + /* + * Multiply by L' + */ + for(i=0; i<=n-1; i++) + { + tmp.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + v = ex.ptr.p_double[i+1]; + if( i>=1 ) + { + ae_v_addd(&tmp.ptr.p_double[0], 1, &lua->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), v); + } + tmp.ptr.p_double[i] = tmp.ptr.p_double[i]+v; + } + ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n)); + + /* + * Multiply by U' + */ + for(i=0; i<=n-1; i++) + { + tmp.ptr.p_double[i] = 0; + } + for(i=0; i<=n-1; i++) + { + v = ex.ptr.p_double[i+1]; + ae_v_addd(&tmp.ptr.p_double[i], 1, &lua->ptr.pp_double[i][i], 1, ae_v_len(i,n-1), v); + } + ae_v_move(&ex.ptr.p_double[1], 1, &tmp.ptr.p_double[0], 1, ae_v_len(1,n)); + } + } + } + + /* + * Scale according to SU/SL + */ + anorm = anorm*su*sl; + + /* + * Quick return if possible + * We assume that ANORM<>0 after this block + */ + if( ae_fp_eq(anorm,0) ) + { + ae_frame_leave(_state); + return; + } + if( n==1 ) + { + *rc = 1; + ae_frame_leave(_state); + return; + } + + /* + * Estimate the norm of inv(A). + */ + ainvnm = 0; + kase = 0; + for(;;) + { + rcond_rmatrixestimatenorm(n, &ev, &ex, &iwork, &ainvnm, &kase, _state); + if( kase==0 ) + { + break; + } + + /* + * from 1-based array to 0-based + */ + for(i=0; i<=n-1; i++) + { + ex.ptr.p_double[i] = ex.ptr.p_double[i+1]; + } + + /* + * multiply by inv(A) or inv(A') + */ + if( kase==kase1 ) + { + + /* + * Multiply by inv(L). + */ + if( !rmatrixscaledtrsafesolve(lua, sl, n, &ex, !mupper, 0, munit, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + + /* + * Multiply by inv(U). + */ + if( !rmatrixscaledtrsafesolve(lua, su, n, &ex, mupper, 0, !munit, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + else + { + + /* + * Multiply by inv(U'). + */ + if( !rmatrixscaledtrsafesolve(lua, su, n, &ex, mupper, 1, !munit, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + + /* + * Multiply by inv(L'). + */ + if( !rmatrixscaledtrsafesolve(lua, sl, n, &ex, !mupper, 1, munit, maxgrowth, _state) ) + { + ae_frame_leave(_state); + return; + } + } + + /* + * from 0-based array to 1-based + */ + for(i=n-1; i>=0; i--) + { + ex.ptr.p_double[i+1] = ex.ptr.p_double[i]; + } + } + + /* + * Compute the estimate of the reciprocal condition number. + */ + if( ae_fp_neq(ainvnm,0) ) + { + *rc = 1/ainvnm; + *rc = *rc/anorm; + if( ae_fp_less(*rc,rcondthreshold(_state)) ) + { + *rc = 0; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 +*************************************************************************/ +static void rcond_cmatrixrcondluinternal(/* Complex */ ae_matrix* lua, + ae_int_t n, + ae_bool onenorm, + ae_bool isanormprovided, + double anorm, + double* rc, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector ex; + ae_vector cwork2; + ae_vector cwork3; + ae_vector cwork4; + ae_vector isave; + ae_vector rsave; + ae_int_t kase; + ae_int_t kase1; + double ainvnm; + ae_complex v; + ae_int_t i; + ae_int_t j; + double su; + double sl; + double maxgrowth; + + ae_frame_make(_state, &_frame_block); + *rc = 0; + ae_vector_init(&ex, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&cwork2, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&cwork3, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&cwork4, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&isave, 0, DT_INT, _state, ae_true); + ae_vector_init(&rsave, 0, DT_REAL, _state, ae_true); + + if( n<=0 ) + { + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&cwork2, n+1, _state); + *rc = 0; + if( n==0 ) + { + *rc = 1; + ae_frame_leave(_state); + return; + } + + /* + * prepare parameters for triangular solver + */ + maxgrowth = 1/rcondthreshold(_state); + su = 0; + sl = 1; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i-1; j++) + { + sl = ae_maxreal(sl, ae_c_abs(lua->ptr.pp_complex[i][j], _state), _state); + } + for(j=i; j<=n-1; j++) + { + su = ae_maxreal(su, ae_c_abs(lua->ptr.pp_complex[i][j], _state), _state); + } + } + if( ae_fp_eq(su,0) ) + { + su = 1; + } + su = 1/su; + sl = 1/sl; + + /* + * Estimate the norm of SU*SL*A. + */ + if( !isanormprovided ) + { + anorm = 0; + if( onenorm ) + { + kase1 = 1; + } + else + { + kase1 = 2; + } + kase = 0; + do + { + rcond_cmatrixestimatenorm(n, &cwork4, &ex, &anorm, &kase, &isave, &rsave, _state); + if( kase!=0 ) + { + if( kase==kase1 ) + { + + /* + * Multiply by U + */ + for(i=1; i<=n; i++) + { + v = ae_v_cdotproduct(&lua->ptr.pp_complex[i-1][i-1], 1, "N", &ex.ptr.p_complex[i], 1, "N", ae_v_len(i-1,n-1)); + ex.ptr.p_complex[i] = v; + } + + /* + * Multiply by L + */ + for(i=n; i>=1; i--) + { + v = ae_complex_from_d(0); + if( i>1 ) + { + v = ae_v_cdotproduct(&lua->ptr.pp_complex[i-1][0], 1, "N", &ex.ptr.p_complex[1], 1, "N", ae_v_len(0,i-2)); + } + ex.ptr.p_complex[i] = ae_c_add(v,ex.ptr.p_complex[i]); + } + } + else + { + + /* + * Multiply by L' + */ + for(i=1; i<=n; i++) + { + cwork2.ptr.p_complex[i] = ae_complex_from_d(0); + } + for(i=1; i<=n; i++) + { + v = ex.ptr.p_complex[i]; + if( i>1 ) + { + ae_v_caddc(&cwork2.ptr.p_complex[1], 1, &lua->ptr.pp_complex[i-1][0], 1, "Conj", ae_v_len(1,i-1), v); + } + cwork2.ptr.p_complex[i] = ae_c_add(cwork2.ptr.p_complex[i],v); + } + + /* + * Multiply by U' + */ + for(i=1; i<=n; i++) + { + ex.ptr.p_complex[i] = ae_complex_from_d(0); + } + for(i=1; i<=n; i++) + { + v = cwork2.ptr.p_complex[i]; + ae_v_caddc(&ex.ptr.p_complex[i], 1, &lua->ptr.pp_complex[i-1][i-1], 1, "Conj", ae_v_len(i,n), v); + } + } + } + } + while(kase!=0); + } + + /* + * Scale according to SU/SL + */ + anorm = anorm*su*sl; + + /* + * Quick return if possible + */ + if( ae_fp_eq(anorm,0) ) + { + ae_frame_leave(_state); + return; + } + + /* + * Estimate the norm of inv(A). + */ + ainvnm = 0; + if( onenorm ) + { + kase1 = 1; + } + else + { + kase1 = 2; + } + kase = 0; + for(;;) + { + rcond_cmatrixestimatenorm(n, &cwork4, &ex, &ainvnm, &kase, &isave, &rsave, _state); + if( kase==0 ) + { + break; + } + + /* + * From 1-based to 0-based + */ + for(i=0; i<=n-1; i++) + { + ex.ptr.p_complex[i] = ex.ptr.p_complex[i+1]; + } + + /* + * multiply by inv(A) or inv(A') + */ + if( kase==kase1 ) + { + + /* + * Multiply by inv(L). + */ + if( !cmatrixscaledtrsafesolve(lua, sl, n, &ex, ae_false, 0, ae_true, maxgrowth, _state) ) + { + *rc = 0; + ae_frame_leave(_state); + return; + } + + /* + * Multiply by inv(U). + */ + if( !cmatrixscaledtrsafesolve(lua, su, n, &ex, ae_true, 0, ae_false, maxgrowth, _state) ) + { + *rc = 0; + ae_frame_leave(_state); + return; + } + } + else + { + + /* + * Multiply by inv(U'). + */ + if( !cmatrixscaledtrsafesolve(lua, su, n, &ex, ae_true, 2, ae_false, maxgrowth, _state) ) + { + *rc = 0; + ae_frame_leave(_state); + return; + } + + /* + * Multiply by inv(L'). + */ + if( !cmatrixscaledtrsafesolve(lua, sl, n, &ex, ae_false, 2, ae_true, maxgrowth, _state) ) + { + *rc = 0; + ae_frame_leave(_state); + return; + } + } + + /* + * from 0-based to 1-based + */ + for(i=n-1; i>=0; i--) + { + ex.ptr.p_complex[i+1] = ex.ptr.p_complex[i]; + } + } + + /* + * Compute the estimate of the reciprocal condition number. + */ + if( ae_fp_neq(ainvnm,0) ) + { + *rc = 1/ainvnm; + *rc = *rc/anorm; + if( ae_fp_less(*rc,rcondthreshold(_state)) ) + { + *rc = 0; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 +*************************************************************************/ +static void rcond_rmatrixestimatenorm(ae_int_t n, + /* Real */ ae_vector* v, + /* Real */ ae_vector* x, + /* Integer */ ae_vector* isgn, + double* est, + ae_int_t* kase, + ae_state *_state) +{ + ae_int_t itmax; + ae_int_t i; + double t; + ae_bool flg; + ae_int_t positer; + ae_int_t posj; + ae_int_t posjlast; + ae_int_t posjump; + ae_int_t posaltsgn; + ae_int_t posestold; + ae_int_t postemp; + + + itmax = 5; + posaltsgn = n+1; + posestold = n+2; + postemp = n+3; + positer = n+1; + posj = n+2; + posjlast = n+3; + posjump = n+4; + if( *kase==0 ) + { + ae_vector_set_length(v, n+4, _state); + ae_vector_set_length(x, n+1, _state); + ae_vector_set_length(isgn, n+5, _state); + t = (double)1/(double)n; + for(i=1; i<=n; i++) + { + x->ptr.p_double[i] = t; + } + *kase = 1; + isgn->ptr.p_int[posjump] = 1; + return; + } + + /* + * ................ ENTRY (JUMP = 1) + * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. + */ + if( isgn->ptr.p_int[posjump]==1 ) + { + if( n==1 ) + { + v->ptr.p_double[1] = x->ptr.p_double[1]; + *est = ae_fabs(v->ptr.p_double[1], _state); + *kase = 0; + return; + } + *est = 0; + for(i=1; i<=n; i++) + { + *est = *est+ae_fabs(x->ptr.p_double[i], _state); + } + for(i=1; i<=n; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],0) ) + { + x->ptr.p_double[i] = 1; + } + else + { + x->ptr.p_double[i] = -1; + } + isgn->ptr.p_int[i] = ae_sign(x->ptr.p_double[i], _state); + } + *kase = 2; + isgn->ptr.p_int[posjump] = 2; + return; + } + + /* + * ................ ENTRY (JUMP = 2) + * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X. + */ + if( isgn->ptr.p_int[posjump]==2 ) + { + isgn->ptr.p_int[posj] = 1; + for(i=2; i<=n; i++) + { + if( ae_fp_greater(ae_fabs(x->ptr.p_double[i], _state),ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state)) ) + { + isgn->ptr.p_int[posj] = i; + } + } + isgn->ptr.p_int[positer] = 2; + + /* + * MAIN LOOP - ITERATIONS 2,3,...,ITMAX. + */ + for(i=1; i<=n; i++) + { + x->ptr.p_double[i] = 0; + } + x->ptr.p_double[isgn->ptr.p_int[posj]] = 1; + *kase = 1; + isgn->ptr.p_int[posjump] = 3; + return; + } + + /* + * ................ ENTRY (JUMP = 3) + * X HAS BEEN OVERWRITTEN BY A*X. + */ + if( isgn->ptr.p_int[posjump]==3 ) + { + ae_v_move(&v->ptr.p_double[1], 1, &x->ptr.p_double[1], 1, ae_v_len(1,n)); + v->ptr.p_double[posestold] = *est; + *est = 0; + for(i=1; i<=n; i++) + { + *est = *est+ae_fabs(v->ptr.p_double[i], _state); + } + flg = ae_false; + for(i=1; i<=n; i++) + { + if( (ae_fp_greater_eq(x->ptr.p_double[i],0)&&isgn->ptr.p_int[i]<0)||(ae_fp_less(x->ptr.p_double[i],0)&&isgn->ptr.p_int[i]>=0) ) + { + flg = ae_true; + } + } + + /* + * REPEATED SIGN VECTOR DETECTED, HENCE ALGORITHM HAS CONVERGED. + * OR MAY BE CYCLING. + */ + if( !flg||ae_fp_less_eq(*est,v->ptr.p_double[posestold]) ) + { + v->ptr.p_double[posaltsgn] = 1; + for(i=1; i<=n; i++) + { + x->ptr.p_double[i] = v->ptr.p_double[posaltsgn]*(1+(double)(i-1)/(double)(n-1)); + v->ptr.p_double[posaltsgn] = -v->ptr.p_double[posaltsgn]; + } + *kase = 1; + isgn->ptr.p_int[posjump] = 5; + return; + } + for(i=1; i<=n; i++) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],0) ) + { + x->ptr.p_double[i] = 1; + isgn->ptr.p_int[i] = 1; + } + else + { + x->ptr.p_double[i] = -1; + isgn->ptr.p_int[i] = -1; + } + } + *kase = 2; + isgn->ptr.p_int[posjump] = 4; + return; + } + + /* + * ................ ENTRY (JUMP = 4) + * X HAS BEEN OVERWRITTEN BY TRANDPOSE(A)*X. + */ + if( isgn->ptr.p_int[posjump]==4 ) + { + isgn->ptr.p_int[posjlast] = isgn->ptr.p_int[posj]; + isgn->ptr.p_int[posj] = 1; + for(i=2; i<=n; i++) + { + if( ae_fp_greater(ae_fabs(x->ptr.p_double[i], _state),ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state)) ) + { + isgn->ptr.p_int[posj] = i; + } + } + if( ae_fp_neq(x->ptr.p_double[isgn->ptr.p_int[posjlast]],ae_fabs(x->ptr.p_double[isgn->ptr.p_int[posj]], _state))&&isgn->ptr.p_int[positer]ptr.p_int[positer] = isgn->ptr.p_int[positer]+1; + for(i=1; i<=n; i++) + { + x->ptr.p_double[i] = 0; + } + x->ptr.p_double[isgn->ptr.p_int[posj]] = 1; + *kase = 1; + isgn->ptr.p_int[posjump] = 3; + return; + } + + /* + * ITERATION COMPLETE. FINAL STAGE. + */ + v->ptr.p_double[posaltsgn] = 1; + for(i=1; i<=n; i++) + { + x->ptr.p_double[i] = v->ptr.p_double[posaltsgn]*(1+(double)(i-1)/(double)(n-1)); + v->ptr.p_double[posaltsgn] = -v->ptr.p_double[posaltsgn]; + } + *kase = 1; + isgn->ptr.p_int[posjump] = 5; + return; + } + + /* + * ................ ENTRY (JUMP = 5) + * X HAS BEEN OVERWRITTEN BY A*X. + */ + if( isgn->ptr.p_int[posjump]==5 ) + { + v->ptr.p_double[postemp] = 0; + for(i=1; i<=n; i++) + { + v->ptr.p_double[postemp] = v->ptr.p_double[postemp]+ae_fabs(x->ptr.p_double[i], _state); + } + v->ptr.p_double[postemp] = 2*v->ptr.p_double[postemp]/(3*n); + if( ae_fp_greater(v->ptr.p_double[postemp],*est) ) + { + ae_v_move(&v->ptr.p_double[1], 1, &x->ptr.p_double[1], 1, ae_v_len(1,n)); + *est = v->ptr.p_double[postemp]; + } + *kase = 0; + return; + } +} + + +static void rcond_cmatrixestimatenorm(ae_int_t n, + /* Complex */ ae_vector* v, + /* Complex */ ae_vector* x, + double* est, + ae_int_t* kase, + /* Integer */ ae_vector* isave, + /* Real */ ae_vector* rsave, + ae_state *_state) +{ + ae_int_t itmax; + ae_int_t i; + ae_int_t iter; + ae_int_t j; + ae_int_t jlast; + ae_int_t jump; + double absxi; + double altsgn; + double estold; + double safmin; + double temp; + + + + /* + *Executable Statements .. + */ + itmax = 5; + safmin = ae_minrealnumber; + if( *kase==0 ) + { + ae_vector_set_length(v, n+1, _state); + ae_vector_set_length(x, n+1, _state); + ae_vector_set_length(isave, 5, _state); + ae_vector_set_length(rsave, 4, _state); + for(i=1; i<=n; i++) + { + x->ptr.p_complex[i] = ae_complex_from_d((double)1/(double)n); + } + *kase = 1; + jump = 1; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } + rcond_internalcomplexrcondloadall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + + /* + * ENTRY (JUMP = 1) + * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY A*X. + */ + if( jump==1 ) + { + if( n==1 ) + { + v->ptr.p_complex[1] = x->ptr.p_complex[1]; + *est = ae_c_abs(v->ptr.p_complex[1], _state); + *kase = 0; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } + *est = rcond_internalcomplexrcondscsum1(x, n, _state); + for(i=1; i<=n; i++) + { + absxi = ae_c_abs(x->ptr.p_complex[i], _state); + if( ae_fp_greater(absxi,safmin) ) + { + x->ptr.p_complex[i] = ae_c_div_d(x->ptr.p_complex[i],absxi); + } + else + { + x->ptr.p_complex[i] = ae_complex_from_d(1); + } + } + *kase = 2; + jump = 2; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } + + /* + * ENTRY (JUMP = 2) + * FIRST ITERATION. X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. + */ + if( jump==2 ) + { + j = rcond_internalcomplexrcondicmax1(x, n, _state); + iter = 2; + + /* + * MAIN LOOP - ITERATIONS 2,3,...,ITMAX. + */ + for(i=1; i<=n; i++) + { + x->ptr.p_complex[i] = ae_complex_from_d(0); + } + x->ptr.p_complex[j] = ae_complex_from_d(1); + *kase = 1; + jump = 3; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } + + /* + * ENTRY (JUMP = 3) + * X HAS BEEN OVERWRITTEN BY A*X. + */ + if( jump==3 ) + { + ae_v_cmove(&v->ptr.p_complex[1], 1, &x->ptr.p_complex[1], 1, "N", ae_v_len(1,n)); + estold = *est; + *est = rcond_internalcomplexrcondscsum1(v, n, _state); + + /* + * TEST FOR CYCLING. + */ + if( ae_fp_less_eq(*est,estold) ) + { + + /* + * ITERATION COMPLETE. FINAL STAGE. + */ + altsgn = 1; + for(i=1; i<=n; i++) + { + x->ptr.p_complex[i] = ae_complex_from_d(altsgn*(1+(double)(i-1)/(double)(n-1))); + altsgn = -altsgn; + } + *kase = 1; + jump = 5; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } + for(i=1; i<=n; i++) + { + absxi = ae_c_abs(x->ptr.p_complex[i], _state); + if( ae_fp_greater(absxi,safmin) ) + { + x->ptr.p_complex[i] = ae_c_div_d(x->ptr.p_complex[i],absxi); + } + else + { + x->ptr.p_complex[i] = ae_complex_from_d(1); + } + } + *kase = 2; + jump = 4; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } + + /* + * ENTRY (JUMP = 4) + * X HAS BEEN OVERWRITTEN BY CTRANS(A)*X. + */ + if( jump==4 ) + { + jlast = j; + j = rcond_internalcomplexrcondicmax1(x, n, _state); + if( ae_fp_neq(ae_c_abs(x->ptr.p_complex[jlast], _state),ae_c_abs(x->ptr.p_complex[j], _state))&&iterptr.p_complex[i] = ae_complex_from_d(0); + } + x->ptr.p_complex[j] = ae_complex_from_d(1); + *kase = 1; + jump = 3; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } + + /* + * ITERATION COMPLETE. FINAL STAGE. + */ + altsgn = 1; + for(i=1; i<=n; i++) + { + x->ptr.p_complex[i] = ae_complex_from_d(altsgn*(1+(double)(i-1)/(double)(n-1))); + altsgn = -altsgn; + } + *kase = 1; + jump = 5; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } + + /* + * ENTRY (JUMP = 5) + * X HAS BEEN OVERWRITTEN BY A*X. + */ + if( jump==5 ) + { + temp = 2*(rcond_internalcomplexrcondscsum1(x, n, _state)/(3*n)); + if( ae_fp_greater(temp,*est) ) + { + ae_v_cmove(&v->ptr.p_complex[1], 1, &x->ptr.p_complex[1], 1, "N", ae_v_len(1,n)); + *est = temp; + } + *kase = 0; + rcond_internalcomplexrcondsaveall(isave, rsave, &i, &iter, &j, &jlast, &jump, &absxi, &altsgn, &estold, &temp, _state); + return; + } +} + + +static double rcond_internalcomplexrcondscsum1(/* Complex */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + double result; + + + result = 0; + for(i=1; i<=n; i++) + { + result = result+ae_c_abs(x->ptr.p_complex[i], _state); + } + return result; +} + + +static ae_int_t rcond_internalcomplexrcondicmax1(/* Complex */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + double m; + ae_int_t result; + + + result = 1; + m = ae_c_abs(x->ptr.p_complex[1], _state); + for(i=2; i<=n; i++) + { + if( ae_fp_greater(ae_c_abs(x->ptr.p_complex[i], _state),m) ) + { + result = i; + m = ae_c_abs(x->ptr.p_complex[i], _state); + } + } + return result; +} + + +static void rcond_internalcomplexrcondsaveall(/* Integer */ ae_vector* isave, + /* Real */ ae_vector* rsave, + ae_int_t* i, + ae_int_t* iter, + ae_int_t* j, + ae_int_t* jlast, + ae_int_t* jump, + double* absxi, + double* altsgn, + double* estold, + double* temp, + ae_state *_state) +{ + + + isave->ptr.p_int[0] = *i; + isave->ptr.p_int[1] = *iter; + isave->ptr.p_int[2] = *j; + isave->ptr.p_int[3] = *jlast; + isave->ptr.p_int[4] = *jump; + rsave->ptr.p_double[0] = *absxi; + rsave->ptr.p_double[1] = *altsgn; + rsave->ptr.p_double[2] = *estold; + rsave->ptr.p_double[3] = *temp; +} + + +static void rcond_internalcomplexrcondloadall(/* Integer */ ae_vector* isave, + /* Real */ ae_vector* rsave, + ae_int_t* i, + ae_int_t* iter, + ae_int_t* j, + ae_int_t* jlast, + ae_int_t* jump, + double* absxi, + double* altsgn, + double* estold, + double* temp, + ae_state *_state) +{ + + + *i = isave->ptr.p_int[0]; + *iter = isave->ptr.p_int[1]; + *j = isave->ptr.p_int[2]; + *jlast = isave->ptr.p_int[3]; + *jump = isave->ptr.p_int[4]; + *absxi = rsave->ptr.p_double[0]; + *altsgn = rsave->ptr.p_double[1]; + *estold = rsave->ptr.p_double[2]; + *temp = rsave->ptr.p_double[3]; +} + + + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 05.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixluinverse(/* Real */ ae_matrix* a, + /* Integer */ ae_vector* pivots, + ae_int_t n, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector work; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double v; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _matinvreport_clear(rep); + ae_vector_init(&work, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "RMatrixLUInverse: N<=0!", _state); + ae_assert(a->cols>=n, "RMatrixLUInverse: cols(A)rows>=n, "RMatrixLUInverse: rows(A)cnt>=n, "RMatrixLUInverse: len(Pivots)ptr.p_int[i]>n-1||pivots->ptr.p_int[i]0, "RMatrixLUInverse: incorrect Pivots array!", _state); + + /* + * calculate condition numbers + */ + rep->r1 = rmatrixlurcond1(a, n, _state); + rep->rinf = rmatrixlurcondinf(a, n, _state); + if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Call cache-oblivious code + */ + ae_vector_set_length(&work, n, _state); + matinv_rmatrixluinverserec(a, 0, n, &work, info, rep, _state); + + /* + * apply permutations + */ + for(i=0; i<=n-1; i++) + { + for(j=n-2; j>=0; j--) + { + k = pivots->ptr.p_int[j]; + v = a->ptr.pp_double[i][j]; + a->ptr.pp_double[i][j] = a->ptr.pp_double[i][k]; + a->ptr.pp_double[i][k] = v; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinverse(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector pivots; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _matinvreport_clear(rep); + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + + ae_assert(n>0, "RMatrixInverse: N<=0!", _state); + ae_assert(a->cols>=n, "RMatrixInverse: cols(A)rows>=n, "RMatrixInverse: rows(A)0, "CMatrixLUInverse: N<=0!", _state); + ae_assert(a->cols>=n, "CMatrixLUInverse: cols(A)rows>=n, "CMatrixLUInverse: rows(A)cnt>=n, "CMatrixLUInverse: len(Pivots)ptr.p_int[i]>n-1||pivots->ptr.p_int[i]0, "CMatrixLUInverse: incorrect Pivots array!", _state); + + /* + * calculate condition numbers + */ + rep->r1 = cmatrixlurcond1(a, n, _state); + rep->rinf = cmatrixlurcondinf(a, n, _state); + if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Call cache-oblivious code + */ + ae_vector_set_length(&work, n, _state); + matinv_cmatrixluinverserec(a, 0, n, &work, info, rep, _state); + + /* + * apply permutations + */ + for(i=0; i<=n-1; i++) + { + for(j=n-2; j>=0; j--) + { + k = pivots->ptr.p_int[j]; + v = a->ptr.pp_complex[i][j]; + a->ptr.pp_complex[i][j] = a->ptr.pp_complex[i][k]; + a->ptr.pp_complex[i][k] = v; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void cmatrixinverse(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector pivots; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _matinvreport_clear(rep); + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + + ae_assert(n>0, "CRMatrixInverse: N<=0!", _state); + ae_assert(a->cols>=n, "CRMatrixInverse: cols(A)rows>=n, "CRMatrixInverse: rows(A)0, "SPDMatrixCholeskyInverse: N<=0!", _state); + ae_assert(a->cols>=n, "SPDMatrixCholeskyInverse: cols(A)rows>=n, "SPDMatrixCholeskyInverse: rows(A)ptr.pp_double[i][i], _state); + } + ae_assert(f, "SPDMatrixCholeskyInverse: A contains infinite or NaN values!", _state); + + /* + * calculate condition numbers + */ + rep->r1 = spdmatrixcholeskyrcond(a, n, isupper, _state); + rep->rinf = rep->r1; + if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) + { + if( isupper ) + { + for(i=0; i<=n-1; i++) + { + for(j=i; j<=n-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + } + else + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Inverse + */ + ae_vector_set_length(&tmp, n, _state); + matinv_spdmatrixcholeskyinverserec(a, 0, n, isupper, &tmp, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixinverse(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + + *info = 0; + _matinvreport_clear(rep); + + ae_assert(n>0, "SPDMatrixInverse: N<=0!", _state); + ae_assert(a->cols>=n, "SPDMatrixInverse: cols(A)rows>=n, "SPDMatrixInverse: rows(A)0, "HPDMatrixCholeskyInverse: N<=0!", _state); + ae_assert(a->cols>=n, "HPDMatrixCholeskyInverse: cols(A)rows>=n, "HPDMatrixCholeskyInverse: rows(A)ptr.pp_complex[i][i].x, _state))&&ae_isfinite(a->ptr.pp_complex[i][i].y, _state); + } + ae_assert(f, "HPDMatrixCholeskyInverse: A contains infinite or NaN values!", _state); + *info = 1; + + /* + * calculate condition numbers + */ + rep->r1 = hpdmatrixcholeskyrcond(a, n, isupper, _state); + rep->rinf = rep->r1; + if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) + { + if( isupper ) + { + for(i=0; i<=n-1; i++) + { + for(j=i; j<=n-1; j++) + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + } + else + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i; j++) + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Inverse + */ + ae_vector_set_length(&tmp, n, _state); + matinv_hpdmatrixcholeskyinverserec(a, 0, n, isupper, &tmp, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixinverse(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + + *info = 0; + _matinvreport_clear(rep); + + ae_assert(n>0, "HPDMatrixInverse: N<=0!", _state); + ae_assert(a->cols>=n, "HPDMatrixInverse: cols(A)rows>=n, "HPDMatrixInverse: rows(A)0, "RMatrixTRInverse: N<=0!", _state); + ae_assert(a->cols>=n, "RMatrixTRInverse: cols(A)rows>=n, "RMatrixTRInverse: rows(A)r1 = rmatrixtrrcond1(a, n, isupper, isunit, _state); + rep->rinf = rmatrixtrrcondinf(a, n, isupper, isunit, _state); + if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_double[i][j] = 0; + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Invert + */ + ae_vector_set_length(&tmp, n, _state); + matinv_rmatrixtrinverserec(a, 0, n, isupper, isunit, &tmp, info, rep, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 05.02.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixtrinverse(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_vector tmp; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _matinvreport_clear(rep); + ae_vector_init(&tmp, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(n>0, "CMatrixTRInverse: N<=0!", _state); + ae_assert(a->cols>=n, "CMatrixTRInverse: cols(A)rows>=n, "CMatrixTRInverse: rows(A)r1 = cmatrixtrrcond1(a, n, isupper, isunit, _state); + rep->rinf = cmatrixtrrcondinf(a, n, isupper, isunit, _state); + if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + a->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + + /* + * Invert + */ + ae_vector_set_length(&tmp, n, _state); + matinv_cmatrixtrinverserec(a, 0, n, isupper, isunit, &tmp, info, rep, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Triangular matrix inversion, recursive subroutine + + -- ALGLIB -- + 05.02.2010, Bochkanov Sergey. + Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., + Courant Institute, Argonne National Lab, and Rice University + February 29, 1992. +*************************************************************************/ +static void matinv_rmatrixtrinverserec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + /* Real */ ae_vector* tmp, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + ae_int_t n1; + ae_int_t n2; + ae_int_t i; + ae_int_t j; + double v; + double ajj; + + + if( n<1 ) + { + *info = -1; + return; + } + + /* + * Base case + */ + if( n<=ablasblocksize(a, _state) ) + { + if( isupper ) + { + + /* + * Compute inverse of upper triangular matrix. + */ + for(j=0; j<=n-1; j++) + { + if( !isunit ) + { + if( ae_fp_eq(a->ptr.pp_double[offs+j][offs+j],0) ) + { + *info = -3; + return; + } + a->ptr.pp_double[offs+j][offs+j] = 1/a->ptr.pp_double[offs+j][offs+j]; + ajj = -a->ptr.pp_double[offs+j][offs+j]; + } + else + { + ajj = -1; + } + + /* + * Compute elements 1:j-1 of j-th column. + */ + if( j>0 ) + { + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+0][offs+j], a->stride, ae_v_len(0,j-1)); + for(i=0; i<=j-1; i++) + { + if( iptr.pp_double[offs+i][offs+i+1], 1, &tmp->ptr.p_double[i+1], 1, ae_v_len(offs+i+1,offs+j-1)); + } + else + { + v = 0; + } + if( !isunit ) + { + a->ptr.pp_double[offs+i][offs+j] = v+a->ptr.pp_double[offs+i][offs+i]*tmp->ptr.p_double[i]; + } + else + { + a->ptr.pp_double[offs+i][offs+j] = v+tmp->ptr.p_double[i]; + } + } + ae_v_muld(&a->ptr.pp_double[offs+0][offs+j], a->stride, ae_v_len(offs+0,offs+j-1), ajj); + } + } + } + else + { + + /* + * Compute inverse of lower triangular matrix. + */ + for(j=n-1; j>=0; j--) + { + if( !isunit ) + { + if( ae_fp_eq(a->ptr.pp_double[offs+j][offs+j],0) ) + { + *info = -3; + return; + } + a->ptr.pp_double[offs+j][offs+j] = 1/a->ptr.pp_double[offs+j][offs+j]; + ajj = -a->ptr.pp_double[offs+j][offs+j]; + } + else + { + ajj = -1; + } + if( jptr.p_double[j+1], 1, &a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(j+1,n-1)); + for(i=j+1; i<=n-1; i++) + { + if( i>j+1 ) + { + v = ae_v_dotproduct(&a->ptr.pp_double[offs+i][offs+j+1], 1, &tmp->ptr.p_double[j+1], 1, ae_v_len(offs+j+1,offs+i-1)); + } + else + { + v = 0; + } + if( !isunit ) + { + a->ptr.pp_double[offs+i][offs+j] = v+a->ptr.pp_double[offs+i][offs+i]*tmp->ptr.p_double[i]; + } + else + { + a->ptr.pp_double[offs+i][offs+j] = v+tmp->ptr.p_double[i]; + } + } + ae_v_muld(&a->ptr.pp_double[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+n-1), ajj); + } + } + } + return; + } + + /* + * Recursive case + */ + ablassplitlength(a, n, &n1, &n2, _state); + if( n2>0 ) + { + if( isupper ) + { + for(i=0; i<=n1-1; i++) + { + ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); + } + rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, isunit, 0, a, offs, offs+n1, _state); + rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs, offs+n1, _state); + } + else + { + for(i=0; i<=n2-1; i++) + { + ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); + } + rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, isunit, 0, a, offs+n1, offs, _state); + rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs+n1, offs, _state); + } + matinv_rmatrixtrinverserec(a, offs+n1, n2, isupper, isunit, tmp, info, rep, _state); + } + matinv_rmatrixtrinverserec(a, offs, n1, isupper, isunit, tmp, info, rep, _state); +} + + +/************************************************************************* +Triangular matrix inversion, recursive subroutine + + -- ALGLIB -- + 05.02.2010, Bochkanov Sergey. + Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., + Courant Institute, Argonne National Lab, and Rice University + February 29, 1992. +*************************************************************************/ +static void matinv_cmatrixtrinverserec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + /* Complex */ ae_vector* tmp, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + ae_int_t n1; + ae_int_t n2; + ae_int_t i; + ae_int_t j; + ae_complex v; + ae_complex ajj; + + + if( n<1 ) + { + *info = -1; + return; + } + + /* + * Base case + */ + if( n<=ablascomplexblocksize(a, _state) ) + { + if( isupper ) + { + + /* + * Compute inverse of upper triangular matrix. + */ + for(j=0; j<=n-1; j++) + { + if( !isunit ) + { + if( ae_c_eq_d(a->ptr.pp_complex[offs+j][offs+j],0) ) + { + *info = -3; + return; + } + a->ptr.pp_complex[offs+j][offs+j] = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]); + ajj = ae_c_neg(a->ptr.pp_complex[offs+j][offs+j]); + } + else + { + ajj = ae_complex_from_d(-1); + } + + /* + * Compute elements 1:j-1 of j-th column. + */ + if( j>0 ) + { + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+0][offs+j], a->stride, "N", ae_v_len(0,j-1)); + for(i=0; i<=j-1; i++) + { + if( iptr.pp_complex[offs+i][offs+i+1], 1, "N", &tmp->ptr.p_complex[i+1], 1, "N", ae_v_len(offs+i+1,offs+j-1)); + } + else + { + v = ae_complex_from_d(0); + } + if( !isunit ) + { + a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,ae_c_mul(a->ptr.pp_complex[offs+i][offs+i],tmp->ptr.p_complex[i])); + } + else + { + a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,tmp->ptr.p_complex[i]); + } + } + ae_v_cmulc(&a->ptr.pp_complex[offs+0][offs+j], a->stride, ae_v_len(offs+0,offs+j-1), ajj); + } + } + } + else + { + + /* + * Compute inverse of lower triangular matrix. + */ + for(j=n-1; j>=0; j--) + { + if( !isunit ) + { + if( ae_c_eq_d(a->ptr.pp_complex[offs+j][offs+j],0) ) + { + *info = -3; + return; + } + a->ptr.pp_complex[offs+j][offs+j] = ae_c_d_div(1,a->ptr.pp_complex[offs+j][offs+j]); + ajj = ae_c_neg(a->ptr.pp_complex[offs+j][offs+j]); + } + else + { + ajj = ae_complex_from_d(-1); + } + if( jptr.p_complex[j+1], 1, &a->ptr.pp_complex[offs+j+1][offs+j], a->stride, "N", ae_v_len(j+1,n-1)); + for(i=j+1; i<=n-1; i++) + { + if( i>j+1 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[offs+i][offs+j+1], 1, "N", &tmp->ptr.p_complex[j+1], 1, "N", ae_v_len(offs+j+1,offs+i-1)); + } + else + { + v = ae_complex_from_d(0); + } + if( !isunit ) + { + a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,ae_c_mul(a->ptr.pp_complex[offs+i][offs+i],tmp->ptr.p_complex[i])); + } + else + { + a->ptr.pp_complex[offs+i][offs+j] = ae_c_add(v,tmp->ptr.p_complex[i]); + } + } + ae_v_cmulc(&a->ptr.pp_complex[offs+j+1][offs+j], a->stride, ae_v_len(offs+j+1,offs+n-1), ajj); + } + } + } + return; + } + + /* + * Recursive case + */ + ablascomplexsplitlength(a, n, &n1, &n2, _state); + if( n2>0 ) + { + if( isupper ) + { + for(i=0; i<=n1-1; i++) + { + ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); + } + cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, isunit, 0, a, offs, offs+n1, _state); + cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs, offs+n1, _state); + } + else + { + for(i=0; i<=n2-1; i++) + { + ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); + } + cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, isunit, 0, a, offs+n1, offs, _state); + cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, isunit, 0, a, offs+n1, offs, _state); + } + matinv_cmatrixtrinverserec(a, offs+n1, n2, isupper, isunit, tmp, info, rep, _state); + } + matinv_cmatrixtrinverserec(a, offs, n1, isupper, isunit, tmp, info, rep, _state); +} + + +static void matinv_rmatrixluinverserec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + /* Real */ ae_vector* work, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double v; + ae_int_t n1; + ae_int_t n2; + + + if( n<1 ) + { + *info = -1; + return; + } + + /* + * Base case + */ + if( n<=ablasblocksize(a, _state) ) + { + + /* + * Form inv(U) + */ + matinv_rmatrixtrinverserec(a, offs, n, ae_true, ae_false, work, info, rep, _state); + 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-1; i++) + { + work->ptr.p_double[i] = a->ptr.pp_double[offs+i][offs+j]; + a->ptr.pp_double[offs+i][offs+j] = 0; + } + + /* + * Compute current column of inv(A). + */ + if( jptr.pp_double[offs+i][offs+j+1], 1, &work->ptr.p_double[j+1], 1, ae_v_len(offs+j+1,offs+n-1)); + a->ptr.pp_double[offs+i][offs+j] = a->ptr.pp_double[offs+i][offs+j]-v; + } + } + } + return; + } + + /* + * Recursive code: + * + * ( L1 ) ( U1 U12 ) + * A = ( ) * ( ) + * ( L12 L2 ) ( U2 ) + * + * ( W X ) + * A^-1 = ( ) + * ( Y Z ) + */ + ablassplitlength(a, n, &n1, &n2, _state); + ae_assert(n2>0, "LUInverseRec: internal error!", _state); + + /* + * X := inv(U1)*U12*inv(U2) + */ + rmatrixlefttrsm(n1, n2, a, offs, offs, ae_true, ae_false, 0, a, offs, offs+n1, _state); + rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs, offs+n1, _state); + + /* + * Y := inv(L2)*L12*inv(L1) + */ + rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs+n1, offs, _state); + rmatrixrighttrsm(n2, n1, a, offs, offs, ae_false, ae_true, 0, a, offs+n1, offs, _state); + + /* + * W := inv(L1*U1)+X*Y + */ + matinv_rmatrixluinverserec(a, offs, n1, work, info, rep, _state); + if( *info<=0 ) + { + return; + } + rmatrixgemm(n1, n1, n2, 1.0, a, offs, offs+n1, 0, a, offs+n1, offs, 0, 1.0, a, offs, offs, _state); + + /* + * X := -X*inv(L2) + * Y := -inv(U2)*Y + */ + rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs, offs+n1, _state); + for(i=0; i<=n1-1; i++) + { + ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); + } + rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs+n1, offs, _state); + for(i=0; i<=n2-1; i++) + { + ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); + } + + /* + * Z := inv(L2*U2) + */ + matinv_rmatrixluinverserec(a, offs+n1, n2, work, info, rep, _state); +} + + +static void matinv_cmatrixluinverserec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + /* Complex */ ae_vector* work, + ae_int_t* info, + matinvreport* rep, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_complex v; + ae_int_t n1; + ae_int_t n2; + + + if( n<1 ) + { + *info = -1; + return; + } + + /* + * Base case + */ + if( n<=ablascomplexblocksize(a, _state) ) + { + + /* + * Form inv(U) + */ + matinv_cmatrixtrinverserec(a, offs, n, ae_true, ae_false, work, info, rep, _state); + 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-1; i++) + { + work->ptr.p_complex[i] = a->ptr.pp_complex[offs+i][offs+j]; + a->ptr.pp_complex[offs+i][offs+j] = ae_complex_from_d(0); + } + + /* + * Compute current column of inv(A). + */ + if( jptr.pp_complex[offs+i][offs+j+1], 1, "N", &work->ptr.p_complex[j+1], 1, "N", ae_v_len(offs+j+1,offs+n-1)); + a->ptr.pp_complex[offs+i][offs+j] = ae_c_sub(a->ptr.pp_complex[offs+i][offs+j],v); + } + } + } + return; + } + + /* + * Recursive code: + * + * ( L1 ) ( U1 U12 ) + * A = ( ) * ( ) + * ( L12 L2 ) ( U2 ) + * + * ( W X ) + * A^-1 = ( ) + * ( Y Z ) + */ + ablascomplexsplitlength(a, n, &n1, &n2, _state); + ae_assert(n2>0, "LUInverseRec: internal error!", _state); + + /* + * X := inv(U1)*U12*inv(U2) + */ + cmatrixlefttrsm(n1, n2, a, offs, offs, ae_true, ae_false, 0, a, offs, offs+n1, _state); + cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs, offs+n1, _state); + + /* + * Y := inv(L2)*L12*inv(L1) + */ + cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs+n1, offs, _state); + cmatrixrighttrsm(n2, n1, a, offs, offs, ae_false, ae_true, 0, a, offs+n1, offs, _state); + + /* + * W := inv(L1*U1)+X*Y + */ + matinv_cmatrixluinverserec(a, offs, n1, work, info, rep, _state); + if( *info<=0 ) + { + return; + } + cmatrixgemm(n1, n1, n2, ae_complex_from_d(1.0), a, offs, offs+n1, 0, a, offs+n1, offs, 0, ae_complex_from_d(1.0), a, offs, offs, _state); + + /* + * X := -X*inv(L2) + * Y := -inv(U2)*Y + */ + cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, ae_false, ae_true, 0, a, offs, offs+n1, _state); + for(i=0; i<=n1-1; i++) + { + ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); + } + cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, ae_true, ae_false, 0, a, offs+n1, offs, _state); + for(i=0; i<=n2-1; i++) + { + ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); + } + + /* + * Z := inv(L2*U2) + */ + matinv_cmatrixluinverserec(a, offs+n1, n2, work, info, rep, _state); +} + + +/************************************************************************* +Recursive subroutine for SPD inversion. + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +static void matinv_spdmatrixcholeskyinverserec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double v; + ae_int_t n1; + ae_int_t n2; + ae_int_t info2; + matinvreport rep2; + + ae_frame_make(_state, &_frame_block); + _matinvreport_init(&rep2, _state, ae_true); + + if( n<1 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Base case + */ + if( n<=ablasblocksize(a, _state) ) + { + matinv_rmatrixtrinverserec(a, offs, n, isupper, ae_false, tmp, &info2, &rep2, _state); + if( isupper ) + { + + /* + * Compute the product U * U'. + * NOTE: we never assume that diagonal of U is real + */ + for(i=0; i<=n-1; i++) + { + if( i==0 ) + { + + /* + * 1x1 matrix + */ + a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state); + } + 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. + */ + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs][offs+i], a->stride, ae_v_len(0,i-1)); + for(j=0; j<=i-1; j++) + { + v = a->ptr.pp_double[offs+j][offs+i]; + ae_v_addd(&a->ptr.pp_double[offs+j][offs+j], 1, &tmp->ptr.p_double[j], 1, ae_v_len(offs+j,offs+i-1), v); + } + v = a->ptr.pp_double[offs+i][offs+i]; + ae_v_muld(&a->ptr.pp_double[offs][offs+i], a->stride, ae_v_len(offs,offs+i-1), v); + a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state); + } + } + } + else + { + + /* + * Compute the product L' * L + * NOTE: we never assume that diagonal of L is real + */ + for(i=0; i<=n-1; i++) + { + if( i==0 ) + { + + /* + * 1x1 matrix + */ + a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state); + } + 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. + */ + ae_v_move(&tmp->ptr.p_double[0], 1, &a->ptr.pp_double[offs+i][offs], 1, ae_v_len(0,i-1)); + for(j=0; j<=i-1; j++) + { + v = a->ptr.pp_double[offs+i][offs+j]; + ae_v_addd(&a->ptr.pp_double[offs+j][offs], 1, &tmp->ptr.p_double[0], 1, ae_v_len(offs,offs+j), v); + } + v = a->ptr.pp_double[offs+i][offs+i]; + ae_v_muld(&a->ptr.pp_double[offs+i][offs], 1, ae_v_len(offs,offs+i-1), v); + a->ptr.pp_double[offs+i][offs+i] = ae_sqr(a->ptr.pp_double[offs+i][offs+i], _state); + } + } + } + ae_frame_leave(_state); + return; + } + + /* + * Recursive code: triangular factor inversion merged with + * UU' or L'L multiplication + */ + ablassplitlength(a, n, &n1, &n2, _state); + + /* + * form off-diagonal block of trangular inverse + */ + if( isupper ) + { + for(i=0; i<=n1-1; i++) + { + ae_v_muld(&a->ptr.pp_double[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); + } + rmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 0, a, offs, offs+n1, _state); + rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs, offs+n1, _state); + } + else + { + for(i=0; i<=n2-1; i++) + { + ae_v_muld(&a->ptr.pp_double[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); + } + rmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 0, a, offs+n1, offs, _state); + rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs+n1, offs, _state); + } + + /* + * invert first diagonal block + */ + matinv_spdmatrixcholeskyinverserec(a, offs, n1, isupper, tmp, _state); + + /* + * update first diagonal block with off-diagonal block, + * update off-diagonal block + */ + if( isupper ) + { + rmatrixsyrk(n1, n2, 1.0, a, offs, offs+n1, 0, 1.0, a, offs, offs, isupper, _state); + rmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 1, a, offs, offs+n1, _state); + } + else + { + rmatrixsyrk(n1, n2, 1.0, a, offs+n1, offs, 1, 1.0, a, offs, offs, isupper, _state); + rmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 1, a, offs+n1, offs, _state); + } + + /* + * invert second diagonal block + */ + matinv_spdmatrixcholeskyinverserec(a, offs+n1, n2, isupper, tmp, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Recursive subroutine for HPD inversion. + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +static void matinv_hpdmatrixcholeskyinverserec(/* Complex */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_complex v; + ae_int_t n1; + ae_int_t n2; + ae_int_t info2; + matinvreport rep2; + + ae_frame_make(_state, &_frame_block); + _matinvreport_init(&rep2, _state, ae_true); + + if( n<1 ) + { + ae_frame_leave(_state); + return; + } + + /* + * Base case + */ + if( n<=ablascomplexblocksize(a, _state) ) + { + matinv_cmatrixtrinverserec(a, offs, n, isupper, ae_false, tmp, &info2, &rep2, _state); + if( isupper ) + { + + /* + * Compute the product U * U'. + * NOTE: we never assume that diagonal of U is real + */ + for(i=0; i<=n-1; i++) + { + if( i==0 ) + { + + /* + * 1x1 matrix + */ + a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state)); + } + 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. + */ + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs][offs+i], a->stride, "Conj", ae_v_len(0,i-1)); + for(j=0; j<=i-1; j++) + { + v = a->ptr.pp_complex[offs+j][offs+i]; + ae_v_caddc(&a->ptr.pp_complex[offs+j][offs+j], 1, &tmp->ptr.p_complex[j], 1, "N", ae_v_len(offs+j,offs+i-1), v); + } + v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+i], _state); + ae_v_cmulc(&a->ptr.pp_complex[offs][offs+i], a->stride, ae_v_len(offs,offs+i-1), v); + a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state)); + } + } + } + else + { + + /* + * Compute the product L' * L + * NOTE: we never assume that diagonal of L is real + */ + for(i=0; i<=n-1; i++) + { + if( i==0 ) + { + + /* + * 1x1 matrix + */ + a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state)); + } + 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. + */ + ae_v_cmove(&tmp->ptr.p_complex[0], 1, &a->ptr.pp_complex[offs+i][offs], 1, "N", ae_v_len(0,i-1)); + for(j=0; j<=i-1; j++) + { + v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+j], _state); + ae_v_caddc(&a->ptr.pp_complex[offs+j][offs], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(offs,offs+j), v); + } + v = ae_c_conj(a->ptr.pp_complex[offs+i][offs+i], _state); + ae_v_cmulc(&a->ptr.pp_complex[offs+i][offs], 1, ae_v_len(offs,offs+i-1), v); + a->ptr.pp_complex[offs+i][offs+i] = ae_complex_from_d(ae_sqr(a->ptr.pp_complex[offs+i][offs+i].x, _state)+ae_sqr(a->ptr.pp_complex[offs+i][offs+i].y, _state)); + } + } + } + ae_frame_leave(_state); + return; + } + + /* + * Recursive code: triangular factor inversion merged with + * UU' or L'L multiplication + */ + ablascomplexsplitlength(a, n, &n1, &n2, _state); + + /* + * form off-diagonal block of trangular inverse + */ + if( isupper ) + { + for(i=0; i<=n1-1; i++) + { + ae_v_cmuld(&a->ptr.pp_complex[offs+i][offs+n1], 1, ae_v_len(offs+n1,offs+n-1), -1); + } + cmatrixlefttrsm(n1, n2, a, offs, offs, isupper, ae_false, 0, a, offs, offs+n1, _state); + cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs, offs+n1, _state); + } + else + { + for(i=0; i<=n2-1; i++) + { + ae_v_cmuld(&a->ptr.pp_complex[offs+n1+i][offs], 1, ae_v_len(offs,offs+n1-1), -1); + } + cmatrixrighttrsm(n2, n1, a, offs, offs, isupper, ae_false, 0, a, offs+n1, offs, _state); + cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 0, a, offs+n1, offs, _state); + } + + /* + * invert first diagonal block + */ + matinv_hpdmatrixcholeskyinverserec(a, offs, n1, isupper, tmp, _state); + + /* + * update first diagonal block with off-diagonal block, + * update off-diagonal block + */ + if( isupper ) + { + cmatrixsyrk(n1, n2, 1.0, a, offs, offs+n1, 0, 1.0, a, offs, offs, isupper, _state); + cmatrixrighttrsm(n1, n2, a, offs+n1, offs+n1, isupper, ae_false, 2, a, offs, offs+n1, _state); + } + else + { + cmatrixsyrk(n1, n2, 1.0, a, offs+n1, offs, 2, 1.0, a, offs, offs, isupper, _state); + cmatrixlefttrsm(n2, n1, a, offs+n1, offs+n1, isupper, ae_false, 2, a, offs+n1, offs, _state); + } + + /* + * invert second diagonal block + */ + matinv_hpdmatrixcholeskyinverserec(a, offs+n1, n2, isupper, tmp, _state); + ae_frame_leave(_state); +} + + +ae_bool _matinvreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + matinvreport *p = (matinvreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _matinvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + matinvreport *dst = (matinvreport*)_dst; + matinvreport *src = (matinvreport*)_src; + dst->r1 = src->r1; + dst->rinf = src->rinf; + return ae_true; +} + + +void _matinvreport_clear(void* _p) +{ + matinvreport *p = (matinvreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _matinvreport_destroy(void* _p) +{ + matinvreport *p = (matinvreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* +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 is 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. + +Sparse matrices can be stored using either Hash-Table representation or +Compressed Row Storage representation. Hast-table is better suited for +querying and dynamic operations (thus, it is used for matrix +initialization), but it is inefficient when you want to make some linear +algebra operations. + +From the other side, CRS is better suited for linear algebra operations, +but initialization is less convenient - you have to tell row sizes at the +initialization, and you can fill matrix only row by row, from left to +right. CRS is also very inefficient when you want to find matrix element +by its index. + +Thus, Hash-Table representation does not support linear algebra +operations, while CRS format does not support modification of the table. +Tables below outline information about these two formats: + + OPERATIONS WITH MATRIX HASH CRS + create + + + read element + + + modify element + + add value to element + + A*x (dense vector) + + A'*x (dense vector) + + A*X (dense matrix) + + A'*X (dense matrix) + + +NOTE 2. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecreate(ae_int_t m, + ae_int_t n, + ae_int_t k, + sparsematrix* s, + ae_state *_state) +{ + ae_int_t i; + ae_int_t sz; + + _sparsematrix_clear(s); + + ae_assert(m>0, "SparseCreate: M<=0", _state); + ae_assert(n>0, "SparseCreate: N<=0", _state); + ae_assert(k>=0, "SparseCreate: K<0", _state); + sz = ae_round(k/sparse_desiredloadfactor+sparse_additional, _state); + s->matrixtype = 0; + s->m = m; + s->n = n; + s->nfree = sz; + ae_vector_set_length(&s->vals, sz, _state); + ae_vector_set_length(&s->idx, 2*sz, _state); + for(i=0; i<=sz-1; i++) + { + s->idx.ptr.p_int[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 +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 + 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 1. + +Sparse matrices can be stored using either Hash-Table representation or +Compressed Row Storage representation. Hast-table is better suited for +querying and dynamic operations (thus, it is used for matrix +initialization), but it is inefficient when you want to make some linear +algebra operations. + +From the other side, CRS is better suited for linear algebra operations, +but initialization is less convenient - you have to tell row sizes at the +initialization, and you can fill matrix only row by row, from left to +right. CRS is also very inefficient when you want to find matrix element +by its index. + +Thus, Hash-Table representation does not support linear algebra +operations, while CRS format does not support modification of the table. +Tables below outline information about these two formats: + + OPERATIONS WITH MATRIX HASH CRS + create + + + read element + + + modify element + + add value to element + + A*x (dense vector) + + A'*x (dense vector) + + A*X (dense matrix) + + A'*X (dense matrix) + + +NOTE 2. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecreatecrs(ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* ner, + sparsematrix* s, + ae_state *_state) +{ + ae_int_t i; + ae_int_t noe; + + _sparsematrix_clear(s); + + ae_assert(m>0, "SparseCreateCRS: M<=0", _state); + ae_assert(n>0, "SparseCreateCRS: N<=0", _state); + ae_assert(ner->cnt>=m, "SparseCreateCRS: Length(NER)matrixtype = 1; + s->ninitialized = 0; + s->m = m; + s->n = n; + ae_vector_set_length(&s->ridx, s->m+1, _state); + s->ridx.ptr.p_int[0] = 0; + for(i=0; i<=s->m-1; i++) + { + ae_assert(ner->ptr.p_int[i]>=0, "SparseCreateCRS: NER[] contains negative elements", _state); + noe = noe+ner->ptr.p_int[i]; + s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i]+ner->ptr.p_int[i]; + } + ae_vector_set_length(&s->vals, noe, _state); + ae_vector_set_length(&s->idx, noe, _state); + if( noe==0 ) + { + sparse_sparseinitduidx(s, _state); + } +} + + +/************************************************************************* +This function copies S0 to S1. + +NOTE: this function does not verify its arguments, it just copies all +fields of the structure. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecopy(sparsematrix* s0, sparsematrix* s1, ae_state *_state) +{ + ae_int_t l; + ae_int_t i; + + _sparsematrix_clear(s1); + + s1->matrixtype = s0->matrixtype; + s1->m = s0->m; + s1->n = s0->n; + s1->nfree = s0->nfree; + s1->ninitialized = s0->ninitialized; + + /* + * Initialization for arrays + */ + l = s0->vals.cnt; + ae_vector_set_length(&s1->vals, l, _state); + for(i=0; i<=l-1; i++) + { + s1->vals.ptr.p_double[i] = s0->vals.ptr.p_double[i]; + } + l = s0->ridx.cnt; + ae_vector_set_length(&s1->ridx, l, _state); + for(i=0; i<=l-1; i++) + { + s1->ridx.ptr.p_int[i] = s0->ridx.ptr.p_int[i]; + } + l = s0->idx.cnt; + ae_vector_set_length(&s1->idx, l, _state); + for(i=0; i<=l-1; i++) + { + s1->idx.ptr.p_int[i] = s0->idx.ptr.p_int[i]; + } + + /* + * Initalization for CRS-parameters + */ + l = s0->uidx.cnt; + ae_vector_set_length(&s1->uidx, l, _state); + for(i=0; i<=l-1; i++) + { + s1->uidx.ptr.p_int[i] = s0->uidx.ptr.p_int[i]; + } + l = s0->didx.cnt; + ae_vector_set_length(&s1->didx, l, _state); + for(i=0; i<=l-1; i++) + { + s1->didx.ptr.p_int[i] = s0->didx.ptr.p_int[i]; + } +} + + +/************************************************************************* +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<=Imatrixtype==0, "SparseAdd: matrix must be in the Hash-Table mode to do this operation", _state); + ae_assert(i>=0, "SparseAdd: I<0", _state); + ae_assert(im, "SparseAdd: I>=M", _state); + ae_assert(j>=0, "SparseAdd: J<0", _state); + ae_assert(jn, "SparseAdd: J>=N", _state); + ae_assert(ae_isfinite(v, _state), "SparseAdd: V is not finite number", _state); + if( ae_fp_eq(v,0) ) + { + return; + } + tcode = -1; + k = s->vals.cnt; + if( ae_fp_greater_eq((1-sparse_maxloadfactor)*k,s->nfree) ) + { + sparseresizematrix(s, _state); + k = s->vals.cnt; + } + hashcode = sparse_hash(i, j, k, _state); + for(;;) + { + if( s->idx.ptr.p_int[2*hashcode]==-1 ) + { + if( tcode!=-1 ) + { + hashcode = tcode; + } + s->vals.ptr.p_double[hashcode] = v; + s->idx.ptr.p_int[2*hashcode] = i; + s->idx.ptr.p_int[2*hashcode+1] = j; + if( tcode==-1 ) + { + s->nfree = s->nfree-1; + } + return; + } + else + { + if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j ) + { + s->vals.ptr.p_double[hashcode] = s->vals.ptr.p_double[hashcode]+v; + if( ae_fp_eq(s->vals.ptr.p_double[hashcode],0) ) + { + s->idx.ptr.p_int[2*hashcode] = -2; + } + return; + } + + /* + * Is it deleted element? + */ + if( tcode==-1&&s->idx.ptr.p_int[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: +* 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: +* new value MUST be non-zero. Exception will be thrown for zero V. +* elements must be initialized in correct order - from top row to bottom, + within row - from left to right. + +INPUT PARAMETERS + S - sparse M*N matrix in Hash-Table or CRS representation. + I - row index of the element to modify, 0<=I=0, "SparseSet: I<0", _state); + ae_assert(im, "SparseSet: I>=M", _state); + ae_assert(j>=0, "SparseSet: J<0", _state); + ae_assert(jn, "SparseSet: J>=N", _state); + ae_assert(ae_isfinite(v, _state), "SparseSet: V is not finite number", _state); + + /* + * Hash-table matrix + */ + if( s->matrixtype==0 ) + { + tcode = -1; + k = s->vals.cnt; + if( ae_fp_greater_eq((1-sparse_maxloadfactor)*k,s->nfree) ) + { + sparseresizematrix(s, _state); + k = s->vals.cnt; + } + hashcode = sparse_hash(i, j, k, _state); + for(;;) + { + if( s->idx.ptr.p_int[2*hashcode]==-1 ) + { + if( ae_fp_neq(v,0) ) + { + if( tcode!=-1 ) + { + hashcode = tcode; + } + s->vals.ptr.p_double[hashcode] = v; + s->idx.ptr.p_int[2*hashcode] = i; + s->idx.ptr.p_int[2*hashcode+1] = j; + if( tcode==-1 ) + { + s->nfree = s->nfree-1; + } + } + return; + } + else + { + if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j ) + { + if( ae_fp_eq(v,0) ) + { + s->idx.ptr.p_int[2*hashcode] = -2; + } + else + { + s->vals.ptr.p_double[hashcode] = v; + } + return; + } + if( tcode==-1&&s->idx.ptr.p_int[2*hashcode]==-2 ) + { + tcode = hashcode; + } + + /* + * Next step + */ + hashcode = (hashcode+1)%k; + } + } + } + + /* + * CRS matrix + */ + if( s->matrixtype==1 ) + { + ae_assert(ae_fp_neq(v,0), "SparseSet: CRS format does not allow you to write zero elements", _state); + ae_assert(s->ridx.ptr.p_int[i]<=s->ninitialized, "SparseSet: too few initialized elements at some row (you have promised more when called SparceCreateCRS)", _state); + ae_assert(s->ridx.ptr.p_int[i+1]>s->ninitialized, "SparseSet: too many initialized elements at some row (you have promised less when called SparceCreateCRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[i]||s->idx.ptr.p_int[s->ninitialized-1]vals.ptr.p_double[s->ninitialized] = v; + s->idx.ptr.p_int[s->ninitialized] = j; + s->ninitialized = s->ninitialized+1; + + /* + * If matrix has been created then + * initiale 'S.UIdx' and 'S.DIdx' + */ + if( s->ninitialized==s->ridx.ptr.p_int[s->m] ) + { + sparse_sparseinitduidx(s, _state); + } + } +} + + +/************************************************************************* +This function returns S[i,j] - element of the sparse matrix. Matrix can +be in any mode (Hash-Table or CRS), but this function is less efficient +for CRS matrices. Hash-Table 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 in Hash-Table representation. + Exception will be thrown for CRS matrix. + I - row index of the element to modify, 0<=I=0, "SparseGet: I<0", _state); + ae_assert(im, "SparseGet: I>=M", _state); + ae_assert(j>=0, "SparseGet: J<0", _state); + ae_assert(jn, "SparseGet: J>=N", _state); + k = s->vals.cnt; + result = 0; + if( s->matrixtype==0 ) + { + hashcode = sparse_hash(i, j, k, _state); + for(;;) + { + if( s->idx.ptr.p_int[2*hashcode]==-1 ) + { + return result; + } + if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j ) + { + result = s->vals.ptr.p_double[hashcode]; + return result; + } + hashcode = (hashcode+1)%k; + } + } + if( s->matrixtype==1 ) + { + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseGet: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + k0 = s->ridx.ptr.p_int[i]; + k1 = s->ridx.ptr.p_int[i+1]-1; + while(k0<=k1) + { + k = (k0+k1)/2; + if( s->idx.ptr.p_int[k]==j ) + { + result = s->vals.ptr.p_double[k]; + return result; + } + if( s->idx.ptr.p_int[k]=0, "SparseGetDiagonal: I<0", _state); + ae_assert(im, "SparseGetDiagonal: I>=M", _state); + ae_assert(in, "SparseGetDiagonal: I>=N", _state); + result = 0; + if( s->matrixtype==0 ) + { + result = sparseget(s, i, i, _state); + return result; + } + if( s->matrixtype==1 ) + { + if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] ) + { + result = s->vals.ptr.p_double[s->didx.ptr.p_int[i]]; + } + return result; + } + return result; +} + + +/************************************************************************* +This function converts matrix to CRS format. + +Some algorithms (linear algebra ones, for example) require matrices in +CRS format. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparseconverttocrs(sparsematrix* s, ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_vector tvals; + ae_vector tidx; + ae_vector temp; + ae_int_t nonne; + ae_int_t k; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tidx, 0, DT_INT, _state, ae_true); + ae_vector_init(&temp, 0, DT_INT, _state, ae_true); + + ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseConvertToCRS: invalid matrix type", _state); + if( s->matrixtype==1 ) + { + ae_frame_leave(_state); + return; + } + s->matrixtype = 1; + nonne = 0; + k = s->vals.cnt; + ae_swap_vectors(&s->vals, &tvals); + ae_swap_vectors(&s->idx, &tidx); + ae_vector_set_length(&s->ridx, s->m+1, _state); + for(i=0; i<=s->m; i++) + { + s->ridx.ptr.p_int[i] = 0; + } + ae_vector_set_length(&temp, s->m, _state); + for(i=0; i<=s->m-1; i++) + { + temp.ptr.p_int[i] = 0; + } + + /* + * Number of elements per row + */ + for(i=0; i<=k-1; i++) + { + if( tidx.ptr.p_int[2*i]>=0 ) + { + s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]+1] = s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]+1]+1; + nonne = nonne+1; + } + } + + /* + * Fill RIdx (offsets of rows) + */ + for(i=0; i<=s->m-1; i++) + { + s->ridx.ptr.p_int[i+1] = s->ridx.ptr.p_int[i+1]+s->ridx.ptr.p_int[i]; + } + + /* + * Allocate memory + */ + ae_vector_set_length(&s->vals, nonne, _state); + ae_vector_set_length(&s->idx, nonne, _state); + for(i=0; i<=k-1; i++) + { + if( tidx.ptr.p_int[2*i]>=0 ) + { + s->vals.ptr.p_double[s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]]+temp.ptr.p_int[tidx.ptr.p_int[2*i]]] = tvals.ptr.p_double[i]; + s->idx.ptr.p_int[s->ridx.ptr.p_int[tidx.ptr.p_int[2*i]]+temp.ptr.p_int[tidx.ptr.p_int[2*i]]] = tidx.ptr.p_int[2*i+1]; + temp.ptr.p_int[tidx.ptr.p_int[2*i]] = temp.ptr.p_int[tidx.ptr.p_int[2*i]]+1; + } + } + + /* + * Set NInitialized + */ + s->ninitialized = s->ridx.ptr.p_int[s->m]; + + /* + * Sorting of elements + */ + for(i=0; i<=s->m-1; i++) + { + tagsortmiddleir(&s->idx, &s->vals, s->ridx.ptr.p_int[i], s->ridx.ptr.p_int[i+1]-s->ridx.ptr.p_int[i], _state); + } + + /* + * Initialization 'S.UIdx' and 'S.DIdx' + */ + sparse_sparseinitduidx(s, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This function calculates matrix-vector product S*x. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemv(sparsematrix* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + double tval; + ae_int_t i; + ae_int_t j; + ae_int_t lt; + ae_int_t rt; + + + ae_assert(s->matrixtype==1, "SparseMV: incorrect matrix type (convert your matrix to CRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + ae_assert(x->cnt>=s->n, "SparseMV: length(X)m, _state); + for(i=0; i<=s->m-1; i++) + { + tval = 0; + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + for(j=lt; j<=rt-1; j++) + { + tval = tval+x->ptr.p_double[s->idx.ptr.p_int[j]]*s->vals.ptr.p_double[j]; + } + y->ptr.p_double[i] = tval; + } +} + + +/************************************************************************* +This function calculates matrix-vector product S^T*x. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemtv(sparsematrix* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t lt; + ae_int_t rt; + ae_int_t ct; + double v; + + + ae_assert(s->matrixtype==1, "SparseMTV: incorrect matrix type (convert your matrix to CRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMTV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + ae_assert(x->cnt>=s->m, "SparseMTV: Length(X)n, _state); + for(i=0; i<=s->n-1; i++) + { + y->ptr.p_double[i] = 0; + } + for(i=0; i<=s->m-1; i++) + { + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + v = x->ptr.p_double[i]; + for(j=lt; j<=rt-1; j++) + { + ct = s->idx.ptr.p_int[j]; + y->ptr.p_double[ct] = y->ptr.p_double[ct]+v*s->vals.ptr.p_double[j]; + } + } +} + + +/************************************************************************* +This function simultaneously calculates two matrix-vector products: + S*x and S^T*x. +S must be square (non-rectangular) matrix stored in CRS format (exception +will be thrown otherwise). + +INPUT PARAMETERS + S - sparse N*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. It also throws exception when S is non-square. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemv2(sparsematrix* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y0, + /* Real */ ae_vector* y1, + ae_state *_state) +{ + ae_int_t l; + double tval; + ae_int_t i; + ae_int_t j; + double vx; + double vs; + ae_int_t vi; + ae_int_t j0; + ae_int_t j1; + + + ae_assert(s->matrixtype==1, "SparseMV2: incorrect matrix type (convert your matrix to CRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + ae_assert(s->m==s->n, "SparseMV2: matrix is non-square", _state); + l = x->cnt; + ae_assert(l>=s->n, "SparseMV2: Length(X)n-1; i++) + { + y1->ptr.p_double[i] = 0; + } + for(i=0; i<=s->m-1; i++) + { + tval = 0; + vx = x->ptr.p_double[i]; + j0 = s->ridx.ptr.p_int[i]; + j1 = s->ridx.ptr.p_int[i+1]-1; + for(j=j0; j<=j1; j++) + { + vi = s->idx.ptr.p_int[j]; + vs = s->vals.ptr.p_double[j]; + tval = tval+x->ptr.p_double[vi]*vs; + y1->ptr.p_double[vi] = y1->ptr.p_double[vi]+vx*vs; + } + y0->ptr.p_double[i] = tval; + } +} + + +/************************************************************************* +This function calculates matrix-vector product S*x, when S is symmetric +matrix. Matrix S must be stored in CRS format (exception will be +thrown otherwise). + +INPUT PARAMETERS + S - sparse M*M matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsesmv(sparsematrix* s, + ae_bool isupper, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t id; + ae_int_t lt; + ae_int_t rt; + double v; + double vy; + double vx; + + + ae_assert(s->matrixtype==1, "SparseSMV: incorrect matrix type (convert your matrix to CRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseSMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + ae_assert(x->cnt>=s->n, "SparseSMV: length(X)m==s->n, "SparseSMV: non-square matrix", _state); + rvectorsetlengthatleast(y, s->m, _state); + for(i=0; i<=s->m-1; i++) + { + y->ptr.p_double[i] = 0; + } + for(i=0; i<=s->m-1; i++) + { + if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] ) + { + y->ptr.p_double[i] = y->ptr.p_double[i]+s->vals.ptr.p_double[s->didx.ptr.p_int[i]]*x->ptr.p_double[s->idx.ptr.p_int[s->didx.ptr.p_int[i]]]; + } + if( isupper ) + { + lt = s->uidx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + vy = 0; + vx = x->ptr.p_double[i]; + for(j=lt; j<=rt-1; j++) + { + id = s->idx.ptr.p_int[j]; + v = s->vals.ptr.p_double[j]; + vy = vy+x->ptr.p_double[id]*v; + y->ptr.p_double[id] = y->ptr.p_double[id]+vx*v; + } + y->ptr.p_double[i] = y->ptr.p_double[i]+vy; + } + else + { + lt = s->ridx.ptr.p_int[i]; + rt = s->didx.ptr.p_int[i]; + vy = 0; + vx = x->ptr.p_double[i]; + for(j=lt; j<=rt-1; j++) + { + id = s->idx.ptr.p_int[j]; + v = s->vals.ptr.p_double[j]; + vy = vy+x->ptr.p_double[id]*v; + y->ptr.p_double[id] = y->ptr.p_double[id]+vx*v; + } + y->ptr.p_double[i] = y->ptr.p_double[i]+vy; + } + } +} + + +/************************************************************************* +This function calculates matrix-matrix product S*A. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemm(sparsematrix* s, + /* Real */ ae_matrix* a, + ae_int_t k, + /* Real */ ae_matrix* b, + ae_state *_state) +{ + double tval; + double v; + ae_int_t id; + ae_int_t i; + ae_int_t j; + ae_int_t k0; + ae_int_t lt; + ae_int_t rt; + + + ae_assert(s->matrixtype==1, "SparseMV: incorrect matrix type (convert your matrix to CRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMV: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + ae_assert(a->rows>=s->n, "SparseMV: Rows(A)0, "SparseMV: K<=0", _state); + rmatrixsetlengthatleast(b, s->m, k, _state); + if( km-1; i++) + { + for(j=0; j<=k-1; j++) + { + tval = 0; + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + for(k0=lt; k0<=rt-1; k0++) + { + tval = tval+s->vals.ptr.p_double[k0]*a->ptr.pp_double[s->idx.ptr.p_int[k0]][j]; + } + b->ptr.pp_double[i][j] = tval; + } + } + } + else + { + for(i=0; i<=s->m-1; i++) + { + for(j=0; j<=k-1; j++) + { + b->ptr.pp_double[i][j] = 0; + } + } + for(i=0; i<=s->m-1; i++) + { + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + for(j=lt; j<=rt-1; j++) + { + id = s->idx.ptr.p_int[j]; + v = s->vals.ptr.p_double[j]; + ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v); + } + } + } +} + + +/************************************************************************* +This function calculates matrix-matrix product S^T*A. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemtm(sparsematrix* s, + /* Real */ ae_matrix* a, + ae_int_t k, + /* Real */ ae_matrix* b, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k0; + ae_int_t lt; + ae_int_t rt; + ae_int_t ct; + double v; + + + ae_assert(s->matrixtype==1, "SparseMTM: incorrect matrix type (convert your matrix to CRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMTM: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + ae_assert(a->rows>=s->m, "SparseMTM: Rows(A)0, "SparseMTM: K<=0", _state); + rmatrixsetlengthatleast(b, s->n, k, _state); + for(i=0; i<=s->n-1; i++) + { + for(j=0; j<=k-1; j++) + { + b->ptr.pp_double[i][j] = 0; + } + } + if( km-1; i++) + { + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + for(k0=lt; k0<=rt-1; k0++) + { + v = s->vals.ptr.p_double[k0]; + ct = s->idx.ptr.p_int[k0]; + for(j=0; j<=k-1; j++) + { + b->ptr.pp_double[ct][j] = b->ptr.pp_double[ct][j]+v*a->ptr.pp_double[i][j]; + } + } + } + } + else + { + for(i=0; i<=s->m-1; i++) + { + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + for(j=lt; j<=rt-1; j++) + { + v = s->vals.ptr.p_double[j]; + ct = s->idx.ptr.p_int[j]; + ae_v_addd(&b->ptr.pp_double[ct][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); + } + } + } +} + + +/************************************************************************* +This function simultaneously calculates two matrix-matrix products: + S*A and S^T*A. +S must be square (non-rectangular) matrix stored in CRS format (exception +will be thrown otherwise). + +INPUT PARAMETERS + S - sparse N*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. It also throws exception when S is non-square. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemm2(sparsematrix* s, + /* Real */ ae_matrix* a, + ae_int_t k, + /* Real */ ae_matrix* b0, + /* Real */ ae_matrix* b1, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k0; + ae_int_t lt; + ae_int_t rt; + ae_int_t ct; + double v; + double tval; + + + ae_assert(s->matrixtype==1, "SparseMM2: incorrect matrix type (convert your matrix to CRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseMM2: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + ae_assert(s->m==s->n, "SparseMM2: matrix is non-square", _state); + ae_assert(a->rows>=s->n, "SparseMM2: Rows(A)0, "SparseMM2: K<=0", _state); + rmatrixsetlengthatleast(b0, s->m, k, _state); + rmatrixsetlengthatleast(b1, s->n, k, _state); + for(i=0; i<=s->n-1; i++) + { + for(j=0; j<=k-1; j++) + { + b1->ptr.pp_double[i][j] = 0; + } + } + if( km-1; i++) + { + for(j=0; j<=k-1; j++) + { + tval = 0; + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + v = a->ptr.pp_double[i][j]; + for(k0=lt; k0<=rt-1; k0++) + { + ct = s->idx.ptr.p_int[k0]; + b1->ptr.pp_double[ct][j] = b1->ptr.pp_double[ct][j]+s->vals.ptr.p_double[k0]*v; + tval = tval+s->vals.ptr.p_double[k0]*a->ptr.pp_double[ct][j]; + } + b0->ptr.pp_double[i][j] = tval; + } + } + } + else + { + for(i=0; i<=s->m-1; i++) + { + for(j=0; j<=k-1; j++) + { + b0->ptr.pp_double[i][j] = 0; + } + } + for(i=0; i<=s->m-1; i++) + { + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + for(j=lt; j<=rt-1; j++) + { + v = s->vals.ptr.p_double[j]; + ct = s->idx.ptr.p_int[j]; + ae_v_addd(&b0->ptr.pp_double[i][0], 1, &a->ptr.pp_double[ct][0], 1, ae_v_len(0,k-1), v); + ae_v_addd(&b1->ptr.pp_double[ct][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); + } + } + } +} + + +/************************************************************************* +This function calculates matrix-matrix product S*A, when S is symmetric +matrix. Matrix S must be stored in CRS format (exception will be +thrown otherwise). + +INPUT PARAMETERS + S - sparse M*M matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsesmm(sparsematrix* s, + ae_bool isupper, + /* Real */ ae_matrix* a, + ae_int_t k, + /* Real */ ae_matrix* b, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k0; + ae_int_t id; + ae_int_t lt; + ae_int_t rt; + double v; + double vb; + double va; + + + ae_assert(s->matrixtype==1, "SparseSMM: incorrect matrix type (convert your matrix to CRS)", _state); + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseSMM: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + ae_assert(a->rows>=s->n, "SparseSMM: Rows(X)m==s->n, "SparseSMM: matrix is non-square", _state); + rmatrixsetlengthatleast(b, s->m, k, _state); + for(i=0; i<=s->m-1; i++) + { + for(j=0; j<=k-1; j++) + { + b->ptr.pp_double[i][j] = 0; + } + } + if( k>sparse_linalgswitch ) + { + for(i=0; i<=s->m-1; i++) + { + for(j=0; j<=k-1; j++) + { + if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] ) + { + id = s->didx.ptr.p_int[i]; + b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+s->vals.ptr.p_double[id]*a->ptr.pp_double[s->idx.ptr.p_int[id]][j]; + } + if( isupper ) + { + lt = s->uidx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + vb = 0; + va = a->ptr.pp_double[i][j]; + for(k0=lt; k0<=rt-1; k0++) + { + id = s->idx.ptr.p_int[k0]; + v = s->vals.ptr.p_double[k0]; + vb = vb+a->ptr.pp_double[id][j]*v; + b->ptr.pp_double[id][j] = b->ptr.pp_double[id][j]+va*v; + } + b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+vb; + } + else + { + lt = s->ridx.ptr.p_int[i]; + rt = s->didx.ptr.p_int[i]; + vb = 0; + va = a->ptr.pp_double[i][j]; + for(k0=lt; k0<=rt-1; k0++) + { + id = s->idx.ptr.p_int[k0]; + v = s->vals.ptr.p_double[k0]; + vb = vb+a->ptr.pp_double[id][j]*v; + b->ptr.pp_double[id][j] = b->ptr.pp_double[id][j]+va*v; + } + b->ptr.pp_double[i][j] = b->ptr.pp_double[i][j]+vb; + } + } + } + } + else + { + for(i=0; i<=s->m-1; i++) + { + if( s->didx.ptr.p_int[i]!=s->uidx.ptr.p_int[i] ) + { + id = s->didx.ptr.p_int[i]; + v = s->vals.ptr.p_double[id]; + ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[s->idx.ptr.p_int[id]][0], 1, ae_v_len(0,k-1), v); + } + if( isupper ) + { + lt = s->uidx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + for(j=lt; j<=rt-1; j++) + { + id = s->idx.ptr.p_int[j]; + v = s->vals.ptr.p_double[j]; + ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v); + ae_v_addd(&b->ptr.pp_double[id][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); + } + } + else + { + lt = s->ridx.ptr.p_int[i]; + rt = s->didx.ptr.p_int[i]; + for(j=lt; j<=rt-1; j++) + { + id = s->idx.ptr.p_int[j]; + v = s->vals.ptr.p_double[j]; + ae_v_addd(&b->ptr.pp_double[i][0], 1, &a->ptr.pp_double[id][0], 1, ae_v_len(0,k-1), v); + ae_v_addd(&b->ptr.pp_double[id][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,k-1), v); + } + } + } + } +} + + +/************************************************************************* +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparseresizematrix(sparsematrix* s, ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t k; + ae_int_t k1; + ae_int_t i; + ae_vector tvals; + ae_vector tidx; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tidx, 0, DT_INT, _state, ae_true); + + ae_assert(s->matrixtype==0, "SparseResizeMatrix: incorrect matrix type", _state); + + /* + * Initialization for length and number of non-null elementd + */ + k = s->vals.cnt; + k1 = 0; + + /* + * Calculating number of non-null elements + */ + for(i=0; i<=k-1; i++) + { + if( s->idx.ptr.p_int[2*i]>=0 ) + { + k1 = k1+1; + } + } + + /* + * Initialization value for free space + */ + s->nfree = ae_round(k1/sparse_desiredloadfactor*sparse_growfactor+sparse_additional, _state)-k1; + ae_vector_set_length(&tvals, s->nfree+k1, _state); + ae_vector_set_length(&tidx, 2*(s->nfree+k1), _state); + ae_swap_vectors(&s->vals, &tvals); + ae_swap_vectors(&s->idx, &tidx); + for(i=0; i<=s->nfree+k1-1; i++) + { + s->idx.ptr.p_int[2*i] = -1; + } + for(i=0; i<=k-1; i++) + { + if( tidx.ptr.p_int[2*i]>=0 ) + { + sparseset(s, tidx.ptr.p_int[2*i], tidx.ptr.p_int[2*i+1], tvals.ptr.p_double[i], _state); + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function return average length of chain at hash-table. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +double sparsegetaveragelengthofchain(sparsematrix* s, ae_state *_state) +{ + ae_int_t nchains; + ae_int_t talc; + ae_int_t l; + ae_int_t i; + ae_int_t ind0; + ae_int_t ind1; + ae_int_t hashcode; + double result; + + + + /* + * If matrix represent in CRS then return zero and exit + */ + if( s->matrixtype==1 ) + { + result = 0; + return result; + } + nchains = 0; + talc = 0; + l = s->vals.cnt; + for(i=0; i<=l-1; i++) + { + ind0 = 2*i; + if( s->idx.ptr.p_int[ind0]!=-1 ) + { + nchains = nchains+1; + hashcode = sparse_hash(s->idx.ptr.p_int[ind0], s->idx.ptr.p_int[ind0+1], l, _state); + for(;;) + { + talc = talc+1; + ind1 = 2*hashcode; + if( s->idx.ptr.p_int[ind0]==s->idx.ptr.p_int[ind1]&&s->idx.ptr.p_int[ind0+1]==s->idx.ptr.p_int[ind1+1] ) + { + break; + } + hashcode = (hashcode+1)%l; + } + } + } + if( nchains==0 ) + { + result = 0; + } + else + { + result = (double)talc/(double)nchains; + } + 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<=Imatrixtype==1&&*t1<0) ) + { + result = ae_false; + return result; + } + + /* + * Hash-table matrix + */ + if( s->matrixtype==0 ) + { + sz = s->vals.cnt; + for(i0=*t0; i0<=sz-1; i0++) + { + if( s->idx.ptr.p_int[2*i0]==-1||s->idx.ptr.p_int[2*i0]==-2 ) + { + continue; + } + else + { + *i = s->idx.ptr.p_int[2*i0]; + *j = s->idx.ptr.p_int[2*i0+1]; + *v = s->vals.ptr.p_double[i0]; + *t0 = i0+1; + result = ae_true; + return result; + } + } + *t0 = 0; + result = ae_false; + return result; + } + + /* + * CRS matrix + */ + if( s->matrixtype==1&&*t0ninitialized ) + { + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseEnumerate: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + while(*t0>s->ridx.ptr.p_int[*t1+1]-1&&*t1m) + { + *t1 = *t1+1; + } + *i = *t1; + *j = s->idx.ptr.p_int[*t0]; + *v = s->vals.ptr.p_double[*t0]; + *t0 = *t0+1; + result = ae_true; + return result; + } + *t0 = 0; + *t1 = 0; + result = ae_false; + 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. + +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 Hash-Table or CRS representation. + I - row index of non-zero element to modify, 0<=Im, "SparseRewriteExisting: invalid argument I(either I<0 or I>=S.M)", _state); + ae_assert(0<=j&&jn, "SparseRewriteExisting: invalid argument J(either J<0 or J>=S.N)", _state); + ae_assert(ae_isfinite(v, _state), "SparseRewriteExisting: invalid argument V(either V is infinite or V is NaN)", _state); + result = ae_false; + + /* + * Hash-table matrix + */ + if( s->matrixtype==0 ) + { + k = s->vals.cnt; + hashcode = sparse_hash(i, j, k, _state); + for(;;) + { + if( s->idx.ptr.p_int[2*hashcode]==-1 ) + { + return result; + } + if( s->idx.ptr.p_int[2*hashcode]==i&&s->idx.ptr.p_int[2*hashcode+1]==j ) + { + s->vals.ptr.p_double[hashcode] = v; + result = ae_true; + return result; + } + hashcode = (hashcode+1)%k; + } + } + + /* + * CRS matrix + */ + if( s->matrixtype==1 ) + { + ae_assert(s->ninitialized==s->ridx.ptr.p_int[s->m], "SparseRewriteExisting: some rows/elements of the CRS matrix were not initialized (you must initialize everything you promised to SparseCreateCRS)", _state); + k0 = s->ridx.ptr.p_int[i]; + k1 = s->ridx.ptr.p_int[i+1]-1; + while(k0<=k1) + { + k = (k0+k1)/2; + if( s->idx.ptr.p_int[k]==j ) + { + s->vals.ptr.p_double[k] = v; + result = ae_true; + return result; + } + if( s->idx.ptr.p_int[k]matrixtype==1, "SparseGetRow: S must be CRS-based matrix", _state); + ae_assert(i>=0&&im, "SparseGetRow: I<0 or I>=M", _state); + rvectorsetlengthatleast(irow, s->n, _state); + for(i0=0; i0<=s->n-1; i0++) + { + irow->ptr.p_double[i0] = 0; + } + for(i0=s->ridx.ptr.p_int[i]; i0<=s->ridx.ptr.p_int[i+1]-1; i0++) + { + irow->ptr.p_double[s->idx.ptr.p_int[i0]] = s->vals.ptr.p_double[i0]; + } +} + + +/************************************************************************* +This function performs in-place conversion from CRS format 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. + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +void sparseconverttohash(sparsematrix* s, ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tidx; + ae_vector tridx; + ae_vector tvals; + ae_int_t tn; + ae_int_t tm; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tidx, 0, DT_INT, _state, ae_true); + ae_vector_init(&tridx, 0, DT_INT, _state, ae_true); + ae_vector_init(&tvals, 0, DT_REAL, _state, ae_true); + + ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseConvertToHash: invalid matrix type", _state); + if( s->matrixtype==0 ) + { + ae_frame_leave(_state); + return; + } + s->matrixtype = 0; + tm = s->m; + tn = s->n; + ae_swap_vectors(&s->idx, &tidx); + ae_swap_vectors(&s->ridx, &tridx); + ae_swap_vectors(&s->vals, &tvals); + + /* + * Delete RIdx + */ + ae_vector_set_length(&s->ridx, 0, _state); + sparsecreate(tm, tn, tridx.ptr.p_int[tm], s, _state); + + /* + * Fill the matrix + */ + for(i=0; i<=tm-1; i++) + { + for(j=tridx.ptr.p_int[i]; j<=tridx.ptr.p_int[i+1]-1; j++) + { + sparseset(s, i, tidx.ptr.p_int[j], tvals.ptr.p_double[j], _state); + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +void sparsecopytohash(sparsematrix* s0, + sparsematrix* s1, + ae_state *_state) +{ + double val; + ae_int_t t0; + ae_int_t t1; + ae_int_t i; + ae_int_t j; + + _sparsematrix_clear(s1); + + ae_assert(s0->matrixtype==0||s0->matrixtype==1, "SparseCopyToHash: invalid matrix type", _state); + if( s0->matrixtype==0 ) + { + sparsecopy(s0, s1, _state); + } + else + { + t0 = 0; + t1 = 0; + sparsecreate(s0->m, s0->n, s0->ridx.ptr.p_int[s0->m], s1, _state); + while(sparseenumerate(s0, &t0, &t1, &i, &j, &val, _state)) + { + sparseset(s1, i, j, val, _state); + } + } +} + + +/************************************************************************* +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. + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +void sparsecopytocrs(sparsematrix* s0, sparsematrix* s1, ae_state *_state) +{ + ae_frame _frame_block; + ae_vector temp; + ae_int_t nonne; + ae_int_t i; + ae_int_t k; + + ae_frame_make(_state, &_frame_block); + _sparsematrix_clear(s1); + ae_vector_init(&temp, 0, DT_INT, _state, ae_true); + + ae_assert(s0->matrixtype==0||s0->matrixtype==1, "SparseCopyToCRS: invalid matrix type", _state); + if( s0->matrixtype==1 ) + { + sparsecopy(s0, s1, _state); + } + else + { + + /* + * Done like ConvertToCRS function + */ + s1->matrixtype = 1; + s1->m = s0->m; + s1->n = s0->n; + s1->nfree = s0->nfree; + nonne = 0; + k = s0->vals.cnt; + ae_vector_set_length(&s1->ridx, s1->m+1, _state); + for(i=0; i<=s1->m; i++) + { + s1->ridx.ptr.p_int[i] = 0; + } + ae_vector_set_length(&temp, s1->m, _state); + for(i=0; i<=s1->m-1; i++) + { + temp.ptr.p_int[i] = 0; + } + + /* + * Number of elements per row + */ + for(i=0; i<=k-1; i++) + { + if( s0->idx.ptr.p_int[2*i]>=0 ) + { + s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]+1] = s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]+1]+1; + nonne = nonne+1; + } + } + + /* + * Fill RIdx (offsets of rows) + */ + for(i=0; i<=s1->m-1; i++) + { + s1->ridx.ptr.p_int[i+1] = s1->ridx.ptr.p_int[i+1]+s1->ridx.ptr.p_int[i]; + } + + /* + * Allocate memory + */ + ae_vector_set_length(&s1->vals, nonne, _state); + ae_vector_set_length(&s1->idx, nonne, _state); + for(i=0; i<=k-1; i++) + { + if( s0->idx.ptr.p_int[2*i]>=0 ) + { + s1->vals.ptr.p_double[s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]]+temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]] = s0->vals.ptr.p_double[i]; + s1->idx.ptr.p_int[s1->ridx.ptr.p_int[s0->idx.ptr.p_int[2*i]]+temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]] = s0->idx.ptr.p_int[2*i+1]; + temp.ptr.p_int[s0->idx.ptr.p_int[2*i]] = temp.ptr.p_int[s0->idx.ptr.p_int[2*i]]+1; + } + } + + /* + * Set NInitialized + */ + s1->ninitialized = s1->ridx.ptr.p_int[s1->m]; + + /* + * Sorting of elements + */ + for(i=0; i<=s1->m-1; i++) + { + tagsortmiddleir(&s1->idx, &s1->vals, s1->ridx.ptr.p_int[i], s1->ridx.ptr.p_int[i+1]-s1->ridx.ptr.p_int[i], _state); + } + + /* + * Initialization 'S.UIdx' and 'S.DIdx' + */ + sparse_sparseinitduidx(s1, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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-format + +NOTE: future versions of ALGLIB may include additional sparse storage + formats. + + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t sparsegetmatrixtype(sparsematrix* s, ae_state *_state) +{ + ae_int_t result; + + + ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseGetMatrixType: invalid matrix type", _state); + result = s->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 + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +ae_bool sparseishash(sparsematrix* s, ae_state *_state) +{ + ae_bool result; + + + ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseIsHash: invalid matrix type", _state); + result = s->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 + + -- ALGLIB PROJECT -- + Copyright 20.07.2012 by Bochkanov Sergey +*************************************************************************/ +ae_bool sparseiscrs(sparsematrix* s, ae_state *_state) +{ + ae_bool result; + + + ae_assert(s->matrixtype==0||s->matrixtype==1, "SparseIsCRS: invalid matrix type", _state); + result = s->matrixtype==1; + 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 + + -- ALGLIB PROJECT -- + Copyright 24.07.2012 by Bochkanov Sergey +*************************************************************************/ +void sparsefree(sparsematrix* s, ae_state *_state) +{ + + _sparsematrix_clear(s); + + s->matrixtype = -1; + s->m = 0; + s->n = 0; + s->nfree = 0; + s->ninitialized = 0; +} + + +/************************************************************************* +The function returns number of rows of a sparse matrix. + +RESULT: number of rows of a sparse matrix. + + -- ALGLIB PROJECT -- + Copyright 23.08.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t sparsegetnrows(sparsematrix* s, ae_state *_state) +{ + ae_int_t result; + + + result = s->m; + return result; +} + + +/************************************************************************* +The function returns number of columns of a sparse matrix. + +RESULT: number of columns of a sparse matrix. + + -- ALGLIB PROJECT -- + Copyright 23.08.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t sparsegetncols(sparsematrix* s, ae_state *_state) +{ + ae_int_t result; + + + result = s->n; + return result; +} + + +/************************************************************************* +Procedure for initialization 'S.DIdx' and 'S.UIdx' + + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +static void sparse_sparseinitduidx(sparsematrix* s, ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t lt; + ae_int_t rt; + + + ae_vector_set_length(&s->didx, s->m, _state); + ae_vector_set_length(&s->uidx, s->m, _state); + for(i=0; i<=s->m-1; i++) + { + s->uidx.ptr.p_int[i] = -1; + s->didx.ptr.p_int[i] = -1; + lt = s->ridx.ptr.p_int[i]; + rt = s->ridx.ptr.p_int[i+1]; + for(j=lt; j<=rt-1; j++) + { + if( iidx.ptr.p_int[j]&&s->uidx.ptr.p_int[i]==-1 ) + { + s->uidx.ptr.p_int[i] = j; + break; + } + else + { + if( i==s->idx.ptr.p_int[j] ) + { + s->didx.ptr.p_int[i] = j; + } + } + } + if( s->uidx.ptr.p_int[i]==-1 ) + { + s->uidx.ptr.p_int[i] = s->ridx.ptr.p_int[i+1]; + } + if( s->didx.ptr.p_int[i]==-1 ) + { + s->didx.ptr.p_int[i] = s->uidx.ptr.p_int[i]; + } + } +} + + +/************************************************************************* +This is hash function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +static ae_int_t sparse_hash(ae_int_t i, + ae_int_t j, + ae_int_t tabsize, + ae_state *_state) +{ + ae_frame _frame_block; + hqrndstate r; + ae_int_t result; + + ae_frame_make(_state, &_frame_block); + _hqrndstate_init(&r, _state, ae_true); + + hqrndseed(i, j, &r, _state); + result = hqrnduniformi(&r, tabsize, _state); + ae_frame_leave(_state); + return result; +} + + +ae_bool _sparsematrix_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + sparsematrix *p = (sparsematrix*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->vals, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->idx, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ridx, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->didx, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->uidx, 0, DT_INT, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _sparsematrix_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + sparsematrix *dst = (sparsematrix*)_dst; + sparsematrix *src = (sparsematrix*)_src; + if( !ae_vector_init_copy(&dst->vals, &src->vals, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->idx, &src->idx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ridx, &src->ridx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->didx, &src->didx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->uidx, &src->uidx, _state, make_automatic) ) + return ae_false; + dst->matrixtype = src->matrixtype; + dst->m = src->m; + dst->n = src->n; + dst->nfree = src->nfree; + dst->ninitialized = src->ninitialized; + return ae_true; +} + + +void _sparsematrix_clear(void* _p) +{ + sparsematrix *p = (sparsematrix*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->vals); + ae_vector_clear(&p->idx); + ae_vector_clear(&p->ridx); + ae_vector_clear(&p->didx); + ae_vector_clear(&p->uidx); +} + + +void _sparsematrix_destroy(void* _p) +{ + sparsematrix *p = (sparsematrix*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->vals); + ae_vector_destroy(&p->idx); + ae_vector_destroy(&p->ridx); + ae_vector_destroy(&p->didx); + ae_vector_destroy(&p->uidx); +} + + + + +/************************************************************************* +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, N>=0. + 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 + +NOTE 1: no assertion or tests are done during algorithm operation +NOTE 2: N=0 will force algorithm to silently return + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void fblscholeskysolve(/* Real */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* xb, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + double v; + + + if( n==0 ) + { + return; + } + if( tmp->cntptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); + if( iptr.p_double[i]; + ae_v_moved(&tmp->ptr.p_double[i+1], 1, &cha->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sqrtscalea); + ae_v_subd(&xb->ptr.p_double[i+1], 1, &tmp->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1), v); + } + } + + /* + * Solve U*x=y then. + */ + for(i=n-1; i>=0; i--) + { + if( iptr.p_double[i+1], 1, &cha->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sqrtscalea); + v = ae_v_dotproduct(&tmp->ptr.p_double[i+1], 1, &xb->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); + xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; + } + xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); + } + } + else + { + + /* + * Solve L*y=b first + */ + for(i=0; i<=n-1; i++) + { + if( i>0 ) + { + ae_v_moved(&tmp->ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sqrtscalea); + v = ae_v_dotproduct(&tmp->ptr.p_double[0], 1, &xb->ptr.p_double[0], 1, ae_v_len(0,i-1)); + xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; + } + xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); + } + + /* + * Solve L'*x=y then. + */ + for(i=n-1; i>=0; i--) + { + xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); + if( i>0 ) + { + v = xb->ptr.p_double[i]; + ae_v_moved(&tmp->ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sqrtscalea); + ae_v_subd(&xb->ptr.p_double[0], 1, &tmp->ptr.p_double[0], 1, ae_v_len(0,i-1), v); + } + } + } +} + + +/************************************************************************* +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)). + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void fblssolvecgx(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + double alpha, + /* Real */ ae_vector* b, + /* Real */ ae_vector* x, + /* Real */ ae_vector* buf, + ae_state *_state) +{ + ae_int_t k; + ae_int_t offsrk; + ae_int_t offsrk1; + ae_int_t offsxk; + ae_int_t offsxk1; + ae_int_t offspk; + ae_int_t offspk1; + ae_int_t offstmp1; + ae_int_t offstmp2; + ae_int_t bs; + double e1; + double e2; + double rk2; + double rk12; + double pap; + double s; + double betak; + double v1; + double v2; + + + + /* + * Test for special case: B=0 + */ + v1 = ae_v_dotproduct(&b->ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_fp_eq(v1,0) ) + { + for(k=0; k<=n-1; k++) + { + x->ptr.p_double[k] = 0; + } + 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] + */ + offsrk = 0; + offsrk1 = offsrk+n; + offsxk = offsrk1+n; + offsxk1 = offsxk+n; + offspk = offsxk1+n; + offspk1 = offspk+n; + offstmp1 = offspk1+n; + offstmp2 = offstmp1+m; + bs = offstmp2+n; + if( buf->cntptr.p_double[offsxk], 1, &x->ptr.p_double[0], 1, ae_v_len(offsxk,offsxk+n-1)); + + /* + * r(0) = b-A*x(0) + * RK2 = r(0)'*r(0) + */ + rmatrixmv(m, n, a, 0, 0, 0, buf, offsxk, buf, offstmp1, _state); + rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state); + ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha); + ae_v_move(&buf->ptr.p_double[offsrk], 1, &b->ptr.p_double[0], 1, ae_v_len(offsrk,offsrk+n-1)); + ae_v_sub(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk,offsrk+n-1)); + rk2 = ae_v_dotproduct(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk,offsrk+n-1)); + ae_v_move(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offspk,offspk+n-1)); + e1 = ae_sqrt(rk2, _state); + + /* + * Cycle + */ + for(k=0; k<=n-1; 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) + */ + rmatrixmv(m, n, a, 0, 0, 0, buf, offspk, buf, offstmp1, _state); + v1 = ae_v_dotproduct(&buf->ptr.p_double[offstmp1], 1, &buf->ptr.p_double[offstmp1], 1, ae_v_len(offstmp1,offstmp1+m-1)); + v2 = ae_v_dotproduct(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offspk,offspk+n-1)); + pap = v1+alpha*v2; + rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state); + ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha); + if( ae_fp_eq(pap,0) ) + { + break; + } + + /* + * S = (r(k)'*r(k))/(p(k)'*A*p(k)) + */ + s = rk2/pap; + + /* + * x(k+1) = x(k) + S*p(k) + */ + ae_v_move(&buf->ptr.p_double[offsxk1], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offsxk1,offsxk1+n-1)); + ae_v_addd(&buf->ptr.p_double[offsxk1], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offsxk1,offsxk1+n-1), 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)) + */ + ae_v_move(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk1,offsrk1+n-1)); + ae_v_subd(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk1,offsrk1+n-1), s); + rk12 = ae_v_dotproduct(&buf->ptr.p_double[offsrk1], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offsrk1,offsrk1+n-1)); + if( ae_fp_less_eq(ae_sqrt(rk12, _state),100*ae_machineepsilon*ae_sqrt(rk2, _state)) ) + { + + /* + * X(k) = x(k+1) before exit - + * - because we expect to find solution at x(k) + */ + ae_v_move(&buf->ptr.p_double[offsxk], 1, &buf->ptr.p_double[offsxk1], 1, ae_v_len(offsxk,offsxk+n-1)); + break; + } + + /* + * BetaK = RK12/RK2 + * p(k+1) = r(k+1)+betak*p(k) + */ + betak = rk12/rk2; + ae_v_move(&buf->ptr.p_double[offspk1], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offspk1,offspk1+n-1)); + ae_v_addd(&buf->ptr.p_double[offspk1], 1, &buf->ptr.p_double[offspk], 1, ae_v_len(offspk1,offspk1+n-1), betak); + + /* + * r(k) := r(k+1) + * x(k) := x(k+1) + * p(k) := p(k+1) + */ + ae_v_move(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk1], 1, ae_v_len(offsrk,offsrk+n-1)); + ae_v_move(&buf->ptr.p_double[offsxk], 1, &buf->ptr.p_double[offsxk1], 1, ae_v_len(offsxk,offsxk+n-1)); + ae_v_move(&buf->ptr.p_double[offspk], 1, &buf->ptr.p_double[offspk1], 1, ae_v_len(offspk,offspk+n-1)); + rk2 = rk12; + } + + /* + * Calculate E2 + */ + rmatrixmv(m, n, a, 0, 0, 0, buf, offsxk, buf, offstmp1, _state); + rmatrixmv(n, m, a, 0, 0, 1, buf, offstmp1, buf, offstmp2, _state); + ae_v_addd(&buf->ptr.p_double[offstmp2], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(offstmp2,offstmp2+n-1), alpha); + ae_v_move(&buf->ptr.p_double[offsrk], 1, &b->ptr.p_double[0], 1, ae_v_len(offsrk,offsrk+n-1)); + ae_v_sub(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offstmp2], 1, ae_v_len(offsrk,offsrk+n-1)); + v1 = ae_v_dotproduct(&buf->ptr.p_double[offsrk], 1, &buf->ptr.p_double[offsrk], 1, ae_v_len(offsrk,offsrk+n-1)); + e2 = ae_sqrt(v1, _state); + + /* + * Output result (if it was improved) + */ + if( ae_fp_less(e2,e1) ) + { + ae_v_move(&x->ptr.p_double[0], 1, &buf->ptr.p_double[offsxk], 1, ae_v_len(0,n-1)); + } +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 22.10.2009 by Bochkanov Sergey +*************************************************************************/ +void fblscgcreate(/* Real */ ae_vector* x, + /* Real */ ae_vector* b, + ae_int_t n, + fblslincgstate* state, + ae_state *_state) +{ + + + if( state->b.cntb, n, _state); + } + if( state->rk.cntrk, n, _state); + } + if( state->rk1.cntrk1, n, _state); + } + if( state->xk.cntxk, n, _state); + } + if( state->xk1.cntxk1, n, _state); + } + if( state->pk.cntpk, n, _state); + } + if( state->pk1.cntpk1, n, _state); + } + if( state->tmp2.cnttmp2, n, _state); + } + if( state->x.cntx, n, _state); + } + if( state->ax.cntax, n, _state); + } + state->n = n; + ae_v_move(&state->xk.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_vector_set_length(&state->rstate.ia, 1+1, _state); + ae_vector_set_length(&state->rstate.ra, 6+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +Linear CG solver, function relying on reverse communication to calculate +matrix-vector products. + +See comments for FBLSLinCGState structure for more info. + + -- ALGLIB -- + Copyright 22.10.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool fblscgiteration(fblslincgstate* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t k; + double rk2; + double rk12; + double pap; + double s; + double betak; + double v1; + double v2; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + k = state->rstate.ia.ptr.p_int[1]; + rk2 = state->rstate.ra.ptr.p_double[0]; + rk12 = state->rstate.ra.ptr.p_double[1]; + pap = state->rstate.ra.ptr.p_double[2]; + s = state->rstate.ra.ptr.p_double[3]; + betak = state->rstate.ra.ptr.p_double[4]; + v1 = state->rstate.ra.ptr.p_double[5]; + v2 = state->rstate.ra.ptr.p_double[6]; + } + else + { + n = -983; + k = -989; + rk2 = -834; + rk12 = 900; + pap = -287; + s = 364; + betak = 214; + v1 = -338; + v2 = -686; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + + /* + * Routine body + */ + + /* + * prepare locals + */ + n = state->n; + + /* + * Test for special case: B=0 + */ + v1 = ae_v_dotproduct(&state->b.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_fp_eq(v1,0) ) + { + for(k=0; k<=n-1; k++) + { + state->xk.ptr.p_double[k] = 0; + } + result = ae_false; + return result; + } + + /* + * r(0) = b-A*x(0) + * RK2 = r(0)'*r(0) + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + ae_v_move(&state->rk.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_sub(&state->rk.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1)); + rk2 = ae_v_dotproduct(&state->rk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->pk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->e1 = ae_sqrt(rk2, _state); + + /* + * Cycle + */ + k = 0; +lbl_3: + if( k>n-1 ) + { + goto lbl_5; + } + + /* + * Calculate A*p(k) - store in State.Tmp2 + * and p(k)'*A*p(k) - store in PAP + * + * If PAP=0, break (iteration is over) + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + ae_v_move(&state->tmp2.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1)); + pap = state->xax; + if( !ae_isfinite(pap, _state) ) + { + goto lbl_5; + } + if( ae_fp_less_eq(pap,0) ) + { + goto lbl_5; + } + + /* + * S = (r(k)'*r(k))/(p(k)'*A*p(k)) + */ + s = rk2/pap; + + /* + * x(k+1) = x(k) + S*p(k) + */ + ae_v_move(&state->xk1.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->xk1.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1), 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)) + */ + ae_v_move(&state->rk1.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_subd(&state->rk1.ptr.p_double[0], 1, &state->tmp2.ptr.p_double[0], 1, ae_v_len(0,n-1), s); + rk12 = ae_v_dotproduct(&state->rk1.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_fp_less_eq(ae_sqrt(rk12, _state),100*ae_machineepsilon*state->e1) ) + { + + /* + * X(k) = x(k+1) before exit - + * - because we expect to find solution at x(k) + */ + ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + goto lbl_5; + } + + /* + * 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; + ae_v_move(&state->pk1.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->pk1.ptr.p_double[0], 1, &state->pk.ptr.p_double[0], 1, ae_v_len(0,n-1), betak); + + /* + * r(k) := r(k+1) + * x(k) := x(k+1) + * p(k) := p(k+1) + */ + ae_v_move(&state->rk.ptr.p_double[0], 1, &state->rk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->pk.ptr.p_double[0], 1, &state->pk1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + rk2 = rk12; + k = k+1; + goto lbl_3; +lbl_5: + + /* + * Calculate E2 + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + ae_v_move(&state->rk.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_sub(&state->rk.ptr.p_double[0], 1, &state->ax.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v1 = ae_v_dotproduct(&state->rk.ptr.p_double[0], 1, &state->rk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->e2 = ae_sqrt(v1, _state); + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = k; + state->rstate.ra.ptr.p_double[0] = rk2; + state->rstate.ra.ptr.p_double[1] = rk12; + state->rstate.ra.ptr.p_double[2] = pap; + state->rstate.ra.ptr.p_double[3] = s; + state->rstate.ra.ptr.p_double[4] = betak; + state->rstate.ra.ptr.p_double[5] = v1; + state->rstate.ra.ptr.p_double[6] = v2; + return result; +} + + +/************************************************************************* +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) + + -- ALGLIB -- + Copyright 20.01.2012 by Bochkanov Sergey +*************************************************************************/ +void fblssolvels(/* Real */ ae_matrix* a, + /* Real */ ae_vector* b, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tmp0, + /* Real */ ae_vector* tmp1, + /* Real */ ae_vector* tmp2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + double v; + + + ae_assert(n>0, "FBLSSolveLS: N<=0", _state); + ae_assert(m>=n, "FBLSSolveLS: Mrows>=m, "FBLSSolveLS: Rows(A)cols>=n, "FBLSSolveLS: Cols(A)cnt>=m, "FBLSSolveLS: Length(B)ptr.p_double[i] = 0; + } + ae_v_move(&tmp0->ptr.p_double[k], 1, &a->ptr.pp_double[k][k], a->stride, ae_v_len(k,m-1)); + tmp0->ptr.p_double[k] = 1; + v = ae_v_dotproduct(&tmp0->ptr.p_double[k], 1, &b->ptr.p_double[k], 1, ae_v_len(k,m-1)); + v = v*tmp2->ptr.p_double[k]; + ae_v_subd(&b->ptr.p_double[k], 1, &tmp0->ptr.p_double[k], 1, ae_v_len(k,m-1), v); + } + + /* + * Solve triangular system + */ + b->ptr.p_double[n-1] = b->ptr.p_double[n-1]/a->ptr.pp_double[n-1][n-1]; + for(i=n-2; i>=0; i--) + { + v = ae_v_dotproduct(&a->ptr.pp_double[i][i+1], 1, &b->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); + b->ptr.p_double[i] = (b->ptr.p_double[i]-v)/a->ptr.pp_double[i][i]; + } + for(i=n; i<=m-1; i++) + { + b->ptr.p_double[i] = 0.0; + } +} + + +ae_bool _fblslincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + fblslincgstate *p = (fblslincgstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ax, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rk1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xk1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->pk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->pk1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp2, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _fblslincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + fblslincgstate *dst = (fblslincgstate*)_dst; + fblslincgstate *src = (fblslincgstate*)_src; + dst->e1 = src->e1; + dst->e2 = src->e2; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ax, &src->ax, _state, make_automatic) ) + return ae_false; + dst->xax = src->xax; + dst->n = src->n; + if( !ae_vector_init_copy(&dst->rk, &src->rk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rk1, &src->rk1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xk, &src->xk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xk1, &src->xk1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->pk, &src->pk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->pk1, &src->pk1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmp2, &src->tmp2, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _fblslincgstate_clear(void* _p) +{ + fblslincgstate *p = (fblslincgstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x); + ae_vector_clear(&p->ax); + ae_vector_clear(&p->rk); + ae_vector_clear(&p->rk1); + ae_vector_clear(&p->xk); + ae_vector_clear(&p->xk1); + ae_vector_clear(&p->pk); + ae_vector_clear(&p->pk1); + ae_vector_clear(&p->b); + _rcommstate_clear(&p->rstate); + ae_vector_clear(&p->tmp2); +} + + +void _fblslincgstate_destroy(void* _p) +{ + fblslincgstate *p = (fblslincgstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->ax); + ae_vector_destroy(&p->rk); + ae_vector_destroy(&p->rk1); + ae_vector_destroy(&p->xk); + ae_vector_destroy(&p->xk1); + ae_vector_destroy(&p->pk); + ae_vector_destroy(&p->pk1); + ae_vector_destroy(&p->b); + _rcommstate_destroy(&p->rstate); + ae_vector_destroy(&p->tmp2); +} + + + + +/************************************************************************* +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 vectors, 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. + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorcreate(ae_int_t m, + ae_int_t n, + ae_int_t nstart, + ae_int_t nits, + normestimatorstate* state, + ae_state *_state) +{ + + _normestimatorstate_clear(state); + + ae_assert(m>0, "NormEstimatorCreate: M<=0", _state); + ae_assert(n>0, "NormEstimatorCreate: N<=0", _state); + ae_assert(nstart>0, "NormEstimatorCreate: NStart<=0", _state); + ae_assert(nits>0, "NormEstimatorCreate: NIts<=0", _state); + state->m = m; + state->n = n; + state->nstart = nstart; + state->nits = nits; + state->seedval = 11; + hqrndrandomize(&state->r, _state); + ae_vector_set_length(&state->x0, state->n, _state); + ae_vector_set_length(&state->t, state->m, _state); + ae_vector_set_length(&state->x1, state->n, _state); + ae_vector_set_length(&state->xbest, state->n, _state); + ae_vector_set_length(&state->x, ae_maxint(state->n, state->m, _state), _state); + ae_vector_set_length(&state->mv, state->m, _state); + ae_vector_set_length(&state->mtv, state->n, _state); + ae_vector_set_length(&state->rstate.ia, 3+1, _state); + ae_vector_set_length(&state->rstate.ra, 2+1, _state); + state->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. + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorsetseed(normestimatorstate* state, + ae_int_t seedval, + ae_state *_state) +{ + + + ae_assert(seedval>=0, "NormEstimatorSetSeed: SeedVal<0", _state); + state->seedval = seedval; +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +ae_bool normestimatoriteration(normestimatorstate* state, + ae_state *_state) +{ + ae_int_t n; + ae_int_t m; + ae_int_t i; + ae_int_t itcnt; + double v; + double growth; + double bestgrowth; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + m = state->rstate.ia.ptr.p_int[1]; + i = state->rstate.ia.ptr.p_int[2]; + itcnt = state->rstate.ia.ptr.p_int[3]; + v = state->rstate.ra.ptr.p_double[0]; + growth = state->rstate.ra.ptr.p_double[1]; + bestgrowth = state->rstate.ra.ptr.p_double[2]; + } + else + { + n = -983; + m = -989; + i = -834; + itcnt = 900; + v = -287; + growth = 364; + bestgrowth = 214; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + + /* + * Routine body + */ + n = state->n; + m = state->m; + if( state->seedval>0 ) + { + hqrndseed(state->seedval, state->seedval+2, &state->r, _state); + } + bestgrowth = 0; + state->xbest.ptr.p_double[0] = 1; + for(i=1; i<=n-1; i++) + { + state->xbest.ptr.p_double[i] = 0; + } + itcnt = 0; +lbl_4: + if( itcnt>state->nstart-1 ) + { + goto lbl_6; + } + do + { + v = 0; + for(i=0; i<=n-1; i++) + { + state->x0.ptr.p_double[i] = hqrndnormal(&state->r, _state); + v = v+ae_sqr(state->x0.ptr.p_double[i], _state); + } + } + while(ae_fp_eq(v,0)); + v = 1/ae_sqrt(v, _state); + ae_v_muld(&state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->needmv = ae_true; + state->needmtv = ae_false; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + ae_v_move(&state->x.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,m-1)); + state->needmv = ae_false; + state->needmtv = ae_true; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + ae_v_move(&state->x1.ptr.p_double[0], 1, &state->mtv.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->x1.ptr.p_double[i], _state); + } + growth = ae_sqrt(ae_sqrt(v, _state), _state); + if( ae_fp_greater(growth,bestgrowth) ) + { + v = 1/ae_sqrt(v, _state); + ae_v_moved(&state->xbest.ptr.p_double[0], 1, &state->x1.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + bestgrowth = growth; + } + itcnt = itcnt+1; + goto lbl_4; +lbl_6: + ae_v_move(&state->x0.ptr.p_double[0], 1, &state->xbest.ptr.p_double[0], 1, ae_v_len(0,n-1)); + itcnt = 0; +lbl_7: + if( itcnt>state->nits-1 ) + { + goto lbl_9; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->x0.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->needmv = ae_true; + state->needmtv = ae_false; + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + ae_v_move(&state->x.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,m-1)); + state->needmv = ae_false; + state->needmtv = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + ae_v_move(&state->x1.ptr.p_double[0], 1, &state->mtv.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->x1.ptr.p_double[i], _state); + } + state->repnorm = ae_sqrt(ae_sqrt(v, _state), _state); + if( ae_fp_neq(v,0) ) + { + v = 1/ae_sqrt(v, _state); + ae_v_moved(&state->x0.ptr.p_double[0], 1, &state->x1.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + } + itcnt = itcnt+1; + goto lbl_7; +lbl_9: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = m; + state->rstate.ia.ptr.p_int[2] = i; + state->rstate.ia.ptr.p_int[3] = itcnt; + state->rstate.ra.ptr.p_double[0] = v; + state->rstate.ra.ptr.p_double[1] = growth; + state->rstate.ra.ptr.p_double[2] = bestgrowth; + return result; +} + + +/************************************************************************* +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). + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorestimatesparse(normestimatorstate* state, + sparsematrix* a, + ae_state *_state) +{ + + + normestimatorrestart(state, _state); + while(normestimatoriteration(state, _state)) + { + if( state->needmv ) + { + sparsemv(a, &state->x, &state->mv, _state); + continue; + } + if( state->needmtv ) + { + sparsemtv(a, &state->x, &state->mtv, _state); + continue; + } + } +} + + +/************************************************************************* +Matrix norm estimation results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + Nrm - estimate of the matrix norm, Nrm>=0 + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorresults(normestimatorstate* state, + double* nrm, + ae_state *_state) +{ + + *nrm = 0; + + *nrm = state->repnorm; +} + + +/************************************************************************* +This function restarts estimator and prepares it for the next estimation +round. + +INPUT PARAMETERS: + State - algorithm state + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorrestart(normestimatorstate* state, ae_state *_state) +{ + + + ae_vector_set_length(&state->rstate.ia, 3+1, _state); + ae_vector_set_length(&state->rstate.ra, 2+1, _state); + state->rstate.stage = -1; +} + + +ae_bool _normestimatorstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + normestimatorstate *p = (normestimatorstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->t, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xbest, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_hqrndstate_init(&p->r, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->mv, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->mtv, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _normestimatorstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + normestimatorstate *dst = (normestimatorstate*)_dst; + normestimatorstate *src = (normestimatorstate*)_src; + dst->n = src->n; + dst->m = src->m; + dst->nstart = src->nstart; + dst->nits = src->nits; + dst->seedval = src->seedval; + if( !ae_vector_init_copy(&dst->x0, &src->x0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->x1, &src->x1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->t, &src->t, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xbest, &src->xbest, _state, make_automatic) ) + return ae_false; + if( !_hqrndstate_init_copy(&dst->r, &src->r, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->mv, &src->mv, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->mtv, &src->mtv, _state, make_automatic) ) + return ae_false; + dst->needmv = src->needmv; + dst->needmtv = src->needmtv; + dst->repnorm = src->repnorm; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _normestimatorstate_clear(void* _p) +{ + normestimatorstate *p = (normestimatorstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x0); + ae_vector_clear(&p->x1); + ae_vector_clear(&p->t); + ae_vector_clear(&p->xbest); + _hqrndstate_clear(&p->r); + ae_vector_clear(&p->x); + ae_vector_clear(&p->mv); + ae_vector_clear(&p->mtv); + _rcommstate_clear(&p->rstate); +} + + +void _normestimatorstate_destroy(void* _p) +{ + normestimatorstate *p = (normestimatorstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x0); + ae_vector_destroy(&p->x1); + ae_vector_destroy(&p->t); + ae_vector_destroy(&p->xbest); + _hqrndstate_destroy(&p->r); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->mv); + ae_vector_destroy(&p->mtv); + _rcommstate_destroy(&p->rstate); +} + + + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +double rmatrixludet(/* Real */ ae_matrix* a, + /* Integer */ ae_vector* pivots, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t s; + double result; + + + ae_assert(n>=1, "RMatrixLUDet: N<1!", _state); + ae_assert(pivots->cnt>=n, "RMatrixLUDet: Pivots array is too short!", _state); + ae_assert(a->rows>=n, "RMatrixLUDet: rows(A)cols>=n, "RMatrixLUDet: cols(A)ptr.pp_double[i][i]; + if( pivots->ptr.p_int[i]!=i ) + { + s = -s; + } + } + result = result*s; + return result; +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +double rmatrixdet(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_vector pivots; + double result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "RMatrixDet: N<1!", _state); + ae_assert(a->rows>=n, "RMatrixDet: rows(A)cols>=n, "RMatrixDet: cols(A)=1, "CMatrixLUDet: N<1!", _state); + ae_assert(pivots->cnt>=n, "CMatrixLUDet: Pivots array is too short!", _state); + ae_assert(a->rows>=n, "CMatrixLUDet: rows(A)cols>=n, "CMatrixLUDet: cols(A)ptr.pp_complex[i][i]); + if( pivots->ptr.p_int[i]!=i ) + { + s = -s; + } + } + result = ae_c_mul_d(result,s); + return result; +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +ae_complex cmatrixdet(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_vector pivots; + ae_complex result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + ae_vector_init(&pivots, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "CMatrixDet: N<1!", _state); + ae_assert(a->rows>=n, "CMatrixDet: rows(A)cols>=n, "CMatrixDet: cols(A)=1, "SPDMatrixCholeskyDet: N<1!", _state); + ae_assert(a->rows>=n, "SPDMatrixCholeskyDet: rows(A)cols>=n, "SPDMatrixCholeskyDet: cols(A)ptr.pp_double[i][i], _state); + } + ae_assert(f, "SPDMatrixCholeskyDet: A contains infinite or NaN values!", _state); + result = 1; + for(i=0; i<=n-1; i++) + { + result = result*ae_sqr(a->ptr.pp_double[i][i], _state); + } + 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. + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +double spdmatrixdet(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _a; + ae_bool b; + double result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_a, a, _state, ae_true); + a = &_a; + + ae_assert(n>=1, "SPDMatrixDet: N<1!", _state); + ae_assert(a->rows>=n, "SPDMatrixDet: rows(A)cols>=n, "SPDMatrixDet: cols(A)ptr.pp_double[0][j] = 0.0; + } + for(i=1; i<=n-1; i++) + { + ae_v_move(&z->ptr.pp_double[i][0], 1, &z->ptr.pp_double[0][0], 1, ae_v_len(0,n-1)); + } + + /* + * 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-1; i++) + { + for(j=j1; j<=j2; j++) + { + v = r.ptr.pp_double[i][j]; + ae_v_addd(&z->ptr.pp_double[i][0], 1, &t.ptr.pp_double[j][0], 1, ae_v_len(0,n-1), v); + } + j1 = j1+j1inc; + j2 = j2+j2inc; + } + } + ae_frame_leave(_state); + 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). + + -- ALGLIB -- + Copyright 1.28.2006 by Bochkanov Sergey +*************************************************************************/ +ae_bool smatrixgevdreduce(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isuppera, + /* Real */ ae_matrix* b, + ae_bool isupperb, + ae_int_t problemtype, + /* Real */ ae_matrix* r, + ae_bool* isupperr, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix t; + ae_vector w1; + ae_vector w2; + ae_vector w3; + ae_int_t i; + ae_int_t j; + double v; + matinvreport rep; + ae_int_t info; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(r); + *isupperr = ae_false; + ae_matrix_init(&t, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w2, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w3, 0, DT_REAL, _state, ae_true); + _matinvreport_init(&rep, _state, ae_true); + + ae_assert(n>0, "SMatrixGEVDReduce: N<=0!", _state); + ae_assert((problemtype==1||problemtype==2)||problemtype==3, "SMatrixGEVDReduce: incorrect ProblemType!", _state); + result = ae_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' + */ + ae_matrix_set_length(&t, n-1+1, n-1+1, _state); + if( isupperb ) + { + for(i=0; i<=n-1; i++) + { + ae_v_move(&t.ptr.pp_double[i][i], t.stride, &b->ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); + } + } + else + { + for(i=0; i<=n-1; i++) + { + ae_v_move(&t.ptr.pp_double[i][0], 1, &b->ptr.pp_double[i][0], 1, ae_v_len(0,i)); + } + } + if( !spdmatrixcholesky(&t, n, ae_false, _state) ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Invert L in T + */ + rmatrixtrinverse(&t, n, ae_false, ae_false, &info, &rep, _state); + if( info<=0 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Build L^(-1) * A * L^(-T) in R + */ + ae_vector_set_length(&w1, n+1, _state); + ae_vector_set_length(&w2, n+1, _state); + ae_matrix_set_length(r, n-1+1, n-1+1, _state); + for(j=1; j<=n; j++) + { + + /* + * Form w2 = A * l'(j) (here l'(j) is j-th column of L^(-T)) + */ + ae_v_move(&w1.ptr.p_double[1], 1, &t.ptr.pp_double[j-1][0], 1, ae_v_len(1,j)); + symmetricmatrixvectormultiply(a, isuppera, 0, j-1, &w1, 1.0, &w2, _state); + if( isuppera ) + { + matrixvectormultiply(a, 0, j-1, j, n-1, ae_true, &w1, 1, j, 1.0, &w2, j+1, n, 0.0, _state); + } + else + { + matrixvectormultiply(a, j, n-1, 0, j-1, ae_false, &w1, 1, j, 1.0, &w2, j+1, n, 0.0, _state); + } + + /* + * Form l(i)*w2 (here l(i) is i-th row of L^(-1)) + */ + for(i=1; i<=n; i++) + { + v = ae_v_dotproduct(&t.ptr.pp_double[i-1][0], 1, &w2.ptr.p_double[1], 1, ae_v_len(0,i-1)); + r->ptr.pp_double[i-1][j-1] = v; + } + } + + /* + * Copy R to A + */ + for(i=0; i<=n-1; i++) + { + ae_v_move(&a->ptr.pp_double[i][0], 1, &r->ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + } + + /* + * Copy L^(-1) from T to R and transpose + */ + *isupperr = ae_true; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i-1; j++) + { + r->ptr.pp_double[i][j] = 0; + } + } + for(i=0; i<=n-1; i++) + { + ae_v_move(&r->ptr.pp_double[i][i], 1, &t.ptr.pp_double[i][i], t.stride, ae_v_len(i,n-1)); + } + ae_frame_leave(_state); + 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 + */ + ae_matrix_set_length(&t, n-1+1, n-1+1, _state); + if( isupperb ) + { + for(i=0; i<=n-1; i++) + { + ae_v_move(&t.ptr.pp_double[i][i], 1, &b->ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); + } + } + else + { + for(i=0; i<=n-1; i++) + { + ae_v_move(&t.ptr.pp_double[i][i], 1, &b->ptr.pp_double[i][i], b->stride, ae_v_len(i,n-1)); + } + } + if( !spdmatrixcholesky(&t, n, ae_true, _state) ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Build U * A * U' in R + */ + ae_vector_set_length(&w1, n+1, _state); + ae_vector_set_length(&w2, n+1, _state); + ae_vector_set_length(&w3, n+1, _state); + ae_matrix_set_length(r, n-1+1, n-1+1, _state); + for(j=1; j<=n; j++) + { + + /* + * Form w2 = A * u'(j) (here u'(j) is j-th column of U') + */ + ae_v_move(&w1.ptr.p_double[1], 1, &t.ptr.pp_double[j-1][j-1], 1, ae_v_len(1,n-j+1)); + symmetricmatrixvectormultiply(a, isuppera, j-1, n-1, &w1, 1.0, &w3, _state); + ae_v_move(&w2.ptr.p_double[j], 1, &w3.ptr.p_double[1], 1, ae_v_len(j,n)); + ae_v_move(&w1.ptr.p_double[j], 1, &t.ptr.pp_double[j-1][j-1], 1, ae_v_len(j,n)); + if( isuppera ) + { + matrixvectormultiply(a, 0, j-2, j-1, n-1, ae_false, &w1, j, n, 1.0, &w2, 1, j-1, 0.0, _state); + } + else + { + matrixvectormultiply(a, j-1, n-1, 0, j-2, ae_true, &w1, j, n, 1.0, &w2, 1, j-1, 0.0, _state); + } + + /* + * Form u(i)*w2 (here u(i) is i-th row of U) + */ + for(i=1; i<=n; i++) + { + v = ae_v_dotproduct(&t.ptr.pp_double[i-1][i-1], 1, &w2.ptr.p_double[i], 1, ae_v_len(i-1,n-1)); + r->ptr.pp_double[i-1][j-1] = v; + } + } + + /* + * Copy R to A + */ + for(i=0; i<=n-1; i++) + { + ae_v_move(&a->ptr.pp_double[i][0], 1, &r->ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + } + if( problemtype==2 ) + { + + /* + * Invert U in T + */ + rmatrixtrinverse(&t, n, ae_true, ae_false, &info, &rep, _state); + if( info<=0 ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + + /* + * Copy U^-1 from T to R + */ + *isupperr = ae_true; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=i-1; j++) + { + r->ptr.pp_double[i][j] = 0; + } + } + for(i=0; i<=n-1; i++) + { + ae_v_move(&r->ptr.pp_double[i][i], 1, &t.ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); + } + } + else + { + + /* + * Copy U from T to R and transpose + */ + *isupperr = ae_false; + for(i=0; i<=n-1; i++) + { + for(j=i+1; j<=n-1; j++) + { + r->ptr.pp_double[i][j] = 0; + } + } + for(i=0; i<=n-1; i++) + { + ae_v_move(&r->ptr.pp_double[i][i], r->stride, &t.ptr.pp_double[i][i], 1, ae_v_len(i,n-1)); + } + } + } + ae_frame_leave(_state); + return result; +} + + + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdatesimple(/* Real */ ae_matrix* inva, + ae_int_t n, + ae_int_t updrow, + ae_int_t updcolumn, + double updval, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector t1; + ae_vector t2; + ae_int_t i; + double lambdav; + double vt; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&t1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); + + ae_assert(updrow>=0&&updrow=0&&updcolumnptr.pp_double[0][updrow], inva->stride, ae_v_len(0,n-1)); + + /* + * T2 = v*InvA + */ + ae_v_move(&t2.ptr.p_double[0], 1, &inva->ptr.pp_double[updcolumn][0], 1, ae_v_len(0,n-1)); + + /* + * Lambda = v * InvA * U + */ + lambdav = updval*inva->ptr.pp_double[updcolumn][updrow]; + + /* + * InvA = InvA - correction + */ + for(i=0; i<=n-1; i++) + { + vt = updval*t1.ptr.p_double[i]; + vt = vt/(1+lambdav); + ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdaterow(/* Real */ ae_matrix* inva, + ae_int_t n, + ae_int_t updrow, + /* Real */ ae_vector* v, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector t1; + ae_vector t2; + ae_int_t i; + ae_int_t j; + double lambdav; + double vt; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&t1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&t1, n-1+1, _state); + ae_vector_set_length(&t2, n-1+1, _state); + + /* + * T1 = InvA * U + */ + ae_v_move(&t1.ptr.p_double[0], 1, &inva->ptr.pp_double[0][updrow], inva->stride, ae_v_len(0,n-1)); + + /* + * T2 = v*InvA + * Lambda = v * InvA * U + */ + for(j=0; j<=n-1; j++) + { + vt = ae_v_dotproduct(&v->ptr.p_double[0], 1, &inva->ptr.pp_double[0][j], inva->stride, ae_v_len(0,n-1)); + t2.ptr.p_double[j] = vt; + } + lambdav = t2.ptr.p_double[updrow]; + + /* + * InvA = InvA - correction + */ + for(i=0; i<=n-1; i++) + { + vt = t1.ptr.p_double[i]/(1+lambdav); + ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdatecolumn(/* Real */ ae_matrix* inva, + ae_int_t n, + ae_int_t updcolumn, + /* Real */ ae_vector* u, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector t1; + ae_vector t2; + ae_int_t i; + double lambdav; + double vt; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&t1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&t1, n-1+1, _state); + ae_vector_set_length(&t2, n-1+1, _state); + + /* + * T1 = InvA * U + * Lambda = v * InvA * U + */ + for(i=0; i<=n-1; i++) + { + vt = ae_v_dotproduct(&inva->ptr.pp_double[i][0], 1, &u->ptr.p_double[0], 1, ae_v_len(0,n-1)); + t1.ptr.p_double[i] = vt; + } + lambdav = t1.ptr.p_double[updcolumn]; + + /* + * T2 = v*InvA + */ + ae_v_move(&t2.ptr.p_double[0], 1, &inva->ptr.pp_double[updcolumn][0], 1, ae_v_len(0,n-1)); + + /* + * InvA = InvA - correction + */ + for(i=0; i<=n-1; i++) + { + vt = t1.ptr.p_double[i]/(1+lambdav); + ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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'. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdateuv(/* Real */ ae_matrix* inva, + ae_int_t n, + /* Real */ ae_vector* u, + /* Real */ ae_vector* v, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector t1; + ae_vector t2; + ae_int_t i; + ae_int_t j; + double lambdav; + double vt; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&t1, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t2, 0, DT_REAL, _state, ae_true); + + ae_vector_set_length(&t1, n-1+1, _state); + ae_vector_set_length(&t2, n-1+1, _state); + + /* + * T1 = InvA * U + * Lambda = v * T1 + */ + for(i=0; i<=n-1; i++) + { + vt = ae_v_dotproduct(&inva->ptr.pp_double[i][0], 1, &u->ptr.p_double[0], 1, ae_v_len(0,n-1)); + t1.ptr.p_double[i] = vt; + } + lambdav = ae_v_dotproduct(&v->ptr.p_double[0], 1, &t1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * T2 = v*InvA + */ + for(j=0; j<=n-1; j++) + { + vt = ae_v_dotproduct(&v->ptr.p_double[0], 1, &inva->ptr.pp_double[0][j], inva->stride, ae_v_len(0,n-1)); + t2.ptr.p_double[j] = vt; + } + + /* + * InvA = InvA - correction + */ + for(i=0; i<=n-1; i++) + { + vt = t1.ptr.p_double[i]/(1+lambdav); + ae_v_subd(&inva->ptr.pp_double[i][0], 1, &t2.ptr.p_double[0], 1, ae_v_len(0,n-1), vt); + } + ae_frame_leave(_state); +} + + + + +/************************************************************************* +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). +*************************************************************************/ +ae_bool rmatrixschur(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_matrix* s, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tau; + ae_vector wi; + ae_vector wr; + ae_matrix a1; + ae_matrix s1; + ae_int_t info; + ae_int_t i; + ae_int_t j; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(s); + ae_vector_init(&tau, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wi, 0, DT_REAL, _state, ae_true); + ae_vector_init(&wr, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&a1, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&s1, 0, 0, DT_REAL, _state, ae_true); + + + /* + * Upper Hessenberg form of the 0-based matrix + */ + rmatrixhessenberg(a, n, &tau, _state); + rmatrixhessenbergunpackq(a, n, &tau, s, _state); + + /* + * Convert from 0-based arrays to 1-based, + * then call InternalSchurDecomposition + * Awkward, of course, but Schur decompisiton subroutine + * is too complex to fix it. + * + */ + ae_matrix_set_length(&a1, n+1, n+1, _state); + ae_matrix_set_length(&s1, n+1, n+1, _state); + for(i=1; i<=n; i++) + { + for(j=1; j<=n; j++) + { + a1.ptr.pp_double[i][j] = a->ptr.pp_double[i-1][j-1]; + s1.ptr.pp_double[i][j] = s->ptr.pp_double[i-1][j-1]; + } + } + internalschurdecomposition(&a1, n, 1, 1, &wr, &wi, &s1, &info, _state); + result = info==0; + + /* + * convert from 1-based arrays to -based + */ + for(i=1; i<=n; i++) + { + for(j=1; j<=n; j++) + { + a->ptr.pp_double[i-1][j-1] = a1.ptr.pp_double[i][j]; + s->ptr.pp_double[i-1][j-1] = s1.ptr.pp_double[i][j]; + } + } + ae_frame_leave(_state); + return result; +} + + + +} + diff --git a/psdlag/src/linalg.h b/psdlag/src/linalg.h new file mode 100644 index 0000000..e6364c1 --- /dev/null +++ b/psdlag/src/linalg.h @@ -0,0 +1,5187 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _linalg_pkg_h +#define _linalg_pkg_h +#include "ap.h" +#include "alglibinternal.h" +#include "alglibmisc.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + double r1; + double rinf; +} matinvreport; +typedef struct +{ + ae_vector vals; + ae_vector idx; + ae_vector ridx; + ae_vector didx; + ae_vector uidx; + ae_int_t matrixtype; + ae_int_t m; + ae_int_t n; + ae_int_t nfree; + ae_int_t ninitialized; +} sparsematrix; +typedef struct +{ + double e1; + double e2; + ae_vector x; + ae_vector ax; + double xax; + ae_int_t n; + ae_vector rk; + ae_vector rk1; + ae_vector xk; + ae_vector xk1; + ae_vector pk; + ae_vector pk1; + ae_vector b; + rcommstate rstate; + ae_vector tmp2; +} fblslincgstate; +typedef struct +{ + ae_int_t n; + ae_int_t m; + ae_int_t nstart; + ae_int_t nits; + ae_int_t seedval; + ae_vector x0; + ae_vector x1; + ae_vector t; + ae_vector xbest; + hqrndstate r; + ae_vector x; + ae_vector mv; + ae_vector mtv; + ae_bool needmv; + ae_bool needmtv; + double repnorm; + rcommstate rstate; +} normestimatorstate; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + + + + + + + + + + + + + + + + +/************************************************************************* +Matrix inverse report: +* R1 reciprocal of condition number in 1-norm +* RInf reciprocal of condition number in inf-norm +*************************************************************************/ +class _matinvreport_owner +{ +public: + _matinvreport_owner(); + _matinvreport_owner(const _matinvreport_owner &rhs); + _matinvreport_owner& operator=(const _matinvreport_owner &rhs); + virtual ~_matinvreport_owner(); + alglib_impl::matinvreport* c_ptr(); + alglib_impl::matinvreport* c_ptr() const; +protected: + alglib_impl::matinvreport *p_struct; +}; +class matinvreport : public _matinvreport_owner +{ +public: + matinvreport(); + matinvreport(const matinvreport &rhs); + matinvreport& operator=(const matinvreport &rhs); + virtual ~matinvreport(); + double &r1; + double &rinf; + +}; + +/************************************************************************* +Sparse matrix + +You should use ALGLIB functions to work with sparse matrix. +Never try to access its fields directly! +*************************************************************************/ +class _sparsematrix_owner +{ +public: + _sparsematrix_owner(); + _sparsematrix_owner(const _sparsematrix_owner &rhs); + _sparsematrix_owner& operator=(const _sparsematrix_owner &rhs); + virtual ~_sparsematrix_owner(); + alglib_impl::sparsematrix* c_ptr(); + alglib_impl::sparsematrix* c_ptr() const; +protected: + alglib_impl::sparsematrix *p_struct; +}; +class sparsematrix : public _sparsematrix_owner +{ +public: + sparsematrix(); + sparsematrix(const sparsematrix &rhs); + sparsematrix& operator=(const sparsematrix &rhs); + virtual ~sparsematrix(); + +}; + + + +/************************************************************************* +This object stores state of the iterative norm estimation algorithm. + +You should use ALGLIB functions to work with this object. +*************************************************************************/ +class _normestimatorstate_owner +{ +public: + _normestimatorstate_owner(); + _normestimatorstate_owner(const _normestimatorstate_owner &rhs); + _normestimatorstate_owner& operator=(const _normestimatorstate_owner &rhs); + virtual ~_normestimatorstate_owner(); + alglib_impl::normestimatorstate* c_ptr(); + alglib_impl::normestimatorstate* c_ptr() const; +protected: + alglib_impl::normestimatorstate *p_struct; +}; +class normestimatorstate : public _normestimatorstate_owner +{ +public: + normestimatorstate(); + normestimatorstate(const normestimatorstate &rhs); + normestimatorstate& operator=(const normestimatorstate &rhs); + virtual ~normestimatorstate(); + +}; + +/************************************************************************* +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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void cmatrixtranspose(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t 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) + B - destination matrix, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void rmatrixtranspose(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_2d_array &b, const ae_int_t ib, const ae_int_t 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 rmatrixenforcesymmetricity(const real_2d_array &a, const ae_int_t n, const bool isupper); + + +/************************************************************************* +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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void cmatrixcopy(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_2d_array &b, const ae_int_t ib, const ae_int_t jb); + + +/************************************************************************* +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, must be large enough to store result + IB - submatrix offset (row index) + JB - submatrix offset (column index) +*************************************************************************/ +void rmatrixcopy(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_2d_array &b, const ae_int_t ib, const ae_int_t jb); + + +/************************************************************************* +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 cmatrixrank1(const ae_int_t m, const ae_int_t n, complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, complex_1d_array &u, const ae_int_t iu, complex_1d_array &v, const ae_int_t iv); + + +/************************************************************************* +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 rmatrixrank1(const ae_int_t m, const ae_int_t n, real_2d_array &a, const ae_int_t ia, const ae_int_t ja, real_1d_array &u, const ae_int_t iu, real_1d_array &v, const ae_int_t iv); + + +/************************************************************************* +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 + Y - preallocated matrix, must be large enough to store result + +OUTPUT PARAMETERS: + Y - vector which stores result + +if M=0, then subroutine does nothing. +if N=0, Y is filled by zeros. + + + -- ALGLIB routine -- + + 28.01.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixmv(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const complex_1d_array &x, const ae_int_t ix, complex_1d_array &y, const ae_int_t iy); + + +/************************************************************************* +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 + Y - preallocated matrix, must be large enough to store result + +OUTPUT PARAMETERS: + Y - vector which stores result + +if M=0, then subroutine does nothing. +if N=0, Y is filled by zeros. + + + -- ALGLIB routine -- + + 28.01.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixmv(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t opa, const real_1d_array &x, const ae_int_t ix, real_1d_array &y, const ae_int_t iy); + + +/************************************************************************* + +*************************************************************************/ +void cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); +void smp_cmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); + + +/************************************************************************* + +*************************************************************************/ +void cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); +void smp_cmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const complex_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); + + +/************************************************************************* + +*************************************************************************/ +void rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2); +void smp_rmatrixrighttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2); + + +/************************************************************************* + +*************************************************************************/ +void rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2); +void smp_rmatrixlefttrsm(const ae_int_t m, const ae_int_t n, const real_2d_array &a, const ae_int_t i1, const ae_int_t j1, const bool isupper, const bool isunit, const ae_int_t optype, const real_2d_array &x, const ae_int_t i2, const ae_int_t j2); + + +/************************************************************************* + +*************************************************************************/ +void cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); +void smp_cmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); + + +/************************************************************************* + +*************************************************************************/ +void rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); +void smp_rmatrixsyrk(const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); + + +/************************************************************************* + +*************************************************************************/ +void cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc); +void smp_cmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const alglib::complex alpha, const complex_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const complex_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const alglib::complex beta, const complex_2d_array &c, const ae_int_t ic, const ae_int_t jc); + + +/************************************************************************* + +*************************************************************************/ +void rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc); +void smp_rmatrixgemm(const ae_int_t m, const ae_int_t n, const ae_int_t k, const double alpha, const real_2d_array &a, const ae_int_t ia, const ae_int_t ja, const ae_int_t optypea, const real_2d_array &b, const ae_int_t ib, const ae_int_t jb, const ae_int_t optypeb, const double beta, const real_2d_array &c, const ae_int_t ic, const ae_int_t jc); + +/************************************************************************* +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). + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqr(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau); + + +/************************************************************************* +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). + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlq(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tau); + + +/************************************************************************* +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 cmatrixqr(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau); + + +/************************************************************************* +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 cmatrixlq(complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_1d_array &tau); + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqrunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qcolumns, real_2d_array &q); + + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixqrunpackr(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &r); + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlqunpackq(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const real_1d_array &tau, const ae_int_t qrows, real_2d_array &q); + + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlqunpackl(const real_2d_array &a, const ae_int_t m, const ae_int_t n, real_2d_array &l); + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixqrunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qcolumns, complex_2d_array &q); + + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixqrunpackr(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &r); + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlqunpackq(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, const complex_1d_array &tau, const ae_int_t qrows, complex_2d_array &q); + + +/************************************************************************* +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]. + + -- ALGLIB routine -- + 17.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlqunpackl(const complex_2d_array &a, const ae_int_t m, const ae_int_t n, complex_2d_array &l); + + +/************************************************************************* +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): 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. + + -- 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. + Sergey Bochkanov, ALGLIB project, translation from FORTRAN to + pseudocode, 2007-2010. +*************************************************************************/ +void rmatrixbd(real_2d_array &a, const ae_int_t m, const ae_int_t n, real_1d_array &tauq, real_1d_array &taup); + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, const ae_int_t qcolumns, real_2d_array &q); + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdmultiplybyq(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &tauq, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose); + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackpt(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, const ae_int_t ptrows, real_2d_array &pt); + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdmultiplybyp(const real_2d_array &qp, const ae_int_t m, const ae_int_t n, const real_1d_array &taup, real_2d_array &z, const ae_int_t zrows, const ae_int_t zcolumns, const bool fromtheright, const bool dotranspose); + + +/************************************************************************* +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. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixbdunpackdiagonals(const real_2d_array &b, const ae_int_t m, const ae_int_t n, bool &isupper, real_1d_array &d, real_1d_array &e); + + +/************************************************************************* +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 rmatrixhessenberg(real_2d_array &a, const ae_int_t n, real_1d_array &tau); + + +/************************************************************************* +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]. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixhessenbergunpackq(const real_2d_array &a, const ae_int_t n, const real_1d_array &tau, real_2d_array &q); + + +/************************************************************************* +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]. + + -- ALGLIB -- + 2005-2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixhessenbergunpackh(const real_2d_array &a, const ae_int_t n, real_2d_array &h); + + +/************************************************************************* +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 smatrixtd(real_2d_array &a, const ae_int_t n, const bool isupper, real_1d_array &tau, real_1d_array &d, real_1d_array &e); + + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void smatrixtdunpackq(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &tau, real_2d_array &q); + + +/************************************************************************* +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 hmatrixtd(complex_2d_array &a, const ae_int_t n, const bool isupper, complex_1d_array &tau, real_1d_array &d, real_1d_array &e); + + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void hmatrixtdunpackq(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &tau, complex_2d_array &q); + +/************************************************************************* +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 - + THIS PARAMETER IS IGNORED SINCE ALGLIB 3.5.0 + SINGULAR VALUES ARE ALWAYS SEARCHED WITH HIGH ACCURACY. + 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 rmatrixbdsvd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const bool isupper, const bool isfractionalaccuracyrequired, real_2d_array &u, const ae_int_t nru, real_2d_array &c, const ae_int_t ncc, real_2d_array &vt, const ae_int_t ncvt); + +/************************************************************************* +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]. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +bool rmatrixsvd(const real_2d_array &a, const ae_int_t m, const ae_int_t n, const ae_int_t uneeded, const ae_int_t vtneeded, const ae_int_t additionalmemory, real_1d_array &w, real_2d_array &u, real_2d_array &vt); + +/************************************************************************* +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). + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +bool smatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, real_2d_array &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. + + -- ALGLIB -- + Copyright 07.01.2006 by Bochkanov Sergey +*************************************************************************/ +bool smatrixevdr(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, real_2d_array &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. + + -- ALGLIB -- + Copyright 07.01.2006 by Bochkanov Sergey +*************************************************************************/ +bool smatrixevdi(const real_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, real_2d_array &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. + + -- ALGLIB -- + Copyright 2005, 23 March 2007 by Bochkanov Sergey +*************************************************************************/ +bool hmatrixevd(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, real_1d_array &d, complex_2d_array &z); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. +*************************************************************************/ +bool hmatrixevdr(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const double b1, const double b2, ae_int_t &m, real_1d_array &w, complex_2d_array &z); + + +/************************************************************************* +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 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. + + -- ALGLIB -- + Copyright 07.01.2006, 24.03.2007 by Bochkanov Sergey. +*************************************************************************/ +bool hmatrixevdi(const complex_2d_array &a, const ae_int_t n, const ae_int_t zneeded, const bool isupper, const ae_int_t i1, const ae_int_t i2, real_1d_array &w, complex_2d_array &z); + + +/************************************************************************* +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 smatrixtdevd(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, real_2d_array &z); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 31.03.2008 by Bochkanov Sergey +*************************************************************************/ +bool smatrixtdevdr(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const double a, const double b, ae_int_t &m, real_2d_array &z); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 25.12.2005 by Bochkanov Sergey +*************************************************************************/ +bool smatrixtdevdi(real_1d_array &d, const real_1d_array &e, const ae_int_t n, const ae_int_t zneeded, const ae_int_t i1, const ae_int_t i2, real_2d_array &z); + + +/************************************************************************* +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]. + WR - 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 rmatrixevd(const real_2d_array &a, const ae_int_t n, const ae_int_t vneeded, real_1d_array &wr, real_1d_array &wi, real_2d_array &vl, real_2d_array &vr); + +/************************************************************************* +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] + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonal(const ae_int_t n, real_2d_array &a); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a); + + +/************************************************************************* +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] + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonal(const ae_int_t n, complex_2d_array &a); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void smatrixrndcond(const ae_int_t n, const double c, real_2d_array &a); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixrndcond(const ae_int_t n, const double c, real_2d_array &a); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixrndcond(const ae_int_t n, const double c, complex_2d_array &a); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonalfromtheright(real_2d_array &a, const ae_int_t m, const ae_int_t n); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void rmatrixrndorthogonalfromtheleft(real_2d_array &a, const ae_int_t m, const ae_int_t n); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonalfromtheright(complex_2d_array &a, const ae_int_t m, const ae_int_t n); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void cmatrixrndorthogonalfromtheleft(complex_2d_array &a, const ae_int_t m, const ae_int_t n); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void smatrixrndmultiply(real_2d_array &a, const ae_int_t n); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 04.12.2009 + Bochkanov Sergey +*************************************************************************/ +void hmatrixrndmultiply(complex_2d_array &a, const ae_int_t n); + +/************************************************************************* +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)]. + + -- ALGLIB routine -- + 10.01.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixlu(real_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &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)]. + + -- ALGLIB routine -- + 10.01.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixlu(complex_2d_array &a, const ae_int_t m, const ae_int_t n, integer_1d_array &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. + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +bool hpdmatrixcholesky(complex_2d_array &a, const ae_int_t n, const bool isupper); + + +/************************************************************************* +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. + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +bool spdmatrixcholesky(real_2d_array &a, const ae_int_t n, const bool isupper); + +/************************************************************************* +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 rmatrixrcond1(const real_2d_array &a, const ae_int_t n); + + +/************************************************************************* +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 rmatrixrcondinf(const real_2d_array &a, const ae_int_t n); + + +/************************************************************************* +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 spdmatrixrcond(const real_2d_array &a, const ae_int_t n, const bool isupper); + + +/************************************************************************* +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 rmatrixtrrcond1(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit); + + +/************************************************************************* +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 rmatrixtrrcondinf(const real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit); + + +/************************************************************************* +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 hpdmatrixrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper); + + +/************************************************************************* +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 cmatrixrcond1(const complex_2d_array &a, const ae_int_t n); + + +/************************************************************************* +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 cmatrixrcondinf(const complex_2d_array &a, const ae_int_t n); + + +/************************************************************************* +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 rmatrixlurcond1(const real_2d_array &lua, const ae_int_t n); + + +/************************************************************************* +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 rmatrixlurcondinf(const real_2d_array &lua, const ae_int_t n); + + +/************************************************************************* +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 spdmatrixcholeskyrcond(const real_2d_array &a, const ae_int_t n, const bool isupper); + + +/************************************************************************* +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 hpdmatrixcholeskyrcond(const complex_2d_array &a, const ae_int_t n, const bool isupper); + + +/************************************************************************* +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 cmatrixlurcond1(const complex_2d_array &lua, const ae_int_t n); + + +/************************************************************************* +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 cmatrixlurcondinf(const complex_2d_array &lua, const ae_int_t n); + + +/************************************************************************* +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 cmatrixtrrcond1(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit); + + +/************************************************************************* +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 cmatrixtrrcondinf(const complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit); + +/************************************************************************* +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. + + -- ALGLIB routine -- + 05.02.2010 + Bochkanov Sergey +*************************************************************************/ +void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep); +void rmatrixluinverse(real_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinverse(real_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep); +void rmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &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 + + -- ALGLIB routine -- + 05.02.2010 + Bochkanov Sergey +*************************************************************************/ +void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n, ae_int_t &info, matinvreport &rep); +void cmatrixluinverse(complex_2d_array &a, const integer_1d_array &pivots, ae_int_t &info, matinvreport &rep); + + +/************************************************************************* +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 + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void cmatrixinverse(complex_2d_array &a, const ae_int_t n, ae_int_t &info, matinvreport &rep); +void cmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskyinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep); +void spdmatrixcholeskyinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void spdmatrixinverse(real_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep); +void spdmatrixinverse(real_2d_array &a, ae_int_t &info, matinvreport &rep); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskyinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep); +void hpdmatrixcholeskyinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep); + + +/************************************************************************* +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 + + -- ALGLIB routine -- + 10.02.2010 + Bochkanov Sergey +*************************************************************************/ +void hpdmatrixinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, ae_int_t &info, matinvreport &rep); +void hpdmatrixinverse(complex_2d_array &a, ae_int_t &info, matinvreport &rep); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 05.02.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixtrinverse(real_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep); +void rmatrixtrinverse(real_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 05.02.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixtrinverse(complex_2d_array &a, const ae_int_t n, const bool isupper, const bool isunit, ae_int_t &info, matinvreport &rep); +void cmatrixtrinverse(complex_2d_array &a, const bool isupper, ae_int_t &info, matinvreport &rep); + +/************************************************************************* +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 is 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. + +Sparse matrices can be stored using either Hash-Table representation or +Compressed Row Storage representation. Hast-table is better suited for +querying and dynamic operations (thus, it is used for matrix +initialization), but it is inefficient when you want to make some linear +algebra operations. + +From the other side, CRS is better suited for linear algebra operations, +but initialization is less convenient - you have to tell row sizes at the +initialization, and you can fill matrix only row by row, from left to +right. CRS is also very inefficient when you want to find matrix element +by its index. + +Thus, Hash-Table representation does not support linear algebra +operations, while CRS format does not support modification of the table. +Tables below outline information about these two formats: + + OPERATIONS WITH MATRIX HASH CRS + create + + + read element + + + modify element + + add value to element + + A*x (dense vector) + + A'*x (dense vector) + + A*X (dense matrix) + + A'*X (dense matrix) + + +NOTE 2. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecreate(const ae_int_t m, const ae_int_t n, const ae_int_t k, sparsematrix &s); +void sparsecreate(const ae_int_t m, const ae_int_t n, sparsematrix &s); + + +/************************************************************************* +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 +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 + 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 1. + +Sparse matrices can be stored using either Hash-Table representation or +Compressed Row Storage representation. Hast-table is better suited for +querying and dynamic operations (thus, it is used for matrix +initialization), but it is inefficient when you want to make some linear +algebra operations. + +From the other side, CRS is better suited for linear algebra operations, +but initialization is less convenient - you have to tell row sizes at the +initialization, and you can fill matrix only row by row, from left to +right. CRS is also very inefficient when you want to find matrix element +by its index. + +Thus, Hash-Table representation does not support linear algebra +operations, while CRS format does not support modification of the table. +Tables below outline information about these two formats: + + OPERATIONS WITH MATRIX HASH CRS + create + + + read element + + + modify element + + add value to element + + A*x (dense vector) + + A'*x (dense vector) + + A*X (dense matrix) + + A'*X (dense matrix) + + +NOTE 2. + +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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecreatecrs(const ae_int_t m, const ae_int_t n, const integer_1d_array &ner, sparsematrix &s); + + +/************************************************************************* +This function copies S0 to S1. + +NOTE: this function does not verify its arguments, it just copies all +fields of the structure. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsecopy(const sparsematrix &s0, sparsematrix &s1); + + +/************************************************************************* +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=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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsesmv(const sparsematrix &s, const bool isupper, const real_1d_array &x, real_1d_array &y); + + +/************************************************************************* +This function calculates matrix-matrix product S*A. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b); + + +/************************************************************************* +This function calculates matrix-matrix product S^T*A. Matrix S must be +stored in CRS format (exception will be thrown otherwise). + +INPUT PARAMETERS + S - sparse M*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemtm(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b); + + +/************************************************************************* +This function simultaneously calculates two matrix-matrix products: + S*A and S^T*A. +S must be square (non-rectangular) matrix stored in CRS format (exception +will be thrown otherwise). + +INPUT PARAMETERS + S - sparse N*N matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. It also throws exception when S is non-square. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsemm2(const sparsematrix &s, const real_2d_array &a, const ae_int_t k, real_2d_array &b0, real_2d_array &b1); + + +/************************************************************************* +This function calculates matrix-matrix product S*A, when S is symmetric +matrix. Matrix S must be stored in CRS format (exception will be +thrown otherwise). + +INPUT PARAMETERS + S - sparse M*M matrix in CRS format (you MUST convert it + to CRS before calling this function). + 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 matrix. You +must convert your matrix with SparseConvertToCRS() before using this +function. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparsesmm(const sparsematrix &s, const bool isupper, const real_2d_array &a, const ae_int_t k, real_2d_array &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. + + -- ALGLIB PROJECT -- + Copyright 14.10.2011 by Bochkanov Sergey +*************************************************************************/ +void sparseresizematrix(const sparsematrix &s); + + +/************************************************************************* +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<=I0 + 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 vectors, 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. + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorcreate(const ae_int_t m, const ae_int_t n, const ae_int_t nstart, const ae_int_t nits, normestimatorstate &state); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorsetseed(const normestimatorstate &state, const ae_int_t seedval); + + +/************************************************************************* +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). + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorestimatesparse(const normestimatorstate &state, const sparsematrix &a); + + +/************************************************************************* +Matrix norm estimation results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + Nrm - estimate of the matrix norm, Nrm>=0 + + -- ALGLIB -- + Copyright 06.12.2011 by Bochkanov Sergey +*************************************************************************/ +void normestimatorresults(const normestimatorstate &state, double &nrm); + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots, const ae_int_t n); +double rmatrixludet(const real_2d_array &a, const integer_1d_array &pivots); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +double rmatrixdet(const real_2d_array &a, const ae_int_t n); +double rmatrixdet(const real_2d_array &a); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots, const ae_int_t n); +alglib::complex cmatrixludet(const complex_2d_array &a, const integer_1d_array &pivots); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +alglib::complex cmatrixdet(const complex_2d_array &a, const ae_int_t n); +alglib::complex cmatrixdet(const complex_2d_array &a); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +double spdmatrixcholeskydet(const real_2d_array &a, const ae_int_t n); +double spdmatrixcholeskydet(const real_2d_array &a); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005-2008 by Bochkanov Sergey +*************************************************************************/ +double spdmatrixdet(const real_2d_array &a, const ae_int_t n, const bool isupper); +double spdmatrixdet(const real_2d_array &a); + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 1.28.2006 by Bochkanov Sergey +*************************************************************************/ +bool smatrixgevd(const real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t zneeded, const ae_int_t problemtype, real_1d_array &d, real_2d_array &z); + + +/************************************************************************* +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). + + -- ALGLIB -- + Copyright 1.28.2006 by Bochkanov Sergey +*************************************************************************/ +bool smatrixgevdreduce(real_2d_array &a, const ae_int_t n, const bool isuppera, const real_2d_array &b, const bool isupperb, const ae_int_t problemtype, real_2d_array &r, bool &isupperr); + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdatesimple(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const ae_int_t updcolumn, const double updval); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdaterow(real_2d_array &inva, const ae_int_t n, const ae_int_t updrow, const real_1d_array &v); + + +/************************************************************************* +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. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdatecolumn(real_2d_array &inva, const ae_int_t n, const ae_int_t updcolumn, const real_1d_array &u); + + +/************************************************************************* +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'. + + -- ALGLIB -- + Copyright 2005 by Bochkanov Sergey +*************************************************************************/ +void rmatrixinvupdateuv(real_2d_array &inva, const ae_int_t n, const real_1d_array &u, const real_1d_array &v); + +/************************************************************************* +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 rmatrixschur(real_2d_array &a, const ae_int_t n, real_2d_array &s); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void ablassplitlength(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state); +void ablascomplexsplitlength(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t* n1, + ae_int_t* n2, + ae_state *_state); +ae_int_t ablasblocksize(/* Real */ ae_matrix* a, ae_state *_state); +ae_int_t ablascomplexblocksize(/* Complex */ ae_matrix* a, + ae_state *_state); +ae_int_t ablasmicroblocksize(ae_state *_state); +void cmatrixtranspose(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_state *_state); +void rmatrixtranspose(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_state *_state); +void rmatrixenforcesymmetricity(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +void cmatrixcopy(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_state *_state); +void rmatrixcopy(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_state *_state); +void cmatrixrank1(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Complex */ ae_vector* u, + ae_int_t iu, + /* Complex */ ae_vector* v, + ae_int_t iv, + ae_state *_state); +void rmatrixrank1(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + /* Real */ ae_vector* u, + ae_int_t iu, + /* Real */ ae_vector* v, + ae_int_t iv, + ae_state *_state); +void cmatrixmv(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t opa, + /* Complex */ ae_vector* x, + ae_int_t ix, + /* Complex */ ae_vector* y, + ae_int_t iy, + ae_state *_state); +void rmatrixmv(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t opa, + /* Real */ ae_vector* x, + ae_int_t ix, + /* Real */ ae_vector* y, + ae_int_t iy, + ae_state *_state); +void cmatrixrighttrsm(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +void _pexec_cmatrixrighttrsm(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, ae_state *_state); +void cmatrixlefttrsm(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +void _pexec_cmatrixlefttrsm(ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Complex */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, ae_state *_state); +void rmatrixrighttrsm(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +void _pexec_rmatrixrighttrsm(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, ae_state *_state); +void rmatrixlefttrsm(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, + ae_state *_state); +void _pexec_rmatrixlefttrsm(ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_int_t i1, + ae_int_t j1, + ae_bool isupper, + ae_bool isunit, + ae_int_t optype, + /* Real */ ae_matrix* x, + ae_int_t i2, + ae_int_t j2, ae_state *_state); +void cmatrixsyrk(ae_int_t n, + ae_int_t k, + double alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state); +void _pexec_cmatrixsyrk(ae_int_t n, + ae_int_t k, + double alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, ae_state *_state); +void rmatrixsyrk(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, + ae_state *_state); +void _pexec_rmatrixsyrk(ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_bool isupper, ae_state *_state); +void cmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +void _pexec_cmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + ae_complex alpha, + /* Complex */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Complex */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + ae_complex beta, + /* Complex */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, ae_state *_state); +void rmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, + ae_state *_state); +void _pexec_rmatrixgemm(ae_int_t m, + ae_int_t n, + ae_int_t k, + double alpha, + /* Real */ ae_matrix* a, + ae_int_t ia, + ae_int_t ja, + ae_int_t optypea, + /* Real */ ae_matrix* b, + ae_int_t ib, + ae_int_t jb, + ae_int_t optypeb, + double beta, + /* Real */ ae_matrix* c, + ae_int_t ic, + ae_int_t jc, ae_state *_state); +void rmatrixqr(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_state *_state); +void rmatrixlq(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_state *_state); +void cmatrixqr(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* tau, + ae_state *_state); +void cmatrixlq(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* tau, + ae_state *_state); +void rmatrixqrunpackq(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_int_t qcolumns, + /* Real */ ae_matrix* q, + ae_state *_state); +void rmatrixqrunpackr(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* r, + ae_state *_state); +void rmatrixlqunpackq(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_int_t qrows, + /* Real */ ae_matrix* q, + ae_state *_state); +void rmatrixlqunpackl(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_matrix* l, + ae_state *_state); +void cmatrixqrunpackq(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* tau, + ae_int_t qcolumns, + /* Complex */ ae_matrix* q, + ae_state *_state); +void cmatrixqrunpackr(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* r, + ae_state *_state); +void cmatrixlqunpackq(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_vector* tau, + ae_int_t qrows, + /* Complex */ ae_matrix* q, + ae_state *_state); +void cmatrixlqunpackl(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Complex */ ae_matrix* l, + ae_state *_state); +void rmatrixqrbasecase(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* work, + /* Real */ ae_vector* t, + /* Real */ ae_vector* tau, + ae_state *_state); +void rmatrixlqbasecase(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* work, + /* Real */ ae_vector* t, + /* Real */ ae_vector* tau, + ae_state *_state); +void rmatrixbd(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tauq, + /* Real */ ae_vector* taup, + ae_state *_state); +void rmatrixbdunpackq(/* Real */ ae_matrix* qp, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tauq, + ae_int_t qcolumns, + /* Real */ ae_matrix* q, + ae_state *_state); +void rmatrixbdmultiplybyq(/* Real */ ae_matrix* qp, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tauq, + /* Real */ ae_matrix* z, + ae_int_t zrows, + ae_int_t zcolumns, + ae_bool fromtheright, + ae_bool dotranspose, + ae_state *_state); +void rmatrixbdunpackpt(/* Real */ ae_matrix* qp, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* taup, + ae_int_t ptrows, + /* Real */ ae_matrix* pt, + ae_state *_state); +void rmatrixbdmultiplybyp(/* Real */ ae_matrix* qp, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* taup, + /* Real */ ae_matrix* z, + ae_int_t zrows, + ae_int_t zcolumns, + ae_bool fromtheright, + ae_bool dotranspose, + ae_state *_state); +void rmatrixbdunpackdiagonals(/* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t n, + ae_bool* isupper, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_state *_state); +void rmatrixhessenberg(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* tau, + ae_state *_state); +void rmatrixhessenbergunpackq(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* tau, + /* Real */ ae_matrix* q, + ae_state *_state); +void rmatrixhessenbergunpackh(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_matrix* h, + ae_state *_state); +void smatrixtd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tau, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_state *_state); +void smatrixtdunpackq(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tau, + /* Real */ ae_matrix* q, + ae_state *_state); +void hmatrixtd(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tau, + /* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_state *_state); +void hmatrixtdunpackq(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* tau, + /* Complex */ ae_matrix* q, + ae_state *_state); +ae_bool rmatrixbdsvd(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_bool isupper, + ae_bool isfractionalaccuracyrequired, + /* Real */ ae_matrix* u, + ae_int_t nru, + /* Real */ ae_matrix* c, + ae_int_t ncc, + /* Real */ ae_matrix* vt, + ae_int_t ncvt, + ae_state *_state); +ae_bool bidiagonalsvddecomposition(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_bool isupper, + ae_bool isfractionalaccuracyrequired, + /* Real */ ae_matrix* u, + ae_int_t nru, + /* Real */ ae_matrix* c, + ae_int_t ncc, + /* Real */ ae_matrix* vt, + ae_int_t ncvt, + ae_state *_state); +ae_bool rmatrixsvd(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_int_t uneeded, + ae_int_t vtneeded, + ae_int_t additionalmemory, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* u, + /* Real */ ae_matrix* vt, + ae_state *_state); +ae_bool smatrixevd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + /* Real */ ae_vector* d, + /* Real */ ae_matrix* z, + ae_state *_state); +ae_bool smatrixevdr(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + double b1, + double b2, + ae_int_t* m, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* z, + ae_state *_state); +ae_bool smatrixevdi(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_vector* w, + /* Real */ ae_matrix* z, + ae_state *_state); +ae_bool hmatrixevd(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + /* Real */ ae_vector* d, + /* Complex */ ae_matrix* z, + ae_state *_state); +ae_bool hmatrixevdr(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + double b1, + double b2, + ae_int_t* m, + /* Real */ ae_vector* w, + /* Complex */ ae_matrix* z, + ae_state *_state); +ae_bool hmatrixevdi(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t zneeded, + ae_bool isupper, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_vector* w, + /* Complex */ ae_matrix* z, + ae_state *_state); +ae_bool smatrixtdevd(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t zneeded, + /* Real */ ae_matrix* z, + ae_state *_state); +ae_bool smatrixtdevdr(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t zneeded, + double a, + double b, + ae_int_t* m, + /* Real */ ae_matrix* z, + ae_state *_state); +ae_bool smatrixtdevdi(/* Real */ ae_vector* d, + /* Real */ ae_vector* e, + ae_int_t n, + ae_int_t zneeded, + ae_int_t i1, + ae_int_t i2, + /* Real */ ae_matrix* z, + ae_state *_state); +ae_bool rmatrixevd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t vneeded, + /* Real */ ae_vector* wr, + /* Real */ ae_vector* wi, + /* Real */ ae_matrix* vl, + /* Real */ ae_matrix* vr, + ae_state *_state); +void rmatrixrndorthogonal(ae_int_t n, + /* Real */ ae_matrix* a, + ae_state *_state); +void rmatrixrndcond(ae_int_t n, + double c, + /* Real */ ae_matrix* a, + ae_state *_state); +void cmatrixrndorthogonal(ae_int_t n, + /* Complex */ ae_matrix* a, + ae_state *_state); +void cmatrixrndcond(ae_int_t n, + double c, + /* Complex */ ae_matrix* a, + ae_state *_state); +void smatrixrndcond(ae_int_t n, + double c, + /* Real */ ae_matrix* a, + ae_state *_state); +void spdmatrixrndcond(ae_int_t n, + double c, + /* Real */ ae_matrix* a, + ae_state *_state); +void hmatrixrndcond(ae_int_t n, + double c, + /* Complex */ ae_matrix* a, + ae_state *_state); +void hpdmatrixrndcond(ae_int_t n, + double c, + /* Complex */ ae_matrix* a, + ae_state *_state); +void rmatrixrndorthogonalfromtheright(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_state *_state); +void rmatrixrndorthogonalfromtheleft(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_state *_state); +void cmatrixrndorthogonalfromtheright(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_state *_state); +void cmatrixrndorthogonalfromtheleft(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + ae_state *_state); +void smatrixrndmultiply(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +void hmatrixrndmultiply(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +void rmatrixlu(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state); +void cmatrixlu(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state); +ae_bool hpdmatrixcholesky(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +ae_bool spdmatrixcholesky(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +void rmatrixlup(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state); +void cmatrixlup(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state); +void rmatrixplu(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state); +void cmatrixplu(/* Complex */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* pivots, + ae_state *_state); +ae_bool spdmatrixcholeskyrec(/* Real */ ae_matrix* a, + ae_int_t offs, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* tmp, + ae_state *_state); +double rmatrixrcond1(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +double rmatrixrcondinf(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +double spdmatrixrcond(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +double rmatrixtrrcond1(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_state *_state); +double rmatrixtrrcondinf(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_state *_state); +double hpdmatrixrcond(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +double cmatrixrcond1(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +double cmatrixrcondinf(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +double rmatrixlurcond1(/* Real */ ae_matrix* lua, + ae_int_t n, + ae_state *_state); +double rmatrixlurcondinf(/* Real */ ae_matrix* lua, + ae_int_t n, + ae_state *_state); +double spdmatrixcholeskyrcond(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +double hpdmatrixcholeskyrcond(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +double cmatrixlurcond1(/* Complex */ ae_matrix* lua, + ae_int_t n, + ae_state *_state); +double cmatrixlurcondinf(/* Complex */ ae_matrix* lua, + ae_int_t n, + ae_state *_state); +double cmatrixtrrcond1(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_state *_state); +double cmatrixtrrcondinf(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_state *_state); +double rcondthreshold(ae_state *_state); +void rmatrixluinverse(/* Real */ ae_matrix* a, + /* Integer */ ae_vector* pivots, + ae_int_t n, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void rmatrixinverse(/* Real */ ae_matrix* a, + ae_int_t n, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void cmatrixluinverse(/* Complex */ ae_matrix* a, + /* Integer */ ae_vector* pivots, + ae_int_t n, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void cmatrixinverse(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void spdmatrixcholeskyinverse(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void spdmatrixinverse(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void hpdmatrixcholeskyinverse(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void hpdmatrixinverse(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void rmatrixtrinverse(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +void cmatrixtrinverse(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_bool isunit, + ae_int_t* info, + matinvreport* rep, + ae_state *_state); +ae_bool _matinvreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _matinvreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _matinvreport_clear(void* _p); +void _matinvreport_destroy(void* _p); +void sparsecreate(ae_int_t m, + ae_int_t n, + ae_int_t k, + sparsematrix* s, + ae_state *_state); +void sparsecreatecrs(ae_int_t m, + ae_int_t n, + /* Integer */ ae_vector* ner, + sparsematrix* s, + ae_state *_state); +void sparsecopy(sparsematrix* s0, sparsematrix* s1, ae_state *_state); +void sparseadd(sparsematrix* s, + ae_int_t i, + ae_int_t j, + double v, + ae_state *_state); +void sparseset(sparsematrix* s, + ae_int_t i, + ae_int_t j, + double v, + ae_state *_state); +double sparseget(sparsematrix* s, + ae_int_t i, + ae_int_t j, + ae_state *_state); +double sparsegetdiagonal(sparsematrix* s, ae_int_t i, ae_state *_state); +void sparseconverttocrs(sparsematrix* s, ae_state *_state); +void sparsemv(sparsematrix* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void sparsemtv(sparsematrix* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void sparsemv2(sparsematrix* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y0, + /* Real */ ae_vector* y1, + ae_state *_state); +void sparsesmv(sparsematrix* s, + ae_bool isupper, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +void sparsemm(sparsematrix* s, + /* Real */ ae_matrix* a, + ae_int_t k, + /* Real */ ae_matrix* b, + ae_state *_state); +void sparsemtm(sparsematrix* s, + /* Real */ ae_matrix* a, + ae_int_t k, + /* Real */ ae_matrix* b, + ae_state *_state); +void sparsemm2(sparsematrix* s, + /* Real */ ae_matrix* a, + ae_int_t k, + /* Real */ ae_matrix* b0, + /* Real */ ae_matrix* b1, + ae_state *_state); +void sparsesmm(sparsematrix* s, + ae_bool isupper, + /* Real */ ae_matrix* a, + ae_int_t k, + /* Real */ ae_matrix* b, + ae_state *_state); +void sparseresizematrix(sparsematrix* s, ae_state *_state); +double sparsegetaveragelengthofchain(sparsematrix* s, ae_state *_state); +ae_bool sparseenumerate(sparsematrix* s, + ae_int_t* t0, + ae_int_t* t1, + ae_int_t* i, + ae_int_t* j, + double* v, + ae_state *_state); +ae_bool sparserewriteexisting(sparsematrix* s, + ae_int_t i, + ae_int_t j, + double v, + ae_state *_state); +void sparsegetrow(sparsematrix* s, + ae_int_t i, + /* Real */ ae_vector* irow, + ae_state *_state); +void sparseconverttohash(sparsematrix* s, ae_state *_state); +void sparsecopytohash(sparsematrix* s0, + sparsematrix* s1, + ae_state *_state); +void sparsecopytocrs(sparsematrix* s0, sparsematrix* s1, ae_state *_state); +ae_int_t sparsegetmatrixtype(sparsematrix* s, ae_state *_state); +ae_bool sparseishash(sparsematrix* s, ae_state *_state); +ae_bool sparseiscrs(sparsematrix* s, ae_state *_state); +void sparsefree(sparsematrix* s, ae_state *_state); +ae_int_t sparsegetnrows(sparsematrix* s, ae_state *_state); +ae_int_t sparsegetncols(sparsematrix* s, ae_state *_state); +ae_bool _sparsematrix_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _sparsematrix_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _sparsematrix_clear(void* _p); +void _sparsematrix_destroy(void* _p); +void fblscholeskysolve(/* Real */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* xb, + /* Real */ ae_vector* tmp, + ae_state *_state); +void fblssolvecgx(/* Real */ ae_matrix* a, + ae_int_t m, + ae_int_t n, + double alpha, + /* Real */ ae_vector* b, + /* Real */ ae_vector* x, + /* Real */ ae_vector* buf, + ae_state *_state); +void fblscgcreate(/* Real */ ae_vector* x, + /* Real */ ae_vector* b, + ae_int_t n, + fblslincgstate* state, + ae_state *_state); +ae_bool fblscgiteration(fblslincgstate* state, ae_state *_state); +void fblssolvels(/* Real */ ae_matrix* a, + /* Real */ ae_vector* b, + ae_int_t m, + ae_int_t n, + /* Real */ ae_vector* tmp0, + /* Real */ ae_vector* tmp1, + /* Real */ ae_vector* tmp2, + ae_state *_state); +ae_bool _fblslincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _fblslincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _fblslincgstate_clear(void* _p); +void _fblslincgstate_destroy(void* _p); +void normestimatorcreate(ae_int_t m, + ae_int_t n, + ae_int_t nstart, + ae_int_t nits, + normestimatorstate* state, + ae_state *_state); +void normestimatorsetseed(normestimatorstate* state, + ae_int_t seedval, + ae_state *_state); +ae_bool normestimatoriteration(normestimatorstate* state, + ae_state *_state); +void normestimatorestimatesparse(normestimatorstate* state, + sparsematrix* a, + ae_state *_state); +void normestimatorresults(normestimatorstate* state, + double* nrm, + ae_state *_state); +void normestimatorrestart(normestimatorstate* state, ae_state *_state); +ae_bool _normestimatorstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _normestimatorstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _normestimatorstate_clear(void* _p); +void _normestimatorstate_destroy(void* _p); +double rmatrixludet(/* Real */ ae_matrix* a, + /* Integer */ ae_vector* pivots, + ae_int_t n, + ae_state *_state); +double rmatrixdet(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +ae_complex cmatrixludet(/* Complex */ ae_matrix* a, + /* Integer */ ae_vector* pivots, + ae_int_t n, + ae_state *_state); +ae_complex cmatrixdet(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +double spdmatrixcholeskydet(/* Real */ ae_matrix* a, + ae_int_t n, + ae_state *_state); +double spdmatrixdet(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + ae_state *_state); +ae_bool smatrixgevd(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isuppera, + /* Real */ ae_matrix* b, + ae_bool isupperb, + ae_int_t zneeded, + ae_int_t problemtype, + /* Real */ ae_vector* d, + /* Real */ ae_matrix* z, + ae_state *_state); +ae_bool smatrixgevdreduce(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isuppera, + /* Real */ ae_matrix* b, + ae_bool isupperb, + ae_int_t problemtype, + /* Real */ ae_matrix* r, + ae_bool* isupperr, + ae_state *_state); +void rmatrixinvupdatesimple(/* Real */ ae_matrix* inva, + ae_int_t n, + ae_int_t updrow, + ae_int_t updcolumn, + double updval, + ae_state *_state); +void rmatrixinvupdaterow(/* Real */ ae_matrix* inva, + ae_int_t n, + ae_int_t updrow, + /* Real */ ae_vector* v, + ae_state *_state); +void rmatrixinvupdatecolumn(/* Real */ ae_matrix* inva, + ae_int_t n, + ae_int_t updcolumn, + /* Real */ ae_vector* u, + ae_state *_state); +void rmatrixinvupdateuv(/* Real */ ae_matrix* inva, + ae_int_t n, + /* Real */ ae_vector* u, + /* Real */ ae_vector* v, + ae_state *_state); +ae_bool rmatrixschur(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_matrix* s, + ae_state *_state); + +} +#endif + diff --git a/psdlag/src/main.cpp b/psdlag/src/main.cpp new file mode 100644 index 0000000..c3732e7 --- /dev/null +++ b/psdlag/src/main.cpp @@ -0,0 +1,203 @@ +/* + * main.cpp + * + * Created on: May 31, 2013 + * Author: azoghbi + */ + +#include "inc/main.hpp" + +/************************************** + * Main function + * Checks if there is an input and + * raises an error. + * otherwise, call do_work(fname) + **************************************/ +int main( int argc , char* argv[] ){ + if ( argc < 2 ){ + cerr << "** Error ** No input file given." << endl; + usage(); + }else { + do_work( argv[1] ); + } + return 0; +} + + + + +/************************************** + * Main function that does the work + * INPUT: char* fname: input file name + * RETURN: void + **************************************/ + +void do_work( char* fname ){ + + /************ Reading the input file ***********/ + ifstream fp(fname); + string line,mcmcfile; stringstream ss; + int i,nfiles,nfq,mode,npar,bin1,bin2,fit_type,nrun,nburn,nwk; bool strict; + getline(fp,line);ss.str(line); ss >> nfiles; ss.clear(); + vector files(nfiles);ivec secL;secL.setlength(nfiles);for(i=0;i> files[i] >> secL[i]; ss.clear();} + getline(fp,line); ss.str(line); ss >> nfq;vec fqL;fqL.setlength(nfq+1); + for(i=0;i<=nfq;i++){ss >> fqL[i];} ss.clear(); + getline(fp,line); ss.str(line); ss >> mode; ss.clear(); + npar = (mode==0)?4*nfq:nfq; vec pars; pars.setlength(npar); + getline(fp,line); ss.str(line); for(i=0;i> pars[i];} ss.clear(); + getline(fp,line); ss.str(line); ss >> bin1 >> bin2; ss.clear(); + if(mode!=0){bin1 = (mode==-1)?-1:(mode-1);bin2=-1;} + getline(fp,line); ss.str(line); ss >> fit_type; ss.clear(); + getline(fp,line); ss.str(line); ss >> i; strict = i!=0; ss.clear(); + getline(fp,line); ss.str(line); ss >> nrun >> nburn >> nwk >> mcmcfile; ss.clear(); + fp.close(); + /********* END Reading the input file **********/ + + /********** Read the light curves **************/ + vector > LC; + for(i=0;i 0 or mode==-1 ){ + vec errs; errs.setlength(nfq); + vector lc1; for( i=0 ; i p1( lc1 , fqL ); + + p1.optimize( pars , errs ); + if( fit_type==1 ) p1.errors( pars , errs ); + }else if( mode == 0 or mode==-1 ){ + vec ec,e1,e2,errs; ec.setlength(2*nfq);e1.setlength(nfq);e2.setlength(nfq);errs.setlength(4*nfq); + vector lc1,lc2; for( i=0 ; i p1( lc1 , fqL ), p2( lc2 , fqL ); + vec pars1,pars2;pars1.setlength(nfq);pars2.setlength(nfq);for(i=0;i l( lc1 , lc2 , fqL , pars ); + l.optimize( pc , ec ); + if( fit_type==1 ) l.errors_avg( pc , ec ); + if( fit_type==2 ) { + mcmc mc( 2*nfq , mcmc_lag10 , (void*)&l ); + mc.nrun=nrun; mc.nburn=nburn; mc.nwk=nwk; + mc.run( pc , errs , mcmcfile.c_str() ); + } + + for(i=0;i pl( lc1 , lc2 , fqL ); + if( fit_type==3 ) pl.errors_avg( pars , errs ); + if( fit_type==4 ) { + mcmc mc( 4*nfq , mcmc_psdlag10 , (void*)&pl ); + mc.nrun=nrun; mc.nburn=nburn; mc.nwk=nwk; + mc.run( pars , errs , mcmcfile.c_str() ); + } + + pl.print_pars( pars , errs ); + } +} + + + + + + + +/************************************** + * Usage function + * prints a sample input text + * INPUT: none + * RETURN: void + **************************************/ +void usage(){ + cerr << setw(40) << setfill('*') << "\n"; + cout << setw(30) << left << "1" << "# of lc" << endl; + cout << setw(30) << left << "lc.dat 0" << "name1 secL1" << endl; + cout << setw(30) << left << "3 1e-5 1e-4 5e-4 1e-3" << "nfq fqL1 fqL2.." << endl; + cout << setw(30) << left << "1" << "mode? 0:lag, n:psd" << endl; + cout << setw(30) << left << "1 1 1 1 1 1 1 1 1 1 1 1" << "init. pars" << endl; + cout << setw(30) << left << "0 1" << "bin1, bin2,-1: all" << endl; + cout << setw(30) << left << "0" << "fit_type" << endl; + cout << setw(30) << left << "0" << "strict" << endl; + cout << setw(30) << left << "100 50 50 mcmc.dat" << "nrun,nburn,nwk,file"<< endl; + cerr << setw(40) << setfill('*') << "\n"; +} + + + + + +/*************************************** + * READ LIGHTCURVES + * Read a standard light curve file that has a description at the top + * the first line is something like: # dT nlc b0 b1 b2 ... b_lc (b0 .. are bins boundaries) + * Then the content with: time lc1 err1 lc2 err2 ... etc + * + * INPUT: + * LC : a vector of vectors of light curves, where the first dimension is the number of + * light curves (i.e. segments), this is incremented in this function when reading a new file. + * The other dimension is either 1 for psd and 2 for lags, which contains either one light curve + * or two for the lag. Passed by reference + * fname : name of the light curve file + * secL : the section length to split the light curves to. + * b1 : the bin1 to read for the first light curve. 0-based, -1 for all + * b2 : the bin2 to read, 0-based, -1 for none (.i.e just psd) + * strict : a boolean on whether to be strict or not in segmenting the light curve + * e.g. for secL=220: 0 gives 100,100 and 1 gives 100,120 + * + **************************************/ +void readLC( vector >&LC , string fname , int secL , int b1 , int b2 , bool strict ){ + + /* Initialize file stream, define some variables */ + ifstream fp(fname.c_str()); string line,sdum; stringstream ss; + int i,j,nlc,n,nsec,ns,sl; double dt; + + /* read dt from the description line */ + getline(fp,line); ss.str(line); ss >> sdum >> dt >> nlc; ss.clear(); + + /* get the number of lines */ + n=0;while(getline(fp,line)){if(line!="")n++;} fp.clear(); fp.seekg(0,ios::beg);getline(fp,line); + + /* calculate section lengths */ + if(secL==0){secL=n;} + nsec = n/secL; vector secl(nsec,secL); if(not strict) secl[nsec-1] += n-nsec*secL; + + /* Start looping through the number of sections */ + for(ns=0;ns Lc; + vec t; vector lc(nlc),lce(nlc); t.setlength( sl ); for(i=0;i>t[i];for(j=0;j>lc[j][i]>>lce[j][i];} ss.clear(); + } + + // if we want the whole light curves in bin1 + if( b1==-1 ){ + vec lc_,lce_; lc_.setlength( sl );lce_.setlength( sl );for(i=0;i to LC + LC.push_back(Lc); + } + fp.close(); +} diff --git a/psdlag/src/makefile b/psdlag/src/makefile new file mode 100644 index 0000000..b08eaf1 --- /dev/null +++ b/psdlag/src/makefile @@ -0,0 +1,7 @@ + + +incdir='/home/caes/science/fourier-agn/psdlag/src/' + + +psdlag: + g++ *cpp -o psdlag -O3 -Wall -I${incdir} diff --git a/psdlag/src/mcmc.cpp b/psdlag/src/mcmc.cpp new file mode 100644 index 0000000..565061b --- /dev/null +++ b/psdlag/src/mcmc.cpp @@ -0,0 +1,73 @@ +/* + * mcmc.cpp + * + * Created on: May 14, 2013 + * Author: abduz + */ + +#include "inc/mcmc.hpp" + +mcmc::mcmc(int np,double (*f)(vec&,void*),void *p) { + npar = np; + loglikelihood = f; + ptr = p; + hqrndrandomize(rnd); + nrun = 100; nburn = 100; nwk = 100; ncheck = 10;avalue = 2.0; +} + +mcmc::~mcmc() {} + +void mcmc::run( vec& p, vec& pe, const char*fname){ + int i,j,k,nacc,nr,n,nsum; + vec2 pars; pars.setlength(nwk,npar); + vec prob,currp,bestp,sum,sum2; + ivec2 compj; + double bestlike,tmplike=-1e20,z,q,a1=1./sqrt(avalue),a2=sqrt(avalue);; + prob.setlength(nwk);currp.setlength(npar);bestp.setlength(npar);sum.setlength(npar);sum2.setlength(npar); + compj.setlength(nwk,nwk-1); + nsum=0;for(i=0;i-1e10 ){ + nacc++;for(i=0;inburn) { + for(i=0;i&cfq , vector& sfq ){ + //fqL[0] *= 1e-6; fqL[nfq]*=2; + int i,j,k, nfq=fqL.length()-1; + double tt,norm,t1,t2,pi=M_PI,pidt=pi*dt,sdt2,sdt1,cdt2,cdt1,s2dt2,s2dt1,c2dt2,c2dt1,dtmt,dtpt; + double st2,st1,ct2,ct1, sm2,sm1,cm2,cm1, sp2,sp1,cp2,cp1; + vec w; w.setlength(nfq+1); for( k=0 ; k<=nfq ; k++ ){ w[k] = 2*pi*fqL[k]; } + norm = 1./( pidt*pidt ); + + for( i=0 ; i>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "optimization.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + + + + + + + + + +/************************************************************************* +This object stores state of the nonlinear CG optimizer. + +You should use ALGLIB functions to work with this object. +*************************************************************************/ +_mincgstate_owner::_mincgstate_owner() +{ + p_struct = (alglib_impl::mincgstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::mincgstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mincgstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mincgstate_owner::_mincgstate_owner(const _mincgstate_owner &rhs) +{ + p_struct = (alglib_impl::mincgstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::mincgstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mincgstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mincgstate_owner& _mincgstate_owner::operator=(const _mincgstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mincgstate_clear(p_struct); + if( !alglib_impl::_mincgstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mincgstate_owner::~_mincgstate_owner() +{ + alglib_impl::_mincgstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mincgstate* _mincgstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mincgstate* _mincgstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mincgstate::mincgstate() : _mincgstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) +{ +} + +mincgstate::mincgstate(const mincgstate &rhs):_mincgstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) +{ +} + +mincgstate& mincgstate::operator=(const mincgstate &rhs) +{ + if( this==&rhs ) + return *this; + _mincgstate_owner::operator=(rhs); + return *this; +} + +mincgstate::~mincgstate() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_mincgreport_owner::_mincgreport_owner() +{ + p_struct = (alglib_impl::mincgreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mincgreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mincgreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mincgreport_owner::_mincgreport_owner(const _mincgreport_owner &rhs) +{ + p_struct = (alglib_impl::mincgreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::mincgreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_mincgreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_mincgreport_owner& _mincgreport_owner::operator=(const _mincgreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_mincgreport_clear(p_struct); + if( !alglib_impl::_mincgreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_mincgreport_owner::~_mincgreport_owner() +{ + alglib_impl::_mincgreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::mincgreport* _mincgreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::mincgreport* _mincgreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +mincgreport::mincgreport() : _mincgreport_owner() ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype) +{ +} + +mincgreport::mincgreport(const mincgreport &rhs):_mincgreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype) +{ +} + +mincgreport& mincgreport::operator=(const mincgreport &rhs) +{ + if( this==&rhs ) + return *this; + _mincgreport_owner::operator=(rhs); + return *this; +} + +mincgreport::~mincgreport() +{ +} + +/************************************************************************* + NONLINEAR CONJUGATE GRADIENT METHOD + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments by using one of the +nonlinear conjugate gradient methods. + +These CG methods are globally convergent (even on non-convex functions) as +long as grad(f) is Lipschitz continuous in a some neighborhood of the +L = { x : f(x)<=f(x0) }. + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function value F and its gradient G (simultaneously) at given point X + + +USAGE: +1. User initializes algorithm state with MinCGCreate() call +2. User tunes solver parameters with MinCGSetCond(), MinCGSetStpMax() and + other functions +3. User calls MinCGOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. +4. User calls MinCGResults() to get solution +5. Optionally, user may call MinCGRestartFrom() to solve another problem + with same N but another starting point and/or another function. + MinCGRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 25.03.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgcreate(const ae_int_t n, const real_1d_array &x, mincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgcreate(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + NONLINEAR CONJUGATE GRADIENT METHOD + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments by using one of the +nonlinear conjugate gradient methods. + +These CG methods are globally convergent (even on non-convex functions) as +long as grad(f) is Lipschitz continuous in a some neighborhood of the +L = { x : f(x)<=f(x0) }. + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function value F and its gradient G (simultaneously) at given point X + + +USAGE: +1. User initializes algorithm state with MinCGCreate() call +2. User tunes solver parameters with MinCGSetCond(), MinCGSetStpMax() and + other functions +3. User calls MinCGOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. +4. User calls MinCGResults() to get solution +5. Optionally, user may call MinCGRestartFrom() to solve another problem + with same N but another starting point and/or another function. + MinCGRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 25.03.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgcreate(const real_1d_array &x, mincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgcreate(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The subroutine is finite difference variant of MinCGCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinCGCreate() in order to get more +information about creation of CG optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinCGSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. L-BFGS needs exact gradient values. + Imprecise gradient may slow down convergence, especially on highly + nonlinear problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void mincgcreatef(const ae_int_t n, const real_1d_array &x, const double diffstep, mincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgcreatef(n, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The subroutine is finite difference variant of MinCGCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinCGCreate() in order to get more +information about creation of CG optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinCGSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. L-BFGS needs exact gradient values. + Imprecise gradient may slow down convergence, especially on highly + nonlinear problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void mincgcreatef(const real_1d_array &x, const double diffstep, mincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgcreatef(n, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets stopping conditions for CG optimization algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinCGSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetcond(const mincgstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets scaling coefficients for CG optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of CG optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the CG too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinCGSetPrec...() functions. + +There is special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void mincgsetscale(const mincgstate &state, const real_1d_array &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetxrep(const mincgstate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets CG algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + CGType - algorithm type: + * -1 automatic selection of the best algorithm + * 0 DY (Dai and Yuan) algorithm + * 1 Hybrid DY-HS algorithm + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetcgtype(const mincgstate &state, const ae_int_t cgtype) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetcgtype(const_cast(state.c_ptr()), cgtype, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetstpmax(const mincgstate &state, const double stpmax) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function allows to suggest initial step length to the CG algorithm. + +Suggested step length is used as starting point for the line search. It +can be useful when you have badly scaled problem, i.e. when ||grad|| +(which is used as initial estimate for the first step) is many orders of +magnitude different from the desired step. + +Line search may fail on such problems without good estimate of initial +step length. Imagine, for example, problem with ||grad||=10^50 and desired +step equal to 0.1 Line search function will use 10^50 as initial step, +then it will decrease step length by 2 (up to 20 attempts) and will get +10^44, which is still too large. + +This function allows us to tell than line search should be started from +some moderate step length, like 1.0, so algorithm will be able to detect +desired step length in a several searches. + +Default behavior (when no step is suggested) is to use preconditioner, if +it is available, to generate initial estimate of step length. + +This function influences only first iteration of algorithm. It should be +called between MinCGCreate/MinCGRestartFrom() call and MinCGOptimize call. +Suggested step is ignored if you have preconditioner. + +INPUT PARAMETERS: + State - structure used to store algorithm state. + Stp - initial estimate of the step length. + Can be zero (no estimate). + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsuggeststep(const mincgstate &state, const double stp) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsuggeststep(const_cast(state.c_ptr()), stp, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: preconditioning is turned off. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecdefault(const mincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetprecdefault(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecdiag(const mincgstate &state, const real_1d_array &d) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetprecdiag(const_cast(state.c_ptr()), const_cast(d.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinCGSetScale() call +(before or after MinCGSetPrecScale() call). Without knowledge of the scale +of your variables scale-based preconditioner will be just unit matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecscale(const mincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetprecscale(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool mincgiteration(const mincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::mincgiteration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void mincgoptimize(mincgstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'mincgoptimize()' (func is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::mincgiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.x, state.f, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'mincgoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void mincgoptimize(mincgstate &state, + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( grad==NULL ) + throw ap_error("ALGLIB: error in 'mincgoptimize()' (grad is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::mincgiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needfg ) + { + grad(state.x, state.f, state.g, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'mincgoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +Conjugate gradient results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -7 gradient verification failed. + See MinCGSetGradientCheck() for more information. + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible, + we return best X found so far + * 8 terminated by user + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + + -- ALGLIB -- + Copyright 20.04.2009 by Bochkanov Sergey +*************************************************************************/ +void mincgresults(const mincgstate &state, real_1d_array &x, mincgreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conjugate gradient results + +Buffered implementation of MinCGResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.04.2009 by Bochkanov Sergey +*************************************************************************/ +void mincgresultsbuf(const mincgstate &state, real_1d_array &x, mincgreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine restarts CG algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used to store algorithm state. + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgrestartfrom(const mincgstate &state, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinCGOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinCGSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 31.05.2012 by Bochkanov Sergey +*************************************************************************/ +void mincgsetgradientcheck(const mincgstate &state, const double teststep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mincgsetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This object stores nonlinear optimizer state. +You should use functions provided by MinBLEIC subpackage to work with this +object +*************************************************************************/ +_minbleicstate_owner::_minbleicstate_owner() +{ + p_struct = (alglib_impl::minbleicstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minbleicstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minbleicstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minbleicstate_owner::_minbleicstate_owner(const _minbleicstate_owner &rhs) +{ + p_struct = (alglib_impl::minbleicstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minbleicstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minbleicstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minbleicstate_owner& _minbleicstate_owner::operator=(const _minbleicstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minbleicstate_clear(p_struct); + if( !alglib_impl::_minbleicstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minbleicstate_owner::~_minbleicstate_owner() +{ + alglib_impl::_minbleicstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minbleicstate* _minbleicstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minbleicstate* _minbleicstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minbleicstate::minbleicstate() : _minbleicstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) +{ +} + +minbleicstate::minbleicstate(const minbleicstate &rhs):_minbleicstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) +{ +} + +minbleicstate& minbleicstate::operator=(const minbleicstate &rhs) +{ + if( this==&rhs ) + return *this; + _minbleicstate_owner::operator=(rhs); + return *this; +} + +minbleicstate::~minbleicstate() +{ +} + + +/************************************************************************* +This structure stores optimization report: +* IterationsCount number of iterations +* NFEV number of gradient evaluations +* TerminationType termination type (see below) + +TERMINATION CODES + +TerminationType field contains completion code, which can be: + -7 gradient verification failed. + See MinBLEICSetGradientCheck() for more information. + -3 inconsistent constraints. Feasible point is + either nonexistent or too hard to find. Try to + restart optimizer with better initial approximation + 1 relative function improvement is no more than EpsF. + 2 relative step is no more than EpsX. + 4 gradient norm is no more than EpsG + 5 MaxIts steps was taken + 7 stopping conditions are too stringent, + further improvement is impossible, + X contains best point found so far. + +ADDITIONAL FIELDS + +There are additional fields which can be used for debugging: +* DebugEqErr error in the equality constraints (2-norm) +* DebugFS f, calculated at projection of initial point + to the feasible set +* DebugFF f, calculated at the final point +* DebugDX |X_start-X_final| +*************************************************************************/ +_minbleicreport_owner::_minbleicreport_owner() +{ + p_struct = (alglib_impl::minbleicreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minbleicreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minbleicreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minbleicreport_owner::_minbleicreport_owner(const _minbleicreport_owner &rhs) +{ + p_struct = (alglib_impl::minbleicreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minbleicreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minbleicreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minbleicreport_owner& _minbleicreport_owner::operator=(const _minbleicreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minbleicreport_clear(p_struct); + if( !alglib_impl::_minbleicreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minbleicreport_owner::~_minbleicreport_owner() +{ + alglib_impl::_minbleicreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minbleicreport* _minbleicreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minbleicreport* _minbleicreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minbleicreport::minbleicreport() : _minbleicreport_owner() ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype),debugeqerr(p_struct->debugeqerr),debugfs(p_struct->debugfs),debugff(p_struct->debugff),debugdx(p_struct->debugdx),debugfeasqpits(p_struct->debugfeasqpits),debugfeasgpaits(p_struct->debugfeasgpaits),inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount) +{ +} + +minbleicreport::minbleicreport(const minbleicreport &rhs):_minbleicreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype),debugeqerr(p_struct->debugeqerr),debugfs(p_struct->debugfs),debugff(p_struct->debugff),debugdx(p_struct->debugdx),debugfeasqpits(p_struct->debugfeasqpits),debugfeasgpaits(p_struct->debugfeasgpaits),inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount) +{ +} + +minbleicreport& minbleicreport::operator=(const minbleicreport &rhs) +{ + if( this==&rhs ) + return *this; + _minbleicreport_owner::operator=(rhs); + return *this; +} + +minbleicreport::~minbleicreport() +{ +} + +/************************************************************************* + BOUND CONSTRAINED OPTIMIZATION + WITH ADDITIONAL LINEAR EQUALITY AND INEQUALITY CONSTRAINTS + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments subject to any +combination of: +* bound constraints +* linear inequality constraints +* linear equality constraints + +REQUIREMENTS: +* user must provide function value and gradient +* starting point X0 must be feasible or + not too far away from the feasible set +* grad(f) must be Lipschitz continuous on a level set: + L = { x : f(x)<=f(x0) } +* function must be defined everywhere on the feasible set F + +USAGE: + +Constrained optimization if far more complex than the unconstrained one. +Here we give very brief outline of the BLEIC optimizer. We strongly recommend +you to read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide +on optimization, which is available at http://www.alglib.net/optimization/ + +1. User initializes algorithm state with MinBLEICCreate() call + +2. USer adds boundary and/or linear constraints by calling + MinBLEICSetBC() and MinBLEICSetLC() functions. + +3. User sets stopping conditions with MinBLEICSetCond(). + +4. User calls MinBLEICOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. + +5. User calls MinBLEICResults() to get solution + +6. Optionally user may call MinBLEICRestartFrom() to solve another problem + with same N but another starting point. + MinBLEICRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size ofX + X - starting point, array[N]: + * it is better to set X to a feasible point + * but X can be infeasible, in which case algorithm will try + to find feasible point first, using X as initial + approximation. + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleiccreate(const ae_int_t n, const real_1d_array &x, minbleicstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleiccreate(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + BOUND CONSTRAINED OPTIMIZATION + WITH ADDITIONAL LINEAR EQUALITY AND INEQUALITY CONSTRAINTS + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments subject to any +combination of: +* bound constraints +* linear inequality constraints +* linear equality constraints + +REQUIREMENTS: +* user must provide function value and gradient +* starting point X0 must be feasible or + not too far away from the feasible set +* grad(f) must be Lipschitz continuous on a level set: + L = { x : f(x)<=f(x0) } +* function must be defined everywhere on the feasible set F + +USAGE: + +Constrained optimization if far more complex than the unconstrained one. +Here we give very brief outline of the BLEIC optimizer. We strongly recommend +you to read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide +on optimization, which is available at http://www.alglib.net/optimization/ + +1. User initializes algorithm state with MinBLEICCreate() call + +2. USer adds boundary and/or linear constraints by calling + MinBLEICSetBC() and MinBLEICSetLC() functions. + +3. User sets stopping conditions with MinBLEICSetCond(). + +4. User calls MinBLEICOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. + +5. User calls MinBLEICResults() to get solution + +6. Optionally user may call MinBLEICRestartFrom() to solve another problem + with same N but another starting point. + MinBLEICRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size ofX + X - starting point, array[N]: + * it is better to set X to a feasible point + * but X can be infeasible, in which case algorithm will try + to find feasible point first, using X as initial + approximation. + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleiccreate(const real_1d_array &x, minbleicstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleiccreate(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The subroutine is finite difference variant of MinBLEICCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinBLEICCreate() in order to get +more information about creation of BLEIC optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinBLEICSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. CG needs exact gradient values. Imprecise + gradient may slow down convergence, especially on highly nonlinear + problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void minbleiccreatef(const ae_int_t n, const real_1d_array &x, const double diffstep, minbleicstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleiccreatef(n, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The subroutine is finite difference variant of MinBLEICCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinBLEICCreate() in order to get +more information about creation of BLEIC optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinBLEICSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. CG needs exact gradient values. Imprecise + gradient may slow down convergence, especially on highly nonlinear + problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void minbleiccreatef(const real_1d_array &x, const double diffstep, minbleicstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleiccreatef(n, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets boundary constraints for BLEIC optimizer. + +Boundary constraints are inactive by default (after initial creation). +They are preserved after algorithm restart with MinBLEICRestartFrom(). + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF. + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF. + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + +NOTE 2: this solver has following useful properties: +* bound constraints are always satisfied exactly +* function is evaluated only INSIDE area specified by bound constraints, + even when numerical differentiation is used (algorithm adjusts nodes + according to boundary constraints) + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetbc(const minbleicstate &state, const real_1d_array &bndl, const real_1d_array &bndu) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetbc(const_cast(state.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets linear constraints for BLEIC optimizer. + +Linear constraints are inactive by default (after initial creation). +They are preserved after algorithm restart with MinBLEICRestartFrom(). + +INPUT PARAMETERS: + State - structure previously allocated with MinBLEICCreate call. + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + +NOTE 1: linear (non-bound) constraints are satisfied only approximately: +* there always exists some minor violation (about Epsilon in magnitude) + due to rounding errors +* numerical differentiation, if used, may lead to function evaluations + outside of the feasible area, because algorithm does NOT change + numerical differentiation formula according to linear constraints. +If you want constraints to be satisfied exactly, try to reformulate your +problem in such manner that all constraints will become boundary ones +(this kind of constraints is always satisfied exactly, both in the final +solution and in all intermediate points). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetlc(const minbleicstate &state, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetlc(const_cast(state.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets linear constraints for BLEIC optimizer. + +Linear constraints are inactive by default (after initial creation). +They are preserved after algorithm restart with MinBLEICRestartFrom(). + +INPUT PARAMETERS: + State - structure previously allocated with MinBLEICCreate call. + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + +NOTE 1: linear (non-bound) constraints are satisfied only approximately: +* there always exists some minor violation (about Epsilon in magnitude) + due to rounding errors +* numerical differentiation, if used, may lead to function evaluations + outside of the feasible area, because algorithm does NOT change + numerical differentiation formula according to linear constraints. +If you want constraints to be satisfied exactly, try to reformulate your +problem in such manner that all constraints will become boundary ones +(this kind of constraints is always satisfied exactly, both in the final +solution and in all intermediate points). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetlc(const minbleicstate &state, const real_2d_array &c, const integer_1d_array &ct) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t k; + if( (c.rows()!=ct.length())) + throw ap_error("Error while calling 'minbleicsetlc': looks like one of arguments has wrong size"); + k = c.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetlc(const_cast(state.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets stopping conditions for the optimizer. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - step vector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinBLEICSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead +to automatic stopping criterion selection. + +NOTE: when SetCond() called with non-zero MaxIts, BLEIC solver may perform + slightly more than MaxIts iterations. I.e., MaxIts sets non-strict + limit on iterations count. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetcond(const minbleicstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets scaling coefficients for BLEIC optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of the optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the BLEIC too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinBLEICSetPrec...() +functions. + +There is a special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetscale(const minbleicstate &state, const real_1d_array &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: preconditioning is turned off. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecdefault(const minbleicstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetprecdefault(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE 1: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 2: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecdiag(const minbleicstate &state, const real_1d_array &d) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetprecdiag(const_cast(state.c_ptr()), const_cast(d.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinBLEICSetScale() +call (before or after MinBLEICSetPrecScale() call). Without knowledge of +the scale of your variables scale-based preconditioner will be just unit +matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecscale(const minbleicstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetprecscale(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinBLEICOptimize(). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetxrep(const minbleicstate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets maximum step length + +IMPORTANT: this feature is hard to combine with preconditioning. You can't +set upper limit on step length, when you solve optimization problem with +linear (non-boundary) constraints AND preconditioner turned on. + +When non-boundary constraints are present, you have to either a) use +preconditioner, or b) use upper limit on step length. YOU CAN'T USE BOTH! +In this case algorithm will terminate with appropriate error code. + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which lead to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetstpmax(const minbleicstate &state, const double stpmax) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool minbleiciteration(const minbleicstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::minbleiciteration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minbleicoptimize(minbleicstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'minbleicoptimize()' (func is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minbleiciteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.x, state.f, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minbleicoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minbleicoptimize(minbleicstate &state, + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( grad==NULL ) + throw ap_error("ALGLIB: error in 'minbleicoptimize()' (grad is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minbleiciteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needfg ) + { + grad(state.x, state.f, state.g, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minbleicoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +BLEIC results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report. You should check Rep.TerminationType + in order to distinguish successful termination from + unsuccessful one: + * -7 gradient verification failed. + See MinBLEICSetGradientCheck() for more information. + * -3 inconsistent constraints. Feasible point is + either nonexistent or too hard to find. Try to + restart optimizer with better initial approximation + * 1 relative function improvement is no more than EpsF. + * 2 scaled step is no more than EpsX. + * 4 scaled gradient norm is no more than EpsG. + * 5 MaxIts steps was taken + More information about fields of this structure can be + found in the comments on MinBLEICReport datatype. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicresults(const minbleicstate &state, real_1d_array &x, minbleicreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +BLEIC results + +Buffered implementation of MinBLEICResults() which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicresultsbuf(const minbleicstate &state, real_1d_array &x, minbleicreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine restarts algorithm from new point. +All optimization parameters (including constraints) are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure previously allocated with MinBLEICCreate call. + X - new starting point. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicrestartfrom(const minbleicstate &state, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinBLEICOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinBLEICSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetgradientcheck(const minbleicstate &state, const double teststep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +_minlbfgsstate_owner::_minlbfgsstate_owner() +{ + p_struct = (alglib_impl::minlbfgsstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlbfgsstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minlbfgsstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minlbfgsstate_owner::_minlbfgsstate_owner(const _minlbfgsstate_owner &rhs) +{ + p_struct = (alglib_impl::minlbfgsstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlbfgsstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minlbfgsstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minlbfgsstate_owner& _minlbfgsstate_owner::operator=(const _minlbfgsstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minlbfgsstate_clear(p_struct); + if( !alglib_impl::_minlbfgsstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minlbfgsstate_owner::~_minlbfgsstate_owner() +{ + alglib_impl::_minlbfgsstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minlbfgsstate* _minlbfgsstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minlbfgsstate* _minlbfgsstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minlbfgsstate::minlbfgsstate() : _minlbfgsstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) +{ +} + +minlbfgsstate::minlbfgsstate(const minlbfgsstate &rhs):_minlbfgsstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) +{ +} + +minlbfgsstate& minlbfgsstate::operator=(const minlbfgsstate &rhs) +{ + if( this==&rhs ) + return *this; + _minlbfgsstate_owner::operator=(rhs); + return *this; +} + +minlbfgsstate::~minlbfgsstate() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_minlbfgsreport_owner::_minlbfgsreport_owner() +{ + p_struct = (alglib_impl::minlbfgsreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlbfgsreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minlbfgsreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minlbfgsreport_owner::_minlbfgsreport_owner(const _minlbfgsreport_owner &rhs) +{ + p_struct = (alglib_impl::minlbfgsreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlbfgsreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minlbfgsreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minlbfgsreport_owner& _minlbfgsreport_owner::operator=(const _minlbfgsreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minlbfgsreport_clear(p_struct); + if( !alglib_impl::_minlbfgsreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minlbfgsreport_owner::~_minlbfgsreport_owner() +{ + alglib_impl::_minlbfgsreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minlbfgsreport* _minlbfgsreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minlbfgsreport* _minlbfgsreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minlbfgsreport::minlbfgsreport() : _minlbfgsreport_owner() ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype) +{ +} + +minlbfgsreport::minlbfgsreport(const minlbfgsreport &rhs):_minlbfgsreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),varidx(p_struct->varidx),terminationtype(p_struct->terminationtype) +{ +} + +minlbfgsreport& minlbfgsreport::operator=(const minlbfgsreport &rhs) +{ + if( this==&rhs ) + return *this; + _minlbfgsreport_owner::operator=(rhs); + return *this; +} + +minlbfgsreport::~minlbfgsreport() +{ +} + +/************************************************************************* + LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments by using a quasi- +Newton method (LBFGS scheme) which is optimized to use a minimum amount +of memory. +The subroutine generates the approximation of an inverse Hessian matrix by +using information about the last M steps of the algorithm (instead of N). +It lessens a required amount of memory from a value of order N^2 to a +value of order 2*N*M. + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function value F and its gradient G (simultaneously) at given point X + + +USAGE: +1. User initializes algorithm state with MinLBFGSCreate() call +2. User tunes solver parameters with MinLBFGSSetCond() MinLBFGSSetStpMax() + and other functions +3. User calls MinLBFGSOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. +4. User calls MinLBFGSResults() to get solution +5. Optionally user may call MinLBFGSRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLBFGSRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension. N>0 + M - number of corrections in the BFGS scheme of Hessian + approximation update. Recommended value: 3<=M<=7. The smaller + value causes worse convergence, the bigger will not cause a + considerably better convergence, but will cause a fall in the + performance. M<=N. + X - initial solution approximation, array[0..N-1]. + + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + +NOTES: +1. you may tune stopping conditions with MinLBFGSSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLBFGSSetStpMax() function to bound algorithm's steps. However, + L-BFGS rarely needs such a tuning. + + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreate(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlbfgsstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgscreate(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments by using a quasi- +Newton method (LBFGS scheme) which is optimized to use a minimum amount +of memory. +The subroutine generates the approximation of an inverse Hessian matrix by +using information about the last M steps of the algorithm (instead of N). +It lessens a required amount of memory from a value of order N^2 to a +value of order 2*N*M. + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function value F and its gradient G (simultaneously) at given point X + + +USAGE: +1. User initializes algorithm state with MinLBFGSCreate() call +2. User tunes solver parameters with MinLBFGSSetCond() MinLBFGSSetStpMax() + and other functions +3. User calls MinLBFGSOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. +4. User calls MinLBFGSResults() to get solution +5. Optionally user may call MinLBFGSRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLBFGSRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension. N>0 + M - number of corrections in the BFGS scheme of Hessian + approximation update. Recommended value: 3<=M<=7. The smaller + value causes worse convergence, the bigger will not cause a + considerably better convergence, but will cause a fall in the + performance. M<=N. + X - initial solution approximation, array[0..N-1]. + + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + +NOTES: +1. you may tune stopping conditions with MinLBFGSSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLBFGSSetStpMax() function to bound algorithm's steps. However, + L-BFGS rarely needs such a tuning. + + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreate(const ae_int_t m, const real_1d_array &x, minlbfgsstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgscreate(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The subroutine is finite difference variant of MinLBFGSCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinLBFGSCreate() in order to get +more information about creation of LBFGS optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of corrections in the BFGS scheme of Hessian + approximation update. Recommended value: 3<=M<=7. The smaller + value causes worse convergence, the bigger will not cause a + considerably better convergence, but will cause a fall in the + performance. M<=N. + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinLBFGSSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. LBFGS needs exact gradient values. + Imprecise gradient may slow down convergence, especially on highly + nonlinear problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreatef(const ae_int_t n, const ae_int_t m, const real_1d_array &x, const double diffstep, minlbfgsstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgscreatef(n, m, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +The subroutine is finite difference variant of MinLBFGSCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinLBFGSCreate() in order to get +more information about creation of LBFGS optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of corrections in the BFGS scheme of Hessian + approximation update. Recommended value: 3<=M<=7. The smaller + value causes worse convergence, the bigger will not cause a + considerably better convergence, but will cause a fall in the + performance. M<=N. + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinLBFGSSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. LBFGS needs exact gradient values. + Imprecise gradient may slow down convergence, especially on highly + nonlinear problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreatef(const ae_int_t m, const real_1d_array &x, const double diffstep, minlbfgsstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgscreatef(n, m, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets stopping conditions for L-BFGS optimization algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinLBFGSSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetcond(const minlbfgsstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinLBFGSOptimize(). + + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetxrep(const minlbfgsstate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0 (default), if + you don't want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetstpmax(const minlbfgsstate &state, const double stpmax) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets scaling coefficients for LBFGS optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of the optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the LBFGS too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinLBFGSSetPrec...() +functions. + +There is special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetscale(const minlbfgsstate &state, const real_1d_array &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: default preconditioner (simple +scaling, same for all elements of X) is used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecdefault(const minlbfgsstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetprecdefault(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: Cholesky factorization of approximate +Hessian is used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + P - triangular preconditioner, Cholesky factorization of + the approximate Hessian. array[0..N-1,0..N-1], + (if larger, only leading N elements are used). + IsUpper - whether upper or lower triangle of P is given + (other triangle is not referenced) + +After call to this function preconditioner is changed to P (P is copied +into the internal buffer). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: P should be nonsingular. Exception will be thrown otherwise. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetpreccholesky(const minlbfgsstate &state, const real_2d_array &p, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetpreccholesky(const_cast(state.c_ptr()), const_cast(p.c_ptr()), isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecdiag(const minlbfgsstate &state, const real_1d_array &d) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetprecdiag(const_cast(state.c_ptr()), const_cast(d.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinLBFGSSetScale() +call (before or after MinLBFGSSetPrecScale() call). Without knowledge of +the scale of your variables scale-based preconditioner will be just unit +matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecscale(const minlbfgsstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetprecscale(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool minlbfgsiteration(const minlbfgsstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::minlbfgsiteration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minlbfgsoptimize(minlbfgsstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'minlbfgsoptimize()' (func is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minlbfgsiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.x, state.f, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minlbfgsoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minlbfgsoptimize(minlbfgsstate &state, + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( grad==NULL ) + throw ap_error("ALGLIB: error in 'minlbfgsoptimize()' (grad is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minlbfgsiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needfg ) + { + grad(state.x, state.f, state.g, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minlbfgsoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +L-BFGS algorithm results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -7 gradient verification failed. + See MinLBFGSSetGradientCheck() for more information. + * -2 rounding errors prevent further improvement. + X contains best point found. + * -1 incorrect parameters were specified + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsresults(const minlbfgsstate &state, real_1d_array &x, minlbfgsreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgsresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +L-BFGS algorithm results + +Buffered implementation of MinLBFGSResults which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsresultsbuf(const minlbfgsstate &state, real_1d_array &x, minlbfgsreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgsresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine restarts LBFGS algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used to store algorithm state + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsrestartfrom(const minlbfgsstate &state, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgsrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinLBFGSOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinLBFGSSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 24.05.2012 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetgradientcheck(const minlbfgsstate &state, const double teststep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This object stores nonlinear optimizer state. +You should use functions provided by MinQP subpackage to work with this +object +*************************************************************************/ +_minqpstate_owner::_minqpstate_owner() +{ + p_struct = (alglib_impl::minqpstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minqpstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minqpstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minqpstate_owner::_minqpstate_owner(const _minqpstate_owner &rhs) +{ + p_struct = (alglib_impl::minqpstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minqpstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minqpstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minqpstate_owner& _minqpstate_owner::operator=(const _minqpstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minqpstate_clear(p_struct); + if( !alglib_impl::_minqpstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minqpstate_owner::~_minqpstate_owner() +{ + alglib_impl::_minqpstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minqpstate* _minqpstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minqpstate* _minqpstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minqpstate::minqpstate() : _minqpstate_owner() +{ +} + +minqpstate::minqpstate(const minqpstate &rhs):_minqpstate_owner(rhs) +{ +} + +minqpstate& minqpstate::operator=(const minqpstate &rhs) +{ + if( this==&rhs ) + return *this; + _minqpstate_owner::operator=(rhs); + return *this; +} + +minqpstate::~minqpstate() +{ +} + + +/************************************************************************* +This structure stores optimization report: +* InnerIterationsCount number of inner iterations +* OuterIterationsCount number of outer iterations +* NCholesky number of Cholesky decomposition +* NMV number of matrix-vector products + (only products calculated as part of iterative + process are counted) +* TerminationType completion code (see below) + +Completion codes: +* -5 inappropriate solver was used: + * Cholesky solver for semidefinite or indefinite problems + * Cholesky solver for problems with non-boundary constraints +* -4 BLEIC-QP algorithm found unconstrained direction + of negative curvature (function is unbounded from + below even under constraints), no meaningful + minimum can be found. +* -3 inconsistent constraints (or, maybe, feasible point is + too hard to find). If you are sure that constraints are feasible, + try to restart optimizer with better initial approximation. +* -1 solver error +* 4 successful completion +* 5 MaxIts steps was taken +* 7 stopping conditions are too stringent, + further improvement is impossible, + X contains best point found so far. +*************************************************************************/ +_minqpreport_owner::_minqpreport_owner() +{ + p_struct = (alglib_impl::minqpreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minqpreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minqpreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minqpreport_owner::_minqpreport_owner(const _minqpreport_owner &rhs) +{ + p_struct = (alglib_impl::minqpreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minqpreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minqpreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minqpreport_owner& _minqpreport_owner::operator=(const _minqpreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minqpreport_clear(p_struct); + if( !alglib_impl::_minqpreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minqpreport_owner::~_minqpreport_owner() +{ + alglib_impl::_minqpreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minqpreport* _minqpreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minqpreport* _minqpreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minqpreport::minqpreport() : _minqpreport_owner() ,inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount),nmv(p_struct->nmv),ncholesky(p_struct->ncholesky),terminationtype(p_struct->terminationtype) +{ +} + +minqpreport::minqpreport(const minqpreport &rhs):_minqpreport_owner(rhs) ,inneriterationscount(p_struct->inneriterationscount),outeriterationscount(p_struct->outeriterationscount),nmv(p_struct->nmv),ncholesky(p_struct->ncholesky),terminationtype(p_struct->terminationtype) +{ +} + +minqpreport& minqpreport::operator=(const minqpreport &rhs) +{ + if( this==&rhs ) + return *this; + _minqpreport_owner::operator=(rhs); + return *this; +} + +minqpreport::~minqpreport() +{ +} + +/************************************************************************* + CONSTRAINED QUADRATIC PROGRAMMING + +The subroutine creates QP optimizer. After initial creation, it contains +default optimization problem with zero quadratic and linear terms and no +constraints. You should set quadratic/linear terms with calls to functions +provided by MinQP subpackage. + +INPUT PARAMETERS: + N - problem size + +OUTPUT PARAMETERS: + State - optimizer with zero quadratic/linear terms + and no constraints + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpcreate(const ae_int_t n, minqpstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpcreate(n, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets linear term for QP solver. + +By default, linear term is zero. + +INPUT PARAMETERS: + State - structure which stores algorithm state + B - linear term, array[N]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetlinearterm(const minqpstate &state, const real_1d_array &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetlinearterm(const_cast(state.c_ptr()), const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets dense quadratic term for QP solver. By default, +quadratic term is zero. + +SUPPORT BY ALGLIB QP ALGORITHMS: + +Dense quadratic term can be handled by any of the QP algorithms supported +by ALGLIB QP Solver. + +IMPORTANT: + +This solver minimizes following function: + f(x) = 0.5*x'*A*x + b'*x. +Note that quadratic term has 0.5 before it. So if you want to minimize + f(x) = x^2 + x +you should rewrite your problem as follows: + f(x) = 0.5*(2*x^2) + x +and your matrix A will be equal to [[2.0]], not to [[1.0]] + +INPUT PARAMETERS: + State - structure which stores algorithm state + A - matrix, array[N,N] + IsUpper - (optional) storage type: + * if True, symmetric matrix A is given by its upper + triangle, and the lower triangle isn’t used + * if False, symmetric matrix A is given by its lower + triangle, and the upper triangle isn’t used + * if not given, both lower and upper triangles must be + filled. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetquadraticterm(const minqpstate &state, const real_2d_array &a, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetquadraticterm(const_cast(state.c_ptr()), const_cast(a.c_ptr()), isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets dense quadratic term for QP solver. By default, +quadratic term is zero. + +SUPPORT BY ALGLIB QP ALGORITHMS: + +Dense quadratic term can be handled by any of the QP algorithms supported +by ALGLIB QP Solver. + +IMPORTANT: + +This solver minimizes following function: + f(x) = 0.5*x'*A*x + b'*x. +Note that quadratic term has 0.5 before it. So if you want to minimize + f(x) = x^2 + x +you should rewrite your problem as follows: + f(x) = 0.5*(2*x^2) + x +and your matrix A will be equal to [[2.0]], not to [[1.0]] + +INPUT PARAMETERS: + State - structure which stores algorithm state + A - matrix, array[N,N] + IsUpper - (optional) storage type: + * if True, symmetric matrix A is given by its upper + triangle, and the lower triangle isn’t used + * if False, symmetric matrix A is given by its lower + triangle, and the upper triangle isn’t used + * if not given, both lower and upper triangles must be + filled. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetquadraticterm(const minqpstate &state, const real_2d_array &a) +{ + alglib_impl::ae_state _alglib_env_state; + bool isupper; + if( !alglib_impl::ae_is_symmetric(const_cast(a.c_ptr())) ) + throw ap_error("'a' parameter is not symmetric matrix"); + isupper = false; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetquadraticterm(const_cast(state.c_ptr()), const_cast(a.c_ptr()), isupper, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets sparse quadratic term for QP solver. By default, +quadratic term is zero. + +SUPPORT BY ALGLIB QP ALGORITHMS: + +Sparse quadratic term is supported only by BLEIC-based QP algorithm (one +which is activated by MinQPSetAlgoBLEIC function). Cholesky-based QP algo +won't be able to deal with sparse quadratic term and will terminate +abnormally. + +IF YOU CALLED THIS FUNCTION, YOU MUST SWITCH TO BLEIC-BASED QP ALGORITHM +BEFORE CALLING MINQPOPTIMIZE() FUNCTION. + +IMPORTANT: + +This solver minimizes following function: + f(x) = 0.5*x'*A*x + b'*x. +Note that quadratic term has 0.5 before it. So if you want to minimize + f(x) = x^2 + x +you should rewrite your problem as follows: + f(x) = 0.5*(2*x^2) + x +and your matrix A will be equal to [[2.0]], not to [[1.0]] + +INPUT PARAMETERS: + State - structure which stores algorithm state + A - matrix, array[N,N] + IsUpper - (optional) storage type: + * if True, symmetric matrix A is given by its upper + triangle, and the lower triangle isn’t used + * if False, symmetric matrix A is given by its lower + triangle, and the upper triangle isn’t used + * if not given, both lower and upper triangles must be + filled. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetquadratictermsparse(const minqpstate &state, const sparsematrix &a, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetquadratictermsparse(const_cast(state.c_ptr()), const_cast(a.c_ptr()), isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets starting point for QP solver. It is useful to have +good initial approximation to the solution, because it will increase +speed of convergence and identification of active constraints. + +INPUT PARAMETERS: + State - structure which stores algorithm state + X - starting point, array[N]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetstartingpoint(const minqpstate &state, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetstartingpoint(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets origin for QP solver. By default, following QP program +is solved: + + min(0.5*x'*A*x+b'*x) + +This function allows to solve different problem: + + min(0.5*(x-x_origin)'*A*(x-x_origin)+b'*(x-x_origin)) + +INPUT PARAMETERS: + State - structure which stores algorithm state + XOrigin - origin, array[N]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetorigin(const minqpstate &state, const real_1d_array &xorigin) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetorigin(const_cast(state.c_ptr()), const_cast(xorigin.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets scaling coefficients. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +BLEIC-based QP solver uses scale for two purposes: +* to evaluate stopping conditions +* for preconditioning of the underlying BLEIC solver + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetscale(const minqpstate &state, const real_1d_array &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function tells solver to use Cholesky-based algorithm. This algorithm +is active by default. + +DESCRIPTION: + +Cholesky-based algorithm can be used only for problems which: +* have dense quadratic term, set by MinQPSetQuadraticTerm(), sparse or + structured problems are not supported. +* are strictly convex, i.e. quadratic term is symmetric positive definite, + indefinite or semidefinite problems are not supported by this algorithm. + +If anything of what listed above is violated, you may use BLEIC-based QP +algorithm which can be activated by MinQPSetAlgoBLEIC(). + +BENEFITS AND DRAWBACKS: + +This algorithm gives best precision amongst all QP solvers provided by +ALGLIB (Newton iterations have much higher precision than any other +optimization algorithm). This solver also gracefully handles problems with +very large amount of constraints. + +Performance of the algorithm is good because internally it uses Level 3 +Dense BLAS for its performance-critical parts. + + +From the other side, algorithm has O(N^3) complexity for unconstrained +problems and up to orders of magnitude slower on constrained problems +(these additional iterations are needed to identify active constraints). +So, its running time depends on number of constraints active at solution. + +Furthermore, this algorithm can not solve problems with sparse matrices or +problems with semidefinite/indefinite matrices of any kind (dense/sparse). + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetalgocholesky(const minqpstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetalgocholesky(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function tells solver to use BLEIC-based algorithm and sets stopping +criteria for the algorithm. + +DESCRIPTION: + +BLEIC-based QP algorithm can be used for any kind of QP problems: +* problems with both dense and sparse quadratic terms +* problems with positive definite, semidefinite, indefinite terms + +BLEIC-based algorithm can solve even indefinite problems - as long as they +are bounded from below on the feasible set. Of course, global minimum is +found only for positive definite and semidefinite problems. As for +indefinite ones - only local minimum is found. + +BENEFITS AND DRAWBACKS: + +This algorithm can be used to solve both convex and indefinite QP problems +and it can utilize sparsity of the quadratic term (algorithm calculates +matrix-vector products, which can be performed efficiently in case of +sparse matrix). + +Algorithm has iteration cost, which (assuming fixed amount of non-boundary +linear constraints) linearly depends on problem size. Boundary constraints +does not significantly change iteration cost. + +Thus, it outperforms Cholesky-based QP algorithm (CQP) on high-dimensional +sparse problems with moderate amount of constraints. + + +From the other side, unlike CQP solver, this algorithm does NOT make use +of Level 3 Dense BLAS. Thus, its performance on dense problems is inferior +to that of CQP solver. + +Its precision is also inferior to that of CQP. CQP performs Newton steps +which are know to achieve very good precision. In many cases Newton step +leads us exactly to the solution. BLEIC-QP performs LBFGS steps, which are +good at detecting neighborhood of the solution, buy need many iterations +to find solution with 6 digits of precision. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if exploratory steepest + descent step on k+1-th iteration satisfies following + condition: |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + EpsX - >=0 + The subroutine finishes its work if exploratory steepest + descent step on k+1-th iteration satisfies following + condition: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - step vector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinQPSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead +to automatic stopping criterion selection (presently it is small step +length, but it may change in the future versions of ALGLIB). + +IT IS VERY IMPORTANT THAT YOU CALL MinQPSetScale() WHEN YOU USE THIS ALGO! + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetalgobleic(const minqpstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetalgobleic(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets boundary constraints for QP solver + +Boundary constraints are inactive by default (after initial creation). +After being set, they are preserved until explicitly turned off with +another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetbc(const minqpstate &state, const real_1d_array &bndl, const real_1d_array &bndu) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetbc(const_cast(state.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets linear constraints for QP optimizer. + +Linear constraints are inactive by default (after initial creation). + +INPUT PARAMETERS: + State - structure previously allocated with MinQPCreate call. + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + +NOTE 1: linear (non-bound) constraints are satisfied only approximately - + there always exists some minor violation (about 10^-10...10^-13) + due to numerical errors. + + -- ALGLIB -- + Copyright 19.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minqpsetlc(const minqpstate &state, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetlc(const_cast(state.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets linear constraints for QP optimizer. + +Linear constraints are inactive by default (after initial creation). + +INPUT PARAMETERS: + State - structure previously allocated with MinQPCreate call. + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + +NOTE 1: linear (non-bound) constraints are satisfied only approximately - + there always exists some minor violation (about 10^-10...10^-13) + due to numerical errors. + + -- ALGLIB -- + Copyright 19.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minqpsetlc(const minqpstate &state, const real_2d_array &c, const integer_1d_array &ct) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t k; + if( (c.rows()!=ct.length())) + throw ap_error("Error while calling 'minqpsetlc': looks like one of arguments has wrong size"); + k = c.rows(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpsetlc(const_cast(state.c_ptr()), const_cast(c.c_ptr()), const_cast(ct.c_ptr()), k, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function solves quadratic programming problem. +You should call it after setting solver options with MinQPSet...() calls. + +INPUT PARAMETERS: + State - algorithm state + +You should use MinQPResults() function to access results after calls +to this function. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey. + Special thanks to Elvira Illarionova for important suggestions on + the linearly constrained QP algorithm. +*************************************************************************/ +void minqpoptimize(const minqpstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpoptimize(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +QP solver results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution. + This array is allocated and initialized only when + Rep.TerminationType parameter is positive (success). + Rep - optimization report. You should check Rep.TerminationType, + which contains completion code, and you may check another + fields which contain another information about algorithm + functioning. + + Failure codes returned by algorithm are: + * -5 inappropriate solver was used: + * Cholesky solver for (semi)indefinite problems + * Cholesky solver for problems with sparse matrix + * -4 BLEIC-QP algorithm found unconstrained direction + of negative curvature (function is unbounded from + below even under constraints), no meaningful + minimum can be found. + * -3 inconsistent constraints (or maybe feasible point + is too hard to find). If you are sure that + constraints are feasible, try to restart optimizer + with better initial approximation. + + Completion codes specific for Cholesky algorithm: + * 4 successful completion + + Completion codes specific for BLEIC-based algorithm: + * 1 relative function improvement is no more than EpsF. + * 2 scaled step is no more than EpsX. + * 4 scaled gradient norm is no more than EpsG. + * 5 MaxIts steps was taken + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpresults(const minqpstate &state, real_1d_array &x, minqpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +QP results + +Buffered implementation of MinQPResults() which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpresultsbuf(const minqpstate &state, real_1d_array &x, minqpreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minqpresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Levenberg-Marquardt optimizer. + +This structure should be created using one of the MinLMCreate???() +functions. You should not access its fields directly; use ALGLIB functions +to work with it. +*************************************************************************/ +_minlmstate_owner::_minlmstate_owner() +{ + p_struct = (alglib_impl::minlmstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlmstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minlmstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minlmstate_owner::_minlmstate_owner(const _minlmstate_owner &rhs) +{ + p_struct = (alglib_impl::minlmstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlmstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minlmstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minlmstate_owner& _minlmstate_owner::operator=(const _minlmstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minlmstate_clear(p_struct); + if( !alglib_impl::_minlmstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minlmstate_owner::~_minlmstate_owner() +{ + alglib_impl::_minlmstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minlmstate* _minlmstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minlmstate* _minlmstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minlmstate::minlmstate() : _minlmstate_owner() ,needf(p_struct->needf),needfg(p_struct->needfg),needfgh(p_struct->needfgh),needfi(p_struct->needfi),needfij(p_struct->needfij),xupdated(p_struct->xupdated),f(p_struct->f),fi(&p_struct->fi),g(&p_struct->g),h(&p_struct->h),j(&p_struct->j),x(&p_struct->x) +{ +} + +minlmstate::minlmstate(const minlmstate &rhs):_minlmstate_owner(rhs) ,needf(p_struct->needf),needfg(p_struct->needfg),needfgh(p_struct->needfgh),needfi(p_struct->needfi),needfij(p_struct->needfij),xupdated(p_struct->xupdated),f(p_struct->f),fi(&p_struct->fi),g(&p_struct->g),h(&p_struct->h),j(&p_struct->j),x(&p_struct->x) +{ +} + +minlmstate& minlmstate::operator=(const minlmstate &rhs) +{ + if( this==&rhs ) + return *this; + _minlmstate_owner::operator=(rhs); + return *this; +} + +minlmstate::~minlmstate() +{ +} + + +/************************************************************************* +Optimization report, filled by MinLMResults() function + +FIELDS: +* TerminationType, completetion code: + * -7 derivative correctness check failed; + see Rep.WrongNum, Rep.WrongI, Rep.WrongJ for + more information. + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient is no more than EpsG. + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible +* IterationsCount, contains iterations count +* NFunc, number of function calculations +* NJac, number of Jacobi matrix calculations +* NGrad, number of gradient calculations +* NHess, number of Hessian calculations +* NCholesky, number of Cholesky decomposition calculations +*************************************************************************/ +_minlmreport_owner::_minlmreport_owner() +{ + p_struct = (alglib_impl::minlmreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlmreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minlmreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minlmreport_owner::_minlmreport_owner(const _minlmreport_owner &rhs) +{ + p_struct = (alglib_impl::minlmreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minlmreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minlmreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minlmreport_owner& _minlmreport_owner::operator=(const _minlmreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minlmreport_clear(p_struct); + if( !alglib_impl::_minlmreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minlmreport_owner::~_minlmreport_owner() +{ + alglib_impl::_minlmreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minlmreport* _minlmreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minlmreport* _minlmreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minlmreport::minlmreport() : _minlmreport_owner() ,iterationscount(p_struct->iterationscount),terminationtype(p_struct->terminationtype),funcidx(p_struct->funcidx),varidx(p_struct->varidx),nfunc(p_struct->nfunc),njac(p_struct->njac),ngrad(p_struct->ngrad),nhess(p_struct->nhess),ncholesky(p_struct->ncholesky) +{ +} + +minlmreport::minlmreport(const minlmreport &rhs):_minlmreport_owner(rhs) ,iterationscount(p_struct->iterationscount),terminationtype(p_struct->terminationtype),funcidx(p_struct->funcidx),varidx(p_struct->varidx),nfunc(p_struct->nfunc),njac(p_struct->njac),ngrad(p_struct->ngrad),nhess(p_struct->nhess),ncholesky(p_struct->ncholesky) +{ +} + +minlmreport& minlmreport::operator=(const minlmreport &rhs) +{ + if( this==&rhs ) + return *this; + _minlmreport_owner::operator=(rhs); + return *this; +} + +minlmreport::~minlmreport() +{ +} + +/************************************************************************* + IMPROVED LEVENBERG-MARQUARDT METHOD FOR + NON-LINEAR LEAST SQUARES OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of function which is represented as +sum of squares: + F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) +using value of function vector f[] and Jacobian of f[]. + + +REQUIREMENTS: +This algorithm will request following information during its operation: + +* function vector f[] at given point X +* function vector f[] and Jacobian of f[] (simultaneously) at given point + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts fvec() and jac() callbacks. +First one is used to calculate f[] at given point, second one calculates +f[] and Jacobian df[i]/dx[j]. + +You can try to initialize MinLMState structure with VJ function and then +use incorrect version of MinLMOptimize() (for example, version which +works with general form function and does not provide Jacobian), but it +will lead to exception being thrown after first attempt to calculate +Jacobian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateVJ() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of functions f[i] + X - initial solution, array[0..N-1] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatevj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatevj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + IMPROVED LEVENBERG-MARQUARDT METHOD FOR + NON-LINEAR LEAST SQUARES OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of function which is represented as +sum of squares: + F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) +using value of function vector f[] and Jacobian of f[]. + + +REQUIREMENTS: +This algorithm will request following information during its operation: + +* function vector f[] at given point X +* function vector f[] and Jacobian of f[] (simultaneously) at given point + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts fvec() and jac() callbacks. +First one is used to calculate f[] at given point, second one calculates +f[] and Jacobian df[i]/dx[j]. + +You can try to initialize MinLMState structure with VJ function and then +use incorrect version of MinLMOptimize() (for example, version which +works with general form function and does not provide Jacobian), but it +will lead to exception being thrown after first attempt to calculate +Jacobian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateVJ() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of functions f[i] + X - initial solution, array[0..N-1] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatevj(const ae_int_t m, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatevj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + IMPROVED LEVENBERG-MARQUARDT METHOD FOR + NON-LINEAR LEAST SQUARES OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of function which is represented as +sum of squares: + F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) +using value of function vector f[] only. Finite differences are used to +calculate Jacobian. + + +REQUIREMENTS: +This algorithm will request following information during its operation: +* function vector f[] at given point X + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts fvec() callback. + +You can try to initialize MinLMState structure with VJ function and then +use incorrect version of MinLMOptimize() (for example, version which +works with general form function and does not accept function vector), but +it will lead to exception being thrown after first attempt to calculate +Jacobian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateV() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of functions f[i] + X - initial solution, array[0..N-1] + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +See also MinLMIteration, MinLMResults. + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatev(const ae_int_t n, const ae_int_t m, const real_1d_array &x, const double diffstep, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatev(n, m, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + IMPROVED LEVENBERG-MARQUARDT METHOD FOR + NON-LINEAR LEAST SQUARES OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of function which is represented as +sum of squares: + F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) +using value of function vector f[] only. Finite differences are used to +calculate Jacobian. + + +REQUIREMENTS: +This algorithm will request following information during its operation: +* function vector f[] at given point X + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts fvec() callback. + +You can try to initialize MinLMState structure with VJ function and then +use incorrect version of MinLMOptimize() (for example, version which +works with general form function and does not accept function vector), but +it will lead to exception being thrown after first attempt to calculate +Jacobian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateV() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of functions f[i] + X - initial solution, array[0..N-1] + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +See also MinLMIteration, MinLMResults. + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatev(const ae_int_t m, const real_1d_array &x, const double diffstep, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatev(n, m, const_cast(x.c_ptr()), diffstep, const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + LEVENBERG-MARQUARDT-LIKE METHOD FOR NON-LINEAR OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of general form (not "sum-of- +-squares") function + F = F(x[0], ..., x[n-1]) +using its gradient and Hessian. Levenberg-Marquardt modification with +L-BFGS pre-optimization and internal pre-conditioned L-BFGS optimization +after each Levenberg-Marquardt step is used. + + +REQUIREMENTS: +This algorithm will request following information during its operation: + +* function value F at given point X +* F and gradient G (simultaneously) at given point X +* F, G and Hessian H (simultaneously) at given point X + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts func(), grad() and hess() +function pointers. First pointer is used to calculate F at given point, +second one calculates F(x) and grad F(x), third one calculates F(x), +grad F(x), hess F(x). + +You can try to initialize MinLMState structure with FGH-function and then +use incorrect version of MinLMOptimize() (for example, version which does +not provide Hessian matrix), but it will lead to exception being thrown +after first attempt to calculate Hessian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateFGH() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + pointers (delegates, etc.) to callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - initial solution, array[0..N-1] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefgh(const ae_int_t n, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatefgh(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + LEVENBERG-MARQUARDT-LIKE METHOD FOR NON-LINEAR OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of general form (not "sum-of- +-squares") function + F = F(x[0], ..., x[n-1]) +using its gradient and Hessian. Levenberg-Marquardt modification with +L-BFGS pre-optimization and internal pre-conditioned L-BFGS optimization +after each Levenberg-Marquardt step is used. + + +REQUIREMENTS: +This algorithm will request following information during its operation: + +* function value F at given point X +* F and gradient G (simultaneously) at given point X +* F, G and Hessian H (simultaneously) at given point X + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts func(), grad() and hess() +function pointers. First pointer is used to calculate F at given point, +second one calculates F(x) and grad F(x), third one calculates F(x), +grad F(x), hess F(x). + +You can try to initialize MinLMState structure with FGH-function and then +use incorrect version of MinLMOptimize() (for example, version which does +not provide Hessian matrix), but it will lead to exception being thrown +after first attempt to calculate Hessian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateFGH() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + pointers (delegates, etc.) to callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - initial solution, array[0..N-1] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefgh(const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatefgh(n, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets stopping conditions for Levenberg-Marquardt optimization +algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinLMSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. Only Levenberg-Marquardt + iterations are counted (L-BFGS/CG iterations are NOT + counted because their cost is very low compared to that of + LM). + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetcond(const minlmstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmsetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinLMOptimize(). Both Levenberg-Marquardt and internal L-BFGS +iterations are reported. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetxrep(const minlmstate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + +NOTE: non-zero StpMax leads to moderate performance degradation because +intermediate step of preconditioned L-BFGS optimization is incompatible +with limits on step size. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetstpmax(const minlmstate &state, const double stpmax) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets scaling coefficients for LM optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Generally, scale is NOT considered to be a form of preconditioner. But LM +optimizer is unique in that it uses scaling matrix both in the stopping +condition tests and as Marquardt damping factor. + +Proper scaling is very important for the algorithm performance. It is less +important for the quality of results, but still has some influence (it is +easier to converge when variables are properly scaled, so premature +stopping is possible when very badly scalled variables are combined with +relaxed stopping conditions). + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlmsetscale(const minlmstate &state, const real_1d_array &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmsetscale(const_cast(state.c_ptr()), const_cast(s.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets boundary constraints for LM optimizer + +Boundary constraints are inactive by default (after initial creation). +They are preserved until explicitly turned off with another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + +NOTE 2: this solver has following useful properties: +* bound constraints are always satisfied exactly +* function is evaluated only INSIDE area specified by bound constraints + or at its boundary + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlmsetbc(const minlmstate &state, const real_1d_array &bndl, const real_1d_array &bndu) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmsetbc(const_cast(state.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is used to change acceleration settings + +You can choose between three acceleration strategies: +* AccType=0, no acceleration. +* AccType=1, secant updates are used to update quadratic model after each + iteration. After fixed number of iterations (or after model breakdown) + we recalculate quadratic model using analytic Jacobian or finite + differences. Number of secant-based iterations depends on optimization + settings: about 3 iterations - when we have analytic Jacobian, up to 2*N + iterations - when we use finite differences to calculate Jacobian. + +AccType=1 is recommended when Jacobian calculation cost is prohibitive +high (several Mx1 function vector calculations followed by several NxN +Cholesky factorizations are faster than calculation of one M*N Jacobian). +It should also be used when we have no Jacobian, because finite difference +approximation takes too much time to compute. + +Table below list optimization protocols (XYZ protocol corresponds to +MinLMCreateXYZ) and acceleration types they support (and use by default). + +ACCELERATION TYPES SUPPORTED BY OPTIMIZATION PROTOCOLS: + +protocol 0 1 comment +V + + +VJ + + +FGH + + +DAFAULT VALUES: + +protocol 0 1 comment +V x without acceleration it is so slooooooooow +VJ x +FGH x + +NOTE: this function should be called before optimization. Attempt to call +it during algorithm iterations may result in unexpected behavior. + +NOTE: attempt to call this function with unsupported protocol/acceleration +combination will result in exception being thrown. + + -- ALGLIB -- + Copyright 14.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetacctype(const minlmstate &state, const ae_int_t acctype) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmsetacctype(const_cast(state.c_ptr()), acctype, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool minlmiteration(const minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::minlmiteration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minlmoptimize(minlmstate &state, + void (*fvec)(const real_1d_array &x, real_1d_array &fi, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( fvec==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (fvec is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needfi ) + { + fvec(state.x, state.fi, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minlmoptimize(minlmstate &state, + void (*fvec)(const real_1d_array &x, real_1d_array &fi, void *ptr), + void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( fvec==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (fvec is NULL)"); + if( jac==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (jac is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needfi ) + { + fvec(state.x, state.fi, ptr); + continue; + } + if( state.needfij ) + { + jac(state.x, state.fi, state.j, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minlmoptimize(minlmstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*hess)(const real_1d_array &x, double &func, real_1d_array &grad, real_2d_array &hess, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (func is NULL)"); + if( grad==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (grad is NULL)"); + if( hess==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (hess is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.x, state.f, ptr); + continue; + } + if( state.needfg ) + { + grad(state.x, state.f, state.g, ptr); + continue; + } + if( state.needfgh ) + { + hess(state.x, state.f, state.g, state.h, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minlmoptimize(minlmstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (func is NULL)"); + if( jac==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (jac is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.x, state.f, ptr); + continue; + } + if( state.needfij ) + { + jac(state.x, state.fi, state.j, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minlmoptimize(minlmstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (func is NULL)"); + if( grad==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (grad is NULL)"); + if( jac==NULL ) + throw ap_error("ALGLIB: error in 'minlmoptimize()' (jac is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minlmiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.x, state.f, ptr); + continue; + } + if( state.needfg ) + { + grad(state.x, state.f, state.g, ptr); + continue; + } + if( state.needfij ) + { + jac(state.x, state.fi, state.j, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minlmoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +Levenberg-Marquardt algorithm results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report; + see comments for this structure for more info. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmresults(const minlmstate &state, real_1d_array &x, minlmreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Levenberg-Marquardt algorithm results + +Buffered implementation of MinLMResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmresultsbuf(const minlmstate &state, real_1d_array &x, minlmreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine restarts LM algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used for reverse communication previously + allocated with MinLMCreateXXX call. + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmrestartfrom(const minlmstate &state, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This is obsolete function. + +Since ALGLIB 3.3 it is equivalent to MinLMCreateVJ(). + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatevgj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatevgj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This is obsolete function. + +Since ALGLIB 3.3 it is equivalent to MinLMCreateVJ(). + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatevgj(const ae_int_t m, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatevgj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This is obsolete function. + +Since ALGLIB 3.3 it is equivalent to MinLMCreateFJ(). + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefgj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatefgj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This is obsolete function. + +Since ALGLIB 3.3 it is equivalent to MinLMCreateFJ(). + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefgj(const ae_int_t m, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatefgj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is considered obsolete since ALGLIB 3.1.0 and is present for +backward compatibility only. We recommend to use MinLMCreateVJ, which +provides similar, but more consistent and feature-rich interface. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatefj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function is considered obsolete since ALGLIB 3.1.0 and is present for +backward compatibility only. We recommend to use MinLMCreateVJ, which +provides similar, but more consistent and feature-rich interface. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefj(const ae_int_t m, const real_1d_array &x, minlmstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmcreatefj(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinLMOptimize() is called +* prior to actual optimization, for each function Fi and each component + of parameters being optimized X[j] algorithm performs following steps: + * two trial steps are made to X[j]-TestStep*S[j] and X[j]+TestStep*S[j], + where X[j] is j-th parameter and S[j] is a scale of j-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * Fi(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative, + Rep.FuncIdx is set to index of the function. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) Jacobian evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided + by some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinLMSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minlmsetgradientcheck(const minlmstate &state, const double teststep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlmsetgradientcheck(const_cast(state.c_ptr()), teststep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +_minasastate_owner::_minasastate_owner() +{ + p_struct = (alglib_impl::minasastate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minasastate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minasastate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minasastate_owner::_minasastate_owner(const _minasastate_owner &rhs) +{ + p_struct = (alglib_impl::minasastate*)alglib_impl::ae_malloc(sizeof(alglib_impl::minasastate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minasastate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minasastate_owner& _minasastate_owner::operator=(const _minasastate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minasastate_clear(p_struct); + if( !alglib_impl::_minasastate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minasastate_owner::~_minasastate_owner() +{ + alglib_impl::_minasastate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minasastate* _minasastate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minasastate* _minasastate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minasastate::minasastate() : _minasastate_owner() ,needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) +{ +} + +minasastate::minasastate(const minasastate &rhs):_minasastate_owner(rhs) ,needfg(p_struct->needfg),xupdated(p_struct->xupdated),f(p_struct->f),g(&p_struct->g),x(&p_struct->x) +{ +} + +minasastate& minasastate::operator=(const minasastate &rhs) +{ + if( this==&rhs ) + return *this; + _minasastate_owner::operator=(rhs); + return *this; +} + +minasastate::~minasastate() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_minasareport_owner::_minasareport_owner() +{ + p_struct = (alglib_impl::minasareport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minasareport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minasareport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minasareport_owner::_minasareport_owner(const _minasareport_owner &rhs) +{ + p_struct = (alglib_impl::minasareport*)alglib_impl::ae_malloc(sizeof(alglib_impl::minasareport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_minasareport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_minasareport_owner& _minasareport_owner::operator=(const _minasareport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_minasareport_clear(p_struct); + if( !alglib_impl::_minasareport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_minasareport_owner::~_minasareport_owner() +{ + alglib_impl::_minasareport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::minasareport* _minasareport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::minasareport* _minasareport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +minasareport::minasareport() : _minasareport_owner() ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),terminationtype(p_struct->terminationtype),activeconstraints(p_struct->activeconstraints) +{ +} + +minasareport::minasareport(const minasareport &rhs):_minasareport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfev(p_struct->nfev),terminationtype(p_struct->terminationtype),activeconstraints(p_struct->activeconstraints) +{ +} + +minasareport& minasareport::operator=(const minasareport &rhs) +{ + if( this==&rhs ) + return *this; + _minasareport_owner::operator=(rhs); + return *this; +} + +minasareport::~minasareport() +{ +} + +/************************************************************************* +Obsolete function, use MinLBFGSSetPrecDefault() instead. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetdefaultpreconditioner(const minlbfgsstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetdefaultpreconditioner(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete function, use MinLBFGSSetCholeskyPreconditioner() instead. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetcholeskypreconditioner(const minlbfgsstate &state, const real_2d_array &p, const bool isupper) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minlbfgssetcholeskypreconditioner(const_cast(state.c_ptr()), const_cast(p.c_ptr()), isupper, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This is obsolete function which was used by previous version of the BLEIC +optimizer. It does nothing in the current version of BLEIC. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetbarrierwidth(const minbleicstate &state, const double mu) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetbarrierwidth(const_cast(state.c_ptr()), mu, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This is obsolete function which was used by previous version of the BLEIC +optimizer. It does nothing in the current version of BLEIC. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetbarrierdecay(const minbleicstate &state, const double mudecay) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minbleicsetbarrierdecay(const_cast(state.c_ptr()), mudecay, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 25.03.2010 by Bochkanov Sergey +*************************************************************************/ +void minasacreate(const ae_int_t n, const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu, minasastate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasacreate(n, const_cast(x.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 25.03.2010 by Bochkanov Sergey +*************************************************************************/ +void minasacreate(const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu, minasastate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=bndl.length()) || (x.length()!=bndu.length())) + throw ap_error("Error while calling 'minasacreate': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasacreate(n, const_cast(x.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetcond(const minasastate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasasetcond(const_cast(state.c_ptr()), epsg, epsf, epsx, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetxrep(const minasastate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasasetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetalgorithm(const minasastate &state, const ae_int_t algotype) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasasetalgorithm(const_cast(state.c_ptr()), algotype, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetstpmax(const minasastate &state, const double stpmax) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasasetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool minasaiteration(const minasastate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::minasaiteration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void minasaoptimize(minasastate &state, + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( grad==NULL ) + throw ap_error("ALGLIB: error in 'minasaoptimize()' (grad is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::minasaiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needfg ) + { + grad(state.x, state.f, state.g, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'minasaoptimize' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minasaresults(const minasastate &state, real_1d_array &x, minasareport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasaresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minasaresultsbuf(const minasastate &state, real_1d_array &x, minasareport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasaresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minasarestartfrom(const minasastate &state, const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::minasarestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(bndl.c_ptr()), const_cast(bndu.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ + + +static ae_int_t cqmodels_newtonrefinementits = 3; +static ae_bool cqmodels_cqmrebuild(convexquadraticmodel* s, + ae_state *_state); +static void cqmodels_cqmsolveea(convexquadraticmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* tmp, + ae_state *_state); + + +static ae_int_t snnls_iterativerefinementits = 3; +static ae_bool snnls_boundedstepandactivation(/* Real */ ae_vector* xc, + /* Real */ ae_vector* xn, + /* Boolean */ ae_vector* nnc, + ae_int_t n, + ae_state *_state); + + +static void sactivesets_constraineddescent(sactiveset* state, + /* Real */ ae_vector* g, + /* Real */ ae_vector* h, + /* Real */ ae_matrix* ha, + ae_bool normalize, + /* Real */ ae_vector* d, + ae_state *_state); +static void sactivesets_reactivateconstraints(sactiveset* state, + /* Real */ ae_vector* gc, + /* Real */ ae_vector* h, + ae_state *_state); + + +static ae_int_t mincg_rscountdownlen = 10; +static double mincg_gtol = 0.3; +static void mincg_clearrequestfields(mincgstate* state, ae_state *_state); +static void mincg_preconditionedmultiply(mincgstate* state, + /* Real */ ae_vector* x, + /* Real */ ae_vector* work0, + /* Real */ ae_vector* work1, + ae_state *_state); +static double mincg_preconditionedmultiply2(mincgstate* state, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* work0, + /* Real */ ae_vector* work1, + ae_state *_state); +static void mincg_mincginitinternal(ae_int_t n, + double diffstep, + mincgstate* state, + ae_state *_state); + + +static double minbleic_gtol = 0.4; +static double minbleic_maxnonmonotoniclen = 1.0E-5; +static double minbleic_initialdecay = 0.5; +static double minbleic_mindecay = 0.1; +static double minbleic_decaycorrection = 0.8; +static double minbleic_penaltyfactor = 100; +static void minbleic_clearrequestfields(minbleicstate* state, + ae_state *_state); +static void minbleic_minbleicinitinternal(ae_int_t n, + /* Real */ ae_vector* x, + double diffstep, + minbleicstate* state, + ae_state *_state); +static void minbleic_updateestimateofgoodstep(double* estimate, + double newstep, + ae_state *_state); + + +static double minlbfgs_gtol = 0.4; +static void minlbfgs_clearrequestfields(minlbfgsstate* state, + ae_state *_state); + + +static ae_int_t minqp_maxlagrangeits = 10; +static ae_int_t minqp_maxbadnewtonits = 7; +static double minqp_penaltyfactor = 100.0; +static ae_int_t minqp_minqpboundedstepandactivation(minqpstate* state, + /* Real */ ae_vector* xn, + /* Real */ ae_vector* buf, + ae_state *_state); +static double minqp_minqpmodelvalue(convexquadraticmodel* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* xc, + ae_int_t n, + /* Real */ ae_vector* tmp, + ae_state *_state); +static ae_bool minqp_minqpconstrainedoptimum(minqpstate* state, + convexquadraticmodel* a, + double anorm, + /* Real */ ae_vector* b, + /* Real */ ae_vector* xn, + /* Real */ ae_vector* tmp, + /* Boolean */ ae_vector* tmpb, + /* Real */ ae_vector* lagrangec, + ae_state *_state); + + +static double minlm_lambdaup = 2.0; +static double minlm_lambdadown = 0.33; +static double minlm_suspiciousnu = 16; +static ae_int_t minlm_smallmodelage = 3; +static ae_int_t minlm_additers = 5; +static void minlm_lmprepare(ae_int_t n, + ae_int_t m, + ae_bool havegrad, + minlmstate* state, + ae_state *_state); +static void minlm_clearrequestfields(minlmstate* state, ae_state *_state); +static ae_bool minlm_increaselambda(double* lambdav, + double* nu, + ae_state *_state); +static void minlm_decreaselambda(double* lambdav, + double* nu, + ae_state *_state); +static double minlm_boundedscaledantigradnorm(minlmstate* state, + /* Real */ ae_vector* x, + /* Real */ ae_vector* g, + ae_state *_state); + + +static ae_int_t mincomp_n1 = 2; +static ae_int_t mincomp_n2 = 2; +static double mincomp_stpmin = 1.0E-300; +static double mincomp_gtol = 0.3; +static double mincomp_gpaftol = 0.0001; +static double mincomp_gpadecay = 0.5; +static double mincomp_asarho = 0.5; +static double mincomp_asaboundedantigradnorm(minasastate* state, + ae_state *_state); +static double mincomp_asaginorm(minasastate* state, ae_state *_state); +static double mincomp_asad1norm(minasastate* state, ae_state *_state); +static ae_bool mincomp_asauisempty(minasastate* state, ae_state *_state); +static void mincomp_clearrequestfields(minasastate* state, + ae_state *_state); + + + + + +/************************************************************************* +This subroutine is used to prepare threshold value which will be used for +trimming of the target function (see comments on TrimFunction() for more +information). + +This function accepts only one parameter: function value at the starting +point. It returns threshold which will be used for trimming. + + -- ALGLIB -- + Copyright 10.05.2011 by Bochkanov Sergey +*************************************************************************/ +void trimprepare(double f, double* threshold, ae_state *_state) +{ + + *threshold = 0; + + *threshold = 10*(ae_fabs(f, _state)+1); +} + + +/************************************************************************* +This subroutine is used to "trim" target function, i.e. to do following +transformation: + + { {F,G} if F=Threshold + +Such transformation allows us to solve problems with singularities by +redefining function in such way that it becomes bounded from above. + + -- ALGLIB -- + Copyright 10.05.2011 by Bochkanov Sergey +*************************************************************************/ +void trimfunction(double* f, + /* Real */ ae_vector* g, + ae_int_t n, + double threshold, + ae_state *_state) +{ + ae_int_t i; + + + if( ae_fp_greater_eq(*f,threshold) ) + { + *f = threshold; + for(i=0; i<=n-1; i++) + { + g->ptr.p_double[i] = 0.0; + } + } +} + + +/************************************************************************* +This function enforces boundary constraints in the X. + +This function correctly (although a bit inefficient) handles BL[i] which +are -INF and BU[i] which are +INF. + +We have NMain+NSlack dimensional X, with first NMain components bounded +by BL/BU, and next NSlack ones bounded by non-negativity constraints. + +INPUT PARAMETERS + X - array[NMain+NSlack], point + BL - array[NMain], lower bounds + (may contain -INF, when bound is not present) + HaveBL - array[NMain], if HaveBL[i] is False, + then i-th bound is not present + BU - array[NMain], upper bounds + (may contain +INF, when bound is not present) + HaveBU - array[NMain], if HaveBU[i] is False, + then i-th bound is not present + +OUTPUT PARAMETERS + X - X with all constraints being enforced + +It returns True when constraints are consistent, +False - when constraints are inconsistent. + + -- ALGLIB -- + Copyright 10.01.2012 by Bochkanov Sergey +*************************************************************************/ +ae_bool enforceboundaryconstraints(/* Real */ ae_vector* x, + /* Real */ ae_vector* bl, + /* Boolean */ ae_vector* havebl, + /* Real */ ae_vector* bu, + /* Boolean */ ae_vector* havebu, + ae_int_t nmain, + ae_int_t nslack, + ae_state *_state) +{ + ae_int_t i; + ae_bool result; + + + result = ae_false; + for(i=0; i<=nmain-1; i++) + { + if( (havebl->ptr.p_bool[i]&&havebu->ptr.p_bool[i])&&ae_fp_greater(bl->ptr.p_double[i],bu->ptr.p_double[i]) ) + { + return result; + } + if( havebl->ptr.p_bool[i]&&ae_fp_less(x->ptr.p_double[i],bl->ptr.p_double[i]) ) + { + x->ptr.p_double[i] = bl->ptr.p_double[i]; + } + if( havebu->ptr.p_bool[i]&&ae_fp_greater(x->ptr.p_double[i],bu->ptr.p_double[i]) ) + { + x->ptr.p_double[i] = bu->ptr.p_double[i]; + } + } + for(i=0; i<=nslack-1; i++) + { + if( ae_fp_less(x->ptr.p_double[nmain+i],0) ) + { + x->ptr.p_double[nmain+i] = 0; + } + } + result = ae_true; + return result; +} + + +/************************************************************************* +This function projects gradient into feasible area of boundary constrained +optimization problem. X can be infeasible with respect to boundary +constraints. We have NMain+NSlack dimensional X, with first NMain +components bounded by BL/BU, and next NSlack ones bounded by non-negativity +constraints. + +INPUT PARAMETERS + X - array[NMain+NSlack], point + G - array[NMain+NSlack], gradient + BL - lower bounds (may contain -INF, when bound is not present) + HaveBL - if HaveBL[i] is False, then i-th bound is not present + BU - upper bounds (may contain +INF, when bound is not present) + HaveBU - if HaveBU[i] is False, then i-th bound is not present + +OUTPUT PARAMETERS + G - projection of G. Components of G which satisfy one of the + following + (1) (X[I]<=BndL[I]) and (G[I]>0), OR + (2) (X[I]>=BndU[I]) and (G[I]<0) + are replaced by zeros. + +NOTE 1: this function assumes that constraints are feasible. It throws +exception otherwise. + +NOTE 2: in fact, projection of ANTI-gradient is calculated, because this +function trims components of -G which points outside of the feasible area. +However, working with -G is considered confusing, because all optimization +source work with G. + + -- ALGLIB -- + Copyright 10.01.2012 by Bochkanov Sergey +*************************************************************************/ +void projectgradientintobc(/* Real */ ae_vector* x, + /* Real */ ae_vector* g, + /* Real */ ae_vector* bl, + /* Boolean */ ae_vector* havebl, + /* Real */ ae_vector* bu, + /* Boolean */ ae_vector* havebu, + ae_int_t nmain, + ae_int_t nslack, + ae_state *_state) +{ + ae_int_t i; + + + for(i=0; i<=nmain-1; i++) + { + ae_assert((!havebl->ptr.p_bool[i]||!havebu->ptr.p_bool[i])||ae_fp_less_eq(bl->ptr.p_double[i],bu->ptr.p_double[i]), "ProjectGradientIntoBC: internal error (infeasible constraints)", _state); + if( (havebl->ptr.p_bool[i]&&ae_fp_less_eq(x->ptr.p_double[i],bl->ptr.p_double[i]))&&ae_fp_greater(g->ptr.p_double[i],0) ) + { + g->ptr.p_double[i] = 0; + } + if( (havebu->ptr.p_bool[i]&&ae_fp_greater_eq(x->ptr.p_double[i],bu->ptr.p_double[i]))&&ae_fp_less(g->ptr.p_double[i],0) ) + { + g->ptr.p_double[i] = 0; + } + } + for(i=0; i<=nslack-1; i++) + { + if( ae_fp_less_eq(x->ptr.p_double[nmain+i],0)&&ae_fp_greater(g->ptr.p_double[nmain+i],0) ) + { + g->ptr.p_double[nmain+i] = 0; + } + } +} + + +/************************************************************************* +Given + a) initial point X0[NMain+NSlack] + (feasible with respect to bound constraints) + b) step vector alpha*D[NMain+NSlack] + c) boundary constraints BndL[NMain], BndU[NMain] + d) implicit non-negativity constraints for slack variables +this function calculates bound on the step length subject to boundary +constraints. + +It returns: + * MaxStepLen - such step length that X0+MaxStepLen*alpha*D is exactly + at the boundary given by constraints + * VariableToFreeze - index of the constraint to be activated, + 0 <= VariableToFreeze < NMain+NSlack + * ValueToFreeze - value of the corresponding constraint. + +Notes: + * it is possible that several constraints can be activated by the step + at once. In such cases only one constraint is returned. It is caller + responsibility to check other constraints. This function makes sure + that we activate at least one constraint, and everything else is the + responsibility of the caller. + * steps smaller than MaxStepLen still can activate constraints due to + numerical errors. Thus purpose of this function is not to guard + against accidental activation of the constraints - quite the reverse, + its purpose is to activate at least constraint upon performing step + which is too long. + * in case there is no constraints to activate, we return negative + VariableToFreeze and zero MaxStepLen and ValueToFreeze. + * this function assumes that constraints are consistent; it throws + exception otherwise. + +INPUT PARAMETERS + X - array[NMain+NSlack], point. Must be feasible with respect + to bound constraints (exception will be thrown otherwise) + D - array[NMain+NSlack], step direction + alpha - scalar multiplier before D, alpha<>0 + BndL - lower bounds, array[NMain] + (may contain -INF, when bound is not present) + HaveBndL - array[NMain], if HaveBndL[i] is False, + then i-th bound is not present + BndU - array[NMain], upper bounds + (may contain +INF, when bound is not present) + HaveBndU - array[NMain], if HaveBndU[i] is False, + then i-th bound is not present + NMain - number of main variables + NSlack - number of slack variables + +OUTPUT PARAMETERS + VariableToFreeze: + * negative value = step is unbounded, ValueToFreeze=0, + MaxStepLen=0. + * non-negative value = at least one constraint, given by + this parameter, will be activated + upon performing maximum step. + ValueToFreeze- value of the variable which will be constrained + MaxStepLen - maximum length of the step. Can be zero when step vector + looks outside of the feasible area. + + -- ALGLIB -- + Copyright 10.01.2012 by Bochkanov Sergey +*************************************************************************/ +void calculatestepbound(/* Real */ ae_vector* x, + /* Real */ ae_vector* d, + double alpha, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + ae_int_t nmain, + ae_int_t nslack, + ae_int_t* variabletofreeze, + double* valuetofreeze, + double* maxsteplen, + ae_state *_state) +{ + ae_int_t i; + double prevmax; + double initval; + + *variabletofreeze = 0; + *valuetofreeze = 0; + *maxsteplen = 0; + + ae_assert(ae_fp_neq(alpha,0), "CalculateStepBound: zero alpha", _state); + *variabletofreeze = -1; + initval = ae_maxrealnumber; + *maxsteplen = initval; + for(i=0; i<=nmain-1; i++) + { + if( havebndl->ptr.p_bool[i]&&ae_fp_less(alpha*d->ptr.p_double[i],0) ) + { + ae_assert(ae_fp_greater_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]), "CalculateStepBound: infeasible X", _state); + prevmax = *maxsteplen; + *maxsteplen = safeminposrv(x->ptr.p_double[i]-bndl->ptr.p_double[i], -alpha*d->ptr.p_double[i], *maxsteplen, _state); + if( ae_fp_less(*maxsteplen,prevmax) ) + { + *variabletofreeze = i; + *valuetofreeze = bndl->ptr.p_double[i]; + } + } + if( havebndu->ptr.p_bool[i]&&ae_fp_greater(alpha*d->ptr.p_double[i],0) ) + { + ae_assert(ae_fp_less_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]), "CalculateStepBound: infeasible X", _state); + prevmax = *maxsteplen; + *maxsteplen = safeminposrv(bndu->ptr.p_double[i]-x->ptr.p_double[i], alpha*d->ptr.p_double[i], *maxsteplen, _state); + if( ae_fp_less(*maxsteplen,prevmax) ) + { + *variabletofreeze = i; + *valuetofreeze = bndu->ptr.p_double[i]; + } + } + } + for(i=0; i<=nslack-1; i++) + { + if( ae_fp_less(alpha*d->ptr.p_double[nmain+i],0) ) + { + ae_assert(ae_fp_greater_eq(x->ptr.p_double[nmain+i],0), "CalculateStepBound: infeasible X", _state); + prevmax = *maxsteplen; + *maxsteplen = safeminposrv(x->ptr.p_double[nmain+i], -alpha*d->ptr.p_double[nmain+i], *maxsteplen, _state); + if( ae_fp_less(*maxsteplen,prevmax) ) + { + *variabletofreeze = nmain+i; + *valuetofreeze = 0; + } + } + } + if( ae_fp_eq(*maxsteplen,initval) ) + { + *valuetofreeze = 0; + *maxsteplen = 0; + } +} + + +/************************************************************************* +This function postprocesses bounded step by: +* analysing step length (whether it is equal to MaxStepLen) and activating + constraint given by VariableToFreeze if needed +* checking for additional bound constraints to activate + +This function uses final point of the step, quantities calculated by the +CalculateStepBound() function. As result, it returns point which is +exactly feasible with respect to boundary constraints. + +NOTE 1: this function does NOT handle and check linear equality constraints +NOTE 2: when StepTaken=MaxStepLen we always activate at least one constraint + +INPUT PARAMETERS + X - array[NMain+NSlack], final point to postprocess + XPrev - array[NMain+NSlack], initial point + BndL - lower bounds, array[NMain] + (may contain -INF, when bound is not present) + HaveBndL - array[NMain], if HaveBndL[i] is False, + then i-th bound is not present + BndU - array[NMain], upper bounds + (may contain +INF, when bound is not present) + HaveBndU - array[NMain], if HaveBndU[i] is False, + then i-th bound is not present + NMain - number of main variables + NSlack - number of slack variables + VariableToFreeze-result of CalculateStepBound() + ValueToFreeze- result of CalculateStepBound() + StepTaken - actual step length (actual step is equal to the possibly + non-unit step direction vector times this parameter). + StepTaken<=MaxStepLen. + MaxStepLen - result of CalculateStepBound() + +OUTPUT PARAMETERS + X - point bounded with respect to constraints. + components corresponding to active constraints are exactly + equal to the boundary values. + +RESULT: + number of constraints activated in addition to previously active ones. + Constraints which were DEACTIVATED are ignored (do not influence + function value). + + -- ALGLIB -- + Copyright 10.01.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t postprocessboundedstep(/* Real */ ae_vector* x, + /* Real */ ae_vector* xprev, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + ae_int_t nmain, + ae_int_t nslack, + ae_int_t variabletofreeze, + double valuetofreeze, + double steptaken, + double maxsteplen, + ae_state *_state) +{ + ae_int_t i; + ae_bool wasactivated; + ae_int_t result; + + + ae_assert(variabletofreeze<0||ae_fp_less_eq(steptaken,maxsteplen), "Assertion failed", _state); + + /* + * Activate constraints + */ + if( variabletofreeze>=0&&ae_fp_eq(steptaken,maxsteplen) ) + { + x->ptr.p_double[variabletofreeze] = valuetofreeze; + } + for(i=0; i<=nmain-1; i++) + { + if( havebndl->ptr.p_bool[i]&&ae_fp_less(x->ptr.p_double[i],bndl->ptr.p_double[i]) ) + { + x->ptr.p_double[i] = bndl->ptr.p_double[i]; + } + if( havebndu->ptr.p_bool[i]&&ae_fp_greater(x->ptr.p_double[i],bndu->ptr.p_double[i]) ) + { + x->ptr.p_double[i] = bndu->ptr.p_double[i]; + } + } + for(i=0; i<=nslack-1; i++) + { + if( ae_fp_less_eq(x->ptr.p_double[nmain+i],0) ) + { + x->ptr.p_double[nmain+i] = 0; + } + } + + /* + * Calculate number of constraints being activated + */ + result = 0; + for(i=0; i<=nmain-1; i++) + { + wasactivated = ae_fp_neq(x->ptr.p_double[i],xprev->ptr.p_double[i])&&((havebndl->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]))||(havebndu->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]))); + wasactivated = wasactivated||variabletofreeze==i; + if( wasactivated ) + { + result = result+1; + } + } + for(i=0; i<=nslack-1; i++) + { + wasactivated = ae_fp_neq(x->ptr.p_double[nmain+i],xprev->ptr.p_double[nmain+i])&&ae_fp_eq(x->ptr.p_double[nmain+i],0.0); + wasactivated = wasactivated||variabletofreeze==nmain+i; + if( wasactivated ) + { + result = result+1; + } + } + return result; +} + + +/************************************************************************* +The purpose of this function is to prevent algorithm from "unsticking" +from the active bound constraints because of numerical noise in the +gradient or Hessian. + +It is done by zeroing some components of the search direction D. D[i] is +zeroed when both (a) and (b) are true: +a) corresponding X[i] is exactly at the boundary +b) |D[i]*S[i]| <= DropTol*Sqrt(SUM(D[i]^2*S[I]^2)) + +D can be step direction , antigradient, gradient, or anything similar. +Sign of D does not matter, nor matters step length. + +NOTE 1: boundary constraints are expected to be consistent, as well as X + is expected to be feasible. Exception will be thrown otherwise. + +INPUT PARAMETERS + D - array[NMain+NSlack], direction + X - array[NMain+NSlack], current point + BndL - lower bounds, array[NMain] + (may contain -INF, when bound is not present) + HaveBndL - array[NMain], if HaveBndL[i] is False, + then i-th bound is not present + BndU - array[NMain], upper bounds + (may contain +INF, when bound is not present) + HaveBndU - array[NMain], if HaveBndU[i] is False, + then i-th bound is not present + S - array[NMain+NSlack], scaling of the variables + NMain - number of main variables + NSlack - number of slack variables + DropTol - drop tolerance, >=0 + +OUTPUT PARAMETERS + X - point bounded with respect to constraints. + components corresponding to active constraints are exactly + equal to the boundary values. + + -- ALGLIB -- + Copyright 10.01.2012 by Bochkanov Sergey +*************************************************************************/ +void filterdirection(/* Real */ ae_vector* d, + /* Real */ ae_vector* x, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + /* Real */ ae_vector* s, + ae_int_t nmain, + ae_int_t nslack, + double droptol, + ae_state *_state) +{ + ae_int_t i; + double scalednorm; + ae_bool isactive; + + + scalednorm = 0.0; + for(i=0; i<=nmain+nslack-1; i++) + { + scalednorm = scalednorm+ae_sqr(d->ptr.p_double[i]*s->ptr.p_double[i], _state); + } + scalednorm = ae_sqrt(scalednorm, _state); + for(i=0; i<=nmain-1; i++) + { + ae_assert(!havebndl->ptr.p_bool[i]||ae_fp_greater_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]), "FilterDirection: infeasible point", _state); + ae_assert(!havebndu->ptr.p_bool[i]||ae_fp_less_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]), "FilterDirection: infeasible point", _state); + isactive = (havebndl->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]))||(havebndu->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i])); + if( isactive&&ae_fp_less_eq(ae_fabs(d->ptr.p_double[i]*s->ptr.p_double[i], _state),droptol*scalednorm) ) + { + d->ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=nslack-1; i++) + { + ae_assert(ae_fp_greater_eq(x->ptr.p_double[nmain+i],0), "FilterDirection: infeasible point", _state); + if( ae_fp_eq(x->ptr.p_double[nmain+i],0)&&ae_fp_less_eq(ae_fabs(d->ptr.p_double[nmain+i]*s->ptr.p_double[nmain+i], _state),droptol*scalednorm) ) + { + d->ptr.p_double[nmain+i] = 0.0; + } + } +} + + +/************************************************************************* +This function returns number of bound constraints whose state was changed +(either activated or deactivated) when making step from XPrev to X. + +Constraints are considered: +* active - when we are exactly at the boundary +* inactive - when we are not at the boundary + +You should note that antigradient direction is NOT taken into account when +we make decions on the constraint status. + +INPUT PARAMETERS + X - array[NMain+NSlack], final point. + Must be feasible with respect to bound constraints. + XPrev - array[NMain+NSlack], initial point. + Must be feasible with respect to bound constraints. + BndL - lower bounds, array[NMain] + (may contain -INF, when bound is not present) + HaveBndL - array[NMain], if HaveBndL[i] is False, + then i-th bound is not present + BndU - array[NMain], upper bounds + (may contain +INF, when bound is not present) + HaveBndU - array[NMain], if HaveBndU[i] is False, + then i-th bound is not present + NMain - number of main variables + NSlack - number of slack variables + +RESULT: + number of constraints whose state was changed. + + -- ALGLIB -- + Copyright 10.01.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t numberofchangedconstraints(/* Real */ ae_vector* x, + /* Real */ ae_vector* xprev, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + ae_int_t nmain, + ae_int_t nslack, + ae_state *_state) +{ + ae_int_t i; + ae_bool statuschanged; + ae_int_t result; + + + result = 0; + for(i=0; i<=nmain-1; i++) + { + if( ae_fp_neq(x->ptr.p_double[i],xprev->ptr.p_double[i]) ) + { + statuschanged = ae_false; + if( havebndl->ptr.p_bool[i]&&(ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i])||ae_fp_eq(xprev->ptr.p_double[i],bndl->ptr.p_double[i])) ) + { + statuschanged = ae_true; + } + if( havebndu->ptr.p_bool[i]&&(ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i])||ae_fp_eq(xprev->ptr.p_double[i],bndu->ptr.p_double[i])) ) + { + statuschanged = ae_true; + } + if( statuschanged ) + { + result = result+1; + } + } + } + for(i=0; i<=nslack-1; i++) + { + if( ae_fp_neq(x->ptr.p_double[nmain+i],xprev->ptr.p_double[nmain+i])&&(ae_fp_eq(x->ptr.p_double[nmain+i],0)||ae_fp_eq(xprev->ptr.p_double[nmain+i],0)) ) + { + result = result+1; + } + } + return result; +} + + +/************************************************************************* +This function finds feasible point of (NMain+NSlack)-dimensional problem +subject to NMain explicit boundary constraints (some constraints can be +omitted), NSlack implicit non-negativity constraints, K linear equality +constraints. + +INPUT PARAMETERS + X - array[NMain+NSlack], initial point. + BndL - lower bounds, array[NMain] + (may contain -INF, when bound is not present) + HaveBndL - array[NMain], if HaveBndL[i] is False, + then i-th bound is not present + BndU - array[NMain], upper bounds + (may contain +INF, when bound is not present) + HaveBndU - array[NMain], if HaveBndU[i] is False, + then i-th bound is not present + NMain - number of main variables + NSlack - number of slack variables + CE - array[K,NMain+NSlack+1], equality constraints CE*x=b. + Rows contain constraints, first NMain+NSlack columns + contain coefficients before X[], last column contain + right part. + K - number of linear constraints + EpsI - infeasibility (error in the right part) allowed in the + solution + +OUTPUT PARAMETERS: + X - feasible point or best infeasible point found before + algorithm termination + QPIts - number of QP iterations (for debug purposes) + GPAIts - number of GPA iterations (for debug purposes) + +RESULT: + True in case X is feasible, False - if it is infeasible. + + -- ALGLIB -- + Copyright 20.01.2012 by Bochkanov Sergey +*************************************************************************/ +ae_bool findfeasiblepoint(/* Real */ ae_vector* x, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + ae_int_t nmain, + ae_int_t nslack, + /* Real */ ae_matrix* ce, + ae_int_t k, + double epsi, + ae_int_t* qpits, + ae_int_t* gpaits, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _ce; + ae_int_t i; + ae_int_t j; + ae_int_t idx0; + ae_int_t idx1; + ae_vector permx; + ae_vector xn; + ae_vector xa; + ae_vector newtonstep; + ae_vector g; + ae_vector pg; + ae_matrix a; + double armijostep; + double armijobeststep; + double armijobestfeas; + double v; + double mx; + double feaserr; + double feasold; + double feasnew; + double pgnorm; + double vn; + double vd; + double stp; + ae_int_t vartofreeze; + double valtofreeze; + double maxsteplen; + ae_bool werechangesinconstraints; + ae_bool stage1isover; + ae_bool converged; + ae_vector activeconstraints; + ae_vector tmpk; + ae_vector colnorms; + ae_int_t nactive; + ae_int_t nfree; + ae_int_t nsvd; + ae_vector p1; + ae_vector p2; + apbuffers buf; + ae_vector w; + ae_vector s; + ae_matrix u; + ae_matrix vt; + ae_int_t itscount; + ae_int_t itswithintolerance; + ae_int_t maxitswithintolerance; + ae_int_t gparuns; + ae_int_t maxarmijoruns; + ae_bool result; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_ce, ce, _state, ae_true); + ce = &_ce; + *qpits = 0; + *gpaits = 0; + ae_vector_init(&permx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xn, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xa, 0, DT_REAL, _state, ae_true); + ae_vector_init(&newtonstep, 0, DT_REAL, _state, ae_true); + ae_vector_init(&g, 0, DT_REAL, _state, ae_true); + ae_vector_init(&pg, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&a, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&activeconstraints, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmpk, 0, DT_REAL, _state, ae_true); + ae_vector_init(&colnorms, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p1, 0, DT_INT, _state, ae_true); + ae_vector_init(&p2, 0, DT_INT, _state, ae_true); + _apbuffers_init(&buf, _state, ae_true); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + ae_vector_init(&s, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); + + maxitswithintolerance = 3; + maxarmijoruns = 5; + *qpits = 0; + *gpaits = 0; + + /* + * Initial enforcement of the feasibility with respect to boundary constraints + * NOTE: after this block we assume that boundary constraints are consistent. + */ + if( !enforceboundaryconstraints(x, bndl, havebndl, bndu, havebndu, nmain, nslack, _state) ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + if( k==0 ) + { + + /* + * No linear constraints, we can exit right now + */ + result = ae_true; + ae_frame_leave(_state); + return result; + } + + /* + * Scale rows of CE in such way that max(CE[i,0..nmain+nslack-1])=1 for any i=0..k-1 + */ + for(i=0; i<=k-1; i++) + { + v = 0.0; + for(j=0; j<=nmain+nslack-1; j++) + { + v = ae_maxreal(v, ae_fabs(ce->ptr.pp_double[i][j], _state), _state); + } + if( ae_fp_neq(v,0) ) + { + v = 1/v; + ae_v_muld(&ce->ptr.pp_double[i][0], 1, ae_v_len(0,nmain+nslack), v); + } + } + + /* + * Allocate temporaries + */ + ae_vector_set_length(&xn, nmain+nslack, _state); + ae_vector_set_length(&xa, nmain+nslack, _state); + ae_vector_set_length(&permx, nmain+nslack, _state); + ae_vector_set_length(&g, nmain+nslack, _state); + ae_vector_set_length(&pg, nmain+nslack, _state); + ae_vector_set_length(&tmpk, k, _state); + ae_matrix_set_length(&a, k, nmain+nslack, _state); + ae_vector_set_length(&activeconstraints, nmain+nslack, _state); + ae_vector_set_length(&newtonstep, nmain+nslack, _state); + ae_vector_set_length(&s, nmain+nslack, _state); + ae_vector_set_length(&colnorms, nmain+nslack, _state); + for(i=0; i<=nmain+nslack-1; i++) + { + s.ptr.p_double[i] = 1.0; + colnorms.ptr.p_double[i] = 0.0; + for(j=0; j<=k-1; j++) + { + colnorms.ptr.p_double[i] = colnorms.ptr.p_double[i]+ae_sqr(ce->ptr.pp_double[j][i], _state); + } + } + + /* + * K>0, we have linear equality constraints combined with bound constraints. + * + * Try to find feasible point as minimizer of the quadratic function + * F(x) = 0.5*||CE*x-b||^2 = 0.5*x'*(CE'*CE)*x - (b'*CE)*x + 0.5*b'*b + * subject to boundary constraints given by BL, BU and non-negativity of + * the slack variables. BTW, we drop constant term because it does not + * actually influences on the solution. + * + * Below we will assume that K>0. + */ + itswithintolerance = 0; + itscount = 0; + for(;;) + { + + /* + * Stage 0: check for exact convergence + */ + converged = ae_true; + feaserr = 0; + for(i=0; i<=k-1; i++) + { + + /* + * Calculate: + * * V - error in the right part + * * MX - maximum term in the left part + * + * Terminate if error in the right part is not greater than 100*Eps*MX. + * + * IMPORTANT: we must perform check for non-strict inequality, i.e. to use <= instead of <. + * it will allow us to easily handle situations with zero rows of CE. + */ + mx = 0; + v = -ce->ptr.pp_double[i][nmain+nslack]; + for(j=0; j<=nmain+nslack-1; j++) + { + mx = ae_maxreal(mx, ae_fabs(ce->ptr.pp_double[i][j]*x->ptr.p_double[j], _state), _state); + v = v+ce->ptr.pp_double[i][j]*x->ptr.p_double[j]; + } + feaserr = feaserr+ae_sqr(v, _state); + converged = converged&&ae_fp_less_eq(ae_fabs(v, _state),100*ae_machineepsilon*mx); + } + feaserr = ae_sqrt(feaserr, _state); + if( converged ) + { + result = ae_fp_less_eq(feaserr,epsi); + ae_frame_leave(_state); + return result; + } + + /* + * Stage 1: equality constrained quadratic programming + * + * * treat active bound constraints as equality ones (constraint is considered + * active when we are at the boundary, independently of the antigradient direction) + * * calculate unrestricted Newton step to point XM (which may be infeasible) + * calculate MaxStepLen = largest step in direction of XM which retains feasibility. + * * perform bounded step from X to XN: + * a) XN=XM (if XM is feasible) + * b) XN=X-MaxStepLen*(XM-X) (otherwise) + * * X := XN + * * if XM (Newton step subject to currently active constraints) was feasible, goto Stage 2 + * * repeat Stage 1 + * + * NOTE 1: in order to solve constrained qudratic subproblem we will have to reorder + * variables in such way that ones corresponding to inactive constraints will + * be first, and active ones will be last in the list. CE and X are now + * [ xi ] + * separated into two parts: CE = [CEi CEa], x = [ ], where CEi/Xi correspond + * [ xa ] + * to INACTIVE constraints, and CEa/Xa correspond to the ACTIVE ones. + * + * Now, instead of F=0.5*x'*(CE'*CE)*x - (b'*CE)*x + 0.5*b'*b, we have + * F(xi) = 0.5*(CEi*xi,CEi*xi) + (CEa*xa-b,CEi*xi) + (0.5*CEa*xa-b,CEa*xa). + * Here xa is considered constant, i.e. we optimize with respect to xi, leaving xa fixed. + * + * We can solve it by performing SVD of CEi and calculating pseudoinverse of the + * Hessian matrix. Of course, we do NOT calculate pseudoinverse explicitly - we + * just use singular vectors to perform implicit multiplication by it. + * + */ + for(;;) + { + + /* + * Calculate G - gradient subject to equality constraints, + * multiply it by inverse of the Hessian diagonal to obtain initial + * step vector. + * + * Bound step subject to constraints which can be activated, + * run Armijo search with increasing step size. + * Search is terminated when feasibility error stops to decrease. + * + * NOTE: it is important to test for "stops to decrease" instead + * of "starts to increase" in order to correctly handle cases with + * zero CE. + */ + armijobeststep = 0.0; + armijobestfeas = 0.0; + for(i=0; i<=nmain+nslack-1; i++) + { + g.ptr.p_double[i] = 0; + } + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + v = v-ce->ptr.pp_double[i][nmain+nslack]; + armijobestfeas = armijobestfeas+ae_sqr(v, _state); + ae_v_addd(&g.ptr.p_double[0], 1, &ce->ptr.pp_double[i][0], 1, ae_v_len(0,nmain+nslack-1), v); + } + armijobestfeas = ae_sqrt(armijobestfeas, _state); + for(i=0; i<=nmain-1; i++) + { + if( havebndl->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]) ) + { + g.ptr.p_double[i] = 0.0; + } + if( havebndu->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]) ) + { + g.ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=nslack-1; i++) + { + if( ae_fp_eq(x->ptr.p_double[nmain+i],0.0) ) + { + g.ptr.p_double[nmain+i] = 0.0; + } + } + v = 0.0; + for(i=0; i<=nmain+nslack-1; i++) + { + if( ae_fp_neq(ae_sqr(colnorms.ptr.p_double[i], _state),0) ) + { + newtonstep.ptr.p_double[i] = -g.ptr.p_double[i]/ae_sqr(colnorms.ptr.p_double[i], _state); + } + else + { + newtonstep.ptr.p_double[i] = 0.0; + } + v = v+ae_sqr(newtonstep.ptr.p_double[i], _state); + } + if( ae_fp_eq(v,0) ) + { + + /* + * Constrained gradient is zero, QP iterations are over + */ + break; + } + calculatestepbound(x, &newtonstep, 1.0, bndl, havebndl, bndu, havebndu, nmain, nslack, &vartofreeze, &valtofreeze, &maxsteplen, _state); + if( vartofreeze>=0&&ae_fp_eq(maxsteplen,0) ) + { + + /* + * Can not perform step, QP iterations are over + */ + break; + } + if( vartofreeze>=0 ) + { + armijostep = ae_minreal(1.0, maxsteplen, _state); + } + else + { + armijostep = 1; + } + for(;;) + { + ae_v_move(&xa.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + ae_v_addd(&xa.ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), armijostep); + enforceboundaryconstraints(&xa, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); + feaserr = 0.0; + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &xa.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + v = v-ce->ptr.pp_double[i][nmain+nslack]; + feaserr = feaserr+ae_sqr(v, _state); + } + feaserr = ae_sqrt(feaserr, _state); + if( ae_fp_greater_eq(feaserr,armijobestfeas) ) + { + break; + } + armijobestfeas = feaserr; + armijobeststep = armijostep; + armijostep = 2.0*armijostep; + } + ae_v_addd(&x->ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), armijobeststep); + enforceboundaryconstraints(x, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); + + /* + * Determine number of active and free constraints + */ + nactive = 0; + for(i=0; i<=nmain-1; i++) + { + activeconstraints.ptr.p_double[i] = 0; + if( havebndl->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndl->ptr.p_double[i]) ) + { + activeconstraints.ptr.p_double[i] = 1; + } + if( havebndu->ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]) ) + { + activeconstraints.ptr.p_double[i] = 1; + } + if( ae_fp_greater(activeconstraints.ptr.p_double[i],0) ) + { + nactive = nactive+1; + } + } + for(i=0; i<=nslack-1; i++) + { + activeconstraints.ptr.p_double[nmain+i] = 0; + if( ae_fp_eq(x->ptr.p_double[nmain+i],0.0) ) + { + activeconstraints.ptr.p_double[nmain+i] = 1; + } + if( ae_fp_greater(activeconstraints.ptr.p_double[nmain+i],0) ) + { + nactive = nactive+1; + } + } + nfree = nmain+nslack-nactive; + if( nfree==0 ) + { + break; + } + *qpits = *qpits+1; + + /* + * Reorder variables + */ + tagsortbuf(&activeconstraints, nmain+nslack, &p1, &p2, &buf, _state); + for(i=0; i<=k-1; i++) + { + for(j=0; j<=nmain+nslack-1; j++) + { + a.ptr.pp_double[i][j] = ce->ptr.pp_double[i][j]; + } + } + for(j=0; j<=nmain+nslack-1; j++) + { + permx.ptr.p_double[j] = x->ptr.p_double[j]; + } + for(j=0; j<=nmain+nslack-1; j++) + { + if( p2.ptr.p_int[j]!=j ) + { + idx0 = p2.ptr.p_int[j]; + idx1 = j; + for(i=0; i<=k-1; i++) + { + v = a.ptr.pp_double[i][idx0]; + a.ptr.pp_double[i][idx0] = a.ptr.pp_double[i][idx1]; + a.ptr.pp_double[i][idx1] = v; + } + v = permx.ptr.p_double[idx0]; + permx.ptr.p_double[idx0] = permx.ptr.p_double[idx1]; + permx.ptr.p_double[idx1] = v; + } + } + + /* + * Calculate (unprojected) gradient: + * G(xi) = CEi'*(CEi*xi + CEa*xa - b) + */ + for(i=0; i<=nfree-1; i++) + { + g.ptr.p_double[i] = 0; + } + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&a.ptr.pp_double[i][0], 1, &permx.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + tmpk.ptr.p_double[i] = v-ce->ptr.pp_double[i][nmain+nslack]; + } + for(i=0; i<=k-1; i++) + { + v = tmpk.ptr.p_double[i]; + ae_v_addd(&g.ptr.p_double[0], 1, &a.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); + } + + /* + * Calculate Newton step using SVD of CEi: + * F(xi) = 0.5*xi'*H*xi + g'*xi (Taylor decomposition) + * XN = -H^(-1)*g (new point, solution of the QP subproblem) + * H = CEi'*CEi + * CEi = U*W*V' (SVD of CEi) + * H = V*W^2*V' + * H^(-1) = V*W^(-2)*V' + * step = -V*W^(-2)*V'*g (it is better to perform multiplication from right to left) + * + * NOTE 1: we do NOT need left singular vectors to perform Newton step. + */ + nsvd = ae_minint(k, nfree, _state); + if( !rmatrixsvd(&a, k, nfree, 0, 1, 2, &w, &u, &vt, _state) ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + for(i=0; i<=nsvd-1; i++) + { + v = ae_v_dotproduct(&vt.ptr.pp_double[i][0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); + tmpk.ptr.p_double[i] = v; + } + for(i=0; i<=nsvd-1; i++) + { + + /* + * It is important to have strict ">" in order to correctly + * handle zero singular values. + */ + if( ae_fp_greater(ae_sqr(w.ptr.p_double[i], _state),ae_sqr(w.ptr.p_double[0], _state)*(nmain+nslack)*ae_machineepsilon) ) + { + tmpk.ptr.p_double[i] = tmpk.ptr.p_double[i]/ae_sqr(w.ptr.p_double[i], _state); + } + else + { + tmpk.ptr.p_double[i] = 0; + } + } + for(i=0; i<=nmain+nslack-1; i++) + { + newtonstep.ptr.p_double[i] = 0; + } + for(i=0; i<=nsvd-1; i++) + { + v = tmpk.ptr.p_double[i]; + ae_v_subd(&newtonstep.ptr.p_double[0], 1, &vt.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); + } + for(j=nmain+nslack-1; j>=0; j--) + { + if( p2.ptr.p_int[j]!=j ) + { + idx0 = p2.ptr.p_int[j]; + idx1 = j; + v = newtonstep.ptr.p_double[idx0]; + newtonstep.ptr.p_double[idx0] = newtonstep.ptr.p_double[idx1]; + newtonstep.ptr.p_double[idx1] = v; + } + } + + /* + * NewtonStep contains Newton step subject to active bound constraints. + * + * Such step leads us to the minimizer of the equality constrained F, + * but such minimizer may be infeasible because some constraints which + * are inactive at the initial point can be violated at the solution. + * + * Thus, we perform optimization in two stages: + * a) perform bounded Newton step, i.e. step in the Newton direction + * until activation of the first constraint + * b) in case (MaxStepLen>0)and(MaxStepLen<1), perform additional iteration + * of the Armijo line search in the rest of the Newton direction. + */ + calculatestepbound(x, &newtonstep, 1.0, bndl, havebndl, bndu, havebndu, nmain, nslack, &vartofreeze, &valtofreeze, &maxsteplen, _state); + if( vartofreeze>=0&&ae_fp_eq(maxsteplen,0) ) + { + + /* + * Activation of the constraints prevent us from performing step, + * QP iterations are over + */ + break; + } + if( vartofreeze>=0 ) + { + v = ae_minreal(1.0, maxsteplen, _state); + } + else + { + v = 1.0; + } + ae_v_moved(&xn.ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), v); + ae_v_add(&xn.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + postprocessboundedstep(&xn, x, bndl, havebndl, bndu, havebndu, nmain, nslack, vartofreeze, valtofreeze, v, maxsteplen, _state); + if( ae_fp_greater(maxsteplen,0)&&ae_fp_less(maxsteplen,1) ) + { + + /* + * Newton step was restricted by activation of the constraints, + * perform Armijo iteration. + * + * Initial estimate for best step is zero step. We try different + * step sizes, from the 1-MaxStepLen (residual of the full Newton + * step) to progressively smaller and smaller steps. + */ + armijobeststep = 0.0; + armijobestfeas = 0.0; + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + v = v-ce->ptr.pp_double[i][nmain+nslack]; + armijobestfeas = armijobestfeas+ae_sqr(v, _state); + } + armijobestfeas = ae_sqrt(armijobestfeas, _state); + armijostep = 1-maxsteplen; + for(j=0; j<=maxarmijoruns-1; j++) + { + ae_v_move(&xa.ptr.p_double[0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + ae_v_addd(&xa.ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), armijostep); + enforceboundaryconstraints(&xa, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); + feaserr = 0.0; + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &xa.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + v = v-ce->ptr.pp_double[i][nmain+nslack]; + feaserr = feaserr+ae_sqr(v, _state); + } + feaserr = ae_sqrt(feaserr, _state); + if( ae_fp_less(feaserr,armijobestfeas) ) + { + armijobestfeas = feaserr; + armijobeststep = armijostep; + } + armijostep = 0.5*armijostep; + } + ae_v_move(&xa.ptr.p_double[0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + ae_v_addd(&xa.ptr.p_double[0], 1, &newtonstep.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), armijobeststep); + enforceboundaryconstraints(&xa, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); + } + else + { + + /* + * Armijo iteration is not performed + */ + ae_v_move(&xa.ptr.p_double[0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + } + stage1isover = ae_fp_greater_eq(maxsteplen,1)||ae_fp_eq(maxsteplen,0); + + /* + * Calculate feasibility errors for old and new X. + * These quantinies are used for debugging purposes only. + * However, we can leave them in release code because performance impact is insignificant. + * + * Update X. Exit if needed. + */ + feasold = 0; + feasnew = 0; + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + feasold = feasold+ae_sqr(v-ce->ptr.pp_double[i][nmain+nslack], _state); + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &xa.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + feasnew = feasnew+ae_sqr(v-ce->ptr.pp_double[i][nmain+nslack], _state); + } + feasold = ae_sqrt(feasold, _state); + feasnew = ae_sqrt(feasnew, _state); + if( ae_fp_greater_eq(feasnew,feasold) ) + { + break; + } + ae_v_move(&x->ptr.p_double[0], 1, &xa.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + if( stage1isover ) + { + break; + } + } + + /* + * Stage 2: gradient projection algorithm (GPA) + * + * * calculate feasibility error (with respect to linear equality constraints) + * * calculate gradient G of F, project it into feasible area (G => PG) + * * exit if norm(PG) is exactly zero or feasibility error is smaller than EpsC + * * let XM be exact minimum of F along -PG (XM may be infeasible). + * calculate MaxStepLen = largest step in direction of -PG which retains feasibility. + * * perform bounded step from X to XN: + * a) XN=XM (if XM is feasible) + * b) XN=X-MaxStepLen*PG (otherwise) + * * X := XN + * * stop after specified number of iterations or when no new constraints was activated + * + * NOTES: + * * grad(F) = (CE'*CE)*x - (b'*CE)^T + * * CE[i] denotes I-th row of CE + * * XM = X+stp*(-PG) where stp=(grad(F(X)),PG)/(CE*PG,CE*PG). + * Here PG is a projected gradient, but in fact it can be arbitrary non-zero + * direction vector - formula for minimum of F along PG still will be correct. + */ + werechangesinconstraints = ae_false; + for(gparuns=1; gparuns<=k; gparuns++) + { + + /* + * calculate feasibility error and G + */ + feaserr = 0; + for(i=0; i<=nmain+nslack-1; i++) + { + g.ptr.p_double[i] = 0; + } + for(i=0; i<=k-1; i++) + { + + /* + * G += CE[i]^T * (CE[i]*x-b[i]) + */ + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + v = v-ce->ptr.pp_double[i][nmain+nslack]; + feaserr = feaserr+ae_sqr(v, _state); + ae_v_addd(&g.ptr.p_double[0], 1, &ce->ptr.pp_double[i][0], 1, ae_v_len(0,nmain+nslack-1), v); + } + + /* + * project G, filter it (strip numerical noise) + */ + ae_v_move(&pg.ptr.p_double[0], 1, &g.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + projectgradientintobc(x, &pg, bndl, havebndl, bndu, havebndu, nmain, nslack, _state); + filterdirection(&pg, x, bndl, havebndl, bndu, havebndu, &s, nmain, nslack, 1.0E-9, _state); + for(i=0; i<=nmain+nslack-1; i++) + { + if( ae_fp_neq(ae_sqr(colnorms.ptr.p_double[i], _state),0) ) + { + pg.ptr.p_double[i] = pg.ptr.p_double[i]/ae_sqr(colnorms.ptr.p_double[i], _state); + } + else + { + pg.ptr.p_double[i] = 0.0; + } + } + + /* + * Check GNorm and feasibility. + * Exit when GNorm is exactly zero. + */ + pgnorm = ae_v_dotproduct(&pg.ptr.p_double[0], 1, &pg.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + feaserr = ae_sqrt(feaserr, _state); + pgnorm = ae_sqrt(pgnorm, _state); + if( ae_fp_eq(pgnorm,0) ) + { + result = ae_fp_less_eq(feaserr,epsi); + ae_frame_leave(_state); + return result; + } + + /* + * calculate planned step length + */ + vn = ae_v_dotproduct(&g.ptr.p_double[0], 1, &pg.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + vd = 0; + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &pg.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + vd = vd+ae_sqr(v, _state); + } + stp = vn/vd; + + /* + * Calculate step bound. + * Perform bounded step and post-process it + */ + calculatestepbound(x, &pg, -1.0, bndl, havebndl, bndu, havebndu, nmain, nslack, &vartofreeze, &valtofreeze, &maxsteplen, _state); + if( vartofreeze>=0&&ae_fp_eq(maxsteplen,0) ) + { + result = ae_false; + ae_frame_leave(_state); + return result; + } + if( vartofreeze>=0 ) + { + v = ae_minreal(stp, maxsteplen, _state); + } + else + { + v = stp; + } + ae_v_move(&xn.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + ae_v_subd(&xn.ptr.p_double[0], 1, &pg.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1), v); + postprocessboundedstep(&xn, x, bndl, havebndl, bndu, havebndu, nmain, nslack, vartofreeze, valtofreeze, v, maxsteplen, _state); + + /* + * update X + * check stopping criteria + */ + werechangesinconstraints = werechangesinconstraints||numberofchangedconstraints(&xn, x, bndl, havebndl, bndu, havebndu, nmain, nslack, _state)>0; + ae_v_move(&x->ptr.p_double[0], 1, &xn.ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + *gpaits = *gpaits+1; + if( !werechangesinconstraints ) + { + break; + } + } + + /* + * Stage 3: decide to stop algorithm or not to stop + * + * 1. we can stop when last GPA run did NOT changed constraints status. + * It means that we've found final set of the active constraints even + * before GPA made its run. And it means that Newton step moved us to + * the minimum subject to the present constraints. + * Depending on feasibility error, True or False is returned. + */ + feaserr = 0; + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&ce->ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,nmain+nslack-1)); + v = v-ce->ptr.pp_double[i][nmain+nslack]; + feaserr = feaserr+ae_sqr(v, _state); + } + feaserr = ae_sqrt(feaserr, _state); + if( ae_fp_less_eq(feaserr,epsi) ) + { + itswithintolerance = itswithintolerance+1; + } + else + { + itswithintolerance = 0; + } + if( !werechangesinconstraints||itswithintolerance>=maxitswithintolerance ) + { + result = ae_fp_less_eq(feaserr,epsi); + ae_frame_leave(_state); + return result; + } + itscount = itscount+1; + } + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* + This function check, that input derivatives are right. First it scale +parameters DF0 and DF1 from segment [A;B] to [0;1]. Than it build Hermite +spline and derivative of it in 0,5. Search scale as Max(DF0,DF1, |F0-F1|). +Right derivative has to satisfy condition: + |H-F|/S<=0,01, |H'-F'|/S<=0,01. + +INPUT PARAMETERS: + F0 - function's value in X-TestStep point; + DF0 - derivative's value in X-TestStep point; + F1 - function's value in X+TestStep point; + DF1 - derivative's value in X+TestStep point; + F - testing function's value; + DF - testing derivative's value; + Width- width of verification segment. + +RESULT: + If input derivatives is right then function returns true, else + function returns false. + + -- ALGLIB -- + Copyright 29.05.2012 by Bochkanov Sergey +*************************************************************************/ +ae_bool derivativecheck(double f0, + double df0, + double f1, + double df1, + double f, + double df, + double width, + ae_state *_state) +{ + double s; + double h; + double dh; + ae_bool result; + + + df = width*df; + df0 = width*df0; + df1 = width*df1; + s = ae_maxreal(ae_maxreal(ae_fabs(df0, _state), ae_fabs(df1, _state), _state), ae_fabs(f1-f0, _state), _state); + h = 0.5*f0+0.125*df0+0.5*f1-0.125*df1; + dh = -1.5*f0-0.25*df0+1.5*f1-0.25*df1; + if( ae_fp_neq(s,0) ) + { + if( ae_fp_greater(ae_fabs(h-f, _state)/s,0.001)||ae_fp_greater(ae_fabs(dh-df, _state)/s,0.001) ) + { + result = ae_false; + return result; + } + } + else + { + if( ae_fp_neq(h-f,0.0)||ae_fp_neq(dh-df,0.0) ) + { + result = ae_false; + return result; + } + } + result = ae_true; + return result; +} + + + + +/************************************************************************* +This subroutine is used to initialize CQM. By default, empty NxN model is +generated, with Alpha=Lambda=Theta=0.0 and zero b. + +Previously allocated buffer variables are reused as much as possible. + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqminit(ae_int_t n, convexquadraticmodel* s, ae_state *_state) +{ + ae_int_t i; + + + s->n = n; + s->k = 0; + s->nfree = n; + s->ecakind = -1; + s->alpha = 0.0; + s->tau = 0.0; + s->theta = 0.0; + s->ismaintermchanged = ae_true; + s->issecondarytermchanged = ae_true; + s->islineartermchanged = ae_true; + s->isactivesetchanged = ae_true; + bvectorsetlengthatleast(&s->activeset, n, _state); + rvectorsetlengthatleast(&s->xc, n, _state); + rvectorsetlengthatleast(&s->eb, n, _state); + rvectorsetlengthatleast(&s->tq1, n, _state); + rvectorsetlengthatleast(&s->txc, n, _state); + rvectorsetlengthatleast(&s->tb, n, _state); + rvectorsetlengthatleast(&s->b, s->n, _state); + rvectorsetlengthatleast(&s->tk1, s->n, _state); + for(i=0; i<=n-1; i++) + { + s->activeset.ptr.p_bool[i] = ae_false; + s->xc.ptr.p_double[i] = 0.0; + s->b.ptr.p_double[i] = 0.0; + } +} + + +/************************************************************************* +This subroutine changes main quadratic term of the model. + +INPUT PARAMETERS: + S - model + A - NxN matrix, only upper or lower triangle is referenced + IsUpper - True, when matrix is stored in upper triangle + Alpha - multiplier; when Alpha=0, A is not referenced at all + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmseta(convexquadraticmodel* s, + /* Real */ ae_matrix* a, + ae_bool isupper, + double alpha, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + double v; + + + ae_assert(ae_isfinite(alpha, _state)&&ae_fp_greater_eq(alpha,0), "CQMSetA: Alpha<0 or is not finite number", _state); + ae_assert(ae_fp_eq(alpha,0)||isfinitertrmatrix(a, s->n, isupper, _state), "CQMSetA: A is not finite NxN matrix", _state); + s->alpha = alpha; + if( ae_fp_greater(alpha,0) ) + { + rmatrixsetlengthatleast(&s->a, s->n, s->n, _state); + rmatrixsetlengthatleast(&s->ecadense, s->n, s->n, _state); + rmatrixsetlengthatleast(&s->tq2dense, s->n, s->n, _state); + for(i=0; i<=s->n-1; i++) + { + for(j=i; j<=s->n-1; j++) + { + if( isupper ) + { + v = a->ptr.pp_double[i][j]; + } + else + { + v = a->ptr.pp_double[j][i]; + } + s->a.ptr.pp_double[i][j] = v; + s->a.ptr.pp_double[j][i] = v; + } + } + } + s->ismaintermchanged = ae_true; +} + + +/************************************************************************* +This subroutine rewrites diagonal of the main quadratic term of the model +(dense A) by vector Z/Alpha (current value of the Alpha coefficient is +used). + +IMPORTANT: in case model has no dense quadratic term, this function + allocates N*N dense matrix of zeros, and fills its diagonal by + non-zero values. + +INPUT PARAMETERS: + S - model + Z - new diagonal, array[N] + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmrewritedensediagonal(convexquadraticmodel* s, + /* Real */ ae_vector* z, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + + + n = s->n; + if( ae_fp_eq(s->alpha,0) ) + { + rmatrixsetlengthatleast(&s->a, s->n, s->n, _state); + rmatrixsetlengthatleast(&s->ecadense, s->n, s->n, _state); + rmatrixsetlengthatleast(&s->tq2dense, s->n, s->n, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + s->a.ptr.pp_double[i][j] = 0.0; + } + } + s->alpha = 1.0; + } + for(i=0; i<=s->n-1; i++) + { + s->a.ptr.pp_double[i][i] = z->ptr.p_double[i]/s->alpha; + } + s->ismaintermchanged = ae_true; +} + + +/************************************************************************* +This subroutine changes diagonal quadratic term of the model. + +INPUT PARAMETERS: + S - model + D - array[N], semidefinite diagonal matrix + Tau - multiplier; when Tau=0, D is not referenced at all + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmsetd(convexquadraticmodel* s, + /* Real */ ae_vector* d, + double tau, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(ae_isfinite(tau, _state)&&ae_fp_greater_eq(tau,0), "CQMSetD: Tau<0 or is not finite number", _state); + ae_assert(ae_fp_eq(tau,0)||isfinitevector(d, s->n, _state), "CQMSetD: D is not finite Nx1 vector", _state); + s->tau = tau; + if( ae_fp_greater(tau,0) ) + { + rvectorsetlengthatleast(&s->d, s->n, _state); + rvectorsetlengthatleast(&s->ecadiag, s->n, _state); + rvectorsetlengthatleast(&s->tq2diag, s->n, _state); + for(i=0; i<=s->n-1; i++) + { + ae_assert(ae_fp_greater_eq(d->ptr.p_double[i],0), "CQMSetD: D[i]<0", _state); + s->d.ptr.p_double[i] = d->ptr.p_double[i]; + } + } + s->ismaintermchanged = ae_true; +} + + +/************************************************************************* +This subroutine drops main quadratic term A from the model. It is same as +call to CQMSetA() with zero A, but gives better performance because +algorithm knows that matrix is zero and can optimize subsequent +calculations. + +INPUT PARAMETERS: + S - model + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmdropa(convexquadraticmodel* s, ae_state *_state) +{ + + + s->alpha = 0.0; + s->ismaintermchanged = ae_true; +} + + +/************************************************************************* +This subroutine changes linear term of the model + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmsetb(convexquadraticmodel* s, + /* Real */ ae_vector* b, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(isfinitevector(b, s->n, _state), "CQMSetB: B is not finite vector", _state); + rvectorsetlengthatleast(&s->b, s->n, _state); + for(i=0; i<=s->n-1; i++) + { + s->b.ptr.p_double[i] = b->ptr.p_double[i]; + } + s->islineartermchanged = ae_true; +} + + +/************************************************************************* +This subroutine changes linear term of the model + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmsetq(convexquadraticmodel* s, + /* Real */ ae_matrix* q, + /* Real */ ae_vector* r, + ae_int_t k, + double theta, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + + + ae_assert(k>=0, "CQMSetQ: K<0", _state); + ae_assert((k==0||ae_fp_eq(theta,0))||apservisfinitematrix(q, k, s->n, _state), "CQMSetQ: Q is not finite matrix", _state); + ae_assert((k==0||ae_fp_eq(theta,0))||isfinitevector(r, k, _state), "CQMSetQ: R is not finite vector", _state); + ae_assert(ae_isfinite(theta, _state)&&ae_fp_greater_eq(theta,0), "CQMSetQ: Theta<0 or is not finite number", _state); + + /* + * degenerate case: K=0 or Theta=0 + */ + if( k==0||ae_fp_eq(theta,0) ) + { + s->k = 0; + s->theta = 0; + s->issecondarytermchanged = ae_true; + return; + } + + /* + * General case: both Theta>0 and K>0 + */ + s->k = k; + s->theta = theta; + rmatrixsetlengthatleast(&s->q, s->k, s->n, _state); + rvectorsetlengthatleast(&s->r, s->k, _state); + rmatrixsetlengthatleast(&s->eq, s->k, s->n, _state); + rmatrixsetlengthatleast(&s->eccm, s->k, s->k, _state); + rmatrixsetlengthatleast(&s->tk2, s->k, s->n, _state); + for(i=0; i<=s->k-1; i++) + { + for(j=0; j<=s->n-1; j++) + { + s->q.ptr.pp_double[i][j] = q->ptr.pp_double[i][j]; + } + s->r.ptr.p_double[i] = r->ptr.p_double[i]; + } + s->issecondarytermchanged = ae_true; +} + + +/************************************************************************* +This subroutine changes active set + +INPUT PARAMETERS + S - model + X - array[N], constraint values + ActiveSet- array[N], active set. If ActiveSet[I]=True, then I-th + variables is constrained to X[I]. + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmsetactiveset(convexquadraticmodel* s, + /* Real */ ae_vector* x, + /* Boolean */ ae_vector* activeset, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(x->cnt>=s->n, "CQMSetActiveSet: Length(X)cnt>=s->n, "CQMSetActiveSet: Length(ActiveSet)n-1; i++) + { + s->isactivesetchanged = s->isactivesetchanged||(s->activeset.ptr.p_bool[i]&&!activeset->ptr.p_bool[i]); + s->isactivesetchanged = s->isactivesetchanged||(activeset->ptr.p_bool[i]&&!s->activeset.ptr.p_bool[i]); + s->activeset.ptr.p_bool[i] = activeset->ptr.p_bool[i]; + if( activeset->ptr.p_bool[i] ) + { + ae_assert(ae_isfinite(x->ptr.p_double[i], _state), "CQMSetActiveSet: X[] contains infinite constraints", _state); + s->isactivesetchanged = s->isactivesetchanged||ae_fp_neq(s->xc.ptr.p_double[i],x->ptr.p_double[i]); + s->xc.ptr.p_double[i] = x->ptr.p_double[i]; + } + } +} + + +/************************************************************************* +This subroutine evaluates model at X. Active constraints are ignored. + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +double cqmeval(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + double v; + double result; + + + n = s->n; + ae_assert(isfinitevector(x, n, _state), "CQMEval: X is not finite vector", _state); + result = 0.0; + + /* + * main quadratic term + */ + if( ae_fp_greater(s->alpha,0) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + result = result+s->alpha*0.5*x->ptr.p_double[i]*s->a.ptr.pp_double[i][j]*x->ptr.p_double[j]; + } + } + } + if( ae_fp_greater(s->tau,0) ) + { + for(i=0; i<=n-1; i++) + { + result = result+0.5*ae_sqr(x->ptr.p_double[i], _state)*s->tau*s->d.ptr.p_double[i]; + } + } + + /* + * secondary quadratic term + */ + if( ae_fp_greater(s->theta,0) ) + { + for(i=0; i<=s->k-1; i++) + { + v = ae_v_dotproduct(&s->q.ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + result = result+0.5*s->theta*ae_sqr(v-s->r.ptr.p_double[i], _state); + } + } + + /* + * linear term + */ + for(i=0; i<=s->n-1; i++) + { + result = result+x->ptr.p_double[i]*s->b.ptr.p_double[i]; + } + return result; +} + + +/************************************************************************* +This subroutine evaluates model at X. Active constraints are ignored. +It returns: + R - model value + Noise- estimate of the numerical noise in data + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmevalx(convexquadraticmodel* s, + /* Real */ ae_vector* x, + double* r, + double* noise, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + double v; + double v2; + double mxq; + double eps; + + *r = 0; + *noise = 0; + + n = s->n; + ae_assert(isfinitevector(x, n, _state), "CQMEval: X is not finite vector", _state); + *r = 0.0; + *noise = 0.0; + eps = 2*ae_machineepsilon; + mxq = 0.0; + + /* + * Main quadratic term. + * + * Noise from the main quadratic term is equal to the + * maximum summand in the term. + */ + if( ae_fp_greater(s->alpha,0) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + v = s->alpha*0.5*x->ptr.p_double[i]*s->a.ptr.pp_double[i][j]*x->ptr.p_double[j]; + *r = *r+v; + *noise = ae_maxreal(*noise, eps*ae_fabs(v, _state), _state); + } + } + } + if( ae_fp_greater(s->tau,0) ) + { + for(i=0; i<=n-1; i++) + { + v = 0.5*ae_sqr(x->ptr.p_double[i], _state)*s->tau*s->d.ptr.p_double[i]; + *r = *r+v; + *noise = ae_maxreal(*noise, eps*ae_fabs(v, _state), _state); + } + } + + /* + * secondary quadratic term + * + * Noise from the secondary quadratic term is estimated as follows: + * * noise in qi*x-r[i] is estimated as + * Eps*MXQ = Eps*max(|r[i]|, |q[i,j]*x[j]|) + * * noise in (qi*x-r[i])^2 is estimated as + * NOISE = (|qi*x-r[i]|+Eps*MXQ)^2-(|qi*x-r[i]|)^2 + * = Eps*MXQ*(2*|qi*x-r[i]|+Eps*MXQ) + */ + if( ae_fp_greater(s->theta,0) ) + { + for(i=0; i<=s->k-1; i++) + { + v = 0.0; + mxq = ae_fabs(s->r.ptr.p_double[i], _state); + for(j=0; j<=n-1; j++) + { + v2 = s->q.ptr.pp_double[i][j]*x->ptr.p_double[j]; + v = v+v2; + mxq = ae_maxreal(mxq, ae_fabs(v2, _state), _state); + } + *r = *r+0.5*s->theta*ae_sqr(v-s->r.ptr.p_double[i], _state); + *noise = ae_maxreal(*noise, eps*mxq*(2*ae_fabs(v-s->r.ptr.p_double[i], _state)+eps*mxq), _state); + } + } + + /* + * linear term + */ + for(i=0; i<=s->n-1; i++) + { + *r = *r+x->ptr.p_double[i]*s->b.ptr.p_double[i]; + *noise = ae_maxreal(*noise, eps*ae_fabs(x->ptr.p_double[i]*s->b.ptr.p_double[i], _state), _state); + } + + /* + * Final update of the noise + */ + *noise = n*(*noise); +} + + +/************************************************************************* +This subroutine evaluates gradient of the model; active constraints are +ignored. + +INPUT PARAMETERS: + S - convex model + X - point, array[N] + G - possibly preallocated buffer; resized, if too small + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmgradunconstrained(convexquadraticmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* g, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + double v; + + + n = s->n; + ae_assert(isfinitevector(x, n, _state), "CQMEvalGradUnconstrained: X is not finite vector", _state); + rvectorsetlengthatleast(g, n, _state); + for(i=0; i<=n-1; i++) + { + g->ptr.p_double[i] = 0; + } + + /* + * main quadratic term + */ + if( ae_fp_greater(s->alpha,0) ) + { + for(i=0; i<=n-1; i++) + { + v = 0.0; + for(j=0; j<=n-1; j++) + { + v = v+s->alpha*s->a.ptr.pp_double[i][j]*x->ptr.p_double[j]; + } + g->ptr.p_double[i] = g->ptr.p_double[i]+v; + } + } + if( ae_fp_greater(s->tau,0) ) + { + for(i=0; i<=n-1; i++) + { + g->ptr.p_double[i] = g->ptr.p_double[i]+x->ptr.p_double[i]*s->tau*s->d.ptr.p_double[i]; + } + } + + /* + * secondary quadratic term + */ + if( ae_fp_greater(s->theta,0) ) + { + for(i=0; i<=s->k-1; i++) + { + v = ae_v_dotproduct(&s->q.ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + v = s->theta*(v-s->r.ptr.p_double[i]); + ae_v_addd(&g->ptr.p_double[0], 1, &s->q.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); + } + } + + /* + * linear term + */ + for(i=0; i<=n-1; i++) + { + g->ptr.p_double[i] = g->ptr.p_double[i]+s->b.ptr.p_double[i]; + } +} + + +/************************************************************************* +This subroutine evaluates x'*(0.5*alpha*A+tau*D)*x + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +double cqmxtadx2(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + double result; + + + n = s->n; + ae_assert(isfinitevector(x, n, _state), "CQMEval: X is not finite vector", _state); + result = 0.0; + + /* + * main quadratic term + */ + if( ae_fp_greater(s->alpha,0) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + result = result+s->alpha*0.5*x->ptr.p_double[i]*s->a.ptr.pp_double[i][j]*x->ptr.p_double[j]; + } + } + } + if( ae_fp_greater(s->tau,0) ) + { + for(i=0; i<=n-1; i++) + { + result = result+0.5*ae_sqr(x->ptr.p_double[i], _state)*s->tau*s->d.ptr.p_double[i]; + } + } + return result; +} + + +/************************************************************************* +This subroutine evaluates (0.5*alpha*A+tau*D)*x + +Y is automatically resized if needed + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmadx(convexquadraticmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + double v; + + + n = s->n; + ae_assert(isfinitevector(x, n, _state), "CQMEval: X is not finite vector", _state); + rvectorsetlengthatleast(y, n, _state); + + /* + * main quadratic term + */ + for(i=0; i<=n-1; i++) + { + y->ptr.p_double[i] = 0; + } + if( ae_fp_greater(s->alpha,0) ) + { + for(i=0; i<=n-1; i++) + { + v = ae_v_dotproduct(&s->a.ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + y->ptr.p_double[i] = y->ptr.p_double[i]+s->alpha*v; + } + } + if( ae_fp_greater(s->tau,0) ) + { + for(i=0; i<=n-1; i++) + { + y->ptr.p_double[i] = y->ptr.p_double[i]+x->ptr.p_double[i]*s->tau*s->d.ptr.p_double[i]; + } + } +} + + +/************************************************************************* +This subroutine finds optimum of the model. It returns False on failure +(indefinite/semidefinite matrix). Optimum is found subject to active +constraints. + +INPUT PARAMETERS + S - model + X - possibly preallocated buffer; automatically resized, if + too small enough. + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +ae_bool cqmconstrainedoptimum(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nfree; + ae_int_t k; + ae_int_t i; + double v; + ae_int_t cidx0; + ae_int_t itidx; + ae_bool result; + + + + /* + * Rebuild internal structures + */ + if( !cqmodels_cqmrebuild(s, _state) ) + { + result = ae_false; + return result; + } + n = s->n; + k = s->k; + nfree = s->nfree; + result = ae_true; + + /* + * Calculate initial point for the iterative refinement: + * * free components are set to zero + * * constrained components are set to their constrained values + */ + rvectorsetlengthatleast(x, n, _state); + for(i=0; i<=n-1; i++) + { + if( s->activeset.ptr.p_bool[i] ) + { + x->ptr.p_double[i] = s->xc.ptr.p_double[i]; + } + else + { + x->ptr.p_double[i] = 0; + } + } + + /* + * Iterative refinement. + * + * In an ideal world without numerical errors it would be enough + * to make just one Newton step from initial point: + * x_new = -H^(-1)*grad(x=0) + * However, roundoff errors can significantly deteriorate quality + * of the solution. So we have to recalculate gradient and to + * perform Newton steps several times. + * + * Below we perform fixed number of Newton iterations. + */ + for(itidx=0; itidx<=cqmodels_newtonrefinementits-1; itidx++) + { + + /* + * Calculate gradient at the current point. + * Move free components of the gradient in the beginning. + */ + cqmgradunconstrained(s, x, &s->tmpg, _state); + cidx0 = 0; + for(i=0; i<=n-1; i++) + { + if( !s->activeset.ptr.p_bool[i] ) + { + s->tmpg.ptr.p_double[cidx0] = s->tmpg.ptr.p_double[i]; + cidx0 = cidx0+1; + } + } + + /* + * Free components of the extrema are calculated in the first NFree elements of TXC. + * + * First, we have to calculate original Newton step, without rank-K perturbations + */ + ae_v_moveneg(&s->txc.ptr.p_double[0], 1, &s->tmpg.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); + cqmodels_cqmsolveea(s, &s->txc, &s->tmp0, _state); + + /* + * Then, we account for rank-K correction. + * Woodbury matrix identity is used. + */ + if( s->k>0&&ae_fp_greater(s->theta,0) ) + { + rvectorsetlengthatleast(&s->tmp0, ae_maxint(nfree, k, _state), _state); + rvectorsetlengthatleast(&s->tmp1, ae_maxint(nfree, k, _state), _state); + ae_v_moveneg(&s->tmp1.ptr.p_double[0], 1, &s->tmpg.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); + cqmodels_cqmsolveea(s, &s->tmp1, &s->tmp0, _state); + for(i=0; i<=k-1; i++) + { + v = ae_v_dotproduct(&s->eq.ptr.pp_double[i][0], 1, &s->tmp1.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); + s->tmp0.ptr.p_double[i] = v; + } + fblscholeskysolve(&s->eccm, 1.0, k, ae_true, &s->tmp0, &s->tmp1, _state); + for(i=0; i<=nfree-1; i++) + { + s->tmp1.ptr.p_double[i] = 0.0; + } + for(i=0; i<=k-1; i++) + { + v = s->tmp0.ptr.p_double[i]; + ae_v_addd(&s->tmp1.ptr.p_double[0], 1, &s->eq.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); + } + cqmodels_cqmsolveea(s, &s->tmp1, &s->tmp0, _state); + ae_v_sub(&s->txc.ptr.p_double[0], 1, &s->tmp1.ptr.p_double[0], 1, ae_v_len(0,nfree-1)); + } + + /* + * Unpack components from TXC into X. We pass through all + * free components of X and add our step. + */ + cidx0 = 0; + for(i=0; i<=n-1; i++) + { + if( !s->activeset.ptr.p_bool[i] ) + { + x->ptr.p_double[i] = x->ptr.p_double[i]+s->txc.ptr.p_double[cidx0]; + cidx0 = cidx0+1; + } + } + } + return result; +} + + +/************************************************************************* +This function scales vector by multiplying it by inverse of the diagonal +of the Hessian matrix. It should be used to accelerate steepest descent +phase of the QP solver. + +Although it is called "scale-grad", it can be called for any vector, +whether it is gradient, anti-gradient, or just some vector. + +This function does NOT takes into account current set of constraints, it +just performs matrix-vector multiplication without taking into account +constraints. + +INPUT PARAMETERS: + S - model + X - vector to scale + +OUTPUT PARAMETERS: + X - scaled vector + +NOTE: + when called for non-SPD matrices, it silently skips components of X + which correspond to zero or negative diagonal elements. + +NOTE: + this function uses diagonals of A and D; it ignores Q - rank-K term of + the quadratic model. + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +void cqmscalevector(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + double v; + + + n = s->n; + for(i=0; i<=n-1; i++) + { + v = 0.0; + if( ae_fp_greater(s->alpha,0) ) + { + v = v+s->a.ptr.pp_double[i][i]; + } + if( ae_fp_greater(s->tau,0) ) + { + v = v+s->d.ptr.p_double[i]; + } + if( ae_fp_greater(v,0) ) + { + x->ptr.p_double[i] = x->ptr.p_double[i]/v; + } + } +} + + +/************************************************************************* +This subroutine calls CQMRebuild() and evaluates model at X subject to +active constraints. + +It is intended for debug purposes only, because it evaluates model by +means of temporaries, which were calculated by CQMRebuild(). The only +purpose of this function is to check correctness of CQMRebuild() by +comparing results of this function with ones obtained by CQMEval(), which +is used as reference point. The idea is that significant deviation in +results of these two functions is evidence of some error in the +CQMRebuild(). + +NOTE: suffix T denotes that temporaries marked by T-prefix are used. There + is one more variant of this function, which uses "effective" model + built by CQMRebuild(). + +NOTE2: in case CQMRebuild() fails (due to model non-convexity), this + function returns NAN. + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +double cqmdebugconstrainedevalt(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nfree; + ae_int_t i; + ae_int_t j; + double v; + double result; + + + n = s->n; + ae_assert(isfinitevector(x, n, _state), "CQMDebugConstrainedEvalT: X is not finite vector", _state); + if( !cqmodels_cqmrebuild(s, _state) ) + { + result = _state->v_nan; + return result; + } + result = 0.0; + nfree = s->nfree; + + /* + * Reorder variables + */ + j = 0; + for(i=0; i<=n-1; i++) + { + if( !s->activeset.ptr.p_bool[i] ) + { + ae_assert(jtxc.ptr.p_double[j] = x->ptr.p_double[i]; + j = j+1; + } + } + + /* + * TQ2, TQ1, TQ0 + * + */ + if( ae_fp_greater(s->alpha,0) ) + { + + /* + * Dense TQ2 + */ + for(i=0; i<=nfree-1; i++) + { + for(j=0; j<=nfree-1; j++) + { + result = result+0.5*s->txc.ptr.p_double[i]*s->tq2dense.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; + } + } + } + else + { + + /* + * Diagonal TQ2 + */ + for(i=0; i<=nfree-1; i++) + { + result = result+0.5*s->tq2diag.ptr.p_double[i]*ae_sqr(s->txc.ptr.p_double[i], _state); + } + } + for(i=0; i<=nfree-1; i++) + { + result = result+s->tq1.ptr.p_double[i]*s->txc.ptr.p_double[i]; + } + result = result+s->tq0; + + /* + * TK2, TK1, TK0 + */ + if( s->k>0&&ae_fp_greater(s->theta,0) ) + { + for(i=0; i<=s->k-1; i++) + { + v = 0; + for(j=0; j<=nfree-1; j++) + { + v = v+s->tk2.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; + } + result = result+0.5*ae_sqr(v, _state); + } + for(i=0; i<=nfree-1; i++) + { + result = result+s->tk1.ptr.p_double[i]*s->txc.ptr.p_double[i]; + } + result = result+s->tk0; + } + + /* + * TB (Bf and Bc parts) + */ + for(i=0; i<=n-1; i++) + { + result = result+s->tb.ptr.p_double[i]*s->txc.ptr.p_double[i]; + } + return result; +} + + +/************************************************************************* +This subroutine calls CQMRebuild() and evaluates model at X subject to +active constraints. + +It is intended for debug purposes only, because it evaluates model by +means of "effective" matrices built by CQMRebuild(). The only purpose of +this function is to check correctness of CQMRebuild() by comparing results +of this function with ones obtained by CQMEval(), which is used as +reference point. The idea is that significant deviation in results of +these two functions is evidence of some error in the CQMRebuild(). + +NOTE: suffix E denotes that effective matrices. There is one more variant + of this function, which uses temporary matrices built by + CQMRebuild(). + +NOTE2: in case CQMRebuild() fails (due to model non-convexity), this + function returns NAN. + + -- ALGLIB -- + Copyright 12.06.2012 by Bochkanov Sergey +*************************************************************************/ +double cqmdebugconstrainedevale(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nfree; + ae_int_t i; + ae_int_t j; + double v; + double result; + + + n = s->n; + ae_assert(isfinitevector(x, n, _state), "CQMDebugConstrainedEvalE: X is not finite vector", _state); + if( !cqmodels_cqmrebuild(s, _state) ) + { + result = _state->v_nan; + return result; + } + result = 0.0; + nfree = s->nfree; + + /* + * Reorder variables + */ + j = 0; + for(i=0; i<=n-1; i++) + { + if( !s->activeset.ptr.p_bool[i] ) + { + ae_assert(jtxc.ptr.p_double[j] = x->ptr.p_double[i]; + j = j+1; + } + } + + /* + * ECA + */ + ae_assert((s->ecakind==0||s->ecakind==1)||(s->ecakind==-1&&nfree==0), "CQMDebugConstrainedEvalE: unexpected ECAKind", _state); + if( s->ecakind==0 ) + { + + /* + * Dense ECA + */ + for(i=0; i<=nfree-1; i++) + { + v = 0.0; + for(j=i; j<=nfree-1; j++) + { + v = v+s->ecadense.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; + } + result = result+0.5*ae_sqr(v, _state); + } + } + if( s->ecakind==1 ) + { + + /* + * Diagonal ECA + */ + for(i=0; i<=nfree-1; i++) + { + result = result+0.5*ae_sqr(s->ecadiag.ptr.p_double[i]*s->txc.ptr.p_double[i], _state); + } + } + + /* + * EQ + */ + for(i=0; i<=s->k-1; i++) + { + v = 0.0; + for(j=0; j<=nfree-1; j++) + { + v = v+s->eq.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; + } + result = result+0.5*ae_sqr(v, _state); + } + + /* + * EB + */ + for(i=0; i<=nfree-1; i++) + { + result = result+s->eb.ptr.p_double[i]*s->txc.ptr.p_double[i]; + } + + /* + * EC + */ + result = result+s->ec; + return result; +} + + +/************************************************************************* +Internal function, rebuilds "effective" model subject to constraints. +Returns False on failure (non-SPD main quadratic term) + + -- ALGLIB -- + Copyright 10.05.2011 by Bochkanov Sergey +*************************************************************************/ +static ae_bool cqmodels_cqmrebuild(convexquadraticmodel* s, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nfree; + ae_int_t k; + ae_int_t i; + ae_int_t j; + ae_int_t ridx0; + ae_int_t ridx1; + ae_int_t cidx0; + ae_int_t cidx1; + double v; + ae_bool result; + + + if( ae_fp_eq(s->alpha,0)&&ae_fp_eq(s->tau,0) ) + { + + /* + * Non-SPD model, quick exit + */ + result = ae_false; + return result; + } + result = ae_true; + n = s->n; + k = s->k; + + /* + * Determine number of free variables. + * Fill TXC - array whose last N-NFree elements store constraints. + */ + if( s->isactivesetchanged ) + { + s->nfree = 0; + for(i=0; i<=n-1; i++) + { + if( !s->activeset.ptr.p_bool[i] ) + { + s->nfree = s->nfree+1; + } + } + j = s->nfree; + for(i=0; i<=n-1; i++) + { + if( s->activeset.ptr.p_bool[i] ) + { + s->txc.ptr.p_double[j] = s->xc.ptr.p_double[i]; + j = j+1; + } + } + } + nfree = s->nfree; + + /* + * Re-evaluate TQ2/TQ1/TQ0, if needed + */ + if( s->isactivesetchanged||s->ismaintermchanged ) + { + + /* + * Handle cases Alpha>0 and Alpha=0 separately: + * * in the first case we have dense matrix + * * in the second one we have diagonal matrix, which can be + * handled more efficiently + */ + if( ae_fp_greater(s->alpha,0) ) + { + + /* + * Alpha>0, dense QP + * + * Split variables into two groups - free (F) and constrained (C). Reorder + * variables in such way that free vars come first, constrained are last: + * x = [xf, xc]. + * + * Main quadratic term x'*(alpha*A+tau*D)*x now splits into quadratic part, + * linear part and constant part: + * ( alpha*Aff+tau*Df alpha*Afc ) ( xf ) + * 0.5*( xf' xc' )*( )*( ) = + * ( alpha*Acf alpha*Acc+tau*Dc ) ( xc ) + * + * = 0.5*xf'*(alpha*Aff+tau*Df)*xf + (alpha*Afc*xc)'*xf + 0.5*xc'(alpha*Acc+tau*Dc)*xc + * + * We store these parts into temporary variables: + * * alpha*Aff+tau*Df, alpha*Afc, alpha*Acc+tau*Dc are stored into upper + * triangle of TQ2 + * * alpha*Afc*xc is stored into TQ1 + * * 0.5*xc'(alpha*Acc+tau*Dc)*xc is stored into TQ0 + * + * Below comes first part of the work - generation of TQ2: + * * we pass through rows of A and copy I-th row into upper block (Aff/Afc) or + * lower one (Acf/Acc) of TQ2, depending on presence of X[i] in the active set. + * RIdx0 variable contains current position for insertion into upper block, + * RIdx1 contains current position for insertion into lower one. + * * within each row, we copy J-th element into left half (Aff/Acf) or right + * one (Afc/Acc), depending on presence of X[j] in the active set. CIdx0 + * contains current position for insertion into left block, CIdx1 contains + * position for insertion into right one. + * * during copying, we multiply elements by alpha and add diagonal matrix D. + */ + ridx0 = 0; + ridx1 = s->nfree; + for(i=0; i<=n-1; i++) + { + cidx0 = 0; + cidx1 = s->nfree; + for(j=0; j<=n-1; j++) + { + if( !s->activeset.ptr.p_bool[i]&&!s->activeset.ptr.p_bool[j] ) + { + + /* + * Element belongs to Aff + */ + v = s->alpha*s->a.ptr.pp_double[i][j]; + if( i==j&&ae_fp_greater(s->tau,0) ) + { + v = v+s->tau*s->d.ptr.p_double[i]; + } + s->tq2dense.ptr.pp_double[ridx0][cidx0] = v; + } + if( !s->activeset.ptr.p_bool[i]&&s->activeset.ptr.p_bool[j] ) + { + + /* + * Element belongs to Afc + */ + s->tq2dense.ptr.pp_double[ridx0][cidx1] = s->alpha*s->a.ptr.pp_double[i][j]; + } + if( s->activeset.ptr.p_bool[i]&&!s->activeset.ptr.p_bool[j] ) + { + + /* + * Element belongs to Acf + */ + s->tq2dense.ptr.pp_double[ridx1][cidx0] = s->alpha*s->a.ptr.pp_double[i][j]; + } + if( s->activeset.ptr.p_bool[i]&&s->activeset.ptr.p_bool[j] ) + { + + /* + * Element belongs to Acc + */ + v = s->alpha*s->a.ptr.pp_double[i][j]; + if( i==j&&ae_fp_greater(s->tau,0) ) + { + v = v+s->tau*s->d.ptr.p_double[i]; + } + s->tq2dense.ptr.pp_double[ridx1][cidx1] = v; + } + if( s->activeset.ptr.p_bool[j] ) + { + cidx1 = cidx1+1; + } + else + { + cidx0 = cidx0+1; + } + } + if( s->activeset.ptr.p_bool[i] ) + { + ridx1 = ridx1+1; + } + else + { + ridx0 = ridx0+1; + } + } + + /* + * Now we have TQ2, and we can evaluate TQ1. + * In the special case when we have Alpha=0, NFree=0 or NFree=N, + * TQ1 is filled by zeros. + */ + for(i=0; i<=n-1; i++) + { + s->tq1.ptr.p_double[i] = 0.0; + } + if( s->nfree>0&&s->nfreenfree, n-s->nfree, &s->tq2dense, 0, s->nfree, 0, &s->txc, s->nfree, &s->tq1, 0, _state); + } + + /* + * And finally, we evaluate TQ0. + */ + v = 0.0; + for(i=s->nfree; i<=n-1; i++) + { + for(j=s->nfree; j<=n-1; j++) + { + v = v+0.5*s->txc.ptr.p_double[i]*s->tq2dense.ptr.pp_double[i][j]*s->txc.ptr.p_double[j]; + } + } + s->tq0 = v; + } + else + { + + /* + * Alpha=0, diagonal QP + * + * Split variables into two groups - free (F) and constrained (C). Reorder + * variables in such way that free vars come first, constrained are last: + * x = [xf, xc]. + * + * Main quadratic term x'*(tau*D)*x now splits into quadratic and constant + * parts: + * ( tau*Df ) ( xf ) + * 0.5*( xf' xc' )*( )*( ) = + * ( tau*Dc ) ( xc ) + * + * = 0.5*xf'*(tau*Df)*xf + 0.5*xc'(tau*Dc)*xc + * + * We store these parts into temporary variables: + * * tau*Df is stored in TQ2Diag + * * 0.5*xc'(tau*Dc)*xc is stored into TQ0 + */ + s->tq0 = 0.0; + ridx0 = 0; + for(i=0; i<=n-1; i++) + { + if( !s->activeset.ptr.p_bool[i] ) + { + s->tq2diag.ptr.p_double[ridx0] = s->tau*s->d.ptr.p_double[i]; + ridx0 = ridx0+1; + } + else + { + s->tq0 = s->tq0+0.5*s->tau*s->d.ptr.p_double[i]*ae_sqr(s->xc.ptr.p_double[i], _state); + } + } + for(i=0; i<=n-1; i++) + { + s->tq1.ptr.p_double[i] = 0.0; + } + } + } + + /* + * Re-evaluate TK2/TK1/TK0, if needed + */ + if( s->isactivesetchanged||s->issecondarytermchanged ) + { + + /* + * Split variables into two groups - free (F) and constrained (C). Reorder + * variables in such way that free vars come first, constrained are last: + * x = [xf, xc]. + * + * Secondary term theta*(Q*x-r)'*(Q*x-r) now splits into quadratic part, + * linear part and constant part: + * ( ( xf ) )' ( ( xf ) ) + * 0.5*theta*( (Qf Qc)'*( ) - r ) * ( (Qf Qc)'*( ) - r ) = + * ( ( xc ) ) ( ( xc ) ) + * + * = 0.5*theta*xf'*(Qf'*Qf)*xf + theta*((Qc*xc-r)'*Qf)*xf + + * + theta*(-r'*(Qc*xc-r)-0.5*r'*r+0.5*xc'*Qc'*Qc*xc) + * + * We store these parts into temporary variables: + * * sqrt(theta)*Qf is stored into TK2 + * * theta*((Qc*xc-r)'*Qf) is stored into TK1 + * * theta*(-r'*(Qc*xc-r)-0.5*r'*r+0.5*xc'*Qc'*Qc*xc) is stored into TK0 + * + * We use several other temporaries to store intermediate results: + * * Tmp0 - to store Qc*xc-r + * * Tmp1 - to store Qc*xc + * + * Generation of TK2/TK1/TK0 is performed as follows: + * * we fill TK2/TK1/TK0 (to handle K=0 or Theta=0) + * * other steps are performed only for K>0 and Theta>0 + * * we pass through columns of Q and copy I-th column into left block (Qf) or + * right one (Qc) of TK2, depending on presence of X[i] in the active set. + * CIdx0 variable contains current position for insertion into upper block, + * CIdx1 contains current position for insertion into lower one. + * * we calculate Qc*xc-r and store it into Tmp0 + * * we calculate TK0 and TK1 + * * we multiply leading part of TK2 which stores Qf by sqrt(theta) + * it is important to perform this step AFTER calculation of TK0 and TK1, + * because we need original (non-modified) Qf to calculate TK0 and TK1. + */ + for(j=0; j<=n-1; j++) + { + for(i=0; i<=k-1; i++) + { + s->tk2.ptr.pp_double[i][j] = 0.0; + } + s->tk1.ptr.p_double[j] = 0.0; + } + s->tk0 = 0.0; + if( s->k>0&&ae_fp_greater(s->theta,0) ) + { + + /* + * Split Q into Qf and Qc + * Calculate Qc*xc-r, store in Tmp0 + */ + rvectorsetlengthatleast(&s->tmp0, k, _state); + rvectorsetlengthatleast(&s->tmp1, k, _state); + cidx0 = 0; + cidx1 = nfree; + for(i=0; i<=k-1; i++) + { + s->tmp1.ptr.p_double[i] = 0.0; + } + for(j=0; j<=n-1; j++) + { + if( s->activeset.ptr.p_bool[j] ) + { + for(i=0; i<=k-1; i++) + { + s->tk2.ptr.pp_double[i][cidx1] = s->q.ptr.pp_double[i][j]; + s->tmp1.ptr.p_double[i] = s->tmp1.ptr.p_double[i]+s->q.ptr.pp_double[i][j]*s->txc.ptr.p_double[cidx1]; + } + cidx1 = cidx1+1; + } + else + { + for(i=0; i<=k-1; i++) + { + s->tk2.ptr.pp_double[i][cidx0] = s->q.ptr.pp_double[i][j]; + } + cidx0 = cidx0+1; + } + } + for(i=0; i<=k-1; i++) + { + s->tmp0.ptr.p_double[i] = s->tmp1.ptr.p_double[i]-s->r.ptr.p_double[i]; + } + + /* + * Calculate TK0 + */ + v = 0.0; + for(i=0; i<=k-1; i++) + { + v = v+s->theta*(0.5*ae_sqr(s->tmp1.ptr.p_double[i], _state)-s->r.ptr.p_double[i]*s->tmp0.ptr.p_double[i]-0.5*ae_sqr(s->r.ptr.p_double[i], _state)); + } + s->tk0 = v; + + /* + * Calculate TK1 + */ + if( nfree>0 ) + { + for(i=0; i<=k-1; i++) + { + v = s->theta*s->tmp0.ptr.p_double[i]; + ae_v_addd(&s->tk1.ptr.p_double[0], 1, &s->tk2.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); + } + } + + /* + * Calculate TK2 + */ + if( nfree>0 ) + { + v = ae_sqrt(s->theta, _state); + for(i=0; i<=k-1; i++) + { + ae_v_muld(&s->tk2.ptr.pp_double[i][0], 1, ae_v_len(0,nfree-1), v); + } + } + } + } + + /* + * Re-evaluate TB + */ + if( s->isactivesetchanged||s->islineartermchanged ) + { + ridx0 = 0; + ridx1 = nfree; + for(i=0; i<=n-1; i++) + { + if( s->activeset.ptr.p_bool[i] ) + { + s->tb.ptr.p_double[ridx1] = s->b.ptr.p_double[i]; + ridx1 = ridx1+1; + } + else + { + s->tb.ptr.p_double[ridx0] = s->b.ptr.p_double[i]; + ridx0 = ridx0+1; + } + } + } + + /* + * Compose ECA: either dense ECA or diagonal ECA + */ + if( (s->isactivesetchanged||s->ismaintermchanged)&&nfree>0 ) + { + if( ae_fp_greater(s->alpha,0) ) + { + + /* + * Dense ECA + */ + s->ecakind = 0; + for(i=0; i<=nfree-1; i++) + { + for(j=i; j<=nfree-1; j++) + { + s->ecadense.ptr.pp_double[i][j] = s->tq2dense.ptr.pp_double[i][j]; + } + } + if( !spdmatrixcholeskyrec(&s->ecadense, 0, nfree, ae_true, &s->tmp0, _state) ) + { + result = ae_false; + return result; + } + } + else + { + + /* + * Diagonal ECA + */ + s->ecakind = 1; + for(i=0; i<=nfree-1; i++) + { + if( ae_fp_less(s->tq2diag.ptr.p_double[i],0) ) + { + result = ae_false; + return result; + } + s->ecadiag.ptr.p_double[i] = ae_sqrt(s->tq2diag.ptr.p_double[i], _state); + } + } + } + + /* + * Compose EQ + */ + if( s->isactivesetchanged||s->issecondarytermchanged ) + { + for(i=0; i<=k-1; i++) + { + for(j=0; j<=nfree-1; j++) + { + s->eq.ptr.pp_double[i][j] = s->tk2.ptr.pp_double[i][j]; + } + } + } + + /* + * Calculate ECCM + */ + if( ((((s->isactivesetchanged||s->ismaintermchanged)||s->issecondarytermchanged)&&s->k>0)&&ae_fp_greater(s->theta,0))&&nfree>0 ) + { + + /* + * Calculate ECCM - Cholesky factor of the "effective" capacitance + * matrix CM = I + EQ*inv(EffectiveA)*EQ'. + * + * We calculate CM as follows: + * CM = I + EQ*inv(EffectiveA)*EQ' + * = I + EQ*ECA^(-1)*ECA^(-T)*EQ' + * = I + (EQ*ECA^(-1))*(EQ*ECA^(-1))' + * + * Then we perform Cholesky decomposition of CM. + */ + rmatrixsetlengthatleast(&s->tmp2, k, n, _state); + rmatrixcopy(k, nfree, &s->eq, 0, 0, &s->tmp2, 0, 0, _state); + ae_assert(s->ecakind==0||s->ecakind==1, "CQMRebuild: unexpected ECAKind", _state); + if( s->ecakind==0 ) + { + rmatrixrighttrsm(k, nfree, &s->ecadense, 0, 0, ae_true, ae_false, 0, &s->tmp2, 0, 0, _state); + } + if( s->ecakind==1 ) + { + for(i=0; i<=k-1; i++) + { + for(j=0; j<=nfree-1; j++) + { + s->tmp2.ptr.pp_double[i][j] = s->tmp2.ptr.pp_double[i][j]/s->ecadiag.ptr.p_double[j]; + } + } + } + for(i=0; i<=k-1; i++) + { + for(j=0; j<=k-1; j++) + { + s->eccm.ptr.pp_double[i][j] = 0.0; + } + s->eccm.ptr.pp_double[i][i] = 1.0; + } + rmatrixsyrk(k, nfree, 1.0, &s->tmp2, 0, 0, 0, 1.0, &s->eccm, 0, 0, ae_true, _state); + if( !spdmatrixcholeskyrec(&s->eccm, 0, k, ae_true, &s->tmp0, _state) ) + { + result = ae_false; + return result; + } + } + + /* + * Compose EB and EC + * + * NOTE: because these quantities are cheap to compute, we do not + * use caching here. + */ + for(i=0; i<=nfree-1; i++) + { + s->eb.ptr.p_double[i] = s->tq1.ptr.p_double[i]+s->tk1.ptr.p_double[i]+s->tb.ptr.p_double[i]; + } + s->ec = s->tq0+s->tk0; + for(i=nfree; i<=n-1; i++) + { + s->ec = s->ec+s->tb.ptr.p_double[i]*s->txc.ptr.p_double[i]; + } + + /* + * Change cache status - everything is cached + */ + s->ismaintermchanged = ae_false; + s->issecondarytermchanged = ae_false; + s->islineartermchanged = ae_false; + s->isactivesetchanged = ae_false; + return result; +} + + +/************************************************************************* +Internal function, solves system Effective_A*x = b. +It should be called after successful completion of CQMRebuild(). + +INPUT PARAMETERS: + S - quadratic model, after call to CQMRebuild() + X - right part B, array[S.NFree] + Tmp - temporary array, automatically reallocated if needed + +OUTPUT PARAMETERS: + X - solution, array[S.NFree] + +NOTE: when called with zero S.NFree, returns silently +NOTE: this function assumes that EA is non-degenerate + + -- ALGLIB -- + Copyright 10.05.2011 by Bochkanov Sergey +*************************************************************************/ +static void cqmodels_cqmsolveea(convexquadraticmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert((s->ecakind==0||s->ecakind==1)||(s->ecakind==-1&&s->nfree==0), "CQMSolveEA: unexpected ECAKind", _state); + if( s->ecakind==0 ) + { + + /* + * Dense ECA, use FBLSCholeskySolve() dense solver. + */ + fblscholeskysolve(&s->ecadense, 1.0, s->nfree, ae_true, x, tmp, _state); + } + if( s->ecakind==1 ) + { + + /* + * Diagonal ECA + */ + for(i=0; i<=s->nfree-1; i++) + { + x->ptr.p_double[i] = x->ptr.p_double[i]/ae_sqr(s->ecadiag.ptr.p_double[i], _state); + } + } +} + + +ae_bool _convexquadraticmodel_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + convexquadraticmodel *p = (convexquadraticmodel*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->a, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->q, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->r, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xc, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->activeset, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tq2dense, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tk2, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tq2diag, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tq1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tk1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->txc, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tb, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->ecadense, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->eq, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->eccm, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ecadiag, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->eb, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpg, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tmp2, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _convexquadraticmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + convexquadraticmodel *dst = (convexquadraticmodel*)_dst; + convexquadraticmodel *src = (convexquadraticmodel*)_src; + dst->n = src->n; + dst->k = src->k; + dst->alpha = src->alpha; + dst->tau = src->tau; + dst->theta = src->theta; + if( !ae_matrix_init_copy(&dst->a, &src->a, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->q, &src->q, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->r, &src->r, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xc, &src->xc, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->activeset, &src->activeset, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tq2dense, &src->tq2dense, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tk2, &src->tk2, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tq2diag, &src->tq2diag, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tq1, &src->tq1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tk1, &src->tk1, _state, make_automatic) ) + return ae_false; + dst->tq0 = src->tq0; + dst->tk0 = src->tk0; + if( !ae_vector_init_copy(&dst->txc, &src->txc, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tb, &src->tb, _state, make_automatic) ) + return ae_false; + dst->nfree = src->nfree; + dst->ecakind = src->ecakind; + if( !ae_matrix_init_copy(&dst->ecadense, &src->ecadense, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->eq, &src->eq, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->eccm, &src->eccm, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->ecadiag, &src->ecadiag, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->eb, &src->eb, _state, make_automatic) ) + return ae_false; + dst->ec = src->ec; + if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmp1, &src->tmp1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpg, &src->tmpg, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tmp2, &src->tmp2, _state, make_automatic) ) + return ae_false; + dst->ismaintermchanged = src->ismaintermchanged; + dst->issecondarytermchanged = src->issecondarytermchanged; + dst->islineartermchanged = src->islineartermchanged; + dst->isactivesetchanged = src->isactivesetchanged; + return ae_true; +} + + +void _convexquadraticmodel_clear(void* _p) +{ + convexquadraticmodel *p = (convexquadraticmodel*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->a); + ae_matrix_clear(&p->q); + ae_vector_clear(&p->b); + ae_vector_clear(&p->r); + ae_vector_clear(&p->xc); + ae_vector_clear(&p->d); + ae_vector_clear(&p->activeset); + ae_matrix_clear(&p->tq2dense); + ae_matrix_clear(&p->tk2); + ae_vector_clear(&p->tq2diag); + ae_vector_clear(&p->tq1); + ae_vector_clear(&p->tk1); + ae_vector_clear(&p->txc); + ae_vector_clear(&p->tb); + ae_matrix_clear(&p->ecadense); + ae_matrix_clear(&p->eq); + ae_matrix_clear(&p->eccm); + ae_vector_clear(&p->ecadiag); + ae_vector_clear(&p->eb); + ae_vector_clear(&p->tmp0); + ae_vector_clear(&p->tmp1); + ae_vector_clear(&p->tmpg); + ae_matrix_clear(&p->tmp2); +} + + +void _convexquadraticmodel_destroy(void* _p) +{ + convexquadraticmodel *p = (convexquadraticmodel*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->a); + ae_matrix_destroy(&p->q); + ae_vector_destroy(&p->b); + ae_vector_destroy(&p->r); + ae_vector_destroy(&p->xc); + ae_vector_destroy(&p->d); + ae_vector_destroy(&p->activeset); + ae_matrix_destroy(&p->tq2dense); + ae_matrix_destroy(&p->tk2); + ae_vector_destroy(&p->tq2diag); + ae_vector_destroy(&p->tq1); + ae_vector_destroy(&p->tk1); + ae_vector_destroy(&p->txc); + ae_vector_destroy(&p->tb); + ae_matrix_destroy(&p->ecadense); + ae_matrix_destroy(&p->eq); + ae_matrix_destroy(&p->eccm); + ae_vector_destroy(&p->ecadiag); + ae_vector_destroy(&p->eb); + ae_vector_destroy(&p->tmp0); + ae_vector_destroy(&p->tmp1); + ae_vector_destroy(&p->tmpg); + ae_matrix_destroy(&p->tmp2); +} + + + + +/************************************************************************* +This subroutine is used to initialize SNNLS solver. + +By default, empty NNLS problem is produced, but we allocated enough space +to store problems with NSMax+NDMax columns and NRMax rows. It is good +place to provide algorithm with initial estimate of the space requirements, +although you may underestimate problem size or even pass zero estimates - +in this case buffer variables will be resized automatically when you set +NNLS problem. + +Previously allocated buffer variables are reused as much as possible. This +function does not clear structure completely, it tries to preserve as much +dynamically allocated memory as possible. + + -- ALGLIB -- + Copyright 10.10.2012 by Bochkanov Sergey +*************************************************************************/ +void snnlsinit(ae_int_t nsmax, + ae_int_t ndmax, + ae_int_t nrmax, + snnlssolver* s, + ae_state *_state) +{ + + + s->ns = 0; + s->nd = 0; + s->nr = 0; + rmatrixsetlengthatleast(&s->densea, nrmax, ndmax, _state); + rmatrixsetlengthatleast(&s->tmpca, nrmax, ndmax, _state); + rmatrixsetlengthatleast(&s->tmpz, ndmax, ndmax, _state); + rvectorsetlengthatleast(&s->b, nrmax, _state); + bvectorsetlengthatleast(&s->nnc, nsmax+ndmax, _state); + s->debugflops = 0.0; + s->debugmaxnewton = 0; + s->refinementits = snnls_iterativerefinementits; +} + + +/************************************************************************* +This subroutine is used to set NNLS problem: + + ( [ 1 | ] [ ] [ ] )^2 + ( [ 1 | ] [ ] [ ] ) + min ( [ 1 | Ad ] * [ x ] - [ b ] ) s.t. x>=0 + ( [ | ] [ ] [ ] ) + ( [ | ] [ ] [ ] ) + +where: +* identity matrix has NS*NS size (NS<=NR, NS can be zero) +* dense matrix Ad has NR*ND size +* b is NR*1 vector +* x is (NS+ND)*1 vector +* all elements of x are non-negative (this constraint can be removed later + by calling SNNLSDropNNC() function) + +Previously allocated buffer variables are reused as much as possible. +After you set problem, you can solve it with SNNLSSolve(). + +INPUT PARAMETERS: + S - SNNLS solver, must be initialized with SNNLSInit() call + A - array[NR,ND], dense part of the system + B - array[NR], right part + NS - size of the sparse part of the system, 0<=NS<=NR + ND - size of the dense part of the system, ND>=0 + NR - rows count, NR>0 + +NOTE: + 1. You can have NS+ND=0, solver will correctly accept such combination + and return empty array as problem solution. + + -- ALGLIB -- + Copyright 10.10.2012 by Bochkanov Sergey +*************************************************************************/ +void snnlssetproblem(snnlssolver* s, + /* Real */ ae_matrix* a, + /* Real */ ae_vector* b, + ae_int_t ns, + ae_int_t nd, + ae_int_t nr, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(nd>=0, "SNNLSSetProblem: ND<0", _state); + ae_assert(ns>=0, "SNNLSSetProblem: NS<0", _state); + ae_assert(nr>0, "SNNLSSetProblem: NR<=0", _state); + ae_assert(ns<=nr, "SNNLSSetProblem: NS>NR", _state); + ae_assert(a->rows>=nr||nd==0, "SNNLSSetProblem: rows(A)cols>=nd, "SNNLSSetProblem: cols(A)cnt>=nr, "SNNLSSetProblem: length(B)ns = ns; + s->nd = nd; + s->nr = nr; + if( nd>0 ) + { + rmatrixsetlengthatleast(&s->densea, nr, nd, _state); + for(i=0; i<=nr-1; i++) + { + ae_v_move(&s->densea.ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,nd-1)); + } + } + rvectorsetlengthatleast(&s->b, nr, _state); + ae_v_move(&s->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,nr-1)); + bvectorsetlengthatleast(&s->nnc, ns+nd, _state); + for(i=0; i<=ns+nd-1; i++) + { + s->nnc.ptr.p_bool[i] = ae_true; + } +} + + +/************************************************************************* +This subroutine drops non-negativity constraint from the problem set by +SNNLSSetProblem() call. This function must be called AFTER problem is set, +because each SetProblem() call resets constraints to their default state +(all constraints are present). + +INPUT PARAMETERS: + S - SNNLS solver, must be initialized with SNNLSInit() call, + problem must be set with SNNLSSetProblem() call. + Idx - constraint index, 0<=IDX=0, "SNNLSDropNNC: Idx<0", _state); + ae_assert(idxns+s->nd, "SNNLSDropNNC: Idx>=NS+ND", _state); + s->nnc.ptr.p_bool[idx] = ae_false; +} + + +/************************************************************************* +This subroutine is used to solve NNLS problem. + +INPUT PARAMETERS: + S - SNNLS solver, must be initialized with SNNLSInit() call and + problem must be set up with SNNLSSetProblem() call. + X - possibly preallocated buffer, automatically resized if needed + +OUTPUT PARAMETERS: + X - array[NS+ND], solution + +NOTE: + 1. You can have NS+ND=0, solver will correctly accept such combination + and return empty array as problem solution. + + 2. Internal field S.DebugFLOPS contains rough estimate of FLOPs used + to solve problem. It can be used for debugging purposes. This field + is real-valued. + + -- ALGLIB -- + Copyright 10.10.2012 by Bochkanov Sergey +*************************************************************************/ +void snnlssolve(snnlssolver* s, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t ns; + ae_int_t nd; + ae_int_t nr; + ae_int_t nsc; + ae_int_t ndc; + ae_int_t newtoncnt; + ae_bool terminationneeded; + double eps; + double fcur; + double fprev; + double fcand; + double noiselevel; + double noisetolerance; + double stplen; + double d2; + double d1; + double d0; + ae_bool wasactivation; + ae_int_t rfsits; + double lambdav; + double v0; + double v1; + double v; + + + + /* + * Prepare + */ + ns = s->ns; + nd = s->nd; + nr = s->nr; + s->debugflops = 0.0; + + /* + * Handle special cases: + * * NS+ND=0 + * * ND=0 + */ + if( ns+nd==0 ) + { + return; + } + if( nd==0 ) + { + rvectorsetlengthatleast(x, ns, _state); + for(i=0; i<=ns-1; i++) + { + x->ptr.p_double[i] = s->b.ptr.p_double[i]; + if( s->nnc.ptr.p_bool[i] ) + { + x->ptr.p_double[i] = ae_maxreal(x->ptr.p_double[i], 0.0, _state); + } + } + return; + } + + /* + * Main cycle of BLEIC-SNNLS algorithm. + * Below we assume that ND>0. + */ + rvectorsetlengthatleast(x, ns+nd, _state); + rvectorsetlengthatleast(&s->xn, ns+nd, _state); + rvectorsetlengthatleast(&s->g, ns+nd, _state); + rvectorsetlengthatleast(&s->d, ns+nd, _state); + rvectorsetlengthatleast(&s->r, nr, _state); + rvectorsetlengthatleast(&s->diagaa, nd, _state); + rvectorsetlengthatleast(&s->dx, ns+nd, _state); + for(i=0; i<=ns+nd-1; i++) + { + x->ptr.p_double[i] = 0.0; + } + eps = 2*ae_machineepsilon; + noisetolerance = 10.0; + lambdav = 1.0E6*ae_machineepsilon; + newtoncnt = 0; + for(;;) + { + + /* + * Phase 1: perform steepest descent step. + * + * TerminationNeeded control variable is set on exit from this loop: + * * TerminationNeeded=False in case we have to proceed to Phase 2 (Newton step) + * * TerminationNeeded=True in case we found solution (step along projected gradient is small enough) + * + * Temporaries used: + * * R (I|A)*x-b + * + * NOTE 1. It is assumed that initial point X is feasible. This feasibility + * is retained during all iterations. + */ + terminationneeded = ae_false; + for(;;) + { + + /* + * Calculate gradient G and constrained descent direction D + */ + for(i=0; i<=nr-1; i++) + { + v = ae_v_dotproduct(&s->densea.ptr.pp_double[i][0], 1, &x->ptr.p_double[ns], 1, ae_v_len(0,nd-1)); + if( iptr.p_double[i]; + } + s->r.ptr.p_double[i] = v-s->b.ptr.p_double[i]; + } + for(i=0; i<=ns-1; i++) + { + s->g.ptr.p_double[i] = s->r.ptr.p_double[i]; + } + for(i=ns; i<=ns+nd-1; i++) + { + s->g.ptr.p_double[i] = 0.0; + } + for(i=0; i<=nr-1; i++) + { + v = s->r.ptr.p_double[i]; + ae_v_addd(&s->g.ptr.p_double[ns], 1, &s->densea.ptr.pp_double[i][0], 1, ae_v_len(ns,ns+nd-1), v); + } + for(i=0; i<=ns+nd-1; i++) + { + if( (s->nnc.ptr.p_bool[i]&&ae_fp_less_eq(x->ptr.p_double[i],0))&&ae_fp_greater(s->g.ptr.p_double[i],0) ) + { + s->d.ptr.p_double[i] = 0.0; + } + else + { + s->d.ptr.p_double[i] = -s->g.ptr.p_double[i]; + } + } + s->debugflops = s->debugflops+2*2*nr*nd; + + /* + * Build quadratic model of F along descent direction: + * F(x+alpha*d) = D2*alpha^2 + D1*alpha + D0 + * + * Estimate numerical noise in the X (noise level is used + * to classify step as singificant or insignificant). Noise + * comes from two sources: + * * noise when calculating rows of (I|A)*x + * * noise when calculating norm of residual + * + * In case function curvature is negative or product of descent + * direction and gradient is non-negative, iterations are terminated. + * + * NOTE: D0 is not actually used, but we prefer to maintain it. + */ + fprev = ae_v_dotproduct(&s->r.ptr.p_double[0], 1, &s->r.ptr.p_double[0], 1, ae_v_len(0,nr-1)); + fprev = fprev/2; + noiselevel = 0.0; + for(i=0; i<=nr-1; i++) + { + + /* + * Estimate noise introduced by I-th row of (I|A)*x + */ + v = 0.0; + if( iptr.p_double[i]; + } + for(j=0; j<=nd-1; j++) + { + v = ae_maxreal(v, eps*ae_fabs(s->densea.ptr.pp_double[i][j]*x->ptr.p_double[ns+j], _state), _state); + } + v = 2*ae_fabs(s->r.ptr.p_double[i]*v, _state)+v*v; + + /* + * Add to summary noise in the model + */ + noiselevel = noiselevel+v; + } + noiselevel = ae_maxreal(noiselevel, eps*fprev, _state); + d2 = 0.0; + for(i=0; i<=nr-1; i++) + { + v = ae_v_dotproduct(&s->densea.ptr.pp_double[i][0], 1, &s->d.ptr.p_double[ns], 1, ae_v_len(0,nd-1)); + if( id.ptr.p_double[i]; + } + d2 = d2+0.5*ae_sqr(v, _state); + } + v = ae_v_dotproduct(&s->d.ptr.p_double[0], 1, &s->g.ptr.p_double[0], 1, ae_v_len(0,ns+nd-1)); + d1 = v; + d0 = fprev; + if( ae_fp_less_eq(d2,0)||ae_fp_greater_eq(d1,0) ) + { + terminationneeded = ae_true; + break; + } + s->debugflops = s->debugflops+2*nr*nd; + touchreal(&d0, _state); + + /* + * Perform full (unconstrained) step with length StpLen in direction D. + * + * We can terminate iterations in case one of two criteria is met: + * 1. function change is dominated by noise (or function actually increased + * instead of decreasing) + * 2. relative change in X is small enough + * + * First condition is not enough to guarantee algorithm termination because + * sometimes our noise estimate is too optimistic (say, in situations when + * function value at solition is zero). + */ + stplen = -d1/(2*d2); + ae_v_move(&s->xn.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,ns+nd-1)); + ae_v_addd(&s->xn.ptr.p_double[0], 1, &s->d.ptr.p_double[0], 1, ae_v_len(0,ns+nd-1), stplen); + fcand = 0.0; + for(i=0; i<=nr-1; i++) + { + v = ae_v_dotproduct(&s->densea.ptr.pp_double[i][0], 1, &s->xn.ptr.p_double[ns], 1, ae_v_len(0,nd-1)); + if( ixn.ptr.p_double[i]; + } + fcand = fcand+0.5*ae_sqr(v-s->b.ptr.p_double[i], _state); + } + s->debugflops = s->debugflops+2*nr*nd; + if( ae_fp_greater_eq(fcand,fprev-noiselevel*noisetolerance) ) + { + terminationneeded = ae_true; + break; + } + v = 0; + for(i=0; i<=ns+nd-1; i++) + { + v0 = ae_fabs(x->ptr.p_double[i], _state); + v1 = ae_fabs(s->xn.ptr.p_double[i], _state); + if( ae_fp_neq(v0,0)||ae_fp_neq(v1,0) ) + { + v = ae_maxreal(v, ae_fabs(x->ptr.p_double[i]-s->xn.ptr.p_double[i], _state)/ae_maxreal(v0, v1, _state), _state); + } + } + if( ae_fp_less_eq(v,eps*noisetolerance) ) + { + terminationneeded = ae_true; + break; + } + + /* + * Perform step one more time, now with non-negativity constraints. + * + * NOTE: complicated code below which deals with VarIdx temporary makes + * sure that in case unconstrained step leads us outside of feasible + * area, we activate at least one constraint. + */ + wasactivation = snnls_boundedstepandactivation(x, &s->xn, &s->nnc, ns+nd, _state); + fcur = 0.0; + for(i=0; i<=nr-1; i++) + { + v = ae_v_dotproduct(&s->densea.ptr.pp_double[i][0], 1, &x->ptr.p_double[ns], 1, ae_v_len(0,nd-1)); + if( iptr.p_double[i]; + } + fcur = fcur+0.5*ae_sqr(v-s->b.ptr.p_double[i], _state); + } + s->debugflops = s->debugflops+2*nr*nd; + + /* + * Depending on results, decide what to do: + * 1. In case step was performed without activation of constraints, + * we proceed to Newton method + * 2. In case there was activated at least one constraint, we repeat + * steepest descent step. + */ + if( !wasactivation ) + { + + /* + * Step without activation, proceed to Newton + */ + break; + } + } + if( terminationneeded ) + { + break; + } + + /* + * Phase 2: Newton method. + */ + rvectorsetlengthatleast(&s->cx, ns+nd, _state); + ivectorsetlengthatleast(&s->columnmap, ns+nd, _state); + ivectorsetlengthatleast(&s->rowmap, nr, _state); + rmatrixsetlengthatleast(&s->tmpca, nr, nd, _state); + rmatrixsetlengthatleast(&s->tmpz, nd, nd, _state); + rvectorsetlengthatleast(&s->cborg, nr, _state); + rvectorsetlengthatleast(&s->cb, nr, _state); + terminationneeded = ae_false; + for(;;) + { + + /* + * Prepare equality constrained subproblem with NSC<=NS "sparse" + * variables and NDC<=ND "dense" variables. + * + * First, we reorder variables (columns) and move all unconstrained + * variables "to the left", ColumnMap stores this permutation. + * + * Then, we reorder first NS rows of A and first NS elements of B in + * such way that we still have identity matrix in first NSC columns + * of problem. This permutation is stored in RowMap. + */ + nsc = 0; + ndc = 0; + for(i=0; i<=ns-1; i++) + { + if( !(s->nnc.ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],0)) ) + { + s->columnmap.ptr.p_int[nsc] = i; + nsc = nsc+1; + } + } + for(i=ns; i<=ns+nd-1; i++) + { + if( !(s->nnc.ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],0)) ) + { + s->columnmap.ptr.p_int[nsc+ndc] = i; + ndc = ndc+1; + } + } + for(i=0; i<=nsc-1; i++) + { + s->rowmap.ptr.p_int[i] = s->columnmap.ptr.p_int[i]; + } + j = nsc; + for(i=0; i<=ns-1; i++) + { + if( s->nnc.ptr.p_bool[i]&&ae_fp_eq(x->ptr.p_double[i],0) ) + { + s->rowmap.ptr.p_int[j] = i; + j = j+1; + } + } + for(i=ns; i<=nr-1; i++) + { + s->rowmap.ptr.p_int[i] = i; + } + + /* + * Now, permutations are ready, and we can copy/reorder + * A, B and X to CA, CB and CX. + */ + for(i=0; i<=nsc+ndc-1; i++) + { + s->cx.ptr.p_double[i] = x->ptr.p_double[s->columnmap.ptr.p_int[i]]; + } + for(i=0; i<=nr-1; i++) + { + for(j=0; j<=ndc-1; j++) + { + s->tmpca.ptr.pp_double[i][j] = s->densea.ptr.pp_double[s->rowmap.ptr.p_int[i]][s->columnmap.ptr.p_int[nsc+j]-ns]; + } + s->cb.ptr.p_double[i] = s->b.ptr.p_double[s->rowmap.ptr.p_int[i]]; + } + + /* + * Solve equality constrained subproblem. + */ + if( ndc>0 ) + { + + /* + * NDC>0. + * + * Solve subproblem using Newton-type algorithm. We have a + * NR*(NSC+NDC) linear least squares subproblem + * + * | ( I AU ) ( XU ) ( BU ) |^2 + * min | ( ) * ( ) - ( ) | + * | ( 0 AL ) ( XL ) ( BL ) | + * + * where: + * * I is a NSC*NSC identity matrix + * * AU is NSC*NDC dense matrix (first NSC rows of CA) + * * AL is (NR-NSC)*NDC dense matrix (next NR-NSC rows of CA) + * * BU and BL are correspondingly sized parts of CB + * + * After conversion to normal equations and small regularization, + * we get: + * + * ( I AU ) ( XU ) ( BU ) + * ( )*( ) = ( ) + * ( AU' Y ) ( XL ) ( AU'*BU+AL'*BL ) + * + * where Y = AU'*AU + AL'*AL + lambda*diag(AU'*AU+AL'*AL). + * + * With Schur Complement Method this system can be solved in + * O(NR*NDC^2+NDC^3) operations. In order to solve it we multiply + * first row by AU' and subtract it from the second one. As result, + * we get system + * + * Z*XL = AL'*BL, where Z=AL'*AL+lambda*diag(AU'*AU+AL'*AL) + * + * We can easily solve it for XL, and we can get XU as XU = BU-AU*XL. + * + * We will start solution from calculating Cholesky decomposition of Z. + */ + for(i=0; i<=nr-1; i++) + { + s->cborg.ptr.p_double[i] = s->cb.ptr.p_double[i]; + } + for(i=0; i<=ndc-1; i++) + { + s->diagaa.ptr.p_double[i] = 0; + } + for(i=0; i<=nr-1; i++) + { + for(j=0; j<=ndc-1; j++) + { + s->diagaa.ptr.p_double[j] = s->diagaa.ptr.p_double[j]+ae_sqr(s->tmpca.ptr.pp_double[i][j], _state); + } + } + for(j=0; j<=ndc-1; j++) + { + if( ae_fp_eq(s->diagaa.ptr.p_double[j],0) ) + { + s->diagaa.ptr.p_double[j] = 1; + } + } + for(;;) + { + + /* + * NOTE: we try to factorize Z. In case of failure we increase + * regularization parameter and try again. + */ + s->debugflops = s->debugflops+2*(nr-nsc)*ae_sqr(ndc, _state)+ae_pow(ndc, 3, _state)/3; + for(i=0; i<=ndc-1; i++) + { + for(j=0; j<=ndc-1; j++) + { + s->tmpz.ptr.pp_double[i][j] = 0.0; + } + } + rmatrixsyrk(ndc, nr-nsc, 1.0, &s->tmpca, nsc, 0, 2, 0.0, &s->tmpz, 0, 0, ae_true, _state); + for(i=0; i<=ndc-1; i++) + { + s->tmpz.ptr.pp_double[i][i] = s->tmpz.ptr.pp_double[i][i]+lambdav*s->diagaa.ptr.p_double[i]; + } + if( spdmatrixcholeskyrec(&s->tmpz, 0, ndc, ae_true, &s->tmpcholesky, _state) ) + { + break; + } + lambdav = lambdav*10; + } + + /* + * We have Cholesky decomposition of Z, now we can solve system: + * * we start from initial point CX + * * we perform several iterations of refinement: + * * BU_new := BU_orig - XU_cur - AU*XL_cur + * * BL_new := BL_orig - AL*XL_cur + * * solve for BU_new/BL_new, obtain solution dx + * * XU_cur := XU_cur + dx_u + * * XL_cur := XL_cur + dx_l + * * BU_new/BL_new are stored in CB, original right part is + * stored in CBOrg, correction to X is stored in DX, current + * X is stored in CX + */ + for(rfsits=1; rfsits<=s->refinementits; rfsits++) + { + for(i=0; i<=nr-1; i++) + { + v = ae_v_dotproduct(&s->tmpca.ptr.pp_double[i][0], 1, &s->cx.ptr.p_double[nsc], 1, ae_v_len(0,ndc-1)); + s->cb.ptr.p_double[i] = s->cborg.ptr.p_double[i]-v; + if( icb.ptr.p_double[i] = s->cb.ptr.p_double[i]-s->cx.ptr.p_double[i]; + } + } + s->debugflops = s->debugflops+2*nr*ndc; + for(i=0; i<=ndc-1; i++) + { + s->dx.ptr.p_double[i] = 0.0; + } + for(i=nsc; i<=nr-1; i++) + { + v = s->cb.ptr.p_double[i]; + ae_v_addd(&s->dx.ptr.p_double[0], 1, &s->tmpca.ptr.pp_double[i][0], 1, ae_v_len(0,ndc-1), v); + } + fblscholeskysolve(&s->tmpz, 1.0, ndc, ae_true, &s->dx, &s->tmpcholesky, _state); + s->debugflops = s->debugflops+2*ndc*ndc; + ae_v_add(&s->cx.ptr.p_double[nsc], 1, &s->dx.ptr.p_double[0], 1, ae_v_len(nsc,nsc+ndc-1)); + for(i=0; i<=nsc-1; i++) + { + v = ae_v_dotproduct(&s->tmpca.ptr.pp_double[i][0], 1, &s->dx.ptr.p_double[0], 1, ae_v_len(0,ndc-1)); + s->cx.ptr.p_double[i] = s->cx.ptr.p_double[i]+s->cb.ptr.p_double[i]-v; + } + s->debugflops = s->debugflops+2*nsc*ndc; + } + } + else + { + + /* + * NDC=0. + * + * We have a NR*NSC linear least squares subproblem + * + * min |XU-BU|^2 + * + * solution is easy to find - it is XU=BU! + */ + for(i=0; i<=nsc-1; i++) + { + s->cx.ptr.p_double[i] = s->cb.ptr.p_double[i]; + } + } + for(i=0; i<=ns+nd-1; i++) + { + s->xn.ptr.p_double[i] = x->ptr.p_double[i]; + } + for(i=0; i<=nsc+ndc-1; i++) + { + s->xn.ptr.p_double[s->columnmap.ptr.p_int[i]] = s->cx.ptr.p_double[i]; + } + newtoncnt = newtoncnt+1; + + /* + * Step to candidate point. + * If no constraints was added, accept candidate point XN and move to next phase. + * Terminate, if number of Newton iterations exceeded DebugMaxNewton counter. + */ + terminationneeded = s->debugmaxnewton>0&&newtoncnt>=s->debugmaxnewton; + if( !snnls_boundedstepandactivation(x, &s->xn, &s->nnc, ns+nd, _state) ) + { + break; + } + if( terminationneeded ) + { + break; + } + } + if( terminationneeded ) + { + break; + } + } +} + + +/************************************************************************* +Having feasible current point XC and possibly infeasible candidate point +XN, this function performs longest step from XC to XN which retains +feasibility. In case XN is found to be infeasible, at least one constraint +is activated. + +For example, if we have: + XC=0.5 + XN=-1.2 + x>=0 +then this function will move us to X=0 and activate constraint "x>=0". + +INPUT PARAMETERS: + XC - current point, must be feasible with respect to + all constraints + XN - candidate point, can be infeasible with respect to some + constraints + NNC - NNC[i] is True when I-th variable is non-negatively + constrained + N - variable count + +OUTPUT PARAMETERS: + XC - new position + +RESULT: + True in case at least one constraint was activated by step + + -- ALGLIB -- + Copyright 19.10.2012 by Bochkanov Sergey +*************************************************************************/ +static ae_bool snnls_boundedstepandactivation(/* Real */ ae_vector* xc, + /* Real */ ae_vector* xn, + /* Boolean */ ae_vector* nnc, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + ae_int_t varidx; + double vmax; + double v; + double stplen; + ae_bool result; + + + + /* + * Check constraints. + * + * NOTE: it is important to test for XN[i]ptr.p_bool[i]&&ae_fp_less(xn->ptr.p_double[i],xc->ptr.p_double[i]))&&ae_fp_less_eq(xn->ptr.p_double[i],0.0) ) + { + v = vmax; + vmax = safeminposrv(xc->ptr.p_double[i], xc->ptr.p_double[i]-xn->ptr.p_double[i], vmax, _state); + if( ae_fp_less(vmax,v) ) + { + varidx = i; + } + } + } + stplen = ae_minreal(vmax, 1.0, _state); + + /* + * Perform step with activation. + * + * NOTE: it is important to use (1-StpLen)*XC + StpLen*XN because + * it allows us to step exactly to XN when StpLen=1, even in + * the presence of numerical errors. + */ + for(i=0; i<=n-1; i++) + { + xc->ptr.p_double[i] = (1-stplen)*xc->ptr.p_double[i]+stplen*xn->ptr.p_double[i]; + } + if( varidx>=0 ) + { + xc->ptr.p_double[varidx] = 0.0; + result = ae_true; + } + for(i=0; i<=n-1; i++) + { + if( nnc->ptr.p_bool[i]&&ae_fp_less(xc->ptr.p_double[i],0.0) ) + { + xc->ptr.p_double[i] = 0.0; + result = ae_true; + } + } + return result; +} + + +ae_bool _snnlssolver_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + snnlssolver *p = (snnlssolver*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->densea, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->nnc, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tmpz, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tmpca, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->dx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->diagaa, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cb, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cborg, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->columnmap, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rowmap, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpcholesky, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->r, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _snnlssolver_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + snnlssolver *dst = (snnlssolver*)_dst; + snnlssolver *src = (snnlssolver*)_src; + dst->ns = src->ns; + dst->nd = src->nd; + dst->nr = src->nr; + if( !ae_matrix_init_copy(&dst->densea, &src->densea, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->nnc, &src->nnc, _state, make_automatic) ) + return ae_false; + dst->refinementits = src->refinementits; + dst->debugflops = src->debugflops; + dst->debugmaxnewton = src->debugmaxnewton; + if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tmpz, &src->tmpz, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tmpca, &src->tmpca, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->dx, &src->dx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->diagaa, &src->diagaa, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->cb, &src->cb, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->cx, &src->cx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->cborg, &src->cborg, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->columnmap, &src->columnmap, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rowmap, &src->rowmap, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpcholesky, &src->tmpcholesky, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->r, &src->r, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _snnlssolver_clear(void* _p) +{ + snnlssolver *p = (snnlssolver*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->densea); + ae_vector_clear(&p->b); + ae_vector_clear(&p->nnc); + ae_vector_clear(&p->xn); + ae_matrix_clear(&p->tmpz); + ae_matrix_clear(&p->tmpca); + ae_vector_clear(&p->g); + ae_vector_clear(&p->d); + ae_vector_clear(&p->dx); + ae_vector_clear(&p->diagaa); + ae_vector_clear(&p->cb); + ae_vector_clear(&p->cx); + ae_vector_clear(&p->cborg); + ae_vector_clear(&p->columnmap); + ae_vector_clear(&p->rowmap); + ae_vector_clear(&p->tmpcholesky); + ae_vector_clear(&p->r); +} + + +void _snnlssolver_destroy(void* _p) +{ + snnlssolver *p = (snnlssolver*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->densea); + ae_vector_destroy(&p->b); + ae_vector_destroy(&p->nnc); + ae_vector_destroy(&p->xn); + ae_matrix_destroy(&p->tmpz); + ae_matrix_destroy(&p->tmpca); + ae_vector_destroy(&p->g); + ae_vector_destroy(&p->d); + ae_vector_destroy(&p->dx); + ae_vector_destroy(&p->diagaa); + ae_vector_destroy(&p->cb); + ae_vector_destroy(&p->cx); + ae_vector_destroy(&p->cborg); + ae_vector_destroy(&p->columnmap); + ae_vector_destroy(&p->rowmap); + ae_vector_destroy(&p->tmpcholesky); + ae_vector_destroy(&p->r); +} + + + + +/************************************************************************* +This subroutine is used to initialize active set. By default, empty +N-variable model with no constraints is generated. Previously allocated +buffer variables are reused as much as possible. + +Two use cases for this object are described below. + +CASE 1 - STEEPEST DESCENT: + + SASInit() + repeat: + SASReactivateConstraints() + SASDescentDirection() + SASExploreDirection() + SASMoveTo() + until convergence + +CASE 1 - PRECONDITIONED STEEPEST DESCENT: + + SASInit() + repeat: + SASReactivateConstraintsPrec() + SASDescentDirectionPrec() + SASExploreDirection() + SASMoveTo() + until convergence + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sasinit(ae_int_t n, sactiveset* s, ae_state *_state) +{ + ae_int_t i; + + + s->n = n; + s->algostate = 0; + + /* + * Constraints + */ + s->constraintschanged = ae_true; + s->nec = 0; + s->nic = 0; + rvectorsetlengthatleast(&s->bndl, n, _state); + bvectorsetlengthatleast(&s->hasbndl, n, _state); + rvectorsetlengthatleast(&s->bndu, n, _state); + bvectorsetlengthatleast(&s->hasbndu, n, _state); + for(i=0; i<=n-1; i++) + { + s->bndl.ptr.p_double[i] = _state->v_neginf; + s->bndu.ptr.p_double[i] = _state->v_posinf; + s->hasbndl.ptr.p_bool[i] = ae_false; + s->hasbndu.ptr.p_bool[i] = ae_false; + } + + /* + * current point, scale + */ + s->hasxc = ae_false; + rvectorsetlengthatleast(&s->xc, n, _state); + rvectorsetlengthatleast(&s->s, n, _state); + rvectorsetlengthatleast(&s->h, n, _state); + for(i=0; i<=n-1; i++) + { + s->xc.ptr.p_double[i] = 0.0; + s->s.ptr.p_double[i] = 1.0; + s->h.ptr.p_double[i] = 1.0; + } + + /* + * Other + */ + rvectorsetlengthatleast(&s->unitdiagonal, n, _state); + for(i=0; i<=n-1; i++) + { + s->unitdiagonal.ptr.p_double[i] = 1.0; + } +} + + +/************************************************************************* +This function sets scaling coefficients for SAS object. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +During orthogonalization phase, scale is used to calculate drop tolerances +(whether vector is significantly non-zero or not). + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sassetscale(sactiveset* state, + /* Real */ ae_vector* s, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(state->algostate==0, "SASSetScale: you may change scale only in modification mode", _state); + ae_assert(s->cnt>=state->n, "SASSetScale: Length(S)n-1; i++) + { + ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "SASSetScale: S contains infinite or NAN elements", _state); + ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "SASSetScale: S contains zero elements", _state); + } + for(i=0; i<=state->n-1; i++) + { + state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE 1: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 2: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sassetprecdiag(sactiveset* state, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(state->algostate==0, "SASSetPrecDiag: you may change preconditioner only in modification mode", _state); + ae_assert(d->cnt>=state->n, "SASSetPrecDiag: D is too short", _state); + for(i=0; i<=state->n-1; i++) + { + ae_assert(ae_isfinite(d->ptr.p_double[i], _state), "SASSetPrecDiag: D contains infinite or NAN elements", _state); + ae_assert(ae_fp_greater(d->ptr.p_double[i],0), "SASSetPrecDiag: D contains non-positive elements", _state); + } + for(i=0; i<=state->n-1; i++) + { + state->h.ptr.p_double[i] = d->ptr.p_double[i]; + } +} + + +/************************************************************************* +This function sets/changes boundary constraints. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF. + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF. + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sassetbc(sactiveset* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n; + + + ae_assert(state->algostate==0, "SASSetBC: you may change constraints only in modification mode", _state); + n = state->n; + ae_assert(bndl->cnt>=n, "SASSetBC: Length(BndL)cnt>=n, "SASSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "SASSetBC: BndL contains NAN or +INF", _state); + ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "SASSetBC: BndL contains NAN or -INF", _state); + state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; + state->hasbndl.ptr.p_bool[i] = ae_isfinite(bndl->ptr.p_double[i], _state); + state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; + state->hasbndu.ptr.p_bool[i] = ae_isfinite(bndu->ptr.p_double[i], _state); + } + state->constraintschanged = ae_true; +} + + +/************************************************************************* +This function sets linear constraints for SAS object. + +Linear constraints are inactive by default (after initial creation). + +INPUT PARAMETERS: + State - SAS structure + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0 + +NOTE 1: linear (non-bound) constraints are satisfied only approximately: +* there always exists some minor violation (about Epsilon in magnitude) + due to rounding errors +* numerical differentiation, if used, may lead to function evaluations + outside of the feasible area, because algorithm does NOT change + numerical differentiation formula according to linear constraints. +If you want constraints to be satisfied exactly, try to reformulate your +problem in such manner that all constraints will become boundary ones +(this kind of constraints is always satisfied exactly, both in the final +solution and in all intermediate points). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void sassetlc(sactiveset* state, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* ct, + ae_int_t k, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + + + ae_assert(state->algostate==0, "SASSetLC: you may change constraints only in modification mode", _state); + n = state->n; + + /* + * First, check for errors in the inputs + */ + ae_assert(k>=0, "SASSetLC: K<0", _state); + ae_assert(c->cols>=n+1||k==0, "SASSetLC: Cols(C)rows>=k, "SASSetLC: Rows(C)cnt>=k, "SASSetLC: Length(CT)nec = 0; + state->nic = 0; + state->constraintschanged = ae_true; + return; + } + + /* + * Equality constraints are stored first, in the upper + * NEC rows of State.CLEIC matrix. Inequality constraints + * are stored in the next NIC rows. + * + * NOTE: we convert inequality constraints to the form + * A*x<=b before copying them. + */ + rmatrixsetlengthatleast(&state->cleic, k, n+1, _state); + state->nec = 0; + state->nic = 0; + for(i=0; i<=k-1; i++) + { + if( ct->ptr.p_int[i]==0 ) + { + ae_v_move(&state->cleic.ptr.pp_double[state->nec][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + state->nec = state->nec+1; + } + } + for(i=0; i<=k-1; i++) + { + if( ct->ptr.p_int[i]!=0 ) + { + if( ct->ptr.p_int[i]>0 ) + { + ae_v_moveneg(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + } + else + { + ae_v_move(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + } + state->nic = state->nic+1; + } + } + + /* + * Mark state as changed + */ + state->constraintschanged = ae_true; +} + + +/************************************************************************* +Another variation of SASSetLC(), which accepts linear constraints using +another representation. + +Linear constraints are inactive by default (after initial creation). + +INPUT PARAMETERS: + State - SAS structure + CLEIC - linear constraints, array[NEC+NIC,N+1]. + Each row of C represents one constraint: + * first N elements correspond to coefficients, + * last element corresponds to the right part. + First NEC rows store equality constraints, next NIC - are + inequality ones. + All elements of C (including right part) must be finite. + NEC - number of equality constraints, NEC>=0 + NIC - number of inequality constraints, NIC>=0 + +NOTE 1: linear (non-bound) constraints are satisfied only approximately: +* there always exists some minor violation (about Epsilon in magnitude) + due to rounding errors +* numerical differentiation, if used, may lead to function evaluations + outside of the feasible area, because algorithm does NOT change + numerical differentiation formula according to linear constraints. +If you want constraints to be satisfied exactly, try to reformulate your +problem in such manner that all constraints will become boundary ones +(this kind of constraints is always satisfied exactly, both in the final +solution and in all intermediate points). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void sassetlcx(sactiveset* state, + /* Real */ ae_matrix* cleic, + ae_int_t nec, + ae_int_t nic, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + + + ae_assert(state->algostate==0, "SASSetLCX: you may change constraints only in modification mode", _state); + n = state->n; + + /* + * First, check for errors in the inputs + */ + ae_assert(nec>=0, "SASSetLCX: NEC<0", _state); + ae_assert(nic>=0, "SASSetLCX: NIC<0", _state); + ae_assert(cleic->cols>=n+1||nec+nic==0, "SASSetLCX: Cols(CLEIC)rows>=nec+nic, "SASSetLCX: Rows(CLEIC)cleic, nec+nic, n+1, _state); + state->nec = nec; + state->nic = nic; + for(i=0; i<=nec+nic-1; i++) + { + for(j=0; j<=n; j++) + { + state->cleic.ptr.pp_double[i][j] = cleic->ptr.pp_double[i][j]; + } + } + + /* + * Mark state as changed + */ + state->constraintschanged = ae_true; +} + + +/************************************************************************* +This subroutine turns on optimization mode: +1. feasibility in X is enforced (in case X=S.XC and constraints have not + changed, algorithm just uses X without any modifications at all) +2. constraints are marked as "candidate" or "inactive" + +INPUT PARAMETERS: + S - active set object + X - initial point (candidate), array[N]. It is expected that X + contains only finite values (we do not check it). + +OUTPUT PARAMETERS: + S - state is changed + X - initial point can be changed to enforce feasibility + +RESULT: + True in case feasible point was found (mode was changed to "optimization") + False in case no feasible point was found (mode was not changed) + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +ae_bool sasstartoptimization(sactiveset* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nec; + ae_int_t nic; + ae_int_t i; + ae_int_t j; + double v; + ae_bool result; + + + ae_assert(state->algostate==0, "SASStartOptimization: already in optimization mode", _state); + result = ae_false; + n = state->n; + nec = state->nec; + nic = state->nic; + + /* + * Enforce feasibility and calculate set of "candidate"/"active" constraints. + * Always active equality constraints are marked as "active", all other constraints + * are marked as "candidate". + */ + ivectorsetlengthatleast(&state->activeset, n+nec+nic, _state); + for(i=0; i<=n-1; i++) + { + if( state->hasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i] ) + { + if( ae_fp_greater(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + return result; + } + } + } + ae_v_move(&state->xc.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( state->nec+state->nic>0 ) + { + + /* + * General linear constraints are present; general code is used. + */ + rvectorsetlengthatleast(&state->tmp0, n, _state); + rvectorsetlengthatleast(&state->tmpfeas, n+state->nic, _state); + rmatrixsetlengthatleast(&state->tmpm0, state->nec+state->nic, n+state->nic+1, _state); + for(i=0; i<=state->nec+state->nic-1; i++) + { + ae_v_move(&state->tmpm0.ptr.pp_double[i][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + for(j=n; j<=n+state->nic-1; j++) + { + state->tmpm0.ptr.pp_double[i][j] = 0; + } + if( i>=state->nec ) + { + state->tmpm0.ptr.pp_double[i][n+i-state->nec] = 1.0; + } + state->tmpm0.ptr.pp_double[i][n+state->nic] = state->cleic.ptr.pp_double[i][n]; + } + ae_v_move(&state->tmpfeas.ptr.p_double[0], 1, &state->xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=state->nic-1; i++) + { + v = ae_v_dotproduct(&state->cleic.ptr.pp_double[i+state->nec][0], 1, &state->xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->tmpfeas.ptr.p_double[i+n] = ae_maxreal(state->cleic.ptr.pp_double[i+state->nec][n]-v, 0.0, _state); + } + if( !findfeasiblepoint(&state->tmpfeas, &state->bndl, &state->hasbndl, &state->bndu, &state->hasbndu, n, state->nic, &state->tmpm0, state->nec+state->nic, 1.0E-6, &i, &j, _state) ) + { + return result; + } + ae_v_move(&state->xc.ptr.p_double[0], 1, &state->tmpfeas.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + if( (state->hasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->activeset.ptr.p_int[i] = 1; + continue; + } + if( (state->hasbndl.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]))||(state->hasbndu.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i])) ) + { + state->activeset.ptr.p_int[i] = 0; + continue; + } + state->activeset.ptr.p_int[i] = -1; + } + for(i=0; i<=state->nec-1; i++) + { + state->activeset.ptr.p_int[n+i] = 1; + } + for(i=0; i<=state->nic-1; i++) + { + if( ae_fp_eq(state->tmpfeas.ptr.p_double[n+i],0) ) + { + state->activeset.ptr.p_int[n+state->nec+i] = 0; + } + else + { + state->activeset.ptr.p_int[n+state->nec+i] = -1; + } + } + } + else + { + + /* + * Only bound constraints are present, quick code can be used + */ + for(i=0; i<=n-1; i++) + { + state->activeset.ptr.p_int[i] = -1; + if( (state->hasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->activeset.ptr.p_int[i] = 1; + state->xc.ptr.p_double[i] = state->bndl.ptr.p_double[i]; + continue; + } + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]) ) + { + state->xc.ptr.p_double[i] = state->bndl.ptr.p_double[i]; + state->activeset.ptr.p_int[i] = 0; + continue; + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->xc.ptr.p_double[i] = state->bndu.ptr.p_double[i]; + state->activeset.ptr.p_int[i] = 0; + continue; + } + } + } + + /* + * Change state, allocate temporaries + */ + result = ae_true; + state->algostate = 1; + state->basisisready = ae_false; + state->hasxc = ae_true; + rmatrixsetlengthatleast(&state->pbasis, ae_minint(nec+nic, n, _state), n+1, _state); + rmatrixsetlengthatleast(&state->ibasis, ae_minint(nec+nic, n, _state), n+1, _state); + rmatrixsetlengthatleast(&state->sbasis, ae_minint(nec+nic, n, _state), n+1, _state); + return result; +} + + +/************************************************************************* +This function explores search direction and calculates bound for step as +well as information for activation of constraints. + +INPUT PARAMETERS: + State - SAS structure which stores current point and all other + active set related information + D - descent direction to explore + +OUTPUT PARAMETERS: + StpMax - upper limit on step length imposed by yet inactive + constraints. Can be zero in case some constraints + can be activated by zero step. Equal to some large + value in case step is unlimited. + CIdx - -1 for unlimited step, in [0,N+NEC+NIC) in case of + limited step. + VVal - value which is assigned to X[CIdx] during activation. + For CIdx<0 or CIdx>=N some dummy value is assigned to + this parameter. +*************************************************************************/ +void sasexploredirection(sactiveset* state, + /* Real */ ae_vector* d, + double* stpmax, + ae_int_t* cidx, + double* vval, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nec; + ae_int_t nic; + ae_int_t i; + double prevmax; + double vc; + double vd; + + *stpmax = 0; + *cidx = 0; + *vval = 0; + + ae_assert(state->algostate==1, "SASExploreDirection: is not in optimization mode", _state); + n = state->n; + nec = state->nec; + nic = state->nic; + *cidx = -1; + *vval = 0; + *stpmax = 1.0E50; + for(i=0; i<=n-1; i++) + { + if( state->activeset.ptr.p_int[i]<=0 ) + { + ae_assert(!state->hasbndl.ptr.p_bool[i]||ae_fp_greater_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]), "SASExploreDirection: internal error - infeasible X", _state); + ae_assert(!state->hasbndu.ptr.p_bool[i]||ae_fp_less_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]), "SASExploreDirection: internal error - infeasible X", _state); + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(d->ptr.p_double[i],0) ) + { + prevmax = *stpmax; + *stpmax = safeminposrv(state->xc.ptr.p_double[i]-state->bndl.ptr.p_double[i], -d->ptr.p_double[i], *stpmax, _state); + if( ae_fp_less(*stpmax,prevmax) ) + { + *cidx = i; + *vval = state->bndl.ptr.p_double[i]; + } + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(d->ptr.p_double[i],0) ) + { + prevmax = *stpmax; + *stpmax = safeminposrv(state->bndu.ptr.p_double[i]-state->xc.ptr.p_double[i], d->ptr.p_double[i], *stpmax, _state); + if( ae_fp_less(*stpmax,prevmax) ) + { + *cidx = i; + *vval = state->bndu.ptr.p_double[i]; + } + } + } + } + for(i=nec; i<=nec+nic-1; i++) + { + if( state->activeset.ptr.p_int[n+i]<=0 ) + { + vc = ae_v_dotproduct(&state->cleic.ptr.pp_double[i][0], 1, &state->xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + vc = vc-state->cleic.ptr.pp_double[i][n]; + vd = ae_v_dotproduct(&state->cleic.ptr.pp_double[i][0], 1, &d->ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_fp_less_eq(vd,0) ) + { + continue; + } + if( ae_fp_less(vc,0) ) + { + + /* + * XC is strictly feasible with respect to I-th constraint, + * we can perform non-zero step because there is non-zero distance + * between XC and bound. + */ + prevmax = *stpmax; + *stpmax = safeminposrv(-vc, vd, *stpmax, _state); + if( ae_fp_less(*stpmax,prevmax) ) + { + *cidx = n+i; + } + } + else + { + + /* + * XC is at the boundary (or slightly beyond it), and step vector + * points beyond the boundary. + * + * The only thing we can do is to perform zero step and activate + * I-th constraint. + */ + *stpmax = 0; + *cidx = n+i; + } + } + } +} + + +/************************************************************************* +This subroutine moves current point to XN, in the direction previously +explored with SASExploreDirection() function. + +Step may activate one constraint. It is assumed than XN is approximately +feasible (small error as large as several ulps is possible). Strict +feasibility with respect to bound constraints is enforced during +activation, feasibility with respect to general linear constraints is not +enforced. + +INPUT PARAMETERS: + S - active set object + XN - new point. + NeedAct - True in case one constraint needs activation + CIdx - index of constraint, in [0,N+NEC+NIC). + Ignored if NeedAct is false. + This value is calculated by SASExploreDirection(). + CVal - for CIdx in [0,N) this field stores value which is + assigned to XC[CIdx] during activation. CVal is ignored in + other cases. + This value is calculated by SASExploreDirection(). + +OUTPUT PARAMETERS: + S - current point and list of active constraints are changed. + +RESULT: + >0, in case at least one inactive non-candidate constraint was activated + =0, in case only "candidate" constraints were activated + <0, in case no constraints were activated by the step + +NOTE: in general case State.XC<>XN because activation of constraints may + slightly change current point (to enforce feasibility). + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +ae_int_t sasmoveto(sactiveset* state, + /* Real */ ae_vector* xn, + ae_bool needact, + ae_int_t cidx, + double cval, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nec; + ae_int_t nic; + ae_int_t i; + ae_bool wasactivation; + ae_int_t result; + + + ae_assert(state->algostate==1, "SASMoveTo: is not in optimization mode", _state); + n = state->n; + nec = state->nec; + nic = state->nic; + + /* + * Save previous state, update current point + */ + rvectorsetlengthatleast(&state->mtx, n, _state); + ivectorsetlengthatleast(&state->mtas, n+nec+nic, _state); + for(i=0; i<=n-1; i++) + { + state->mtx.ptr.p_double[i] = state->xc.ptr.p_double[i]; + state->xc.ptr.p_double[i] = xn->ptr.p_double[i]; + } + for(i=0; i<=n+nec+nic-1; i++) + { + state->mtas.ptr.p_int[i] = state->activeset.ptr.p_int[i]; + } + + /* + * Activate constraints + */ + wasactivation = ae_false; + if( needact ) + { + + /* + * Activation + */ + ae_assert(cidx>=0&&cidxxc.ptr.p_double[cidx] = cval; + } + state->activeset.ptr.p_int[cidx] = 1; + wasactivation = ae_true; + } + for(i=0; i<=n-1; i++) + { + + /* + * Post-check (some constraints may be activated because of numerical errors) + */ + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]) ) + { + state->xc.ptr.p_double[i] = state->bndl.ptr.p_double[i]; + state->activeset.ptr.p_int[i] = 1; + wasactivation = ae_true; + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->xc.ptr.p_double[i] = state->bndu.ptr.p_double[i]; + state->activeset.ptr.p_int[i] = 1; + wasactivation = ae_true; + } + } + + /* + * Determine return status: + * * -1 in case no constraints were activated + * * 0 in case only "candidate" constraints were activated + * * +1 in case at least one "non-candidate" constraint was activated + */ + if( wasactivation ) + { + + /* + * Step activated one/several constraints, but sometimes it is spurious + * activation - RecalculateConstraints() tells us that constraint is + * inactive (negative Largrange multiplier), but step activates it + * because of numerical noise. + * + * This block of code checks whether step activated truly new constraints + * (ones which were not in the active set at the solution): + * + * * for non-boundary constraint it is enough to check that previous value + * of ActiveSet[i] is negative (=far from boundary), and new one is + * positive (=we are at the boundary, constraint is activated). + * + * * for boundary constraints previous criterion won't work. Each variable + * has two constraints, and simply checking their status is not enough - + * we have to correctly identify cases when we leave one boundary + * (PrevActiveSet[i]=0) and move to another boundary (ActiveSet[i]>0). + * Such cases can be identified if we compare previous X with new X. + * + * In case only "candidate" constraints were activated, result variable + * is set to 0. In case at least one new constraint was activated, result + * is set to 1. + */ + result = 0; + for(i=0; i<=n-1; i++) + { + if( state->activeset.ptr.p_int[i]>0&&ae_fp_neq(state->xc.ptr.p_double[i],state->mtx.ptr.p_double[i]) ) + { + result = 1; + } + } + for(i=n; i<=n+state->nec+state->nic-1; i++) + { + if( state->mtas.ptr.p_int[i]<0&&state->activeset.ptr.p_int[i]>0 ) + { + result = 1; + } + } + } + else + { + + /* + * No activation, return -1 + */ + result = -1; + } + + /* + * Invalidate basis + */ + state->basisisready = ae_false; + return result; +} + + +/************************************************************************* +This subroutine performs immediate activation of one constraint: +* "immediate" means that we do not have to move to activate it +* in case boundary constraint is activated, we enforce current point to be + exactly at the boundary + +INPUT PARAMETERS: + S - active set object + CIdx - index of constraint, in [0,N+NEC+NIC). + This value is calculated by SASExploreDirection(). + CVal - for CIdx in [0,N) this field stores value which is + assigned to XC[CIdx] during activation. CVal is ignored in + other cases. + This value is calculated by SASExploreDirection(). + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sasimmediateactivation(sactiveset* state, + ae_int_t cidx, + double cval, + ae_state *_state) +{ + + + ae_assert(state->algostate==1, "SASMoveTo: is not in optimization mode", _state); + if( cidxn ) + { + state->xc.ptr.p_double[cidx] = cval; + } + state->activeset.ptr.p_int[cidx] = 1; + state->basisisready = ae_false; +} + + +/************************************************************************* +This subroutine calculates descent direction subject to current active set. + +INPUT PARAMETERS: + S - active set object + G - array[N], gradient + D - possibly prealocated buffer; + automatically resized if needed. + +OUTPUT PARAMETERS: + D - descent direction projected onto current active set. + Components of D which correspond to active boundary + constraints are forced to be exactly zero. + In case D is non-zero, it is normalized to have unit norm. + +NOTE: in case active set has N active constraints (or more), descent + direction is forced to be exactly zero. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sasconstraineddescent(sactiveset* state, + /* Real */ ae_vector* g, + /* Real */ ae_vector* d, + ae_state *_state) +{ + + + ae_assert(state->algostate==1, "SASConstrainedDescent: is not in optimization mode", _state); + sasrebuildbasis(state, _state); + sactivesets_constraineddescent(state, g, &state->unitdiagonal, &state->ibasis, ae_true, d, _state); +} + + +/************************************************************************* +This subroutine calculates preconditioned descent direction subject to +current active set. + +INPUT PARAMETERS: + S - active set object + G - array[N], gradient + D - possibly prealocated buffer; + automatically resized if needed. + +OUTPUT PARAMETERS: + D - descent direction projected onto current active set. + Components of D which correspond to active boundary + constraints are forced to be exactly zero. + In case D is non-zero, it is normalized to have unit norm. + +NOTE: in case active set has N active constraints (or more), descent + direction is forced to be exactly zero. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sasconstraineddescentprec(sactiveset* state, + /* Real */ ae_vector* g, + /* Real */ ae_vector* d, + ae_state *_state) +{ + + + ae_assert(state->algostate==1, "SASConstrainedDescentPrec: is not in optimization mode", _state); + sasrebuildbasis(state, _state); + sactivesets_constraineddescent(state, g, &state->h, &state->pbasis, ae_true, d, _state); +} + + +/************************************************************************* +This subroutine calculates product of direction vector and preconditioner +multiplied subject to current active set. + +INPUT PARAMETERS: + S - active set object + D - array[N], direction + +OUTPUT PARAMETERS: + D - preconditioned direction projected onto current active set. + Components of D which correspond to active boundary + constraints are forced to be exactly zero. + +NOTE: in case active set has N active constraints (or more), descent + direction is forced to be exactly zero. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sasconstraineddirection(sactiveset* state, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(state->algostate==1, "SASConstrainedAntigradientPrec: is not in optimization mode", _state); + sasrebuildbasis(state, _state); + sactivesets_constraineddescent(state, d, &state->unitdiagonal, &state->ibasis, ae_false, &state->cdtmp, _state); + for(i=0; i<=state->n-1; i++) + { + d->ptr.p_double[i] = -state->cdtmp.ptr.p_double[i]; + } +} + + +/************************************************************************* +This subroutine calculates product of direction vector and preconditioner +multiplied subject to current active set. + +INPUT PARAMETERS: + S - active set object + D - array[N], direction + +OUTPUT PARAMETERS: + D - preconditioned direction projected onto current active set. + Components of D which correspond to active boundary + constraints are forced to be exactly zero. + +NOTE: in case active set has N active constraints (or more), descent + direction is forced to be exactly zero. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sasconstraineddirectionprec(sactiveset* state, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(state->algostate==1, "SASConstrainedAntigradientPrec: is not in optimization mode", _state); + sasrebuildbasis(state, _state); + sactivesets_constraineddescent(state, d, &state->h, &state->pbasis, ae_false, &state->cdtmp, _state); + for(i=0; i<=state->n-1; i++) + { + d->ptr.p_double[i] = -state->cdtmp.ptr.p_double[i]; + } +} + + +/************************************************************************* +This subroutine performs correction of some (possibly infeasible) point +with respect to a) current active set, b) all boundary constraints, both +active and inactive: + +0) we calculate L1 penalty term for violation of active linear constraints + (one which is returned by SASActiveLCPenalty1() function). +1) first, it performs projection (orthogonal with respect to scale matrix + S) of X into current active set: X -> X1. +2) next, we perform projection with respect to ALL boundary constraints + which are violated at X1: X1 -> X2. +3) X is replaced by X2. + +The idea is that this function can preserve and enforce feasibility during +optimization, and additional penalty parameter can be used to prevent algo +from leaving feasible set because of rounding errors. + +INPUT PARAMETERS: + S - active set object + X - array[N], candidate point + +OUTPUT PARAMETERS: + X - "improved" candidate point: + a) feasible with respect to all boundary constraints + b) feasibility with respect to active set is retained at + good level. + Penalty - penalty term, which can be added to function value if user + wants to penalize violation of constraints (recommended). + +NOTE: this function is not intended to find exact projection (i.e. best + approximation) of X into feasible set. It just improves situation a + bit. + Regular use of this function will help you to retain feasibility + - if you already have something to start with and constrain your + steps is such way that the only source of infeasibility are roundoff + errors. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sascorrection(sactiveset* state, + /* Real */ ae_vector* x, + double* penalty, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n; + double v; + + *penalty = 0; + + ae_assert(state->algostate==1, "SASCorrection: is not in optimization mode", _state); + sasrebuildbasis(state, _state); + n = state->n; + rvectorsetlengthatleast(&state->corrtmp, n, _state); + + /* + * Calculate penalty term. + */ + *penalty = sasactivelcpenalty1(state, x, _state); + + /* + * Perform projection 1. + * + * This projecton is given by: + * + * x_proj = x - S*S*As'*(As*x-b) + * + * where x is original x before projection, S is a scale matrix, + * As is a matrix of equality constraints (active set) which were + * orthogonalized with respect to inner product given by S (i.e. we + * have As*S*S'*As'=I), b is a right part of the orthogonalized + * constraints. + * + * NOTE: you can verify that x_proj is strictly feasible w.r.t. + * active set by multiplying it by As - you will get + * As*x_proj = As*x - As*x + b = b. + * + * This formula for projection can be obtained by solving + * following minimization problem. + * + * min ||inv(S)*(x_proj-x)||^2 s.t. As*x_proj=b + * + */ + ae_v_move(&state->corrtmp.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=state->basissize-1; i++) + { + v = -state->sbasis.ptr.pp_double[i][n]; + for(j=0; j<=n-1; j++) + { + v = v+state->sbasis.ptr.pp_double[i][j]*state->corrtmp.ptr.p_double[j]; + } + for(j=0; j<=n-1; j++) + { + state->corrtmp.ptr.p_double[j] = state->corrtmp.ptr.p_double[j]-v*state->sbasis.ptr.pp_double[i][j]*ae_sqr(state->s.ptr.p_double[j], _state); + } + } + for(i=0; i<=n-1; i++) + { + if( state->activeset.ptr.p_int[i]>0 ) + { + state->corrtmp.ptr.p_double[i] = state->xc.ptr.p_double[i]; + } + } + + /* + * Perform projection 2 + */ + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = state->corrtmp.ptr.p_double[i]; + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(x->ptr.p_double[i],state->bndl.ptr.p_double[i]) ) + { + x->ptr.p_double[i] = state->bndl.ptr.p_double[i]; + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(x->ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + x->ptr.p_double[i] = state->bndu.ptr.p_double[i]; + } + } +} + + +/************************************************************************* +This subroutine returns L1 penalty for violation of active general linear +constraints (violation of boundary or inactive linear constraints is not +added to penalty). + +Penalty term is equal to: + + Penalty = SUM( Abs((C_i*x-R_i)/Alpha_i) ) + +Here: +* summation is performed for I=0...NEC+NIC-1, ActiveSet[N+I]>0 + (only for rows of CLEIC which are in active set) +* C_i is I-th row of CLEIC +* R_i is corresponding right part +* S is a scale matrix +* Alpha_i = ||S*C_i|| - is a scaling coefficient which "normalizes" + I-th summation term according to its scale. + +INPUT PARAMETERS: + S - active set object + X - array[N], candidate point + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +double sasactivelcpenalty1(sactiveset* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n; + ae_int_t nec; + ae_int_t nic; + double v; + double alpha; + double p; + double result; + + + ae_assert(state->algostate==1, "SASActiveLCPenalty1: is not in optimization mode", _state); + sasrebuildbasis(state, _state); + n = state->n; + nec = state->nec; + nic = state->nic; + + /* + * Calculate penalty term. + */ + result = 0; + for(i=0; i<=nec+nic-1; i++) + { + if( state->activeset.ptr.p_int[n+i]>0 ) + { + alpha = 0; + p = -state->cleic.ptr.pp_double[i][n]; + for(j=0; j<=n-1; j++) + { + v = state->cleic.ptr.pp_double[i][j]; + p = p+v*x->ptr.p_double[j]; + alpha = alpha+ae_sqr(v*state->s.ptr.p_double[j], _state); + } + alpha = ae_sqrt(alpha, _state); + if( ae_fp_neq(alpha,0) ) + { + result = result+ae_fabs(p/alpha, _state); + } + } + } + return result; +} + + +/************************************************************************* +This subroutine calculates scaled norm of vector after projection onto +subspace of active constraints. Most often this function is used to test +stopping conditions. + +INPUT PARAMETERS: + S - active set object + D - vector whose norm is calculated + +RESULT: + Vector norm (after projection and scaling) + +NOTE: projection is performed first, scaling is performed after projection + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +double sasscaledconstrainednorm(sactiveset* state, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n; + double v; + double result; + + + ae_assert(state->algostate==1, "SASMoveTo: is not in optimization mode", _state); + n = state->n; + rvectorsetlengthatleast(&state->scntmp, n, _state); + + /* + * Prepare basis (if needed) + */ + sasrebuildbasis(state, _state); + + /* + * Calculate descent direction + */ + for(i=0; i<=n-1; i++) + { + if( state->activeset.ptr.p_int[i]>0 ) + { + state->scntmp.ptr.p_double[i] = 0; + } + else + { + state->scntmp.ptr.p_double[i] = d->ptr.p_double[i]; + } + } + for(i=0; i<=state->basissize-1; i++) + { + v = ae_v_dotproduct(&state->ibasis.ptr.pp_double[i][0], 1, &state->scntmp.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_subd(&state->scntmp.ptr.p_double[0], 1, &state->ibasis.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); + } + v = 0.0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->s.ptr.p_double[i]*state->scntmp.ptr.p_double[i], _state); + } + result = ae_sqrt(v, _state); + return result; +} + + +/************************************************************************* +This subroutine turns off optimization mode. + +INPUT PARAMETERS: + S - active set object + +OUTPUT PARAMETERS: + S - state is changed + +NOTE: this function can be called many times for optimizer which was + already stopped. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sasstopoptimization(sactiveset* state, ae_state *_state) +{ + + + state->algostate = 0; +} + + +/************************************************************************* +This function recalculates constraints - activates and deactivates them +according to gradient value at current point. Algorithm assumes that we +want to make steepest descent step from current point; constraints are +activated and deactivated in such way that we won't violate any constraint +by steepest descent step. + +After call to this function active set is ready to try steepest descent +step (SASDescentDirection-SASExploreDirection-SASMoveTo). + +Only already "active" and "candidate" elements of ActiveSet are examined; +constraints which are not active are not examined. + +INPUT PARAMETERS: + State - active set object + GC - array[N], gradient at XC + +OUTPUT PARAMETERS: + State - active set object, with new set of constraint + + -- ALGLIB -- + Copyright 26.09.2012 by Bochkanov Sergey +*************************************************************************/ +void sasreactivateconstraints(sactiveset* state, + /* Real */ ae_vector* gc, + ae_state *_state) +{ + + + ae_assert(state->algostate==1, "SASReactivateConstraints: must be in optimization mode", _state); + sactivesets_reactivateconstraints(state, gc, &state->unitdiagonal, _state); +} + + +/************************************************************************* +This function recalculates constraints - activates and deactivates them +according to gradient value at current point. + +Algorithm assumes that we want to make Quasi-Newton step from current +point with diagonal Quasi-Newton matrix H. Constraints are activated and +deactivated in such way that we won't violate any constraint by step. + +After call to this function active set is ready to try preconditioned +steepest descent step (SASDescentDirection-SASExploreDirection-SASMoveTo). + +Only already "active" and "candidate" elements of ActiveSet are examined; +constraints which are not active are not examined. + +INPUT PARAMETERS: + State - active set object + GC - array[N], gradient at XC + +OUTPUT PARAMETERS: + State - active set object, with new set of constraint + + -- ALGLIB -- + Copyright 26.09.2012 by Bochkanov Sergey +*************************************************************************/ +void sasreactivateconstraintsprec(sactiveset* state, + /* Real */ ae_vector* gc, + ae_state *_state) +{ + + + ae_assert(state->algostate==1, "SASReactivateConstraintsPrec: must be in optimization mode", _state); + sactivesets_reactivateconstraints(state, gc, &state->h, _state); +} + + +/************************************************************************* +This function builds three orthonormal basises for current active set: +* P-orthogonal one, which is orthogonalized with inner product + (x,y) = x'*P*y, where P=inv(H) is current preconditioner +* S-orthogonal one, which is orthogonalized with inner product + (x,y) = x'*S'*S*y, where S is diagonal scaling matrix +* I-orthogonal one, which is orthogonalized with standard dot product + +NOTE: all sets of orthogonal vectors are guaranteed to have same size. + P-orthogonal basis is built first, I/S-orthogonal basises are forced + to have same number of vectors as P-orthogonal one (padded by zero + vectors if needed). + +NOTE: this function tracks changes in active set; first call will result + in reorthogonalization + +INPUT PARAMETERS: + State - active set object + H - diagonal preconditioner, H[i]>0 + +OUTPUT PARAMETERS: + State - active set object with new basis + + -- ALGLIB -- + Copyright 20.06.2012 by Bochkanov Sergey +*************************************************************************/ +void sasrebuildbasis(sactiveset* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t nec; + ae_int_t nic; + ae_int_t i; + ae_int_t j; + ae_int_t t; + ae_int_t nactivelin; + ae_int_t nactivebnd; + double v; + double vmax; + ae_int_t kmax; + + + if( state->basisisready ) + { + return; + } + n = state->n; + nec = state->nec; + nic = state->nic; + rmatrixsetlengthatleast(&state->tmpbasis, nec+nic, n+1, _state); + state->basissize = 0; + state->basisisready = ae_true; + + /* + * Determine number of active boundary and non-boundary + * constraints, move them to TmpBasis. Quick exit if no + * non-boundary constraints were detected. + */ + nactivelin = 0; + nactivebnd = 0; + for(i=0; i<=nec+nic-1; i++) + { + if( state->activeset.ptr.p_int[n+i]>0 ) + { + nactivelin = nactivelin+1; + } + } + for(j=0; j<=n-1; j++) + { + if( state->activeset.ptr.p_int[j]>0 ) + { + nactivebnd = nactivebnd+1; + } + } + if( nactivelin==0 ) + { + return; + } + + /* + * Orthogonalize linear constraints (inner product is given by preconditioner) + * with respect to each other and boundary ones: + * * normalize all constraints + * * orthogonalize with respect to boundary ones + * * repeat: + * * if basisSize+nactivebnd=n - TERMINATE + * * choose largest row from TmpBasis + * * if row norm is too small - TERMINATE + * * add row to basis, normalize + * * remove from TmpBasis, orthogonalize other constraints with respect to this one + */ + nactivelin = 0; + for(i=0; i<=nec+nic-1; i++) + { + if( state->activeset.ptr.p_int[n+i]>0 ) + { + ae_v_move(&state->tmpbasis.ptr.pp_double[nactivelin][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n)); + nactivelin = nactivelin+1; + } + } + for(i=0; i<=nactivelin-1; i++) + { + v = 0.0; + for(j=0; j<=n-1; j++) + { + v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j], _state)/state->h.ptr.p_double[j]; + } + if( ae_fp_greater(v,0) ) + { + v = 1/ae_sqrt(v, _state); + for(j=0; j<=n; j++) + { + state->tmpbasis.ptr.pp_double[i][j] = state->tmpbasis.ptr.pp_double[i][j]*v; + } + } + } + for(j=0; j<=n-1; j++) + { + if( state->activeset.ptr.p_int[j]>0 ) + { + for(i=0; i<=nactivelin-1; i++) + { + state->tmpbasis.ptr.pp_double[i][n] = state->tmpbasis.ptr.pp_double[i][n]-state->tmpbasis.ptr.pp_double[i][j]*state->xc.ptr.p_double[j]; + state->tmpbasis.ptr.pp_double[i][j] = 0.0; + } + } + } + while(state->basissize+nactivebndtmpbasis.ptr.pp_double[i][j], _state)/state->h.ptr.p_double[j]; + } + v = ae_sqrt(v, _state); + if( ae_fp_greater(v,vmax) ) + { + vmax = v; + kmax = i; + } + } + if( ae_fp_less(vmax,1.0E4*ae_machineepsilon) ) + { + break; + } + v = 1/vmax; + ae_v_moved(&state->pbasis.ptr.pp_double[state->basissize][0], 1, &state->tmpbasis.ptr.pp_double[kmax][0], 1, ae_v_len(0,n), v); + state->basissize = state->basissize+1; + + /* + * Reorthogonalize other vectors with respect to chosen one. + * Remove it from the array. + */ + for(i=0; i<=nactivelin-1; i++) + { + if( i!=kmax ) + { + v = 0; + for(j=0; j<=n-1; j++) + { + v = v+state->pbasis.ptr.pp_double[state->basissize-1][j]*state->tmpbasis.ptr.pp_double[i][j]/state->h.ptr.p_double[j]; + } + ae_v_subd(&state->tmpbasis.ptr.pp_double[i][0], 1, &state->pbasis.ptr.pp_double[state->basissize-1][0], 1, ae_v_len(0,n), v); + } + } + for(j=0; j<=n; j++) + { + state->tmpbasis.ptr.pp_double[kmax][j] = 0; + } + } + + /* + * Orthogonalize linear constraints using traditional dot product + * with respect to each other and boundary ones. + * + * NOTE: we force basis size to be equal to one which was computed + * at the previous step, with preconditioner-based inner product. + */ + nactivelin = 0; + for(i=0; i<=nec+nic-1; i++) + { + if( state->activeset.ptr.p_int[n+i]>0 ) + { + ae_v_move(&state->tmpbasis.ptr.pp_double[nactivelin][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n)); + nactivelin = nactivelin+1; + } + } + for(i=0; i<=nactivelin-1; i++) + { + v = 0.0; + for(j=0; j<=n-1; j++) + { + v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j], _state); + } + if( ae_fp_greater(v,0) ) + { + v = 1/ae_sqrt(v, _state); + for(j=0; j<=n; j++) + { + state->tmpbasis.ptr.pp_double[i][j] = state->tmpbasis.ptr.pp_double[i][j]*v; + } + } + } + for(j=0; j<=n-1; j++) + { + if( state->activeset.ptr.p_int[j]>0 ) + { + for(i=0; i<=nactivelin-1; i++) + { + state->tmpbasis.ptr.pp_double[i][n] = state->tmpbasis.ptr.pp_double[i][n]-state->tmpbasis.ptr.pp_double[i][j]*state->xc.ptr.p_double[j]; + state->tmpbasis.ptr.pp_double[i][j] = 0.0; + } + } + } + for(t=0; t<=state->basissize-1; t++) + { + + /* + * Find largest vector, add to basis. + */ + vmax = -1; + kmax = -1; + for(i=0; i<=nactivelin-1; i++) + { + v = 0.0; + for(j=0; j<=n-1; j++) + { + v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j], _state); + } + v = ae_sqrt(v, _state); + if( ae_fp_greater(v,vmax) ) + { + vmax = v; + kmax = i; + } + } + if( ae_fp_eq(vmax,0) ) + { + for(j=0; j<=n; j++) + { + state->ibasis.ptr.pp_double[t][j] = 0.0; + } + continue; + } + v = 1/vmax; + ae_v_moved(&state->ibasis.ptr.pp_double[t][0], 1, &state->tmpbasis.ptr.pp_double[kmax][0], 1, ae_v_len(0,n), v); + + /* + * Reorthogonalize other vectors with respect to chosen one. + * Remove it from the array. + */ + for(i=0; i<=nactivelin-1; i++) + { + if( i!=kmax ) + { + v = 0; + for(j=0; j<=n-1; j++) + { + v = v+state->ibasis.ptr.pp_double[t][j]*state->tmpbasis.ptr.pp_double[i][j]; + } + ae_v_subd(&state->tmpbasis.ptr.pp_double[i][0], 1, &state->ibasis.ptr.pp_double[t][0], 1, ae_v_len(0,n), v); + } + } + for(j=0; j<=n; j++) + { + state->tmpbasis.ptr.pp_double[kmax][j] = 0; + } + } + + /* + * Orthogonalize linear constraints using inner product given by + * scale matrix. + * + * NOTE: we force basis size to be equal to one which was computed + * with preconditioner-based inner product. + */ + nactivelin = 0; + for(i=0; i<=nec+nic-1; i++) + { + if( state->activeset.ptr.p_int[n+i]>0 ) + { + ae_v_move(&state->tmpbasis.ptr.pp_double[nactivelin][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n)); + nactivelin = nactivelin+1; + } + } + for(i=0; i<=nactivelin-1; i++) + { + v = 0.0; + for(j=0; j<=n-1; j++) + { + v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j]*state->s.ptr.p_double[j], _state); + } + if( ae_fp_greater(v,0) ) + { + v = 1/ae_sqrt(v, _state); + for(j=0; j<=n; j++) + { + state->tmpbasis.ptr.pp_double[i][j] = state->tmpbasis.ptr.pp_double[i][j]*v; + } + } + } + for(j=0; j<=n-1; j++) + { + if( state->activeset.ptr.p_int[j]>0 ) + { + for(i=0; i<=nactivelin-1; i++) + { + state->tmpbasis.ptr.pp_double[i][n] = state->tmpbasis.ptr.pp_double[i][n]-state->tmpbasis.ptr.pp_double[i][j]*state->xc.ptr.p_double[j]; + state->tmpbasis.ptr.pp_double[i][j] = 0.0; + } + } + } + for(t=0; t<=state->basissize-1; t++) + { + + /* + * Find largest vector, add to basis. + */ + vmax = -1; + kmax = -1; + for(i=0; i<=nactivelin-1; i++) + { + v = 0.0; + for(j=0; j<=n-1; j++) + { + v = v+ae_sqr(state->tmpbasis.ptr.pp_double[i][j]*state->s.ptr.p_double[j], _state); + } + v = ae_sqrt(v, _state); + if( ae_fp_greater(v,vmax) ) + { + vmax = v; + kmax = i; + } + } + if( ae_fp_eq(vmax,0) ) + { + for(j=0; j<=n; j++) + { + state->sbasis.ptr.pp_double[t][j] = 0.0; + } + continue; + } + v = 1/vmax; + ae_v_moved(&state->sbasis.ptr.pp_double[t][0], 1, &state->tmpbasis.ptr.pp_double[kmax][0], 1, ae_v_len(0,n), v); + + /* + * Reorthogonalize other vectors with respect to chosen one. + * Remove it from the array. + */ + for(i=0; i<=nactivelin-1; i++) + { + if( i!=kmax ) + { + v = 0; + for(j=0; j<=n-1; j++) + { + v = v+state->sbasis.ptr.pp_double[t][j]*state->tmpbasis.ptr.pp_double[i][j]*ae_sqr(state->s.ptr.p_double[j], _state); + } + ae_v_subd(&state->tmpbasis.ptr.pp_double[i][0], 1, &state->sbasis.ptr.pp_double[t][0], 1, ae_v_len(0,n), v); + } + } + for(j=0; j<=n; j++) + { + state->tmpbasis.ptr.pp_double[kmax][j] = 0; + } + } +} + + +/************************************************************************* +This subroutine calculates preconditioned descent direction subject to +current active set. + +INPUT PARAMETERS: + State - active set object + G - array[N], gradient + H - array[N], Hessian matrix + HA - active constraints orthogonalized in such way + that HA*inv(H)*HA'= I. + Normalize- whether we need normalized descent or not + D - possibly preallocated buffer; automatically resized. + +OUTPUT PARAMETERS: + D - descent direction projected onto current active set. + Components of D which correspond to active boundary + constraints are forced to be exactly zero. + In case D is non-zero and Normalize is True, it is + normalized to have unit norm. + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +static void sactivesets_constraineddescent(sactiveset* state, + /* Real */ ae_vector* g, + /* Real */ ae_vector* h, + /* Real */ ae_matrix* ha, + ae_bool normalize, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n; + double v; + ae_int_t nactive; + + + ae_assert(state->algostate==1, "SAS: internal error in ConstrainedDescent() - not in optimization mode", _state); + ae_assert(state->basisisready, "SAS: internal error in ConstrainedDescent() - no basis", _state); + n = state->n; + rvectorsetlengthatleast(d, n, _state); + + /* + * Calculate preconditioned constrained descent direction: + * + * d := -inv(H)*( g - HA'*(HA*inv(H)*g) ) + * + * Formula above always gives direction which is orthogonal to rows of HA. + * You can verify it by multiplication of both sides by HA[i] (I-th row), + * taking into account that HA*inv(H)*HA'= I (by definition of HA - it is + * orthogonal basis with inner product given by inv(H)). + */ + nactive = 0; + for(i=0; i<=n-1; i++) + { + if( state->activeset.ptr.p_int[i]>0 ) + { + d->ptr.p_double[i] = 0; + nactive = nactive+1; + } + else + { + d->ptr.p_double[i] = g->ptr.p_double[i]; + } + } + for(i=0; i<=state->basissize-1; i++) + { + v = 0.0; + for(j=0; j<=n-1; j++) + { + v = v+ha->ptr.pp_double[i][j]*d->ptr.p_double[j]/h->ptr.p_double[j]; + } + ae_v_subd(&d->ptr.p_double[0], 1, &ha->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); + nactive = nactive+1; + } + v = 0.0; + for(i=0; i<=n-1; i++) + { + if( state->activeset.ptr.p_int[i]>0 ) + { + d->ptr.p_double[i] = 0; + } + else + { + d->ptr.p_double[i] = -d->ptr.p_double[i]/h->ptr.p_double[i]; + v = v+ae_sqr(d->ptr.p_double[i], _state); + } + } + v = ae_sqrt(v, _state); + if( nactive>=n ) + { + v = 0; + for(i=0; i<=n-1; i++) + { + d->ptr.p_double[i] = 0; + } + } + if( normalize&&ae_fp_greater(v,0) ) + { + for(i=0; i<=n-1; i++) + { + d->ptr.p_double[i] = d->ptr.p_double[i]/v; + } + } +} + + +/************************************************************************* +This function recalculates constraints - activates and deactivates them +according to gradient value at current point. + +Algorithm assumes that we want to make Quasi-Newton step from current +point with diagonal Quasi-Newton matrix H. Constraints are activated and +deactivated in such way that we won't violate any constraint by step. + +Only already "active" and "candidate" elements of ActiveSet are examined; +constraints which are not active are not examined. + +INPUT PARAMETERS: + State - active set object + GC - array[N], gradient at XC + H - array[N], Hessian matrix + +OUTPUT PARAMETERS: + State - active set object, with new set of constraint + + -- ALGLIB -- + Copyright 26.09.2012 by Bochkanov Sergey +*************************************************************************/ +static void sactivesets_reactivateconstraints(sactiveset* state, + /* Real */ ae_vector* gc, + /* Real */ ae_vector* h, + ae_state *_state) +{ + ae_int_t n; + ae_int_t nec; + ae_int_t nic; + ae_int_t i; + ae_int_t j; + ae_int_t idx0; + ae_int_t idx1; + double v; + ae_int_t nactivebnd; + ae_int_t nactivelin; + ae_int_t nactiveconstraints; + double rowscale; + + + ae_assert(state->algostate==1, "SASReactivateConstraintsPrec: must be in optimization mode", _state); + + /* + * Prepare + */ + n = state->n; + nec = state->nec; + nic = state->nic; + state->basisisready = ae_false; + + /* + * Handle important special case - no linear constraints, + * only boundary constraints are present + */ + if( nec+nic==0 ) + { + for(i=0; i<=n-1; i++) + { + if( (state->hasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->activeset.ptr.p_int[i] = 1; + continue; + } + if( (state->hasbndl.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]))&&ae_fp_greater_eq(gc->ptr.p_double[i],0) ) + { + state->activeset.ptr.p_int[i] = 1; + continue; + } + if( (state->hasbndu.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]))&&ae_fp_less_eq(gc->ptr.p_double[i],0) ) + { + state->activeset.ptr.p_int[i] = 1; + continue; + } + state->activeset.ptr.p_int[i] = -1; + } + return; + } + + /* + * General case. + * Allocate temporaries. + */ + rvectorsetlengthatleast(&state->rctmpg, n, _state); + rvectorsetlengthatleast(&state->rctmprightpart, n, _state); + rvectorsetlengthatleast(&state->rctmps, n, _state); + rmatrixsetlengthatleast(&state->rctmpdense0, n, nec+nic, _state); + rmatrixsetlengthatleast(&state->rctmpdense1, n, nec+nic, _state); + bvectorsetlengthatleast(&state->rctmpisequality, n+nec+nic, _state); + ivectorsetlengthatleast(&state->rctmpconstraintidx, n+nec+nic, _state); + + /* + * Calculate descent direction + */ + ae_v_moveneg(&state->rctmpg.ptr.p_double[0], 1, &gc->ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * Determine candidates to the active set. + * + * After this block constraints become either "inactive" (ActiveSet[i]<0) + * or "candidates" (ActiveSet[i]=0). Previously active constraints always + * become "candidates". + */ + for(i=0; i<=n+nec+nic-1; i++) + { + if( state->activeset.ptr.p_int[i]>0 ) + { + state->activeset.ptr.p_int[i] = 0; + } + else + { + state->activeset.ptr.p_int[i] = -1; + } + } + nactiveconstraints = 0; + nactivebnd = 0; + nactivelin = 0; + for(i=0; i<=n-1; i++) + { + + /* + * Activate boundary constraints: + * * copy constraint index to RCTmpConstraintIdx + * * set corresponding element of ActiveSet[] to "candidate" + * * fill RCTmpS by either +1 (lower bound) or -1 (upper bound) + * * set RCTmpIsEquality to False (BndLhasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + + /* + * Equality constraint is activated + */ + state->rctmpconstraintidx.ptr.p_int[nactiveconstraints] = i; + state->activeset.ptr.p_int[i] = 0; + state->rctmps.ptr.p_double[i] = 1.0; + state->rctmpisequality.ptr.p_bool[nactiveconstraints] = ae_true; + nactiveconstraints = nactiveconstraints+1; + nactivebnd = nactivebnd+1; + continue; + } + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]) ) + { + + /* + * Lower bound is activated + */ + state->rctmpconstraintidx.ptr.p_int[nactiveconstraints] = i; + state->activeset.ptr.p_int[i] = 0; + state->rctmps.ptr.p_double[i] = -1.0; + state->rctmpisequality.ptr.p_bool[nactiveconstraints] = ae_false; + nactiveconstraints = nactiveconstraints+1; + nactivebnd = nactivebnd+1; + continue; + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + + /* + * Upper bound is activated + */ + state->rctmpconstraintidx.ptr.p_int[nactiveconstraints] = i; + state->activeset.ptr.p_int[i] = 0; + state->rctmps.ptr.p_double[i] = 1.0; + state->rctmpisequality.ptr.p_bool[nactiveconstraints] = ae_false; + nactiveconstraints = nactiveconstraints+1; + nactivebnd = nactivebnd+1; + continue; + } + } + for(i=0; i<=nec+nic-1; i++) + { + if( i>=nec ) + { + + /* + * Inequality constraints are skipped if we too far away from + * the boundary. + */ + rowscale = 0.0; + v = -state->cleic.ptr.pp_double[i][n]; + for(j=0; j<=n-1; j++) + { + v = v+state->cleic.ptr.pp_double[i][j]*state->xc.ptr.p_double[j]; + rowscale = ae_maxreal(rowscale, ae_fabs(state->cleic.ptr.pp_double[i][j]*state->s.ptr.p_double[j], _state), _state); + } + if( ae_fp_less_eq(v,-1.0E5*ae_machineepsilon*rowscale) ) + { + + /* + * NOTE: it is important to check for non-strict inequality + * because we have to correctly handle zero constraint + * 0*x<=0 + */ + continue; + } + } + ae_v_move(&state->rctmpdense0.ptr.pp_double[0][nactivelin], state->rctmpdense0.stride, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + state->rctmpconstraintidx.ptr.p_int[nactiveconstraints] = n+i; + state->activeset.ptr.p_int[n+i] = 0; + state->rctmpisequality.ptr.p_bool[nactiveconstraints] = ihasbndl.ptr.p_bool[i]&&state->hasbndu.ptr.p_bool[i])&&ae_fp_eq(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->activeset.ptr.p_int[i] = 1; + continue; + } + if( (state->hasbndl.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndl.ptr.p_double[i]))&&ae_fp_greater_eq(gc->ptr.p_double[i],0) ) + { + state->activeset.ptr.p_int[i] = 1; + continue; + } + if( (state->hasbndu.ptr.p_bool[i]&&ae_fp_eq(state->xc.ptr.p_double[i],state->bndu.ptr.p_double[i]))&&ae_fp_less_eq(gc->ptr.p_double[i],0) ) + { + state->activeset.ptr.p_int[i] = 1; + continue; + } + } + return; + } + + /* + * General case. + * + * APPROACH TO CONSTRAINTS ACTIVATION/DEACTIVATION + * + * We have NActiveConstraints "candidates": NActiveBnd boundary candidates, + * NActiveLin linear candidates. Indexes of boundary constraints are stored + * in RCTmpConstraintIdx[0:NActiveBnd-1], indexes of linear ones are stored + * in RCTmpConstraintIdx[NActiveBnd:NActiveBnd+NActiveLin-1]. Some of the + * constraints are equality ones, some are inequality - as specified by + * RCTmpIsEquality[i]. + * + * Now we have to determine active subset of "candidates" set. In order to + * do so we solve following constrained minimization problem: + * ( )^2 + * min ( SUM(lambda[i]*A[i]) + G ) + * ( ) + * Here: + * * G is a gradient (column vector) + * * A[i] is a column vector, linear (left) part of I-th constraint. + * I=0..NActiveConstraints-1, first NActiveBnd elements of A are just + * subset of identity matrix (boundary constraints), next NActiveLin + * elements are subset of rows of the matrix of general linear constraints. + * * lambda[i] is a Lagrange multiplier corresponding to I-th constraint + * + * NOTE: for preconditioned setting A is replaced by A*H^(-0.5), G is + * replaced by G*H^(-0.5). We apply this scaling at the last stage, + * before passing data to NNLS solver. + * + * Minimization is performed subject to non-negativity constraints on + * lambda[i] corresponding to inequality constraints. Inequality constraints + * which correspond to non-zero lambda are activated, equality constraints + * are always considered active. + * + * Informally speaking, we "decompose" descent direction -G and represent + * it as sum of constraint vectors and "residual" part (which is equal to + * the actual descent direction subject to constraints). + * + * SOLUTION OF THE NNLS PROBLEM + * + * We solve this optimization problem with Non-Negative Least Squares solver, + * which can efficiently solve least squares problems of the form + * + * ( [ I | AU ] )^2 + * min ( [ | ]*x-b ) s.t. non-negativity constraints on some x[i] + * ( [ 0 | AL ] ) + * + * In order to use this solver we have to rearrange rows of A[] and G in + * such way that first NActiveBnd columns of A store identity matrix (before + * sorting non-zero elements are randomly distributed in the first NActiveBnd + * columns of A, during sorting we move them to first NActiveBnd rows). + * + * Then we create instance of NNLS solver (we reuse instance left from the + * previous run of the optimization problem) and solve NNLS problem. + */ + idx0 = 0; + idx1 = nactivebnd; + for(i=0; i<=n-1; i++) + { + if( state->activeset.ptr.p_int[i]>=0 ) + { + v = 1/ae_sqrt(h->ptr.p_double[i], _state); + for(j=0; j<=nactivelin-1; j++) + { + state->rctmpdense1.ptr.pp_double[idx0][j] = state->rctmpdense0.ptr.pp_double[i][j]/state->rctmps.ptr.p_double[i]*v; + } + state->rctmprightpart.ptr.p_double[idx0] = state->rctmpg.ptr.p_double[i]/state->rctmps.ptr.p_double[i]*v; + idx0 = idx0+1; + } + else + { + v = 1/ae_sqrt(h->ptr.p_double[i], _state); + for(j=0; j<=nactivelin-1; j++) + { + state->rctmpdense1.ptr.pp_double[idx1][j] = state->rctmpdense0.ptr.pp_double[i][j]*v; + } + state->rctmprightpart.ptr.p_double[idx1] = state->rctmpg.ptr.p_double[i]*v; + idx1 = idx1+1; + } + } + snnlsinit(n, nec+nic, n, &state->solver, _state); + snnlssetproblem(&state->solver, &state->rctmpdense1, &state->rctmprightpart, nactivebnd, nactiveconstraints-nactivebnd, n, _state); + for(i=0; i<=nactiveconstraints-1; i++) + { + if( state->rctmpisequality.ptr.p_bool[i] ) + { + snnlsdropnnc(&state->solver, i, _state); + } + } + snnlssolve(&state->solver, &state->rctmplambdas, _state); + + /* + * After solution of the problem we activate equality constraints (always active) + * and inequality constraints with non-zero Lagrange multipliers. Then we reorthogonalize + * active constraints. + */ + for(i=0; i<=nactiveconstraints-1; i++) + { + if( state->rctmpisequality.ptr.p_bool[i]||ae_fp_greater(state->rctmplambdas.ptr.p_double[i],0) ) + { + state->activeset.ptr.p_int[state->rctmpconstraintidx.ptr.p_int[i]] = 1; + } + else + { + state->activeset.ptr.p_int[state->rctmpconstraintidx.ptr.p_int[i]] = 0; + } + } + sasrebuildbasis(state, _state); +} + + +ae_bool _sactiveset_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + sactiveset *p = (sactiveset*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->xc, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->h, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->activeset, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->sbasis, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->pbasis, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->ibasis, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->hasbndl, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->hasbndu, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->cleic, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->mtx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->mtas, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cdtmp, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->corrtmp, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->unitdiagonal, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_snnlssolver_init(&p->solver, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->scntmp, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpfeas, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tmpm0, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rctmps, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rctmpg, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rctmprightpart, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->rctmpdense0, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->rctmpdense1, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rctmpisequality, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rctmpconstraintidx, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rctmplambdas, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->tmpbasis, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _sactiveset_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + sactiveset *dst = (sactiveset*)_dst; + sactiveset *src = (sactiveset*)_src; + dst->n = src->n; + dst->algostate = src->algostate; + if( !ae_vector_init_copy(&dst->xc, &src->xc, _state, make_automatic) ) + return ae_false; + dst->hasxc = src->hasxc; + if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->h, &src->h, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->activeset, &src->activeset, _state, make_automatic) ) + return ae_false; + dst->basisisready = src->basisisready; + if( !ae_matrix_init_copy(&dst->sbasis, &src->sbasis, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->pbasis, &src->pbasis, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->ibasis, &src->ibasis, _state, make_automatic) ) + return ae_false; + dst->basissize = src->basissize; + dst->constraintschanged = src->constraintschanged; + if( !ae_vector_init_copy(&dst->hasbndl, &src->hasbndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->hasbndu, &src->hasbndu, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->cleic, &src->cleic, _state, make_automatic) ) + return ae_false; + dst->nec = src->nec; + dst->nic = src->nic; + if( !ae_vector_init_copy(&dst->mtx, &src->mtx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->mtas, &src->mtas, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->cdtmp, &src->cdtmp, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->corrtmp, &src->corrtmp, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->unitdiagonal, &src->unitdiagonal, _state, make_automatic) ) + return ae_false; + if( !_snnlssolver_init_copy(&dst->solver, &src->solver, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->scntmp, &src->scntmp, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpfeas, &src->tmpfeas, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tmpm0, &src->tmpm0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rctmps, &src->rctmps, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rctmpg, &src->rctmpg, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rctmprightpart, &src->rctmprightpart, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->rctmpdense0, &src->rctmpdense0, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->rctmpdense1, &src->rctmpdense1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rctmpisequality, &src->rctmpisequality, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rctmpconstraintidx, &src->rctmpconstraintidx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rctmplambdas, &src->rctmplambdas, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->tmpbasis, &src->tmpbasis, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _sactiveset_clear(void* _p) +{ + sactiveset *p = (sactiveset*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->xc); + ae_vector_clear(&p->s); + ae_vector_clear(&p->h); + ae_vector_clear(&p->activeset); + ae_matrix_clear(&p->sbasis); + ae_matrix_clear(&p->pbasis); + ae_matrix_clear(&p->ibasis); + ae_vector_clear(&p->hasbndl); + ae_vector_clear(&p->hasbndu); + ae_vector_clear(&p->bndl); + ae_vector_clear(&p->bndu); + ae_matrix_clear(&p->cleic); + ae_vector_clear(&p->mtx); + ae_vector_clear(&p->mtas); + ae_vector_clear(&p->cdtmp); + ae_vector_clear(&p->corrtmp); + ae_vector_clear(&p->unitdiagonal); + _snnlssolver_clear(&p->solver); + ae_vector_clear(&p->scntmp); + ae_vector_clear(&p->tmp0); + ae_vector_clear(&p->tmpfeas); + ae_matrix_clear(&p->tmpm0); + ae_vector_clear(&p->rctmps); + ae_vector_clear(&p->rctmpg); + ae_vector_clear(&p->rctmprightpart); + ae_matrix_clear(&p->rctmpdense0); + ae_matrix_clear(&p->rctmpdense1); + ae_vector_clear(&p->rctmpisequality); + ae_vector_clear(&p->rctmpconstraintidx); + ae_vector_clear(&p->rctmplambdas); + ae_matrix_clear(&p->tmpbasis); +} + + +void _sactiveset_destroy(void* _p) +{ + sactiveset *p = (sactiveset*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->xc); + ae_vector_destroy(&p->s); + ae_vector_destroy(&p->h); + ae_vector_destroy(&p->activeset); + ae_matrix_destroy(&p->sbasis); + ae_matrix_destroy(&p->pbasis); + ae_matrix_destroy(&p->ibasis); + ae_vector_destroy(&p->hasbndl); + ae_vector_destroy(&p->hasbndu); + ae_vector_destroy(&p->bndl); + ae_vector_destroy(&p->bndu); + ae_matrix_destroy(&p->cleic); + ae_vector_destroy(&p->mtx); + ae_vector_destroy(&p->mtas); + ae_vector_destroy(&p->cdtmp); + ae_vector_destroy(&p->corrtmp); + ae_vector_destroy(&p->unitdiagonal); + _snnlssolver_destroy(&p->solver); + ae_vector_destroy(&p->scntmp); + ae_vector_destroy(&p->tmp0); + ae_vector_destroy(&p->tmpfeas); + ae_matrix_destroy(&p->tmpm0); + ae_vector_destroy(&p->rctmps); + ae_vector_destroy(&p->rctmpg); + ae_vector_destroy(&p->rctmprightpart); + ae_matrix_destroy(&p->rctmpdense0); + ae_matrix_destroy(&p->rctmpdense1); + ae_vector_destroy(&p->rctmpisequality); + ae_vector_destroy(&p->rctmpconstraintidx); + ae_vector_destroy(&p->rctmplambdas); + ae_matrix_destroy(&p->tmpbasis); +} + + + + +/************************************************************************* + NONLINEAR CONJUGATE GRADIENT METHOD + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments by using one of the +nonlinear conjugate gradient methods. + +These CG methods are globally convergent (even on non-convex functions) as +long as grad(f) is Lipschitz continuous in a some neighborhood of the +L = { x : f(x)<=f(x0) }. + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function value F and its gradient G (simultaneously) at given point X + + +USAGE: +1. User initializes algorithm state with MinCGCreate() call +2. User tunes solver parameters with MinCGSetCond(), MinCGSetStpMax() and + other functions +3. User calls MinCGOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. +4. User calls MinCGResults() to get solution +5. Optionally, user may call MinCGRestartFrom() to solve another problem + with same N but another starting point and/or another function. + MinCGRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 25.03.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgcreate(ae_int_t n, + /* Real */ ae_vector* x, + mincgstate* state, + ae_state *_state) +{ + + _mincgstate_clear(state); + + ae_assert(n>=1, "MinCGCreate: N too small!", _state); + ae_assert(x->cnt>=n, "MinCGCreate: Length(X)0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinCGSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. L-BFGS needs exact gradient values. + Imprecise gradient may slow down convergence, especially on highly + nonlinear problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void mincgcreatef(ae_int_t n, + /* Real */ ae_vector* x, + double diffstep, + mincgstate* state, + ae_state *_state) +{ + + _mincgstate_clear(state); + + ae_assert(n>=1, "MinCGCreateF: N too small!", _state); + ae_assert(x->cnt>=n, "MinCGCreateF: Length(X)=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinCGSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetcond(mincgstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsg, _state), "MinCGSetCond: EpsG is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsg,0), "MinCGSetCond: negative EpsG!", _state); + ae_assert(ae_isfinite(epsf, _state), "MinCGSetCond: EpsF is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsf,0), "MinCGSetCond: negative EpsF!", _state); + ae_assert(ae_isfinite(epsx, _state), "MinCGSetCond: EpsX is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsx,0), "MinCGSetCond: negative EpsX!", _state); + ae_assert(maxits>=0, "MinCGSetCond: negative MaxIts!", _state); + if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) + { + epsx = 1.0E-6; + } + state->epsg = epsg; + state->epsf = epsf; + state->epsx = epsx; + state->maxits = maxits; +} + + +/************************************************************************* +This function sets scaling coefficients for CG optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of CG optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the CG too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinCGSetPrec...() functions. + +There is special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void mincgsetscale(mincgstate* state, + /* Real */ ae_vector* s, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(s->cnt>=state->n, "MinCGSetScale: Length(S)n-1; i++) + { + ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinCGSetScale: S contains infinite or NAN elements", _state); + ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinCGSetScale: S contains zero elements", _state); + state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetxrep(mincgstate* state, ae_bool needxrep, ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +This function turns on/off line search reports. +These reports are described in more details in developer-only comments on +MinCGState object. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedDRep- whether line search reports are needed or not + +This function is intended for private use only. Turning it on artificially +may cause program failure. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetdrep(mincgstate* state, ae_bool needdrep, ae_state *_state) +{ + + + state->drep = needdrep; +} + + +/************************************************************************* +This function sets CG algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + CGType - algorithm type: + * -1 automatic selection of the best algorithm + * 0 DY (Dai and Yuan) algorithm + * 1 Hybrid DY-HS algorithm + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetcgtype(mincgstate* state, ae_int_t cgtype, ae_state *_state) +{ + + + ae_assert(cgtype>=-1&&cgtype<=1, "MinCGSetCGType: incorrect CGType!", _state); + if( cgtype==-1 ) + { + cgtype = 1; + } + state->cgtype = cgtype; +} + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetstpmax(mincgstate* state, double stpmax, ae_state *_state) +{ + + + ae_assert(ae_isfinite(stpmax, _state), "MinCGSetStpMax: StpMax is not finite!", _state); + ae_assert(ae_fp_greater_eq(stpmax,0), "MinCGSetStpMax: StpMax<0!", _state); + state->stpmax = stpmax; +} + + +/************************************************************************* +This function allows to suggest initial step length to the CG algorithm. + +Suggested step length is used as starting point for the line search. It +can be useful when you have badly scaled problem, i.e. when ||grad|| +(which is used as initial estimate for the first step) is many orders of +magnitude different from the desired step. + +Line search may fail on such problems without good estimate of initial +step length. Imagine, for example, problem with ||grad||=10^50 and desired +step equal to 0.1 Line search function will use 10^50 as initial step, +then it will decrease step length by 2 (up to 20 attempts) and will get +10^44, which is still too large. + +This function allows us to tell than line search should be started from +some moderate step length, like 1.0, so algorithm will be able to detect +desired step length in a several searches. + +Default behavior (when no step is suggested) is to use preconditioner, if +it is available, to generate initial estimate of step length. + +This function influences only first iteration of algorithm. It should be +called between MinCGCreate/MinCGRestartFrom() call and MinCGOptimize call. +Suggested step is ignored if you have preconditioner. + +INPUT PARAMETERS: + State - structure used to store algorithm state. + Stp - initial estimate of the step length. + Can be zero (no estimate). + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsuggeststep(mincgstate* state, double stp, ae_state *_state) +{ + + + ae_assert(ae_isfinite(stp, _state), "MinCGSuggestStep: Stp is infinite or NAN", _state); + ae_assert(ae_fp_greater_eq(stp,0), "MinCGSuggestStep: Stp<0", _state); + state->suggestedstep = stp; +} + + +/************************************************************************* +Modification of the preconditioner: preconditioning is turned off. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecdefault(mincgstate* state, ae_state *_state) +{ + + + state->prectype = 0; + state->innerresetneeded = ae_true; +} + + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecdiag(mincgstate* state, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(d->cnt>=state->n, "MinCGSetPrecDiag: D is too short", _state); + for(i=0; i<=state->n-1; i++) + { + ae_assert(ae_isfinite(d->ptr.p_double[i], _state), "MinCGSetPrecDiag: D contains infinite or NAN elements", _state); + ae_assert(ae_fp_greater(d->ptr.p_double[i],0), "MinCGSetPrecDiag: D contains non-positive elements", _state); + } + mincgsetprecdiagfast(state, d, _state); +} + + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinCGSetScale() call +(before or after MinCGSetPrecScale() call). Without knowledge of the scale +of your variables scale-based preconditioner will be just unit matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecscale(mincgstate* state, ae_state *_state) +{ + + + state->prectype = 3; + state->innerresetneeded = ae_true; +} + + +/************************************************************************* +NOTES: + +1. This function has two different implementations: one which uses exact + (analytical) user-supplied gradient, and one which uses function value + only and numerically differentiates function in order to obtain + gradient. + + Depending on the specific function used to create optimizer object + (either MinCGCreate() for analytical gradient or MinCGCreateF() for + numerical differentiation) you should choose appropriate variant of + MinCGOptimize() - one which accepts function AND gradient or one which + accepts function ONLY. + + Be careful to choose variant of MinCGOptimize() which corresponds to + your optimization scheme! Table below lists different combinations of + callback (function/gradient) passed to MinCGOptimize() and specific + function used to create optimizer. + + + | USER PASSED TO MinCGOptimize() + CREATED WITH | function only | function and gradient + ------------------------------------------------------------ + MinCGCreateF() | work FAIL + MinCGCreate() | FAIL work + + Here "FAIL" denotes inappropriate combinations of optimizer creation + function and MinCGOptimize() version. Attemps to use such combination + (for example, to create optimizer with MinCGCreateF() and to pass + gradient information to MinCGOptimize()) will lead to exception being + thrown. Either you did not pass gradient when it WAS needed or you + passed gradient when it was NOT needed. + + -- ALGLIB -- + Copyright 20.04.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool mincgiteration(mincgstate* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + double betak; + double v; + double vv; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + i = state->rstate.ia.ptr.p_int[1]; + betak = state->rstate.ra.ptr.p_double[0]; + v = state->rstate.ra.ptr.p_double[1]; + vv = state->rstate.ra.ptr.p_double[2]; + } + else + { + n = -983; + i = -989; + betak = -834; + v = 900; + vv = -287; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + if( state->rstate.stage==5 ) + { + goto lbl_5; + } + if( state->rstate.stage==6 ) + { + goto lbl_6; + } + if( state->rstate.stage==7 ) + { + goto lbl_7; + } + if( state->rstate.stage==8 ) + { + goto lbl_8; + } + if( state->rstate.stage==9 ) + { + goto lbl_9; + } + if( state->rstate.stage==10 ) + { + goto lbl_10; + } + if( state->rstate.stage==11 ) + { + goto lbl_11; + } + if( state->rstate.stage==12 ) + { + goto lbl_12; + } + if( state->rstate.stage==13 ) + { + goto lbl_13; + } + if( state->rstate.stage==14 ) + { + goto lbl_14; + } + if( state->rstate.stage==15 ) + { + goto lbl_15; + } + if( state->rstate.stage==16 ) + { + goto lbl_16; + } + if( state->rstate.stage==17 ) + { + goto lbl_17; + } + if( state->rstate.stage==18 ) + { + goto lbl_18; + } + if( state->rstate.stage==19 ) + { + goto lbl_19; + } + + /* + * Routine body + */ + + /* + * Prepare + */ + n = state->n; + state->repterminationtype = 0; + state->repiterationscount = 0; + state->repvaridx = -1; + state->repnfev = 0; + state->debugrestartscount = 0; + + /* + * Check, that transferred derivative value is right + */ + mincg_clearrequestfields(state, _state); + if( !(ae_fp_eq(state->diffstep,0)&&ae_fp_greater(state->teststep,0)) ) + { + goto lbl_20; + } + state->needfg = ae_true; + i = 0; +lbl_22: + if( i>n-1 ) + { + goto lbl_24; + } + v = state->x.ptr.p_double[i]; + state->x.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->fm1 = state->f; + state->fp1 = state->g.ptr.p_double[i]; + state->x.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->fm2 = state->f; + state->fp2 = state->g.ptr.p_double[i]; + state->x.ptr.p_double[i] = v; + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + + /* + * 2*State.TestStep - scale parameter + * width of segment [Xi-TestStep;Xi+TestStep] + */ + if( !derivativecheck(state->fm1, state->fp1, state->fm2, state->fp2, state->f, state->g.ptr.p_double[i], 2*state->teststep, _state) ) + { + state->repvaridx = i; + state->repterminationtype = -7; + result = ae_false; + return result; + } + i = i+1; + goto lbl_22; +lbl_24: + state->needfg = ae_false; +lbl_20: + + /* + * Preparations continue: + * * set XK + * * calculate F/G + * * set DK to -G + * * powerup algo (it may change preconditioner) + * * apply preconditioner to DK + * * report update of X + * * check stopping conditions for G + */ + ae_v_move(&state->xk.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->terminationneeded = ae_false; + mincg_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_25; + } + state->needfg = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needfg = ae_false; + goto lbl_26; +lbl_25: + state->needf = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->fbase = state->f; + i = 0; +lbl_27: + if( i>n-1 ) + { + goto lbl_29; + } + v = state->x.ptr.p_double[i]; + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 5; + goto lbl_rcomm; +lbl_5: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 7; + goto lbl_rcomm; +lbl_7: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 8; + goto lbl_rcomm; +lbl_8: + state->fp2 = state->f; + state->x.ptr.p_double[i] = v; + state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); + i = i+1; + goto lbl_27; +lbl_29: + state->f = state->fbase; + state->needf = ae_false; +lbl_26: + if( !state->drep ) + { + goto lbl_30; + } + + /* + * Report algorithm powerup (if needed) + */ + mincg_clearrequestfields(state, _state); + state->algpowerup = ae_true; + state->rstate.stage = 9; + goto lbl_rcomm; +lbl_9: + state->algpowerup = ae_false; +lbl_30: + trimprepare(state->f, &state->trimthreshold, _state); + ae_v_moveneg(&state->dk.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + mincg_preconditionedmultiply(state, &state->dk, &state->work0, &state->work1, _state); + if( !state->xrep ) + { + goto lbl_32; + } + mincg_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 10; + goto lbl_rcomm; +lbl_10: + state->xupdated = ae_false; +lbl_32: + if( state->terminationneeded ) + { + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->repterminationtype = 8; + result = ae_false; + return result; + } + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->g.ptr.p_double[i]*state->s.ptr.p_double[i], _state); + } + if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsg) ) + { + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->repterminationtype = 4; + result = ae_false; + return result; + } + state->repnfev = 1; + state->k = 0; + state->fold = state->f; + + /* + * Choose initial step. + * Apply preconditioner, if we have something other than default. + */ + if( state->prectype==2||state->prectype==3 ) + { + + /* + * because we use preconditioner, step length must be equal + * to the norm of DK + */ + v = ae_v_dotproduct(&state->dk.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->lastgoodstep = ae_sqrt(v, _state); + } + else + { + + /* + * No preconditioner is used, we try to use suggested step + */ + if( ae_fp_greater(state->suggestedstep,0) ) + { + state->lastgoodstep = state->suggestedstep; + } + else + { + state->lastgoodstep = 1.0; + } + } + + /* + * Main cycle + */ + state->rstimer = mincg_rscountdownlen; +lbl_34: + if( ae_false ) + { + goto lbl_35; + } + + /* + * * clear reset flag + * * clear termination flag + * * store G[k] for later calculation of Y[k] + * * prepare starting point and direction and step length for line search + */ + state->innerresetneeded = ae_false; + state->terminationneeded = ae_false; + ae_v_moveneg(&state->yk.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->d.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->mcstage = 0; + state->stp = 1.0; + linminnormalized(&state->d, &state->stp, n, _state); + if( ae_fp_neq(state->lastgoodstep,0) ) + { + state->stp = state->lastgoodstep; + } + state->curstpmax = state->stpmax; + + /* + * Report beginning of line search (if needed) + * Terminate algorithm, if user request was detected + */ + if( !state->drep ) + { + goto lbl_36; + } + mincg_clearrequestfields(state, _state); + state->lsstart = ae_true; + state->rstate.stage = 11; + goto lbl_rcomm; +lbl_11: + state->lsstart = ae_false; +lbl_36: + if( state->terminationneeded ) + { + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->repterminationtype = 8; + result = ae_false; + return result; + } + + /* + * Minimization along D + */ + mcsrch(n, &state->x, &state->f, &state->g, &state->d, &state->stp, state->curstpmax, mincg_gtol, &state->mcinfo, &state->nfev, &state->work0, &state->lstate, &state->mcstage, _state); +lbl_38: + if( state->mcstage==0 ) + { + goto lbl_39; + } + + /* + * Calculate function/gradient using either + * analytical gradient supplied by user + * or finite difference approximation. + * + * "Trim" function in order to handle near-singularity points. + */ + mincg_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_40; + } + state->needfg = ae_true; + state->rstate.stage = 12; + goto lbl_rcomm; +lbl_12: + state->needfg = ae_false; + goto lbl_41; +lbl_40: + state->needf = ae_true; + state->rstate.stage = 13; + goto lbl_rcomm; +lbl_13: + state->fbase = state->f; + i = 0; +lbl_42: + if( i>n-1 ) + { + goto lbl_44; + } + v = state->x.ptr.p_double[i]; + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 14; + goto lbl_rcomm; +lbl_14: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 15; + goto lbl_rcomm; +lbl_15: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 16; + goto lbl_rcomm; +lbl_16: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 17; + goto lbl_rcomm; +lbl_17: + state->fp2 = state->f; + state->x.ptr.p_double[i] = v; + state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); + i = i+1; + goto lbl_42; +lbl_44: + state->f = state->fbase; + state->needf = ae_false; +lbl_41: + trimfunction(&state->f, &state->g, n, state->trimthreshold, _state); + + /* + * Call MCSRCH again + */ + mcsrch(n, &state->x, &state->f, &state->g, &state->d, &state->stp, state->curstpmax, mincg_gtol, &state->mcinfo, &state->nfev, &state->work0, &state->lstate, &state->mcstage, _state); + goto lbl_38; +lbl_39: + + /* + * * report end of line search + * * store current point to XN + * * report iteration + * * terminate algorithm if user request was detected + */ + if( !state->drep ) + { + goto lbl_45; + } + + /* + * Report end of line search (if needed) + */ + mincg_clearrequestfields(state, _state); + state->lsend = ae_true; + state->rstate.stage = 18; + goto lbl_rcomm; +lbl_18: + state->lsend = ae_false; +lbl_45: + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( !state->xrep ) + { + goto lbl_47; + } + mincg_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 19; + goto lbl_rcomm; +lbl_19: + state->xupdated = ae_false; +lbl_47: + if( state->terminationneeded ) + { + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->repterminationtype = 8; + result = ae_false; + return result; + } + + /* + * Line search is finished. + * * calculate BetaK + * * calculate DN + * * update timers + * * calculate step length: + * * LastScaledStep is ALWAYS calculated because it is used in the stopping criteria + * * LastGoodStep is updated only when MCINFO is equal to 1 (Wolfe conditions hold). + * See below for more explanation. + */ + if( state->mcinfo==1&&!state->innerresetneeded ) + { + + /* + * Standard Wolfe conditions hold + * Calculate Y[K] and D[K]'*Y[K] + */ + ae_v_add(&state->yk.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + vv = ae_v_dotproduct(&state->yk.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * Calculate BetaK according to DY formula + */ + v = mincg_preconditionedmultiply2(state, &state->g, &state->g, &state->work0, &state->work1, _state); + state->betady = v/vv; + + /* + * Calculate BetaK according to HS formula + */ + v = mincg_preconditionedmultiply2(state, &state->g, &state->yk, &state->work0, &state->work1, _state); + state->betahs = v/vv; + + /* + * Choose BetaK + */ + if( state->cgtype==0 ) + { + betak = state->betady; + } + if( state->cgtype==1 ) + { + betak = ae_maxreal(0, ae_minreal(state->betady, state->betahs, _state), _state); + } + } + else + { + + /* + * Something is wrong (may be function is too wild or too flat) + * or we just have to restart algo. + * + * We'll set BetaK=0, which will restart CG algorithm. + * We can stop later (during normal checks) if stopping conditions are met. + */ + betak = 0; + state->debugrestartscount = state->debugrestartscount+1; + } + if( state->repiterationscount>0&&state->repiterationscount%(3+n)==0 ) + { + + /* + * clear Beta every N iterations + */ + betak = 0; + } + if( state->mcinfo==1||state->mcinfo==5 ) + { + state->rstimer = mincg_rscountdownlen; + } + else + { + state->rstimer = state->rstimer-1; + } + ae_v_moveneg(&state->dn.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + mincg_preconditionedmultiply(state, &state->dn, &state->work0, &state->work1, _state); + ae_v_addd(&state->dn.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1), betak); + state->lastscaledstep = 0.0; + for(i=0; i<=n-1; i++) + { + state->lastscaledstep = state->lastscaledstep+ae_sqr(state->d.ptr.p_double[i]/state->s.ptr.p_double[i], _state); + } + state->lastscaledstep = state->stp*ae_sqrt(state->lastscaledstep, _state); + if( state->mcinfo==1 ) + { + + /* + * Step is good (Wolfe conditions hold), update LastGoodStep. + * + * This check for MCINFO=1 is essential because sometimes in the + * constrained optimization setting we may take very short steps + * (like 1E-15) because we were very close to boundary of the + * feasible area. Such short step does not mean that we've converged + * to the solution - it was so short because we were close to the + * boundary and there was a limit on step length. + * + * So having such short step is quite normal situation. However, we + * should NOT start next iteration from step whose initial length is + * estimated as 1E-15 because it may lead to the failure of the + * linear minimizer (step is too short, function does not changes, + * line search stagnates). + */ + state->lastgoodstep = 0; + for(i=0; i<=n-1; i++) + { + state->lastgoodstep = state->lastgoodstep+ae_sqr(state->d.ptr.p_double[i], _state); + } + state->lastgoodstep = state->stp*ae_sqrt(state->lastgoodstep, _state); + } + + /* + * Update information. + * Check stopping conditions. + */ + state->repnfev = state->repnfev+state->nfev; + state->repiterationscount = state->repiterationscount+1; + if( state->repiterationscount>=state->maxits&&state->maxits>0 ) + { + + /* + * Too many iterations + */ + state->repterminationtype = 5; + result = ae_false; + return result; + } + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->g.ptr.p_double[i]*state->s.ptr.p_double[i], _state); + } + if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsg) ) + { + + /* + * Gradient is small enough + */ + state->repterminationtype = 4; + result = ae_false; + return result; + } + if( !state->innerresetneeded ) + { + + /* + * These conditions are checked only when no inner reset was requested by user + */ + if( ae_fp_less_eq(state->fold-state->f,state->epsf*ae_maxreal(ae_fabs(state->fold, _state), ae_maxreal(ae_fabs(state->f, _state), 1.0, _state), _state)) ) + { + + /* + * F(k+1)-F(k) is small enough + */ + state->repterminationtype = 1; + result = ae_false; + return result; + } + if( ae_fp_less_eq(state->lastscaledstep,state->epsx) ) + { + + /* + * X(k+1)-X(k) is small enough + */ + state->repterminationtype = 2; + result = ae_false; + return result; + } + } + if( state->rstimer<=0 ) + { + + /* + * Too many subsequent restarts + */ + state->repterminationtype = 7; + result = ae_false; + return result; + } + + /* + * Shift Xk/Dk, update other information + */ + ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->dk.ptr.p_double[0], 1, &state->dn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fold = state->f; + state->k = state->k+1; + goto lbl_34; +lbl_35: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = i; + state->rstate.ra.ptr.p_double[0] = betak; + state->rstate.ra.ptr.p_double[1] = v; + state->rstate.ra.ptr.p_double[2] = vv; + return result; +} + + +/************************************************************************* +Conjugate gradient results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -7 gradient verification failed. + See MinCGSetGradientCheck() for more information. + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible, + we return best X found so far + * 8 terminated by user + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + + -- ALGLIB -- + Copyright 20.04.2009 by Bochkanov Sergey +*************************************************************************/ +void mincgresults(mincgstate* state, + /* Real */ ae_vector* x, + mincgreport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _mincgreport_clear(rep); + + mincgresultsbuf(state, x, rep, _state); +} + + +/************************************************************************* +Conjugate gradient results + +Buffered implementation of MinCGResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.04.2009 by Bochkanov Sergey +*************************************************************************/ +void mincgresultsbuf(mincgstate* state, + /* Real */ ae_vector* x, + mincgreport* rep, + ae_state *_state) +{ + + + if( x->cntn ) + { + ae_vector_set_length(x, state->n, _state); + } + ae_v_move(&x->ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + rep->iterationscount = state->repiterationscount; + rep->nfev = state->repnfev; + rep->varidx = state->repvaridx; + rep->terminationtype = state->repterminationtype; +} + + +/************************************************************************* +This subroutine restarts CG algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used to store algorithm state. + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgrestartfrom(mincgstate* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + + + ae_assert(x->cnt>=state->n, "MinCGRestartFrom: Length(X)n, _state), "MinCGCreate: X contains infinite or NaN values!", _state); + ae_v_move(&state->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + mincgsuggeststep(state, 0.0, _state); + ae_vector_set_length(&state->rstate.ia, 1+1, _state); + ae_vector_set_length(&state->rstate.ra, 2+1, _state); + state->rstate.stage = -1; + mincg_clearrequestfields(state, _state); +} + + +/************************************************************************* +Faster version of MinCGSetPrecDiag(), for time-critical parts of code, +without safety checks. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecdiagfast(mincgstate* state, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + + + rvectorsetlengthatleast(&state->diagh, state->n, _state); + rvectorsetlengthatleast(&state->diaghl2, state->n, _state); + state->prectype = 2; + state->vcnt = 0; + state->innerresetneeded = ae_true; + for(i=0; i<=state->n-1; i++) + { + state->diagh.ptr.p_double[i] = d->ptr.p_double[i]; + state->diaghl2.ptr.p_double[i] = 0.0; + } +} + + +/************************************************************************* +This function sets low-rank preconditioner for Hessian matrix H=D+V'*C*V, +where: +* H is a Hessian matrix, which is approximated by D/V/C +* D=D1+D2 is a diagonal matrix, which includes two positive definite terms: + * constant term D1 (is not updated or infrequently updated) + * variable term D2 (can be cheaply updated from iteration to iteration) +* V is a low-rank correction +* C is a diagonal factor of low-rank correction + +Preconditioner P is calculated using approximate Woodburry formula: + P = D^(-1) - D^(-1)*V'*(C^(-1)+V*D1^(-1)*V')^(-1)*V*D^(-1) + = D^(-1) - D^(-1)*VC'*VC*D^(-1), +where + VC = sqrt(B)*V + B = (C^(-1)+V*D1^(-1)*V')^(-1) + +Note that B is calculated using constant term (D1) only, which allows us +to update D2 without recalculation of B or VC. Such preconditioner is +exact when D2 is zero. When D2 is non-zero, it is only approximation, but +very good and cheap one. + +This function accepts D1, V, C. +D2 is set to zero by default. + +Cost of this update is O(N*VCnt*VCnt), but D2 can be updated in just O(N) +by MinCGSetPrecVarPart. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetpreclowrankfast(mincgstate* state, + /* Real */ ae_vector* d1, + /* Real */ ae_vector* c, + /* Real */ ae_matrix* v, + ae_int_t vcnt, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t n; + double t; + ae_matrix b; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init(&b, 0, 0, DT_REAL, _state, ae_true); + + if( vcnt==0 ) + { + mincgsetprecdiagfast(state, d1, _state); + ae_frame_leave(_state); + return; + } + n = state->n; + ae_matrix_set_length(&b, vcnt, vcnt, _state); + rvectorsetlengthatleast(&state->diagh, n, _state); + rvectorsetlengthatleast(&state->diaghl2, n, _state); + rmatrixsetlengthatleast(&state->vcorr, vcnt, n, _state); + state->prectype = 2; + state->vcnt = vcnt; + state->innerresetneeded = ae_true; + for(i=0; i<=n-1; i++) + { + state->diagh.ptr.p_double[i] = d1->ptr.p_double[i]; + state->diaghl2.ptr.p_double[i] = 0.0; + } + for(i=0; i<=vcnt-1; i++) + { + for(j=i; j<=vcnt-1; j++) + { + t = 0; + for(k=0; k<=n-1; k++) + { + t = t+v->ptr.pp_double[i][k]*v->ptr.pp_double[j][k]/d1->ptr.p_double[k]; + } + b.ptr.pp_double[i][j] = t; + } + b.ptr.pp_double[i][i] = b.ptr.pp_double[i][i]+1.0/c->ptr.p_double[i]; + } + if( !spdmatrixcholeskyrec(&b, 0, vcnt, ae_true, &state->work0, _state) ) + { + state->vcnt = 0; + ae_frame_leave(_state); + return; + } + for(i=0; i<=vcnt-1; i++) + { + ae_v_move(&state->vcorr.ptr.pp_double[i][0], 1, &v->ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + for(j=0; j<=i-1; j++) + { + t = b.ptr.pp_double[j][i]; + ae_v_subd(&state->vcorr.ptr.pp_double[i][0], 1, &state->vcorr.ptr.pp_double[j][0], 1, ae_v_len(0,n-1), t); + } + t = 1/b.ptr.pp_double[i][i]; + ae_v_muld(&state->vcorr.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), t); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +This function updates variable part (diagonal matrix D2) +of low-rank preconditioner. + +This update is very cheap and takes just O(N) time. + +It has no effect with default preconditioner. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecvarpart(mincgstate* state, + /* Real */ ae_vector* d2, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n; + + + n = state->n; + for(i=0; i<=n-1; i++) + { + state->diaghl2.ptr.p_double[i] = d2->ptr.p_double[i]; + } +} + + +/************************************************************************* + +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinCGOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinCGSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 31.05.2012 by Bochkanov Sergey +*************************************************************************/ +void mincgsetgradientcheck(mincgstate* state, + double teststep, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(teststep, _state), "MinCGSetGradientCheck: TestStep contains NaN or Infinite", _state); + ae_assert(ae_fp_greater_eq(teststep,0), "MinCGSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); + state->teststep = teststep; +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forgot to clear something) +*************************************************************************/ +static void mincg_clearrequestfields(mincgstate* state, ae_state *_state) +{ + + + state->needf = ae_false; + state->needfg = ae_false; + state->xupdated = ae_false; + state->lsstart = ae_false; + state->lsend = ae_false; + state->algpowerup = ae_false; +} + + +/************************************************************************* +This function calculates preconditioned product H^(-1)*x and stores result +back into X. Work0[] and Work1[] are used as temporaries (size must be at +least N; this function doesn't allocate arrays). + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +static void mincg_preconditionedmultiply(mincgstate* state, + /* Real */ ae_vector* x, + /* Real */ ae_vector* work0, + /* Real */ ae_vector* work1, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n; + ae_int_t vcnt; + double v; + + + n = state->n; + vcnt = state->vcnt; + if( state->prectype==0 ) + { + return; + } + if( state->prectype==3 ) + { + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = x->ptr.p_double[i]*state->s.ptr.p_double[i]*state->s.ptr.p_double[i]; + } + return; + } + ae_assert(state->prectype==2, "MinCG: internal error (unexpected PrecType)", _state); + + /* + * handle part common for VCnt=0 and VCnt<>0 + */ + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = x->ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); + } + + /* + * if VCnt>0 + */ + if( vcnt>0 ) + { + for(i=0; i<=vcnt-1; i++) + { + v = ae_v_dotproduct(&state->vcorr.ptr.pp_double[i][0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + work0->ptr.p_double[i] = v; + } + for(i=0; i<=n-1; i++) + { + work1->ptr.p_double[i] = 0; + } + for(i=0; i<=vcnt-1; i++) + { + v = work0->ptr.p_double[i]; + ae_v_addd(&state->work1.ptr.p_double[0], 1, &state->vcorr.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); + } + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[i] = x->ptr.p_double[i]-state->work1.ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); + } + } +} + + +/************************************************************************* +This function calculates preconditioned product x'*H^(-1)*y. Work0[] and +Work1[] are used as temporaries (size must be at least N; this function +doesn't allocate arrays). + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +static double mincg_preconditionedmultiply2(mincgstate* state, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + /* Real */ ae_vector* work0, + /* Real */ ae_vector* work1, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n; + ae_int_t vcnt; + double v0; + double v1; + double result; + + + n = state->n; + vcnt = state->vcnt; + + /* + * no preconditioning + */ + if( state->prectype==0 ) + { + v0 = ae_v_dotproduct(&x->ptr.p_double[0], 1, &y->ptr.p_double[0], 1, ae_v_len(0,n-1)); + result = v0; + return result; + } + if( state->prectype==3 ) + { + result = 0; + for(i=0; i<=n-1; i++) + { + result = result+x->ptr.p_double[i]*state->s.ptr.p_double[i]*state->s.ptr.p_double[i]*y->ptr.p_double[i]; + } + return result; + } + ae_assert(state->prectype==2, "MinCG: internal error (unexpected PrecType)", _state); + + /* + * low rank preconditioning + */ + result = 0.0; + for(i=0; i<=n-1; i++) + { + result = result+x->ptr.p_double[i]*y->ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); + } + if( vcnt>0 ) + { + for(i=0; i<=n-1; i++) + { + work0->ptr.p_double[i] = x->ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); + work1->ptr.p_double[i] = y->ptr.p_double[i]/(state->diagh.ptr.p_double[i]+state->diaghl2.ptr.p_double[i]); + } + for(i=0; i<=vcnt-1; i++) + { + v0 = ae_v_dotproduct(&work0->ptr.p_double[0], 1, &state->vcorr.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + v1 = ae_v_dotproduct(&work1->ptr.p_double[0], 1, &state->vcorr.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + result = result-v0*v1; + } + } + return result; +} + + +/************************************************************************* +Internal initialization subroutine + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +static void mincg_mincginitinternal(ae_int_t n, + double diffstep, + mincgstate* state, + ae_state *_state) +{ + ae_int_t i; + + + + /* + * Initialize + */ + state->teststep = 0; + state->n = n; + state->diffstep = diffstep; + mincgsetcond(state, 0, 0, 0, 0, _state); + mincgsetxrep(state, ae_false, _state); + mincgsetdrep(state, ae_false, _state); + mincgsetstpmax(state, 0, _state); + mincgsetcgtype(state, -1, _state); + mincgsetprecdefault(state, _state); + ae_vector_set_length(&state->xk, n, _state); + ae_vector_set_length(&state->dk, n, _state); + ae_vector_set_length(&state->xn, n, _state); + ae_vector_set_length(&state->dn, n, _state); + ae_vector_set_length(&state->x, n, _state); + ae_vector_set_length(&state->d, n, _state); + ae_vector_set_length(&state->g, n, _state); + ae_vector_set_length(&state->work0, n, _state); + ae_vector_set_length(&state->work1, n, _state); + ae_vector_set_length(&state->yk, n, _state); + ae_vector_set_length(&state->s, n, _state); + for(i=0; i<=n-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + } +} + + +ae_bool _mincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mincgstate *p = (mincgstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->diagh, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->diaghl2, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->vcorr, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->dk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->dn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->yk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + if( !_linminstate_init(&p->lstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->work0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->work1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _mincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mincgstate *dst = (mincgstate*)_dst; + mincgstate *src = (mincgstate*)_src; + dst->n = src->n; + dst->epsg = src->epsg; + dst->epsf = src->epsf; + dst->epsx = src->epsx; + dst->maxits = src->maxits; + dst->stpmax = src->stpmax; + dst->suggestedstep = src->suggestedstep; + dst->xrep = src->xrep; + dst->drep = src->drep; + dst->cgtype = src->cgtype; + dst->prectype = src->prectype; + if( !ae_vector_init_copy(&dst->diagh, &src->diagh, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->diaghl2, &src->diaghl2, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->vcorr, &src->vcorr, _state, make_automatic) ) + return ae_false; + dst->vcnt = src->vcnt; + if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) + return ae_false; + dst->diffstep = src->diffstep; + dst->nfev = src->nfev; + dst->mcstage = src->mcstage; + dst->k = src->k; + if( !ae_vector_init_copy(&dst->xk, &src->xk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->dk, &src->dk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->dn, &src->dn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) + return ae_false; + dst->fold = src->fold; + dst->stp = src->stp; + dst->curstpmax = src->curstpmax; + if( !ae_vector_init_copy(&dst->yk, &src->yk, _state, make_automatic) ) + return ae_false; + dst->lastgoodstep = src->lastgoodstep; + dst->lastscaledstep = src->lastscaledstep; + dst->mcinfo = src->mcinfo; + dst->innerresetneeded = src->innerresetneeded; + dst->terminationneeded = src->terminationneeded; + dst->trimthreshold = src->trimthreshold; + dst->rstimer = src->rstimer; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + dst->f = src->f; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + dst->needf = src->needf; + dst->needfg = src->needfg; + dst->xupdated = src->xupdated; + dst->algpowerup = src->algpowerup; + dst->lsstart = src->lsstart; + dst->lsend = src->lsend; + dst->teststep = src->teststep; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + dst->repiterationscount = src->repiterationscount; + dst->repnfev = src->repnfev; + dst->repvaridx = src->repvaridx; + dst->repterminationtype = src->repterminationtype; + dst->debugrestartscount = src->debugrestartscount; + if( !_linminstate_init_copy(&dst->lstate, &src->lstate, _state, make_automatic) ) + return ae_false; + dst->fbase = src->fbase; + dst->fm2 = src->fm2; + dst->fm1 = src->fm1; + dst->fp1 = src->fp1; + dst->fp2 = src->fp2; + dst->betahs = src->betahs; + dst->betady = src->betady; + if( !ae_vector_init_copy(&dst->work0, &src->work0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->work1, &src->work1, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _mincgstate_clear(void* _p) +{ + mincgstate *p = (mincgstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->diagh); + ae_vector_clear(&p->diaghl2); + ae_matrix_clear(&p->vcorr); + ae_vector_clear(&p->s); + ae_vector_clear(&p->xk); + ae_vector_clear(&p->dk); + ae_vector_clear(&p->xn); + ae_vector_clear(&p->dn); + ae_vector_clear(&p->d); + ae_vector_clear(&p->yk); + ae_vector_clear(&p->x); + ae_vector_clear(&p->g); + _rcommstate_clear(&p->rstate); + _linminstate_clear(&p->lstate); + ae_vector_clear(&p->work0); + ae_vector_clear(&p->work1); +} + + +void _mincgstate_destroy(void* _p) +{ + mincgstate *p = (mincgstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->diagh); + ae_vector_destroy(&p->diaghl2); + ae_matrix_destroy(&p->vcorr); + ae_vector_destroy(&p->s); + ae_vector_destroy(&p->xk); + ae_vector_destroy(&p->dk); + ae_vector_destroy(&p->xn); + ae_vector_destroy(&p->dn); + ae_vector_destroy(&p->d); + ae_vector_destroy(&p->yk); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->g); + _rcommstate_destroy(&p->rstate); + _linminstate_destroy(&p->lstate); + ae_vector_destroy(&p->work0); + ae_vector_destroy(&p->work1); +} + + +ae_bool _mincgreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + mincgreport *p = (mincgreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _mincgreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + mincgreport *dst = (mincgreport*)_dst; + mincgreport *src = (mincgreport*)_src; + dst->iterationscount = src->iterationscount; + dst->nfev = src->nfev; + dst->varidx = src->varidx; + dst->terminationtype = src->terminationtype; + return ae_true; +} + + +void _mincgreport_clear(void* _p) +{ + mincgreport *p = (mincgreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _mincgreport_destroy(void* _p) +{ + mincgreport *p = (mincgreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* + BOUND CONSTRAINED OPTIMIZATION + WITH ADDITIONAL LINEAR EQUALITY AND INEQUALITY CONSTRAINTS + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments subject to any +combination of: +* bound constraints +* linear inequality constraints +* linear equality constraints + +REQUIREMENTS: +* user must provide function value and gradient +* starting point X0 must be feasible or + not too far away from the feasible set +* grad(f) must be Lipschitz continuous on a level set: + L = { x : f(x)<=f(x0) } +* function must be defined everywhere on the feasible set F + +USAGE: + +Constrained optimization if far more complex than the unconstrained one. +Here we give very brief outline of the BLEIC optimizer. We strongly recommend +you to read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide +on optimization, which is available at http://www.alglib.net/optimization/ + +1. User initializes algorithm state with MinBLEICCreate() call + +2. USer adds boundary and/or linear constraints by calling + MinBLEICSetBC() and MinBLEICSetLC() functions. + +3. User sets stopping conditions with MinBLEICSetCond(). + +4. User calls MinBLEICOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. + +5. User calls MinBLEICResults() to get solution + +6. Optionally user may call MinBLEICRestartFrom() to solve another problem + with same N but another starting point. + MinBLEICRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size ofX + X - starting point, array[N]: + * it is better to set X to a feasible point + * but X can be infeasible, in which case algorithm will try + to find feasible point first, using X as initial + approximation. + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleiccreate(ae_int_t n, + /* Real */ ae_vector* x, + minbleicstate* state, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix c; + ae_vector ct; + + ae_frame_make(_state, &_frame_block); + _minbleicstate_clear(state); + ae_matrix_init(&c, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ct, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "MinBLEICCreate: N<1", _state); + ae_assert(x->cnt>=n, "MinBLEICCreate: Length(X)0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinBLEICSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. CG needs exact gradient values. Imprecise + gradient may slow down convergence, especially on highly nonlinear + problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void minbleiccreatef(ae_int_t n, + /* Real */ ae_vector* x, + double diffstep, + minbleicstate* state, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix c; + ae_vector ct; + + ae_frame_make(_state, &_frame_block); + _minbleicstate_clear(state); + ae_matrix_init(&c, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ct, 0, DT_INT, _state, ae_true); + + ae_assert(n>=1, "MinBLEICCreateF: N<1", _state); + ae_assert(x->cnt>=n, "MinBLEICCreateF: Length(X)nmain; + ae_assert(bndl->cnt>=n, "MinBLEICSetBC: Length(BndL)cnt>=n, "MinBLEICSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "MinBLEICSetBC: BndL contains NAN or +INF", _state); + ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "MinBLEICSetBC: BndL contains NAN or -INF", _state); + state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; + state->hasbndl.ptr.p_bool[i] = ae_isfinite(bndl->ptr.p_double[i], _state); + state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; + state->hasbndu.ptr.p_bool[i] = ae_isfinite(bndu->ptr.p_double[i], _state); + } + sassetbc(&state->sas, bndl, bndu, _state); +} + + +/************************************************************************* +This function sets linear constraints for BLEIC optimizer. + +Linear constraints are inactive by default (after initial creation). +They are preserved after algorithm restart with MinBLEICRestartFrom(). + +INPUT PARAMETERS: + State - structure previously allocated with MinBLEICCreate call. + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + +NOTE 1: linear (non-bound) constraints are satisfied only approximately: +* there always exists some minor violation (about Epsilon in magnitude) + due to rounding errors +* numerical differentiation, if used, may lead to function evaluations + outside of the feasible area, because algorithm does NOT change + numerical differentiation formula according to linear constraints. +If you want constraints to be satisfied exactly, try to reformulate your +problem in such manner that all constraints will become boundary ones +(this kind of constraints is always satisfied exactly, both in the final +solution and in all intermediate points). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetlc(minbleicstate* state, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* ct, + ae_int_t k, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + double v; + + + n = state->nmain; + + /* + * First, check for errors in the inputs + */ + ae_assert(k>=0, "MinBLEICSetLC: K<0", _state); + ae_assert(c->cols>=n+1||k==0, "MinBLEICSetLC: Cols(C)rows>=k, "MinBLEICSetLC: Rows(C)cnt>=k, "MinBLEICSetLC: Length(CT)nec = 0; + state->nic = 0; + return; + } + + /* + * Equality constraints are stored first, in the upper + * NEC rows of State.CLEIC matrix. Inequality constraints + * are stored in the next NIC rows. + * + * NOTE: we convert inequality constraints to the form + * A*x<=b before copying them. + */ + rmatrixsetlengthatleast(&state->cleic, k, n+1, _state); + state->nec = 0; + state->nic = 0; + for(i=0; i<=k-1; i++) + { + if( ct->ptr.p_int[i]==0 ) + { + ae_v_move(&state->cleic.ptr.pp_double[state->nec][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + state->nec = state->nec+1; + } + } + for(i=0; i<=k-1; i++) + { + if( ct->ptr.p_int[i]!=0 ) + { + if( ct->ptr.p_int[i]>0 ) + { + ae_v_moveneg(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + } + else + { + ae_v_move(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + } + state->nic = state->nic+1; + } + } + + /* + * Normalize rows of State.CLEIC: each row must have unit norm. + * Norm is calculated using first N elements (i.e. right part is + * not counted when we calculate norm). + */ + for(i=0; i<=k-1; i++) + { + v = 0; + for(j=0; j<=n-1; j++) + { + v = v+ae_sqr(state->cleic.ptr.pp_double[i][j], _state); + } + if( ae_fp_eq(v,0) ) + { + continue; + } + v = 1/ae_sqrt(v, _state); + ae_v_muld(&state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n), v); + } + sassetlc(&state->sas, c, ct, k, _state); +} + + +/************************************************************************* +This function sets stopping conditions for the optimizer. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - step vector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinBLEICSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead +to automatic stopping criterion selection. + +NOTE: when SetCond() called with non-zero MaxIts, BLEIC solver may perform + slightly more than MaxIts iterations. I.e., MaxIts sets non-strict + limit on iterations count. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetcond(minbleicstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsg, _state), "MinBLEICSetCond: EpsG is not finite number", _state); + ae_assert(ae_fp_greater_eq(epsg,0), "MinBLEICSetCond: negative EpsG", _state); + ae_assert(ae_isfinite(epsf, _state), "MinBLEICSetCond: EpsF is not finite number", _state); + ae_assert(ae_fp_greater_eq(epsf,0), "MinBLEICSetCond: negative EpsF", _state); + ae_assert(ae_isfinite(epsx, _state), "MinBLEICSetCond: EpsX is not finite number", _state); + ae_assert(ae_fp_greater_eq(epsx,0), "MinBLEICSetCond: negative EpsX", _state); + ae_assert(maxits>=0, "MinBLEICSetCond: negative MaxIts!", _state); + if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) + { + epsx = 1.0E-6; + } + state->epsg = epsg; + state->epsf = epsf; + state->epsx = epsx; + state->maxits = maxits; +} + + +/************************************************************************* +This function sets scaling coefficients for BLEIC optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of the optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the BLEIC too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinBLEICSetPrec...() +functions. + +There is a special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetscale(minbleicstate* state, + /* Real */ ae_vector* s, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(s->cnt>=state->nmain, "MinBLEICSetScale: Length(S)nmain-1; i++) + { + ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinBLEICSetScale: S contains infinite or NAN elements", _state); + ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinBLEICSetScale: S contains zero elements", _state); + state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); + } + sassetscale(&state->sas, s, _state); +} + + +/************************************************************************* +Modification of the preconditioner: preconditioning is turned off. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecdefault(minbleicstate* state, ae_state *_state) +{ + + + state->prectype = 0; +} + + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE 1: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 2: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecdiag(minbleicstate* state, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(d->cnt>=state->nmain, "MinBLEICSetPrecDiag: D is too short", _state); + for(i=0; i<=state->nmain-1; i++) + { + ae_assert(ae_isfinite(d->ptr.p_double[i], _state), "MinBLEICSetPrecDiag: D contains infinite or NAN elements", _state); + ae_assert(ae_fp_greater(d->ptr.p_double[i],0), "MinBLEICSetPrecDiag: D contains non-positive elements", _state); + } + rvectorsetlengthatleast(&state->diagh, state->nmain, _state); + state->prectype = 2; + for(i=0; i<=state->nmain-1; i++) + { + state->diagh.ptr.p_double[i] = d->ptr.p_double[i]; + } +} + + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinBLEICSetScale() +call (before or after MinBLEICSetPrecScale() call). Without knowledge of +the scale of your variables scale-based preconditioner will be just unit +matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecscale(minbleicstate* state, ae_state *_state) +{ + + + state->prectype = 3; +} + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinBLEICOptimize(). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetxrep(minbleicstate* state, + ae_bool needxrep, + ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +This function turns on/off line search reports. +These reports are described in more details in developer-only comments on +MinBLEICState object. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedDRep- whether line search reports are needed or not + +This function is intended for private use only. Turning it on artificially +may cause program failure. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetdrep(minbleicstate* state, + ae_bool needdrep, + ae_state *_state) +{ + + + state->drep = needdrep; +} + + +/************************************************************************* +This function sets maximum step length + +IMPORTANT: this feature is hard to combine with preconditioning. You can't +set upper limit on step length, when you solve optimization problem with +linear (non-boundary) constraints AND preconditioner turned on. + +When non-boundary constraints are present, you have to either a) use +preconditioner, or b) use upper limit on step length. YOU CAN'T USE BOTH! +In this case algorithm will terminate with appropriate error code. + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which lead to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetstpmax(minbleicstate* state, + double stpmax, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(stpmax, _state), "MinBLEICSetStpMax: StpMax is not finite!", _state); + ae_assert(ae_fp_greater_eq(stpmax,0), "MinBLEICSetStpMax: StpMax<0!", _state); + state->stpmax = stpmax; +} + + +/************************************************************************* +NOTES: + +1. This function has two different implementations: one which uses exact + (analytical) user-supplied gradient, and one which uses function value + only and numerically differentiates function in order to obtain + gradient. + + Depending on the specific function used to create optimizer object + (either MinBLEICCreate() for analytical gradient or MinBLEICCreateF() + for numerical differentiation) you should choose appropriate variant of + MinBLEICOptimize() - one which accepts function AND gradient or one + which accepts function ONLY. + + Be careful to choose variant of MinBLEICOptimize() which corresponds to + your optimization scheme! Table below lists different combinations of + callback (function/gradient) passed to MinBLEICOptimize() and specific + function used to create optimizer. + + + | USER PASSED TO MinBLEICOptimize() + CREATED WITH | function only | function and gradient + ------------------------------------------------------------ + MinBLEICCreateF() | work FAIL + MinBLEICCreate() | FAIL work + + Here "FAIL" denotes inappropriate combinations of optimizer creation + function and MinBLEICOptimize() version. Attemps to use such + combination (for example, to create optimizer with MinBLEICCreateF() + and to pass gradient information to MinCGOptimize()) will lead to + exception being thrown. Either you did not pass gradient when it WAS + needed or you passed gradient when it was NOT needed. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +ae_bool minbleiciteration(minbleicstate* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t m; + ae_int_t i; + ae_int_t j; + double v; + double vv; + ae_int_t badbfgsits; + ae_bool b; + ae_int_t nextaction; + ae_int_t mcinfo; + ae_int_t actstatus; + ae_int_t ic; + double penalty; + double ginit; + double gdecay; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + m = state->rstate.ia.ptr.p_int[1]; + i = state->rstate.ia.ptr.p_int[2]; + j = state->rstate.ia.ptr.p_int[3]; + badbfgsits = state->rstate.ia.ptr.p_int[4]; + nextaction = state->rstate.ia.ptr.p_int[5]; + mcinfo = state->rstate.ia.ptr.p_int[6]; + actstatus = state->rstate.ia.ptr.p_int[7]; + ic = state->rstate.ia.ptr.p_int[8]; + b = state->rstate.ba.ptr.p_bool[0]; + v = state->rstate.ra.ptr.p_double[0]; + vv = state->rstate.ra.ptr.p_double[1]; + penalty = state->rstate.ra.ptr.p_double[2]; + ginit = state->rstate.ra.ptr.p_double[3]; + gdecay = state->rstate.ra.ptr.p_double[4]; + } + else + { + n = -983; + m = -989; + i = -834; + j = 900; + badbfgsits = -287; + nextaction = 364; + mcinfo = 214; + actstatus = -338; + ic = -686; + b = ae_false; + v = 585; + vv = 497; + penalty = -271; + ginit = -581; + gdecay = 745; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + if( state->rstate.stage==5 ) + { + goto lbl_5; + } + if( state->rstate.stage==6 ) + { + goto lbl_6; + } + if( state->rstate.stage==7 ) + { + goto lbl_7; + } + if( state->rstate.stage==8 ) + { + goto lbl_8; + } + if( state->rstate.stage==9 ) + { + goto lbl_9; + } + if( state->rstate.stage==10 ) + { + goto lbl_10; + } + if( state->rstate.stage==11 ) + { + goto lbl_11; + } + if( state->rstate.stage==12 ) + { + goto lbl_12; + } + if( state->rstate.stage==13 ) + { + goto lbl_13; + } + if( state->rstate.stage==14 ) + { + goto lbl_14; + } + if( state->rstate.stage==15 ) + { + goto lbl_15; + } + if( state->rstate.stage==16 ) + { + goto lbl_16; + } + if( state->rstate.stage==17 ) + { + goto lbl_17; + } + if( state->rstate.stage==18 ) + { + goto lbl_18; + } + if( state->rstate.stage==19 ) + { + goto lbl_19; + } + if( state->rstate.stage==20 ) + { + goto lbl_20; + } + if( state->rstate.stage==21 ) + { + goto lbl_21; + } + if( state->rstate.stage==22 ) + { + goto lbl_22; + } + if( state->rstate.stage==23 ) + { + goto lbl_23; + } + if( state->rstate.stage==24 ) + { + goto lbl_24; + } + if( state->rstate.stage==25 ) + { + goto lbl_25; + } + if( state->rstate.stage==26 ) + { + goto lbl_26; + } + if( state->rstate.stage==27 ) + { + goto lbl_27; + } + if( state->rstate.stage==28 ) + { + goto lbl_28; + } + if( state->rstate.stage==29 ) + { + goto lbl_29; + } + if( state->rstate.stage==30 ) + { + goto lbl_30; + } + if( state->rstate.stage==31 ) + { + goto lbl_31; + } + if( state->rstate.stage==32 ) + { + goto lbl_32; + } + if( state->rstate.stage==33 ) + { + goto lbl_33; + } + if( state->rstate.stage==34 ) + { + goto lbl_34; + } + if( state->rstate.stage==35 ) + { + goto lbl_35; + } + if( state->rstate.stage==36 ) + { + goto lbl_36; + } + if( state->rstate.stage==37 ) + { + goto lbl_37; + } + if( state->rstate.stage==38 ) + { + goto lbl_38; + } + if( state->rstate.stage==39 ) + { + goto lbl_39; + } + if( state->rstate.stage==40 ) + { + goto lbl_40; + } + if( state->rstate.stage==41 ) + { + goto lbl_41; + } + + /* + * Routine body + */ + + /* + * Algorithm parameters: + * * M number of L-BFGS corrections. + * This coefficient remains fixed during iterations. + * * GDecay desired decrease of constrained gradient during L-BFGS iterations. + * This coefficient is decreased after each L-BFGS round until + * it reaches minimum decay. + */ + m = ae_minint(5, state->nmain, _state); + gdecay = minbleic_initialdecay; + + /* + * Init + */ + n = state->nmain; + state->repterminationtype = 0; + state->repinneriterationscount = 0; + state->repouteriterationscount = 0; + state->repnfev = 0; + state->repvaridx = -1; + state->repdebugeqerr = 0.0; + state->repdebugfs = _state->v_nan; + state->repdebugff = _state->v_nan; + state->repdebugdx = _state->v_nan; + if( ae_fp_neq(state->stpmax,0)&&state->prectype!=0 ) + { + state->repterminationtype = -10; + result = ae_false; + return result; + } + rvectorsetlengthatleast(&state->rho, m, _state); + rvectorsetlengthatleast(&state->theta, m, _state); + rmatrixsetlengthatleast(&state->yk, m, n, _state); + rmatrixsetlengthatleast(&state->sk, m, n, _state); + + /* + * Fill TmpPrec with current preconditioner + */ + rvectorsetlengthatleast(&state->tmpprec, n, _state); + for(i=0; i<=n-1; i++) + { + if( state->prectype==2 ) + { + state->tmpprec.ptr.p_double[i] = state->diagh.ptr.p_double[i]; + continue; + } + if( state->prectype==3 ) + { + state->tmpprec.ptr.p_double[i] = 1/ae_sqr(state->s.ptr.p_double[i], _state); + continue; + } + state->tmpprec.ptr.p_double[i] = 1; + } + sassetprecdiag(&state->sas, &state->tmpprec, _state); + + /* + * Start optimization + */ + if( !sasstartoptimization(&state->sas, &state->xstart, _state) ) + { + state->repterminationtype = -3; + result = ae_false; + return result; + } + + /* + * Check correctness of user-supplied gradient + */ + if( !(ae_fp_eq(state->diffstep,0)&&ae_fp_greater(state->teststep,0)) ) + { + goto lbl_42; + } + minbleic_clearrequestfields(state, _state); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->needfg = ae_true; + i = 0; +lbl_44: + if( i>n-1 ) + { + goto lbl_46; + } + ae_assert(!state->hasbndl.ptr.p_bool[i]||ae_fp_greater_eq(state->sas.xc.ptr.p_double[i],state->bndl.ptr.p_double[i]), "MinBLEICIteration: internal error(State.X is out of bounds)", _state); + ae_assert(!state->hasbndu.ptr.p_bool[i]||ae_fp_less_eq(state->sas.xc.ptr.p_double[i],state->bndu.ptr.p_double[i]), "MinBLEICIteration: internal error(State.X is out of bounds)", _state); + v = state->x.ptr.p_double[i]; + state->x.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; + if( state->hasbndl.ptr.p_bool[i] ) + { + state->x.ptr.p_double[i] = ae_maxreal(state->x.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); + } + state->xm1 = state->x.ptr.p_double[i]; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->fm1 = state->f; + state->gm1 = state->g.ptr.p_double[i]; + state->x.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; + if( state->hasbndu.ptr.p_bool[i] ) + { + state->x.ptr.p_double[i] = ae_minreal(state->x.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + state->xp1 = state->x.ptr.p_double[i]; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->fp1 = state->f; + state->gp1 = state->g.ptr.p_double[i]; + state->x.ptr.p_double[i] = (state->xm1+state->xp1)/2; + if( state->hasbndl.ptr.p_bool[i] ) + { + state->x.ptr.p_double[i] = ae_maxreal(state->x.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); + } + if( state->hasbndu.ptr.p_bool[i] ) + { + state->x.ptr.p_double[i] = ae_minreal(state->x.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + state->x.ptr.p_double[i] = v; + if( !derivativecheck(state->fm1, state->gm1, state->fp1, state->gp1, state->f, state->g.ptr.p_double[i], state->xp1-state->xm1, _state) ) + { + state->repvaridx = i; + state->repterminationtype = -7; + sasstopoptimization(&state->sas, _state); + result = ae_false; + return result; + } + i = i+1; + goto lbl_44; +lbl_46: + state->needfg = ae_false; +lbl_42: + + /* + * Main cycle of BLEIC-PG algorithm + */ + state->repterminationtype = 4; + badbfgsits = 0; + state->lastgoodstep = 0; + state->lastscaledgoodstep = 0; + state->maxscaledgrad = 0; + state->nonmonotoniccnt = n+state->nic; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minbleic_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_47; + } + state->needfg = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needfg = ae_false; + goto lbl_48; +lbl_47: + state->needf = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->needf = ae_false; +lbl_48: + state->fc = state->f; + trimprepare(state->f, &state->trimthreshold, _state); + state->repnfev = state->repnfev+1; + if( !state->xrep ) + { + goto lbl_49; + } + + /* + * Report current point + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->f = state->fc; + state->xupdated = ae_true; + state->rstate.stage = 5; + goto lbl_rcomm; +lbl_5: + state->xupdated = ae_false; +lbl_49: +lbl_51: + if( ae_false ) + { + goto lbl_52; + } + + /* + * Phase 1 + * + * (a) calculate unconstrained gradient + * (b) determine active set + * (c) update MaxScaledGrad + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minbleic_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_53; + } + + /* + * Analytic gradient + */ + state->needfg = ae_true; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->needfg = ae_false; + goto lbl_54; +lbl_53: + + /* + * Numerical differentiation + */ + state->needf = ae_true; + state->rstate.stage = 7; + goto lbl_rcomm; +lbl_7: + state->fbase = state->f; + i = 0; +lbl_55: + if( i>n-1 ) + { + goto lbl_57; + } + v = state->x.ptr.p_double[i]; + b = ae_false; + if( state->hasbndl.ptr.p_bool[i] ) + { + b = b||ae_fp_less(v-state->diffstep*state->s.ptr.p_double[i],state->bndl.ptr.p_double[i]); + } + if( state->hasbndu.ptr.p_bool[i] ) + { + b = b||ae_fp_greater(v+state->diffstep*state->s.ptr.p_double[i],state->bndu.ptr.p_double[i]); + } + if( b ) + { + goto lbl_58; + } + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 8; + goto lbl_rcomm; +lbl_8: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 9; + goto lbl_rcomm; +lbl_9: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 10; + goto lbl_rcomm; +lbl_10: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 11; + goto lbl_rcomm; +lbl_11: + state->fp2 = state->f; + state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); + goto lbl_59; +lbl_58: + state->xm1 = v-state->diffstep*state->s.ptr.p_double[i]; + state->xp1 = v+state->diffstep*state->s.ptr.p_double[i]; + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xm1,state->bndl.ptr.p_double[i]) ) + { + state->xm1 = state->bndl.ptr.p_double[i]; + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xp1,state->bndu.ptr.p_double[i]) ) + { + state->xp1 = state->bndu.ptr.p_double[i]; + } + state->x.ptr.p_double[i] = state->xm1; + state->rstate.stage = 12; + goto lbl_rcomm; +lbl_12: + state->fm1 = state->f; + state->x.ptr.p_double[i] = state->xp1; + state->rstate.stage = 13; + goto lbl_rcomm; +lbl_13: + state->fp1 = state->f; + if( ae_fp_neq(state->xm1,state->xp1) ) + { + state->g.ptr.p_double[i] = (state->fp1-state->fm1)/(state->xp1-state->xm1); + } + else + { + state->g.ptr.p_double[i] = 0; + } +lbl_59: + state->x.ptr.p_double[i] = v; + i = i+1; + goto lbl_55; +lbl_57: + state->f = state->fbase; + state->needf = ae_false; +lbl_54: + state->fc = state->f; + ae_v_move(&state->gc.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + sasreactivateconstraintsprec(&state->sas, &state->gc, _state); + v = 0.0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->gc.ptr.p_double[i]*state->s.ptr.p_double[i], _state); + } + state->maxscaledgrad = ae_maxreal(state->maxscaledgrad, ae_sqrt(v, _state), _state); + + /* + * Phase 2: perform steepest descent step. + * + * NextAction control variable is set on exit from this loop: + * * NextAction>0 in case we have to proceed to Phase 3 (L-BFGS step) + * * NextAction<0 in case we have to proceed to Phase 1 (recalculate active set) + * * NextAction=0 in case we found solution (step size or function change are small enough) + */ + nextaction = 0; +lbl_60: + if( ae_false ) + { + goto lbl_61; + } + + /* + * Check gradient-based stopping criteria + */ + if( ae_fp_less_eq(sasscaledconstrainednorm(&state->sas, &state->gc, _state),state->epsg) ) + { + + /* + * Gradient is small enough, stop iterations + */ + state->repterminationtype = 4; + nextaction = 0; + goto lbl_61; + } + + /* + * Calculate normalized constrained descent direction, store to D. + * Try to use previous scaled step length as initial estimate for new step. + * + * NOTE: D can be exactly zero, in this case Stp is set to 1.0 + */ + sasconstraineddescentprec(&state->sas, &state->gc, &state->d, _state); + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->d.ptr.p_double[i]/state->s.ptr.p_double[i], _state); + } + v = ae_sqrt(v, _state); + if( ae_fp_greater(state->lastscaledgoodstep,0)&&ae_fp_greater(v,0) ) + { + state->stp = state->lastscaledgoodstep/v; + } + else + { + state->stp = 1.0; + } + + /* + * Calculate bound on step length. + * Enforce user-supplied limit on step length. + */ + sasexploredirection(&state->sas, &state->d, &state->curstpmax, &state->cidx, &state->cval, _state); + state->activationstep = state->curstpmax; + if( state->cidx>=0&&ae_fp_eq(state->activationstep,0) ) + { + sasimmediateactivation(&state->sas, state->cidx, state->cval, _state); + goto lbl_60; + } + if( ae_fp_greater(state->stpmax,0) ) + { + state->curstpmax = ae_minreal(state->curstpmax, state->stpmax, _state); + } + + /* + * Report beginning of line search (if requested by caller). + * See description of the MinBLEICState for more information + * about fields accessible to caller. + * + * Caller may do following: + * * change State.Stp and load better initial estimate of + * the step length. + */ + if( !state->drep ) + { + goto lbl_62; + } + minbleic_clearrequestfields(state, _state); + state->lsstart = ae_true; + state->lbfgssearch = ae_false; + state->boundedstep = state->cidx>=0; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->g.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->f = state->fc; + state->rstate.stage = 14; + goto lbl_rcomm; +lbl_14: + state->lsstart = ae_false; +lbl_62: + + /* + * Perform optimization of F along XC+alpha*D. + */ + state->mcstage = 0; + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->gn.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fn = state->fc; + mcsrch(n, &state->xn, &state->fn, &state->gn, &state->d, &state->stp, state->curstpmax, minbleic_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); +lbl_64: + if( state->mcstage==0 ) + { + goto lbl_65; + } + + /* + * Enforce constraints (correction) in XN. + * Copy current point from XN to X. + */ + sascorrection(&state->sas, &state->xn, &penalty, _state); + for(i=0; i<=n-1; i++) + { + state->x.ptr.p_double[i] = state->xn.ptr.p_double[i]; + } + + /* + * Gradient, either user-provided or numerical differentiation + */ + minbleic_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_66; + } + + /* + * Analytic gradient + */ + state->needfg = ae_true; + state->rstate.stage = 15; + goto lbl_rcomm; +lbl_15: + state->needfg = ae_false; + state->repnfev = state->repnfev+1; + goto lbl_67; +lbl_66: + + /* + * Numerical differentiation + */ + state->needf = ae_true; + state->rstate.stage = 16; + goto lbl_rcomm; +lbl_16: + state->fbase = state->f; + i = 0; +lbl_68: + if( i>n-1 ) + { + goto lbl_70; + } + v = state->x.ptr.p_double[i]; + b = ae_false; + if( state->hasbndl.ptr.p_bool[i] ) + { + b = b||ae_fp_less(v-state->diffstep*state->s.ptr.p_double[i],state->bndl.ptr.p_double[i]); + } + if( state->hasbndu.ptr.p_bool[i] ) + { + b = b||ae_fp_greater(v+state->diffstep*state->s.ptr.p_double[i],state->bndu.ptr.p_double[i]); + } + if( b ) + { + goto lbl_71; + } + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 17; + goto lbl_rcomm; +lbl_17: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 18; + goto lbl_rcomm; +lbl_18: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 19; + goto lbl_rcomm; +lbl_19: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 20; + goto lbl_rcomm; +lbl_20: + state->fp2 = state->f; + state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); + state->repnfev = state->repnfev+4; + goto lbl_72; +lbl_71: + state->xm1 = v-state->diffstep*state->s.ptr.p_double[i]; + state->xp1 = v+state->diffstep*state->s.ptr.p_double[i]; + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xm1,state->bndl.ptr.p_double[i]) ) + { + state->xm1 = state->bndl.ptr.p_double[i]; + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xp1,state->bndu.ptr.p_double[i]) ) + { + state->xp1 = state->bndu.ptr.p_double[i]; + } + state->x.ptr.p_double[i] = state->xm1; + state->rstate.stage = 21; + goto lbl_rcomm; +lbl_21: + state->fm1 = state->f; + state->x.ptr.p_double[i] = state->xp1; + state->rstate.stage = 22; + goto lbl_rcomm; +lbl_22: + state->fp1 = state->f; + if( ae_fp_neq(state->xm1,state->xp1) ) + { + state->g.ptr.p_double[i] = (state->fp1-state->fm1)/(state->xp1-state->xm1); + } + else + { + state->g.ptr.p_double[i] = 0; + } + state->repnfev = state->repnfev+2; +lbl_72: + state->x.ptr.p_double[i] = v; + i = i+1; + goto lbl_68; +lbl_70: + state->f = state->fbase; + state->needf = ae_false; +lbl_67: + + /* + * Back to MCSRCH + * + * NOTE: penalty term from correction is added to FN in order + * to penalize increase in infeasibility. + */ + state->fn = state->f+minbleic_penaltyfactor*state->maxscaledgrad*penalty; + ae_v_move(&state->gn.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + trimfunction(&state->fn, &state->gn, n, state->trimthreshold, _state); + mcsrch(n, &state->xn, &state->fn, &state->gn, &state->d, &state->stp, state->curstpmax, minbleic_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); + goto lbl_64; +lbl_65: + + /* + * Handle possible failure of the line search + */ + if( mcinfo!=1&&mcinfo!=5 ) + { + + /* + * We can not find step which decreases function value. We have + * two possibilities: + * (a) numerical properties of the function do not allow us to + * find good solution. + * (b) we are close to activation of some constraint, and it is + * so close that step which activates it leads to change in + * target function which is smaller than numerical noise. + * + * Optimization algorithm must be able to handle case (b), because + * inability to handle it will cause failure when algorithm + * started very close to boundary of the feasible area. + * + * In order to correctly handle such cases we allow limited amount + * of small steps which increase function value. + */ + v = 0.0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->d.ptr.p_double[i]*state->curstpmax/state->s.ptr.p_double[i], _state); + } + v = ae_sqrt(v, _state); + if( (state->cidx>=0&&ae_fp_less_eq(v,minbleic_maxnonmonotoniclen))&&state->nonmonotoniccnt>0 ) + { + + /* + * We enforce non-monotonic step: + * * Stp := CurStpMax + * * MCINFO := 5 + * * XN := XC+CurStpMax*D + * * non-monotonic counter is decreased + */ + state->stp = state->curstpmax; + mcinfo = 5; + v = state->curstpmax; + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->xn.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + state->nonmonotoniccnt = state->nonmonotoniccnt-1; + } + else + { + + /* + * Numerical properties of the function does not allow us to solve problem + */ + state->repterminationtype = 7; + nextaction = 0; + goto lbl_61; + } + } + + /* + * Current point is updated. + */ + ae_v_move(&state->xp.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->gp.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fp = state->fc; + actstatus = sasmoveto(&state->sas, &state->xn, state->cidx>=0&&ae_fp_greater_eq(state->stp,state->activationstep), state->cidx, state->cval, _state); + ae_v_move(&state->gc.ptr.p_double[0], 1, &state->gn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fc = state->fn; + state->repinneriterationscount = state->repinneriterationscount+1; + if( !state->xrep ) + { + goto lbl_73; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minbleic_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 23; + goto lbl_rcomm; +lbl_23: + state->xupdated = ae_false; +lbl_73: + + /* + * Check for stopping. + * + * Step, gradient and function-based stopping criteria are tested only + * for steps which satisfy Wolfe conditions. + * + * MaxIts-based stopping condition is checked for all steps + */ + if( mcinfo==1 ) + { + + /* + * Step is small enough + */ + v = 0; + vv = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr((state->sas.xc.ptr.p_double[i]-state->xp.ptr.p_double[i])/state->s.ptr.p_double[i], _state); + vv = vv+ae_sqr(state->sas.xc.ptr.p_double[i]-state->xp.ptr.p_double[i], _state); + } + v = ae_sqrt(v, _state); + vv = ae_sqrt(vv, _state); + if( ae_fp_less_eq(v,state->epsx) ) + { + state->repterminationtype = 2; + nextaction = 0; + goto lbl_61; + } + state->lastgoodstep = vv; + minbleic_updateestimateofgoodstep(&state->lastscaledgoodstep, v, _state); + + /* + * Function change is small enough + */ + if( ae_fp_less_eq(ae_fabs(state->fp-state->fc, _state),state->epsf*ae_maxreal(ae_fabs(state->fc, _state), ae_maxreal(ae_fabs(state->fp, _state), 1.0, _state), _state)) ) + { + + /* + * Function change is small enough + */ + state->repterminationtype = 1; + nextaction = 0; + goto lbl_61; + } + } + if( state->maxits>0&&state->repinneriterationscount>=state->maxits ) + { + + /* + * Required number of iterations was performed + */ + state->repterminationtype = 5; + nextaction = 0; + goto lbl_61; + } + + /* + * Decide where to move: + * * in case only "candidate" constraints were activated, repeat stage 2 + * * in case no constraints was activated, move to stage 3 + * * otherwise, move to stage 1 (re-evaluation of the active set) + */ + if( actstatus==0 ) + { + goto lbl_60; + } + if( actstatus<0 ) + { + nextaction = 1; + } + else + { + nextaction = -1; + } + goto lbl_61; + goto lbl_60; +lbl_61: + if( nextaction<0 ) + { + goto lbl_51; + } + if( nextaction==0 ) + { + goto lbl_52; + } + + /* + * Phase 3: L-BFGS step + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minbleic_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_75; + } + + /* + * Analytic gradient + */ + state->needfg = ae_true; + state->rstate.stage = 24; + goto lbl_rcomm; +lbl_24: + state->needfg = ae_false; + state->repnfev = state->repnfev+1; + goto lbl_76; +lbl_75: + + /* + * Numerical differentiation + */ + state->needf = ae_true; + state->rstate.stage = 25; + goto lbl_rcomm; +lbl_25: + state->fbase = state->f; + i = 0; +lbl_77: + if( i>n-1 ) + { + goto lbl_79; + } + v = state->x.ptr.p_double[i]; + b = ae_false; + if( state->hasbndl.ptr.p_bool[i] ) + { + b = b||ae_fp_less(v-state->diffstep*state->s.ptr.p_double[i],state->bndl.ptr.p_double[i]); + } + if( state->hasbndu.ptr.p_bool[i] ) + { + b = b||ae_fp_greater(v+state->diffstep*state->s.ptr.p_double[i],state->bndu.ptr.p_double[i]); + } + if( b ) + { + goto lbl_80; + } + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 26; + goto lbl_rcomm; +lbl_26: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 27; + goto lbl_rcomm; +lbl_27: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 28; + goto lbl_rcomm; +lbl_28: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 29; + goto lbl_rcomm; +lbl_29: + state->fp2 = state->f; + state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); + state->repnfev = state->repnfev+4; + goto lbl_81; +lbl_80: + state->xm1 = v-state->diffstep*state->s.ptr.p_double[i]; + state->xp1 = v+state->diffstep*state->s.ptr.p_double[i]; + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xm1,state->bndl.ptr.p_double[i]) ) + { + state->xm1 = state->bndl.ptr.p_double[i]; + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xp1,state->bndu.ptr.p_double[i]) ) + { + state->xp1 = state->bndu.ptr.p_double[i]; + } + state->x.ptr.p_double[i] = state->xm1; + state->rstate.stage = 30; + goto lbl_rcomm; +lbl_30: + state->fm1 = state->f; + state->x.ptr.p_double[i] = state->xp1; + state->rstate.stage = 31; + goto lbl_rcomm; +lbl_31: + state->fp1 = state->f; + if( ae_fp_neq(state->xm1,state->xp1) ) + { + state->g.ptr.p_double[i] = (state->fp1-state->fm1)/(state->xp1-state->xm1); + } + else + { + state->g.ptr.p_double[i] = 0; + } + state->repnfev = state->repnfev+2; +lbl_81: + state->x.ptr.p_double[i] = v; + i = i+1; + goto lbl_77; +lbl_79: + state->f = state->fbase; + state->needf = ae_false; +lbl_76: + state->fc = state->f; + trimprepare(state->fc, &state->trimthreshold, _state); + ae_v_move(&state->gc.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + sasconstraineddirection(&state->sas, &state->gc, _state); + sasconstraineddirectionprec(&state->sas, &state->d, _state); + ginit = 0.0; + for(i=0; i<=n-1; i++) + { + ginit = ginit+ae_sqr(state->gc.ptr.p_double[i]*state->s.ptr.p_double[i], _state); + } + ginit = ae_sqrt(ginit, _state); + state->k = 0; +lbl_82: + if( state->k>n ) + { + goto lbl_83; + } + + /* + * Main cycle: prepare to 1-D line search + */ + state->p = state->k%m; + state->q = ae_minint(state->k, m-1, _state); + + /* + * Store X[k], G[k] + */ + ae_v_moveneg(&state->sk.ptr.pp_double[state->p][0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_moveneg(&state->yk.ptr.pp_double[state->p][0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * Try to use previous scaled step length as initial estimate for new step. + */ + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->d.ptr.p_double[i]/state->s.ptr.p_double[i], _state); + } + v = ae_sqrt(v, _state); + if( ae_fp_greater(state->lastscaledgoodstep,0)&&ae_fp_greater(v,0) ) + { + state->stp = state->lastscaledgoodstep/v; + } + else + { + state->stp = 1.0; + } + + /* + * Calculate bound on step length + */ + sasexploredirection(&state->sas, &state->d, &state->curstpmax, &state->cidx, &state->cval, _state); + state->activationstep = state->curstpmax; + if( state->cidx>=0&&ae_fp_eq(state->activationstep,0) ) + { + goto lbl_83; + } + if( ae_fp_greater(state->stpmax,0) ) + { + v = ae_v_dotproduct(&state->d.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v = ae_sqrt(v, _state); + if( ae_fp_greater(v,0) ) + { + state->curstpmax = ae_minreal(state->curstpmax, state->stpmax/v, _state); + } + } + + /* + * Report beginning of line search (if requested by caller). + * See description of the MinBLEICState for more information + * about fields accessible to caller. + * + * Caller may do following: + * * change State.Stp and load better initial estimate of + * the step length. + * Caller may not terminate algorithm. + */ + if( !state->drep ) + { + goto lbl_84; + } + minbleic_clearrequestfields(state, _state); + state->lsstart = ae_true; + state->lbfgssearch = ae_true; + state->boundedstep = state->cidx>=0; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->rstate.stage = 32; + goto lbl_rcomm; +lbl_32: + state->lsstart = ae_false; +lbl_84: + + /* + * Minimize F(x+alpha*d) + */ + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->gn.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fn = state->fc; + state->mcstage = 0; + mcsrch(n, &state->xn, &state->fn, &state->gn, &state->d, &state->stp, state->curstpmax, minbleic_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); +lbl_86: + if( state->mcstage==0 ) + { + goto lbl_87; + } + + /* + * Perform correction (constraints are enforced) + * Copy XN to X + */ + sascorrection(&state->sas, &state->xn, &penalty, _state); + for(i=0; i<=n-1; i++) + { + state->x.ptr.p_double[i] = state->xn.ptr.p_double[i]; + } + + /* + * Gradient, either user-provided or numerical differentiation + */ + minbleic_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_88; + } + + /* + * Analytic gradient + */ + state->needfg = ae_true; + state->rstate.stage = 33; + goto lbl_rcomm; +lbl_33: + state->needfg = ae_false; + state->repnfev = state->repnfev+1; + goto lbl_89; +lbl_88: + + /* + * Numerical differentiation + */ + state->needf = ae_true; + state->rstate.stage = 34; + goto lbl_rcomm; +lbl_34: + state->fbase = state->f; + i = 0; +lbl_90: + if( i>n-1 ) + { + goto lbl_92; + } + v = state->x.ptr.p_double[i]; + b = ae_false; + if( state->hasbndl.ptr.p_bool[i] ) + { + b = b||ae_fp_less(v-state->diffstep*state->s.ptr.p_double[i],state->bndl.ptr.p_double[i]); + } + if( state->hasbndu.ptr.p_bool[i] ) + { + b = b||ae_fp_greater(v+state->diffstep*state->s.ptr.p_double[i],state->bndu.ptr.p_double[i]); + } + if( b ) + { + goto lbl_93; + } + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 35; + goto lbl_rcomm; +lbl_35: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 36; + goto lbl_rcomm; +lbl_36: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 37; + goto lbl_rcomm; +lbl_37: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 38; + goto lbl_rcomm; +lbl_38: + state->fp2 = state->f; + state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); + state->repnfev = state->repnfev+4; + goto lbl_94; +lbl_93: + state->xm1 = v-state->diffstep*state->s.ptr.p_double[i]; + state->xp1 = v+state->diffstep*state->s.ptr.p_double[i]; + if( state->hasbndl.ptr.p_bool[i]&&ae_fp_less(state->xm1,state->bndl.ptr.p_double[i]) ) + { + state->xm1 = state->bndl.ptr.p_double[i]; + } + if( state->hasbndu.ptr.p_bool[i]&&ae_fp_greater(state->xp1,state->bndu.ptr.p_double[i]) ) + { + state->xp1 = state->bndu.ptr.p_double[i]; + } + state->x.ptr.p_double[i] = state->xm1; + state->rstate.stage = 39; + goto lbl_rcomm; +lbl_39: + state->fm1 = state->f; + state->x.ptr.p_double[i] = state->xp1; + state->rstate.stage = 40; + goto lbl_rcomm; +lbl_40: + state->fp1 = state->f; + if( ae_fp_neq(state->xm1,state->xp1) ) + { + state->g.ptr.p_double[i] = (state->fp1-state->fm1)/(state->xp1-state->xm1); + } + else + { + state->g.ptr.p_double[i] = 0; + } + state->repnfev = state->repnfev+2; +lbl_94: + state->x.ptr.p_double[i] = v; + i = i+1; + goto lbl_90; +lbl_92: + state->f = state->fbase; + state->needf = ae_false; +lbl_89: + + /* + * Back to MCSRCH + * + * NOTE: penalty term from correction is added to FN in order + * to penalize increase in infeasibility. + */ + state->fn = state->f+minbleic_penaltyfactor*state->maxscaledgrad*penalty; + ae_v_move(&state->gn.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + sasconstraineddirection(&state->sas, &state->gn, _state); + trimfunction(&state->fn, &state->gn, n, state->trimthreshold, _state); + mcsrch(n, &state->xn, &state->fn, &state->gn, &state->d, &state->stp, state->curstpmax, minbleic_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); + goto lbl_86; +lbl_87: + ae_v_add(&state->sk.ptr.pp_double[state->p][0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_add(&state->yk.ptr.pp_double[state->p][0], 1, &state->gn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * Handle possible failure of the line search + */ + if( mcinfo!=1&&mcinfo!=5 ) + { + goto lbl_83; + } + + /* + * Current point is updated. + */ + ae_v_move(&state->xp.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->gp.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fp = state->fc; + actstatus = sasmoveto(&state->sas, &state->xn, state->cidx>=0&&ae_fp_greater_eq(state->stp,state->activationstep), state->cidx, state->cval, _state); + ae_v_move(&state->gc.ptr.p_double[0], 1, &state->gn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fc = state->fn; + if( !state->xrep ) + { + goto lbl_95; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minbleic_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 41; + goto lbl_rcomm; +lbl_41: + state->xupdated = ae_false; +lbl_95: + state->repinneriterationscount = state->repinneriterationscount+1; + + /* + * Update length of the good step + */ + if( mcinfo==1 ) + { + v = 0; + vv = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr((state->sas.xc.ptr.p_double[i]-state->xp.ptr.p_double[i])/state->s.ptr.p_double[i], _state); + vv = vv+ae_sqr(state->sas.xc.ptr.p_double[i]-state->xp.ptr.p_double[i], _state); + } + state->lastgoodstep = ae_sqrt(vv, _state); + minbleic_updateestimateofgoodstep(&state->lastscaledgoodstep, ae_sqrt(v, _state), _state); + } + + /* + * Termination of the L-BFGS algorithm: + * a) line search was performed with activation of constraint + * b) scaled gradient decreased below GDecay + * c) iterations counter >= MaxIts + */ + if( actstatus>=0 ) + { + goto lbl_83; + } + v = 0.0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->gc.ptr.p_double[i]*state->s.ptr.p_double[i], _state); + } + if( ae_fp_less(ae_sqrt(v, _state),gdecay*ginit) ) + { + goto lbl_83; + } + if( state->maxits>0&&state->repinneriterationscount>=state->maxits ) + { + goto lbl_83; + } + + /* + * Update L-BFGS model: + * * calculate Rho[k] + * * calculate d(k+1) = -H(k+1)*g(k+1) + * (use constrained preconditioner to perform multiplication) + */ + v = ae_v_dotproduct(&state->yk.ptr.pp_double[state->p][0], 1, &state->sk.ptr.pp_double[state->p][0], 1, ae_v_len(0,n-1)); + vv = ae_v_dotproduct(&state->yk.ptr.pp_double[state->p][0], 1, &state->yk.ptr.pp_double[state->p][0], 1, ae_v_len(0,n-1)); + if( ae_fp_eq(v,0)||ae_fp_eq(vv,0) ) + { + goto lbl_83; + } + state->rho.ptr.p_double[state->p] = 1/v; + ae_v_move(&state->work.ptr.p_double[0], 1, &state->gn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=state->k; i>=state->k-state->q; i--) + { + ic = i%m; + v = ae_v_dotproduct(&state->sk.ptr.pp_double[ic][0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->theta.ptr.p_double[ic] = v; + vv = v*state->rho.ptr.p_double[ic]; + ae_v_subd(&state->work.ptr.p_double[0], 1, &state->yk.ptr.pp_double[ic][0], 1, ae_v_len(0,n-1), vv); + } + sasconstraineddirectionprec(&state->sas, &state->work, _state); + for(i=state->k-state->q; i<=state->k; i++) + { + ic = i%m; + v = ae_v_dotproduct(&state->yk.ptr.pp_double[ic][0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); + vv = state->rho.ptr.p_double[ic]*(-v+state->theta.ptr.p_double[ic]); + ae_v_addd(&state->work.ptr.p_double[0], 1, &state->sk.ptr.pp_double[ic][0], 1, ae_v_len(0,n-1), vv); + } + ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->k = state->k+1; + goto lbl_82; +lbl_83: + + /* + * Decrease decay coefficient. Subsequent L-BFGS stages will + * have more stringent stopping criteria. + */ + gdecay = ae_maxreal(gdecay*minbleic_decaycorrection, minbleic_mindecay, _state); + goto lbl_51; +lbl_52: + sasstopoptimization(&state->sas, _state); + state->repouteriterationscount = 1; + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = m; + state->rstate.ia.ptr.p_int[2] = i; + state->rstate.ia.ptr.p_int[3] = j; + state->rstate.ia.ptr.p_int[4] = badbfgsits; + state->rstate.ia.ptr.p_int[5] = nextaction; + state->rstate.ia.ptr.p_int[6] = mcinfo; + state->rstate.ia.ptr.p_int[7] = actstatus; + state->rstate.ia.ptr.p_int[8] = ic; + state->rstate.ba.ptr.p_bool[0] = b; + state->rstate.ra.ptr.p_double[0] = v; + state->rstate.ra.ptr.p_double[1] = vv; + state->rstate.ra.ptr.p_double[2] = penalty; + state->rstate.ra.ptr.p_double[3] = ginit; + state->rstate.ra.ptr.p_double[4] = gdecay; + return result; +} + + +/************************************************************************* +BLEIC results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report. You should check Rep.TerminationType + in order to distinguish successful termination from + unsuccessful one: + * -7 gradient verification failed. + See MinBLEICSetGradientCheck() for more information. + * -3 inconsistent constraints. Feasible point is + either nonexistent or too hard to find. Try to + restart optimizer with better initial approximation + * 1 relative function improvement is no more than EpsF. + * 2 scaled step is no more than EpsX. + * 4 scaled gradient norm is no more than EpsG. + * 5 MaxIts steps was taken + More information about fields of this structure can be + found in the comments on MinBLEICReport datatype. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicresults(minbleicstate* state, + /* Real */ ae_vector* x, + minbleicreport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _minbleicreport_clear(rep); + + minbleicresultsbuf(state, x, rep, _state); +} + + +/************************************************************************* +BLEIC results + +Buffered implementation of MinBLEICResults() which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicresultsbuf(minbleicstate* state, + /* Real */ ae_vector* x, + minbleicreport* rep, + ae_state *_state) +{ + ae_int_t i; + + + if( x->cntnmain ) + { + ae_vector_set_length(x, state->nmain, _state); + } + rep->iterationscount = state->repinneriterationscount; + rep->inneriterationscount = state->repinneriterationscount; + rep->outeriterationscount = state->repouteriterationscount; + rep->nfev = state->repnfev; + rep->varidx = state->repvaridx; + rep->terminationtype = state->repterminationtype; + if( state->repterminationtype>0 ) + { + ae_v_move(&x->ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,state->nmain-1)); + } + else + { + for(i=0; i<=state->nmain-1; i++) + { + x->ptr.p_double[i] = _state->v_nan; + } + } + rep->debugeqerr = state->repdebugeqerr; + rep->debugfs = state->repdebugfs; + rep->debugff = state->repdebugff; + rep->debugdx = state->repdebugdx; + rep->debugfeasqpits = state->repdebugfeasqpits; + rep->debugfeasgpaits = state->repdebugfeasgpaits; +} + + +/************************************************************************* +This subroutine restarts algorithm from new point. +All optimization parameters (including constraints) are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure previously allocated with MinBLEICCreate call. + X - new starting point. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicrestartfrom(minbleicstate* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + + + n = state->nmain; + + /* + * First, check for errors in the inputs + */ + ae_assert(x->cnt>=n, "MinBLEICRestartFrom: Length(X)xstart.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * prepare RComm facilities + */ + ae_vector_set_length(&state->rstate.ia, 8+1, _state); + ae_vector_set_length(&state->rstate.ba, 0+1, _state); + ae_vector_set_length(&state->rstate.ra, 4+1, _state); + state->rstate.stage = -1; + minbleic_clearrequestfields(state, _state); + sasstopoptimization(&state->sas, _state); +} + + +/************************************************************************* +This subroutine finalizes internal structures after emergency termination +from State.LSStart report (see comments on MinBLEICState for more information). + +INPUT PARAMETERS: + State - structure after exit from LSStart report + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicemergencytermination(minbleicstate* state, ae_state *_state) +{ + + + sasstopoptimization(&state->sas, _state); +} + + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinBLEICOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinBLEICSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetgradientcheck(minbleicstate* state, + double teststep, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(teststep, _state), "MinBLEICSetGradientCheck: TestStep contains NaN or Infinite", _state); + ae_assert(ae_fp_greater_eq(teststep,0), "MinBLEICSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); + state->teststep = teststep; +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forget to clear something) +*************************************************************************/ +static void minbleic_clearrequestfields(minbleicstate* state, + ae_state *_state) +{ + + + state->needf = ae_false; + state->needfg = ae_false; + state->xupdated = ae_false; + state->lsstart = ae_false; +} + + +/************************************************************************* +Internal initialization subroutine +*************************************************************************/ +static void minbleic_minbleicinitinternal(ae_int_t n, + /* Real */ ae_vector* x, + double diffstep, + minbleicstate* state, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_matrix c; + ae_vector ct; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init(&c, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ct, 0, DT_INT, _state, ae_true); + + + /* + * Initialize + */ + state->teststep = 0; + state->nmain = n; + state->diffstep = diffstep; + sasinit(n, &state->sas, _state); + ae_vector_set_length(&state->bndl, n, _state); + ae_vector_set_length(&state->hasbndl, n, _state); + ae_vector_set_length(&state->bndu, n, _state); + ae_vector_set_length(&state->hasbndu, n, _state); + ae_vector_set_length(&state->xstart, n, _state); + ae_vector_set_length(&state->gc, n, _state); + ae_vector_set_length(&state->xn, n, _state); + ae_vector_set_length(&state->gn, n, _state); + ae_vector_set_length(&state->xp, n, _state); + ae_vector_set_length(&state->gp, n, _state); + ae_vector_set_length(&state->d, n, _state); + ae_vector_set_length(&state->s, n, _state); + ae_vector_set_length(&state->x, n, _state); + ae_vector_set_length(&state->g, n, _state); + ae_vector_set_length(&state->work, n, _state); + for(i=0; i<=n-1; i++) + { + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->hasbndl.ptr.p_bool[i] = ae_false; + state->bndu.ptr.p_double[i] = _state->v_posinf; + state->hasbndu.ptr.p_bool[i] = ae_false; + state->s.ptr.p_double[i] = 1.0; + } + minbleicsetlc(state, &c, &ct, 0, _state); + minbleicsetcond(state, 0.0, 0.0, 0.0, 0, _state); + minbleicsetxrep(state, ae_false, _state); + minbleicsetdrep(state, ae_false, _state); + minbleicsetstpmax(state, 0.0, _state); + minbleicsetprecdefault(state, _state); + minbleicrestartfrom(state, x, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +This subroutine updates estimate of the good step length given: +1) previous estimate +2) new length of the good step + +It makes sure that estimate does not change too rapidly - ratio of new and +old estimates will be at least 0.01, at most 100.0 + +In case previous estimate of good step is zero (no estimate), new estimate +is used unconditionally. + + -- ALGLIB -- + Copyright 16.01.2013 by Bochkanov Sergey +*************************************************************************/ +static void minbleic_updateestimateofgoodstep(double* estimate, + double newstep, + ae_state *_state) +{ + + + if( ae_fp_eq(*estimate,0) ) + { + *estimate = newstep; + return; + } + if( ae_fp_less(newstep,*estimate*0.01) ) + { + *estimate = *estimate*0.01; + return; + } + if( ae_fp_greater(newstep,*estimate*100) ) + { + *estimate = *estimate*100; + return; + } + *estimate = newstep; +} + + +ae_bool _minbleicstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minbleicstate *p = (minbleicstate*)_p; + ae_touch_ptr((void*)p); + if( !_sactiveset_init(&p->sas, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->diagh, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gc, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xp, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gp, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->cleic, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->hasbndl, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->hasbndu, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xstart, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_snnlssolver_init(&p->solver, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpprec, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->work, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_linminstate_init(&p->lstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rho, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->yk, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->sk, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->theta, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _minbleicstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minbleicstate *dst = (minbleicstate*)_dst; + minbleicstate *src = (minbleicstate*)_src; + dst->nmain = src->nmain; + dst->nslack = src->nslack; + dst->epsg = src->epsg; + dst->epsf = src->epsf; + dst->epsx = src->epsx; + dst->maxits = src->maxits; + dst->xrep = src->xrep; + dst->drep = src->drep; + dst->stpmax = src->stpmax; + dst->diffstep = src->diffstep; + if( !_sactiveset_init_copy(&dst->sas, &src->sas, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) + return ae_false; + dst->prectype = src->prectype; + if( !ae_vector_init_copy(&dst->diagh, &src->diagh, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + dst->f = src->f; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + dst->needf = src->needf; + dst->needfg = src->needfg; + dst->xupdated = src->xupdated; + dst->lsstart = src->lsstart; + dst->lbfgssearch = src->lbfgssearch; + dst->boundedstep = src->boundedstep; + dst->teststep = src->teststep; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gc, &src->gc, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gn, &src->gn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xp, &src->xp, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gp, &src->gp, _state, make_automatic) ) + return ae_false; + dst->fc = src->fc; + dst->fn = src->fn; + dst->fp = src->fp; + if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->cleic, &src->cleic, _state, make_automatic) ) + return ae_false; + dst->nec = src->nec; + dst->nic = src->nic; + dst->lastgoodstep = src->lastgoodstep; + dst->lastscaledgoodstep = src->lastscaledgoodstep; + dst->maxscaledgrad = src->maxscaledgrad; + if( !ae_vector_init_copy(&dst->hasbndl, &src->hasbndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->hasbndu, &src->hasbndu, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) + return ae_false; + dst->repinneriterationscount = src->repinneriterationscount; + dst->repouteriterationscount = src->repouteriterationscount; + dst->repnfev = src->repnfev; + dst->repvaridx = src->repvaridx; + dst->repterminationtype = src->repterminationtype; + dst->repdebugeqerr = src->repdebugeqerr; + dst->repdebugfs = src->repdebugfs; + dst->repdebugff = src->repdebugff; + dst->repdebugdx = src->repdebugdx; + dst->repdebugfeasqpits = src->repdebugfeasqpits; + dst->repdebugfeasgpaits = src->repdebugfeasgpaits; + if( !ae_vector_init_copy(&dst->xstart, &src->xstart, _state, make_automatic) ) + return ae_false; + if( !_snnlssolver_init_copy(&dst->solver, &src->solver, _state, make_automatic) ) + return ae_false; + dst->fbase = src->fbase; + dst->fm2 = src->fm2; + dst->fm1 = src->fm1; + dst->fp1 = src->fp1; + dst->fp2 = src->fp2; + dst->xm1 = src->xm1; + dst->xp1 = src->xp1; + dst->gm1 = src->gm1; + dst->gp1 = src->gp1; + dst->cidx = src->cidx; + dst->cval = src->cval; + if( !ae_vector_init_copy(&dst->tmpprec, &src->tmpprec, _state, make_automatic) ) + return ae_false; + dst->nfev = src->nfev; + dst->mcstage = src->mcstage; + dst->stp = src->stp; + dst->curstpmax = src->curstpmax; + dst->activationstep = src->activationstep; + if( !ae_vector_init_copy(&dst->work, &src->work, _state, make_automatic) ) + return ae_false; + if( !_linminstate_init_copy(&dst->lstate, &src->lstate, _state, make_automatic) ) + return ae_false; + dst->trimthreshold = src->trimthreshold; + dst->nonmonotoniccnt = src->nonmonotoniccnt; + dst->k = src->k; + dst->q = src->q; + dst->p = src->p; + if( !ae_vector_init_copy(&dst->rho, &src->rho, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->yk, &src->yk, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->sk, &src->sk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->theta, &src->theta, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _minbleicstate_clear(void* _p) +{ + minbleicstate *p = (minbleicstate*)_p; + ae_touch_ptr((void*)p); + _sactiveset_clear(&p->sas); + ae_vector_clear(&p->s); + ae_vector_clear(&p->diagh); + ae_vector_clear(&p->x); + ae_vector_clear(&p->g); + _rcommstate_clear(&p->rstate); + ae_vector_clear(&p->gc); + ae_vector_clear(&p->xn); + ae_vector_clear(&p->gn); + ae_vector_clear(&p->xp); + ae_vector_clear(&p->gp); + ae_vector_clear(&p->d); + ae_matrix_clear(&p->cleic); + ae_vector_clear(&p->hasbndl); + ae_vector_clear(&p->hasbndu); + ae_vector_clear(&p->bndl); + ae_vector_clear(&p->bndu); + ae_vector_clear(&p->xstart); + _snnlssolver_clear(&p->solver); + ae_vector_clear(&p->tmpprec); + ae_vector_clear(&p->work); + _linminstate_clear(&p->lstate); + ae_vector_clear(&p->rho); + ae_matrix_clear(&p->yk); + ae_matrix_clear(&p->sk); + ae_vector_clear(&p->theta); +} + + +void _minbleicstate_destroy(void* _p) +{ + minbleicstate *p = (minbleicstate*)_p; + ae_touch_ptr((void*)p); + _sactiveset_destroy(&p->sas); + ae_vector_destroy(&p->s); + ae_vector_destroy(&p->diagh); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->g); + _rcommstate_destroy(&p->rstate); + ae_vector_destroy(&p->gc); + ae_vector_destroy(&p->xn); + ae_vector_destroy(&p->gn); + ae_vector_destroy(&p->xp); + ae_vector_destroy(&p->gp); + ae_vector_destroy(&p->d); + ae_matrix_destroy(&p->cleic); + ae_vector_destroy(&p->hasbndl); + ae_vector_destroy(&p->hasbndu); + ae_vector_destroy(&p->bndl); + ae_vector_destroy(&p->bndu); + ae_vector_destroy(&p->xstart); + _snnlssolver_destroy(&p->solver); + ae_vector_destroy(&p->tmpprec); + ae_vector_destroy(&p->work); + _linminstate_destroy(&p->lstate); + ae_vector_destroy(&p->rho); + ae_matrix_destroy(&p->yk); + ae_matrix_destroy(&p->sk); + ae_vector_destroy(&p->theta); +} + + +ae_bool _minbleicreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minbleicreport *p = (minbleicreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _minbleicreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minbleicreport *dst = (minbleicreport*)_dst; + minbleicreport *src = (minbleicreport*)_src; + dst->iterationscount = src->iterationscount; + dst->nfev = src->nfev; + dst->varidx = src->varidx; + dst->terminationtype = src->terminationtype; + dst->debugeqerr = src->debugeqerr; + dst->debugfs = src->debugfs; + dst->debugff = src->debugff; + dst->debugdx = src->debugdx; + dst->debugfeasqpits = src->debugfeasqpits; + dst->debugfeasgpaits = src->debugfeasgpaits; + dst->inneriterationscount = src->inneriterationscount; + dst->outeriterationscount = src->outeriterationscount; + return ae_true; +} + + +void _minbleicreport_clear(void* _p) +{ + minbleicreport *p = (minbleicreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _minbleicreport_destroy(void* _p) +{ + minbleicreport *p = (minbleicreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* + LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments by using a quasi- +Newton method (LBFGS scheme) which is optimized to use a minimum amount +of memory. +The subroutine generates the approximation of an inverse Hessian matrix by +using information about the last M steps of the algorithm (instead of N). +It lessens a required amount of memory from a value of order N^2 to a +value of order 2*N*M. + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function value F and its gradient G (simultaneously) at given point X + + +USAGE: +1. User initializes algorithm state with MinLBFGSCreate() call +2. User tunes solver parameters with MinLBFGSSetCond() MinLBFGSSetStpMax() + and other functions +3. User calls MinLBFGSOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. +4. User calls MinLBFGSResults() to get solution +5. Optionally user may call MinLBFGSRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLBFGSRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension. N>0 + M - number of corrections in the BFGS scheme of Hessian + approximation update. Recommended value: 3<=M<=7. The smaller + value causes worse convergence, the bigger will not cause a + considerably better convergence, but will cause a fall in the + performance. M<=N. + X - initial solution approximation, array[0..N-1]. + + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + +NOTES: +1. you may tune stopping conditions with MinLBFGSSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLBFGSSetStpMax() function to bound algorithm's steps. However, + L-BFGS rarely needs such a tuning. + + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreate(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlbfgsstate* state, + ae_state *_state) +{ + + _minlbfgsstate_clear(state); + + ae_assert(n>=1, "MinLBFGSCreate: N<1!", _state); + ae_assert(m>=1, "MinLBFGSCreate: M<1", _state); + ae_assert(m<=n, "MinLBFGSCreate: M>N", _state); + ae_assert(x->cnt>=n, "MinLBFGSCreate: Length(X)0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of corrections in the BFGS scheme of Hessian + approximation update. Recommended value: 3<=M<=7. The smaller + value causes worse convergence, the bigger will not cause a + considerably better convergence, but will cause a fall in the + performance. M<=N. + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinLBFGSSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. LBFGS needs exact gradient values. + Imprecise gradient may slow down convergence, especially on highly + nonlinear problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreatef(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + double diffstep, + minlbfgsstate* state, + ae_state *_state) +{ + + _minlbfgsstate_clear(state); + + ae_assert(n>=1, "MinLBFGSCreateF: N too small!", _state); + ae_assert(m>=1, "MinLBFGSCreateF: M<1", _state); + ae_assert(m<=n, "MinLBFGSCreateF: M>N", _state); + ae_assert(x->cnt>=n, "MinLBFGSCreateF: Length(X)=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinLBFGSSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetcond(minlbfgsstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsg, _state), "MinLBFGSSetCond: EpsG is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsg,0), "MinLBFGSSetCond: negative EpsG!", _state); + ae_assert(ae_isfinite(epsf, _state), "MinLBFGSSetCond: EpsF is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsf,0), "MinLBFGSSetCond: negative EpsF!", _state); + ae_assert(ae_isfinite(epsx, _state), "MinLBFGSSetCond: EpsX is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsx,0), "MinLBFGSSetCond: negative EpsX!", _state); + ae_assert(maxits>=0, "MinLBFGSSetCond: negative MaxIts!", _state); + if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) + { + epsx = 1.0E-6; + } + state->epsg = epsg; + state->epsf = epsf; + state->epsx = epsx; + state->maxits = maxits; +} + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinLBFGSOptimize(). + + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetxrep(minlbfgsstate* state, + ae_bool needxrep, + ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0 (default), if + you don't want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetstpmax(minlbfgsstate* state, + double stpmax, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(stpmax, _state), "MinLBFGSSetStpMax: StpMax is not finite!", _state); + ae_assert(ae_fp_greater_eq(stpmax,0), "MinLBFGSSetStpMax: StpMax<0!", _state); + state->stpmax = stpmax; +} + + +/************************************************************************* +This function sets scaling coefficients for LBFGS optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of the optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the LBFGS too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinLBFGSSetPrec...() +functions. + +There is special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetscale(minlbfgsstate* state, + /* Real */ ae_vector* s, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(s->cnt>=state->n, "MinLBFGSSetScale: Length(S)n-1; i++) + { + ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinLBFGSSetScale: S contains infinite or NAN elements", _state); + ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinLBFGSSetScale: S contains zero elements", _state); + state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +Extended subroutine for internal use only. + +Accepts additional parameters: + + Flags - additional settings: + * Flags = 0 means no additional settings + * Flags = 1 "do not allocate memory". used when solving + a many subsequent tasks with same N/M values. + First call MUST be without this flag bit set, + subsequent calls of MinLBFGS with same + MinLBFGSState structure can set Flags to 1. + DiffStep - numerical differentiation step + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreatex(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + ae_int_t flags, + double diffstep, + minlbfgsstate* state, + ae_state *_state) +{ + ae_bool allocatemem; + ae_int_t i; + + + ae_assert(n>=1, "MinLBFGS: N too small!", _state); + ae_assert(m>=1, "MinLBFGS: M too small!", _state); + ae_assert(m<=n, "MinLBFGS: M too large!", _state); + + /* + * Initialize + */ + state->teststep = 0; + state->diffstep = diffstep; + state->n = n; + state->m = m; + allocatemem = flags%2==0; + flags = flags/2; + if( allocatemem ) + { + ae_vector_set_length(&state->rho, m, _state); + ae_vector_set_length(&state->theta, m, _state); + ae_matrix_set_length(&state->yk, m, n, _state); + ae_matrix_set_length(&state->sk, m, n, _state); + ae_vector_set_length(&state->d, n, _state); + ae_vector_set_length(&state->x, n, _state); + ae_vector_set_length(&state->s, n, _state); + ae_vector_set_length(&state->g, n, _state); + ae_vector_set_length(&state->work, n, _state); + } + minlbfgssetcond(state, 0, 0, 0, 0, _state); + minlbfgssetxrep(state, ae_false, _state); + minlbfgssetstpmax(state, 0, _state); + minlbfgsrestartfrom(state, x, _state); + for(i=0; i<=n-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + } + state->prectype = 0; +} + + +/************************************************************************* +Modification of the preconditioner: default preconditioner (simple +scaling, same for all elements of X) is used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecdefault(minlbfgsstate* state, ae_state *_state) +{ + + + state->prectype = 0; +} + + +/************************************************************************* +Modification of the preconditioner: Cholesky factorization of approximate +Hessian is used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + P - triangular preconditioner, Cholesky factorization of + the approximate Hessian. array[0..N-1,0..N-1], + (if larger, only leading N elements are used). + IsUpper - whether upper or lower triangle of P is given + (other triangle is not referenced) + +After call to this function preconditioner is changed to P (P is copied +into the internal buffer). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: P should be nonsingular. Exception will be thrown otherwise. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetpreccholesky(minlbfgsstate* state, + /* Real */ ae_matrix* p, + ae_bool isupper, + ae_state *_state) +{ + ae_int_t i; + double mx; + + + ae_assert(isfinitertrmatrix(p, state->n, isupper, _state), "MinLBFGSSetPrecCholesky: P contains infinite or NAN values!", _state); + mx = 0; + for(i=0; i<=state->n-1; i++) + { + mx = ae_maxreal(mx, ae_fabs(p->ptr.pp_double[i][i], _state), _state); + } + ae_assert(ae_fp_greater(mx,0), "MinLBFGSSetPrecCholesky: P is strictly singular!", _state); + if( state->denseh.rowsn||state->denseh.colsn ) + { + ae_matrix_set_length(&state->denseh, state->n, state->n, _state); + } + state->prectype = 1; + if( isupper ) + { + rmatrixcopy(state->n, state->n, p, 0, 0, &state->denseh, 0, 0, _state); + } + else + { + rmatrixtranspose(state->n, state->n, p, 0, 0, &state->denseh, 0, 0, _state); + } +} + + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecdiag(minlbfgsstate* state, + /* Real */ ae_vector* d, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(d->cnt>=state->n, "MinLBFGSSetPrecDiag: D is too short", _state); + for(i=0; i<=state->n-1; i++) + { + ae_assert(ae_isfinite(d->ptr.p_double[i], _state), "MinLBFGSSetPrecDiag: D contains infinite or NAN elements", _state); + ae_assert(ae_fp_greater(d->ptr.p_double[i],0), "MinLBFGSSetPrecDiag: D contains non-positive elements", _state); + } + rvectorsetlengthatleast(&state->diagh, state->n, _state); + state->prectype = 2; + for(i=0; i<=state->n-1; i++) + { + state->diagh.ptr.p_double[i] = d->ptr.p_double[i]; + } +} + + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinLBFGSSetScale() +call (before or after MinLBFGSSetPrecScale() call). Without knowledge of +the scale of your variables scale-based preconditioner will be just unit +matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecscale(minlbfgsstate* state, ae_state *_state) +{ + + + state->prectype = 3; +} + + +/************************************************************************* +NOTES: + +1. This function has two different implementations: one which uses exact + (analytical) user-supplied gradient, and one which uses function value + only and numerically differentiates function in order to obtain + gradient. + + Depending on the specific function used to create optimizer object + (either MinLBFGSCreate() for analytical gradient or MinLBFGSCreateF() + for numerical differentiation) you should choose appropriate variant of + MinLBFGSOptimize() - one which accepts function AND gradient or one + which accepts function ONLY. + + Be careful to choose variant of MinLBFGSOptimize() which corresponds to + your optimization scheme! Table below lists different combinations of + callback (function/gradient) passed to MinLBFGSOptimize() and specific + function used to create optimizer. + + + | USER PASSED TO MinLBFGSOptimize() + CREATED WITH | function only | function and gradient + ------------------------------------------------------------ + MinLBFGSCreateF() | work FAIL + MinLBFGSCreate() | FAIL work + + Here "FAIL" denotes inappropriate combinations of optimizer creation + function and MinLBFGSOptimize() version. Attemps to use such + combination (for example, to create optimizer with MinLBFGSCreateF() and + to pass gradient information to MinCGOptimize()) will lead to exception + being thrown. Either you did not pass gradient when it WAS needed or + you passed gradient when it was NOT needed. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool minlbfgsiteration(minlbfgsstate* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t m; + ae_int_t i; + ae_int_t j; + ae_int_t ic; + ae_int_t mcinfo; + double v; + double vv; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + m = state->rstate.ia.ptr.p_int[1]; + i = state->rstate.ia.ptr.p_int[2]; + j = state->rstate.ia.ptr.p_int[3]; + ic = state->rstate.ia.ptr.p_int[4]; + mcinfo = state->rstate.ia.ptr.p_int[5]; + v = state->rstate.ra.ptr.p_double[0]; + vv = state->rstate.ra.ptr.p_double[1]; + } + else + { + n = -983; + m = -989; + i = -834; + j = 900; + ic = -287; + mcinfo = 364; + v = 214; + vv = -338; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + if( state->rstate.stage==5 ) + { + goto lbl_5; + } + if( state->rstate.stage==6 ) + { + goto lbl_6; + } + if( state->rstate.stage==7 ) + { + goto lbl_7; + } + if( state->rstate.stage==8 ) + { + goto lbl_8; + } + if( state->rstate.stage==9 ) + { + goto lbl_9; + } + if( state->rstate.stage==10 ) + { + goto lbl_10; + } + if( state->rstate.stage==11 ) + { + goto lbl_11; + } + if( state->rstate.stage==12 ) + { + goto lbl_12; + } + if( state->rstate.stage==13 ) + { + goto lbl_13; + } + if( state->rstate.stage==14 ) + { + goto lbl_14; + } + if( state->rstate.stage==15 ) + { + goto lbl_15; + } + if( state->rstate.stage==16 ) + { + goto lbl_16; + } + + /* + * Routine body + */ + + /* + * Unload frequently used variables from State structure + * (just for typing convinience) + */ + n = state->n; + m = state->m; + state->repterminationtype = 0; + state->repiterationscount = 0; + state->repvaridx = -1; + state->repnfev = 0; + + /* + * Check, that transferred derivative value is right + */ + minlbfgs_clearrequestfields(state, _state); + if( !(ae_fp_eq(state->diffstep,0)&&ae_fp_greater(state->teststep,0)) ) + { + goto lbl_17; + } + state->needfg = ae_true; + i = 0; +lbl_19: + if( i>n-1 ) + { + goto lbl_21; + } + v = state->x.ptr.p_double[i]; + state->x.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->fm1 = state->f; + state->fp1 = state->g.ptr.p_double[i]; + state->x.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->fm2 = state->f; + state->fp2 = state->g.ptr.p_double[i]; + state->x.ptr.p_double[i] = v; + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + + /* + * 2*State.TestStep - scale parameter + * width of segment [Xi-TestStep;Xi+TestStep] + */ + if( !derivativecheck(state->fm1, state->fp1, state->fm2, state->fp2, state->f, state->g.ptr.p_double[i], 2*state->teststep, _state) ) + { + state->repvaridx = i; + state->repterminationtype = -7; + result = ae_false; + return result; + } + i = i+1; + goto lbl_19; +lbl_21: + state->needfg = ae_false; +lbl_17: + + /* + * Calculate F/G at the initial point + */ + minlbfgs_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_22; + } + state->needfg = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needfg = ae_false; + goto lbl_23; +lbl_22: + state->needf = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->fbase = state->f; + i = 0; +lbl_24: + if( i>n-1 ) + { + goto lbl_26; + } + v = state->x.ptr.p_double[i]; + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 5; + goto lbl_rcomm; +lbl_5: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 7; + goto lbl_rcomm; +lbl_7: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 8; + goto lbl_rcomm; +lbl_8: + state->fp2 = state->f; + state->x.ptr.p_double[i] = v; + state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); + i = i+1; + goto lbl_24; +lbl_26: + state->f = state->fbase; + state->needf = ae_false; +lbl_23: + trimprepare(state->f, &state->trimthreshold, _state); + if( !state->xrep ) + { + goto lbl_27; + } + minlbfgs_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 9; + goto lbl_rcomm; +lbl_9: + state->xupdated = ae_false; +lbl_27: + state->repnfev = 1; + state->fold = state->f; + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->g.ptr.p_double[i]*state->s.ptr.p_double[i], _state); + } + if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsg) ) + { + state->repterminationtype = 4; + result = ae_false; + return result; + } + + /* + * Choose initial step and direction. + * Apply preconditioner, if we have something other than default. + */ + ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( state->prectype==0 ) + { + + /* + * Default preconditioner is used, but we can't use it before iterations will start + */ + v = ae_v_dotproduct(&state->g.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v = ae_sqrt(v, _state); + if( ae_fp_eq(state->stpmax,0) ) + { + state->stp = ae_minreal(1.0/v, 1, _state); + } + else + { + state->stp = ae_minreal(1.0/v, state->stpmax, _state); + } + } + if( state->prectype==1 ) + { + + /* + * Cholesky preconditioner is used + */ + fblscholeskysolve(&state->denseh, 1.0, n, ae_true, &state->d, &state->autobuf, _state); + state->stp = 1; + } + if( state->prectype==2 ) + { + + /* + * diagonal approximation is used + */ + for(i=0; i<=n-1; i++) + { + state->d.ptr.p_double[i] = state->d.ptr.p_double[i]/state->diagh.ptr.p_double[i]; + } + state->stp = 1; + } + if( state->prectype==3 ) + { + + /* + * scale-based preconditioner is used + */ + for(i=0; i<=n-1; i++) + { + state->d.ptr.p_double[i] = state->d.ptr.p_double[i]*state->s.ptr.p_double[i]*state->s.ptr.p_double[i]; + } + state->stp = 1; + } + + /* + * Main cycle + */ + state->k = 0; +lbl_29: + if( ae_false ) + { + goto lbl_30; + } + + /* + * Main cycle: prepare to 1-D line search + */ + state->p = state->k%m; + state->q = ae_minint(state->k, m-1, _state); + + /* + * Store X[k], G[k] + */ + ae_v_moveneg(&state->sk.ptr.pp_double[state->p][0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_moveneg(&state->yk.ptr.pp_double[state->p][0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * Minimize F(x+alpha*d) + * Calculate S[k], Y[k] + */ + state->mcstage = 0; + if( state->k!=0 ) + { + state->stp = 1.0; + } + linminnormalized(&state->d, &state->stp, n, _state); + mcsrch(n, &state->x, &state->f, &state->g, &state->d, &state->stp, state->stpmax, minlbfgs_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); +lbl_31: + if( state->mcstage==0 ) + { + goto lbl_32; + } + minlbfgs_clearrequestfields(state, _state); + if( ae_fp_neq(state->diffstep,0) ) + { + goto lbl_33; + } + state->needfg = ae_true; + state->rstate.stage = 10; + goto lbl_rcomm; +lbl_10: + state->needfg = ae_false; + goto lbl_34; +lbl_33: + state->needf = ae_true; + state->rstate.stage = 11; + goto lbl_rcomm; +lbl_11: + state->fbase = state->f; + i = 0; +lbl_35: + if( i>n-1 ) + { + goto lbl_37; + } + v = state->x.ptr.p_double[i]; + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 12; + goto lbl_rcomm; +lbl_12: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 13; + goto lbl_rcomm; +lbl_13: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 14; + goto lbl_rcomm; +lbl_14: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 15; + goto lbl_rcomm; +lbl_15: + state->fp2 = state->f; + state->x.ptr.p_double[i] = v; + state->g.ptr.p_double[i] = (8*(state->fp1-state->fm1)-(state->fp2-state->fm2))/(6*state->diffstep*state->s.ptr.p_double[i]); + i = i+1; + goto lbl_35; +lbl_37: + state->f = state->fbase; + state->needf = ae_false; +lbl_34: + trimfunction(&state->f, &state->g, n, state->trimthreshold, _state); + mcsrch(n, &state->x, &state->f, &state->g, &state->d, &state->stp, state->stpmax, minlbfgs_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); + goto lbl_31; +lbl_32: + if( !state->xrep ) + { + goto lbl_38; + } + + /* + * report + */ + minlbfgs_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 16; + goto lbl_rcomm; +lbl_16: + state->xupdated = ae_false; +lbl_38: + state->repnfev = state->repnfev+state->nfev; + state->repiterationscount = state->repiterationscount+1; + ae_v_add(&state->sk.ptr.pp_double[state->p][0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_add(&state->yk.ptr.pp_double[state->p][0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * Stopping conditions + */ + if( state->repiterationscount>=state->maxits&&state->maxits>0 ) + { + + /* + * Too many iterations + */ + state->repterminationtype = 5; + result = ae_false; + return result; + } + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->g.ptr.p_double[i]*state->s.ptr.p_double[i], _state); + } + if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsg) ) + { + + /* + * Gradient is small enough + */ + state->repterminationtype = 4; + result = ae_false; + return result; + } + if( ae_fp_less_eq(state->fold-state->f,state->epsf*ae_maxreal(ae_fabs(state->fold, _state), ae_maxreal(ae_fabs(state->f, _state), 1.0, _state), _state)) ) + { + + /* + * F(k+1)-F(k) is small enough + */ + state->repterminationtype = 1; + result = ae_false; + return result; + } + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->sk.ptr.pp_double[state->p][i]/state->s.ptr.p_double[i], _state); + } + if( ae_fp_less_eq(ae_sqrt(v, _state),state->epsx) ) + { + + /* + * X(k+1)-X(k) is small enough + */ + state->repterminationtype = 2; + result = ae_false; + return result; + } + + /* + * If Wolfe conditions are satisfied, we can update + * limited memory model. + * + * However, if conditions are not satisfied (NFEV limit is met, + * function is too wild, ...), we'll skip L-BFGS update + */ + if( mcinfo!=1 ) + { + + /* + * Skip update. + * + * In such cases we'll initialize search direction by + * antigradient vector, because it leads to more + * transparent code with less number of special cases + */ + state->fold = state->f; + ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + } + else + { + + /* + * Calculate Rho[k], GammaK + */ + v = ae_v_dotproduct(&state->yk.ptr.pp_double[state->p][0], 1, &state->sk.ptr.pp_double[state->p][0], 1, ae_v_len(0,n-1)); + vv = ae_v_dotproduct(&state->yk.ptr.pp_double[state->p][0], 1, &state->yk.ptr.pp_double[state->p][0], 1, ae_v_len(0,n-1)); + if( ae_fp_eq(v,0)||ae_fp_eq(vv,0) ) + { + + /* + * Rounding errors make further iterations impossible. + */ + state->repterminationtype = -2; + result = ae_false; + return result; + } + state->rho.ptr.p_double[state->p] = 1/v; + state->gammak = v/vv; + + /* + * Calculate d(k+1) = -H(k+1)*g(k+1) + * + * for I:=K downto K-Q do + * V = s(i)^T * work(iteration:I) + * theta(i) = V + * work(iteration:I+1) = work(iteration:I) - V*Rho(i)*y(i) + * work(last iteration) = H0*work(last iteration) - preconditioner + * for I:=K-Q to K do + * V = y(i)^T*work(iteration:I) + * work(iteration:I+1) = work(iteration:I) +(-V+theta(i))*Rho(i)*s(i) + * + * NOW WORK CONTAINS d(k+1) + */ + ae_v_move(&state->work.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=state->k; i>=state->k-state->q; i--) + { + ic = i%m; + v = ae_v_dotproduct(&state->sk.ptr.pp_double[ic][0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->theta.ptr.p_double[ic] = v; + vv = v*state->rho.ptr.p_double[ic]; + ae_v_subd(&state->work.ptr.p_double[0], 1, &state->yk.ptr.pp_double[ic][0], 1, ae_v_len(0,n-1), vv); + } + if( state->prectype==0 ) + { + + /* + * Simple preconditioner is used + */ + v = state->gammak; + ae_v_muld(&state->work.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + } + if( state->prectype==1 ) + { + + /* + * Cholesky preconditioner is used + */ + fblscholeskysolve(&state->denseh, 1, n, ae_true, &state->work, &state->autobuf, _state); + } + if( state->prectype==2 ) + { + + /* + * diagonal approximation is used + */ + for(i=0; i<=n-1; i++) + { + state->work.ptr.p_double[i] = state->work.ptr.p_double[i]/state->diagh.ptr.p_double[i]; + } + } + if( state->prectype==3 ) + { + + /* + * scale-based preconditioner is used + */ + for(i=0; i<=n-1; i++) + { + state->work.ptr.p_double[i] = state->work.ptr.p_double[i]*state->s.ptr.p_double[i]*state->s.ptr.p_double[i]; + } + } + for(i=state->k-state->q; i<=state->k; i++) + { + ic = i%m; + v = ae_v_dotproduct(&state->yk.ptr.pp_double[ic][0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); + vv = state->rho.ptr.p_double[ic]*(-v+state->theta.ptr.p_double[ic]); + ae_v_addd(&state->work.ptr.p_double[0], 1, &state->sk.ptr.pp_double[ic][0], 1, ae_v_len(0,n-1), vv); + } + ae_v_moveneg(&state->d.ptr.p_double[0], 1, &state->work.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * Next step + */ + state->fold = state->f; + state->k = state->k+1; + } + goto lbl_29; +lbl_30: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = m; + state->rstate.ia.ptr.p_int[2] = i; + state->rstate.ia.ptr.p_int[3] = j; + state->rstate.ia.ptr.p_int[4] = ic; + state->rstate.ia.ptr.p_int[5] = mcinfo; + state->rstate.ra.ptr.p_double[0] = v; + state->rstate.ra.ptr.p_double[1] = vv; + return result; +} + + +/************************************************************************* +L-BFGS algorithm results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -7 gradient verification failed. + See MinLBFGSSetGradientCheck() for more information. + * -2 rounding errors prevent further improvement. + X contains best point found. + * -1 incorrect parameters were specified + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsresults(minlbfgsstate* state, + /* Real */ ae_vector* x, + minlbfgsreport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _minlbfgsreport_clear(rep); + + minlbfgsresultsbuf(state, x, rep, _state); +} + + +/************************************************************************* +L-BFGS algorithm results + +Buffered implementation of MinLBFGSResults which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsresultsbuf(minlbfgsstate* state, + /* Real */ ae_vector* x, + minlbfgsreport* rep, + ae_state *_state) +{ + + + if( x->cntn ) + { + ae_vector_set_length(x, state->n, _state); + } + ae_v_move(&x->ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + rep->iterationscount = state->repiterationscount; + rep->nfev = state->repnfev; + rep->varidx = state->repvaridx; + rep->terminationtype = state->repterminationtype; +} + + +/************************************************************************* +This subroutine restarts LBFGS algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used to store algorithm state + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsrestartfrom(minlbfgsstate* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + + + ae_assert(x->cnt>=state->n, "MinLBFGSRestartFrom: Length(X)n, _state), "MinLBFGSRestartFrom: X contains infinite or NaN values!", _state); + ae_v_move(&state->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + ae_vector_set_length(&state->rstate.ia, 5+1, _state); + ae_vector_set_length(&state->rstate.ra, 1+1, _state); + state->rstate.stage = -1; + minlbfgs_clearrequestfields(state, _state); +} + + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinLBFGSOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinLBFGSSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 24.05.2012 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetgradientcheck(minlbfgsstate* state, + double teststep, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(teststep, _state), "MinLBFGSSetGradientCheck: TestStep contains NaN or Infinite", _state); + ae_assert(ae_fp_greater_eq(teststep,0), "MinLBFGSSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); + state->teststep = teststep; +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forgot to clear something) +*************************************************************************/ +static void minlbfgs_clearrequestfields(minlbfgsstate* state, + ae_state *_state) +{ + + + state->needf = ae_false; + state->needfg = ae_false; + state->xupdated = ae_false; +} + + +ae_bool _minlbfgsstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minlbfgsstate *p = (minlbfgsstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rho, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->yk, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->sk, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->theta, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->work, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->denseh, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->diagh, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->autobuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + if( !_linminstate_init(&p->lstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _minlbfgsstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minlbfgsstate *dst = (minlbfgsstate*)_dst; + minlbfgsstate *src = (minlbfgsstate*)_src; + dst->n = src->n; + dst->m = src->m; + dst->epsg = src->epsg; + dst->epsf = src->epsf; + dst->epsx = src->epsx; + dst->maxits = src->maxits; + dst->xrep = src->xrep; + dst->stpmax = src->stpmax; + if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) + return ae_false; + dst->diffstep = src->diffstep; + dst->nfev = src->nfev; + dst->mcstage = src->mcstage; + dst->k = src->k; + dst->q = src->q; + dst->p = src->p; + if( !ae_vector_init_copy(&dst->rho, &src->rho, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->yk, &src->yk, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->sk, &src->sk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->theta, &src->theta, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) + return ae_false; + dst->stp = src->stp; + if( !ae_vector_init_copy(&dst->work, &src->work, _state, make_automatic) ) + return ae_false; + dst->fold = src->fold; + dst->trimthreshold = src->trimthreshold; + dst->prectype = src->prectype; + dst->gammak = src->gammak; + if( !ae_matrix_init_copy(&dst->denseh, &src->denseh, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->diagh, &src->diagh, _state, make_automatic) ) + return ae_false; + dst->fbase = src->fbase; + dst->fm2 = src->fm2; + dst->fm1 = src->fm1; + dst->fp1 = src->fp1; + dst->fp2 = src->fp2; + if( !ae_vector_init_copy(&dst->autobuf, &src->autobuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + dst->f = src->f; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + dst->needf = src->needf; + dst->needfg = src->needfg; + dst->xupdated = src->xupdated; + dst->teststep = src->teststep; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + dst->repiterationscount = src->repiterationscount; + dst->repnfev = src->repnfev; + dst->repvaridx = src->repvaridx; + dst->repterminationtype = src->repterminationtype; + if( !_linminstate_init_copy(&dst->lstate, &src->lstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _minlbfgsstate_clear(void* _p) +{ + minlbfgsstate *p = (minlbfgsstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->s); + ae_vector_clear(&p->rho); + ae_matrix_clear(&p->yk); + ae_matrix_clear(&p->sk); + ae_vector_clear(&p->theta); + ae_vector_clear(&p->d); + ae_vector_clear(&p->work); + ae_matrix_clear(&p->denseh); + ae_vector_clear(&p->diagh); + ae_vector_clear(&p->autobuf); + ae_vector_clear(&p->x); + ae_vector_clear(&p->g); + _rcommstate_clear(&p->rstate); + _linminstate_clear(&p->lstate); +} + + +void _minlbfgsstate_destroy(void* _p) +{ + minlbfgsstate *p = (minlbfgsstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->s); + ae_vector_destroy(&p->rho); + ae_matrix_destroy(&p->yk); + ae_matrix_destroy(&p->sk); + ae_vector_destroy(&p->theta); + ae_vector_destroy(&p->d); + ae_vector_destroy(&p->work); + ae_matrix_destroy(&p->denseh); + ae_vector_destroy(&p->diagh); + ae_vector_destroy(&p->autobuf); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->g); + _rcommstate_destroy(&p->rstate); + _linminstate_destroy(&p->lstate); +} + + +ae_bool _minlbfgsreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minlbfgsreport *p = (minlbfgsreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _minlbfgsreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minlbfgsreport *dst = (minlbfgsreport*)_dst; + minlbfgsreport *src = (minlbfgsreport*)_src; + dst->iterationscount = src->iterationscount; + dst->nfev = src->nfev; + dst->varidx = src->varidx; + dst->terminationtype = src->terminationtype; + return ae_true; +} + + +void _minlbfgsreport_clear(void* _p) +{ + minlbfgsreport *p = (minlbfgsreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _minlbfgsreport_destroy(void* _p) +{ + minlbfgsreport *p = (minlbfgsreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* + CONSTRAINED QUADRATIC PROGRAMMING + +The subroutine creates QP optimizer. After initial creation, it contains +default optimization problem with zero quadratic and linear terms and no +constraints. You should set quadratic/linear terms with calls to functions +provided by MinQP subpackage. + +INPUT PARAMETERS: + N - problem size + +OUTPUT PARAMETERS: + State - optimizer with zero quadratic/linear terms + and no constraints + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpcreate(ae_int_t n, minqpstate* state, ae_state *_state) +{ + ae_int_t i; + + _minqpstate_clear(state); + + ae_assert(n>=1, "MinQPCreate: N<1", _state); + + /* + * initialize QP solver + */ + state->n = n; + state->nec = 0; + state->nic = 0; + state->repterminationtype = 0; + state->anorm = 1; + state->akind = 0; + cqminit(n, &state->a, _state); + sasinit(n, &state->sas, _state); + ae_vector_set_length(&state->b, n, _state); + ae_vector_set_length(&state->bndl, n, _state); + ae_vector_set_length(&state->bndu, n, _state); + ae_vector_set_length(&state->workbndl, n, _state); + ae_vector_set_length(&state->workbndu, n, _state); + ae_vector_set_length(&state->havebndl, n, _state); + ae_vector_set_length(&state->havebndu, n, _state); + ae_vector_set_length(&state->s, n, _state); + ae_vector_set_length(&state->startx, n, _state); + ae_vector_set_length(&state->xorigin, n, _state); + ae_vector_set_length(&state->xs, n, _state); + ae_vector_set_length(&state->xn, n, _state); + ae_vector_set_length(&state->gc, n, _state); + ae_vector_set_length(&state->pg, n, _state); + for(i=0; i<=n-1; i++) + { + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->bndu.ptr.p_double[i] = _state->v_posinf; + state->havebndl.ptr.p_bool[i] = ae_false; + state->havebndu.ptr.p_bool[i] = ae_false; + state->b.ptr.p_double[i] = 0.0; + state->startx.ptr.p_double[i] = 0.0; + state->xorigin.ptr.p_double[i] = 0.0; + state->s.ptr.p_double[i] = 1.0; + } + state->havex = ae_false; + minqpsetalgocholesky(state, _state); + normestimatorcreate(n, n, 5, 5, &state->estimator, _state); + minbleiccreate(n, &state->startx, &state->solver, _state); +} + + +/************************************************************************* +This function sets linear term for QP solver. + +By default, linear term is zero. + +INPUT PARAMETERS: + State - structure which stores algorithm state + B - linear term, array[N]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetlinearterm(minqpstate* state, + /* Real */ ae_vector* b, + ae_state *_state) +{ + ae_int_t n; + + + n = state->n; + ae_assert(b->cnt>=n, "MinQPSetLinearTerm: Length(B)n; + ae_assert(a->rows>=n, "MinQPSetQuadraticTerm: Rows(A)cols>=n, "MinQPSetQuadraticTerm: Cols(A)n; + ae_assert(sparsegetnrows(a, _state)>=n, "MinQPSetQuadraticTermSparse: Rows(A)=n, "MinQPSetQuadraticTermSparse: Cols(A)sparsea, _state); + state->sparseaupper = isupper; + state->akind = 1; +} + + +/************************************************************************* +This function sets starting point for QP solver. It is useful to have +good initial approximation to the solution, because it will increase +speed of convergence and identification of active constraints. + +INPUT PARAMETERS: + State - structure which stores algorithm state + X - starting point, array[N]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetstartingpoint(minqpstate* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + + + n = state->n; + ae_assert(x->cnt>=n, "MinQPSetStartingPoint: Length(B)n; + ae_assert(xorigin->cnt>=n, "MinQPSetOrigin: Length(B)cnt>=state->n, "MinQPSetScale: Length(S)n-1; i++) + { + ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinQPSetScale: S contains infinite or NAN elements", _state); + ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinQPSetScale: S contains zero elements", _state); + state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +This function tells solver to use Cholesky-based algorithm. This algorithm +is active by default. + +DESCRIPTION: + +Cholesky-based algorithm can be used only for problems which: +* have dense quadratic term, set by MinQPSetQuadraticTerm(), sparse or + structured problems are not supported. +* are strictly convex, i.e. quadratic term is symmetric positive definite, + indefinite or semidefinite problems are not supported by this algorithm. + +If anything of what listed above is violated, you may use BLEIC-based QP +algorithm which can be activated by MinQPSetAlgoBLEIC(). + +BENEFITS AND DRAWBACKS: + +This algorithm gives best precision amongst all QP solvers provided by +ALGLIB (Newton iterations have much higher precision than any other +optimization algorithm). This solver also gracefully handles problems with +very large amount of constraints. + +Performance of the algorithm is good because internally it uses Level 3 +Dense BLAS for its performance-critical parts. + + +From the other side, algorithm has O(N^3) complexity for unconstrained +problems and up to orders of magnitude slower on constrained problems +(these additional iterations are needed to identify active constraints). +So, its running time depends on number of constraints active at solution. + +Furthermore, this algorithm can not solve problems with sparse matrices or +problems with semidefinite/indefinite matrices of any kind (dense/sparse). + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetalgocholesky(minqpstate* state, ae_state *_state) +{ + + + state->algokind = 1; +} + + +/************************************************************************* +This function tells solver to use BLEIC-based algorithm and sets stopping +criteria for the algorithm. + +DESCRIPTION: + +BLEIC-based QP algorithm can be used for any kind of QP problems: +* problems with both dense and sparse quadratic terms +* problems with positive definite, semidefinite, indefinite terms + +BLEIC-based algorithm can solve even indefinite problems - as long as they +are bounded from below on the feasible set. Of course, global minimum is +found only for positive definite and semidefinite problems. As for +indefinite ones - only local minimum is found. + +BENEFITS AND DRAWBACKS: + +This algorithm can be used to solve both convex and indefinite QP problems +and it can utilize sparsity of the quadratic term (algorithm calculates +matrix-vector products, which can be performed efficiently in case of +sparse matrix). + +Algorithm has iteration cost, which (assuming fixed amount of non-boundary +linear constraints) linearly depends on problem size. Boundary constraints +does not significantly change iteration cost. + +Thus, it outperforms Cholesky-based QP algorithm (CQP) on high-dimensional +sparse problems with moderate amount of constraints. + + +From the other side, unlike CQP solver, this algorithm does NOT make use +of Level 3 Dense BLAS. Thus, its performance on dense problems is inferior +to that of CQP solver. + +Its precision is also inferior to that of CQP. CQP performs Newton steps +which are know to achieve very good precision. In many cases Newton step +leads us exactly to the solution. BLEIC-QP performs LBFGS steps, which are +good at detecting neighborhood of the solution, buy need many iterations +to find solution with 6 digits of precision. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if exploratory steepest + descent step on k+1-th iteration satisfies following + condition: |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + EpsX - >=0 + The subroutine finishes its work if exploratory steepest + descent step on k+1-th iteration satisfies following + condition: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - step vector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinQPSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead +to automatic stopping criterion selection (presently it is small step +length, but it may change in the future versions of ALGLIB). + +IT IS VERY IMPORTANT THAT YOU CALL MinQPSetScale() WHEN YOU USE THIS ALGO! + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetalgobleic(minqpstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsg, _state), "MinQPSetAlgoBLEIC: EpsG is not finite number", _state); + ae_assert(ae_fp_greater_eq(epsg,0), "MinQPSetAlgoBLEIC: negative EpsG", _state); + ae_assert(ae_isfinite(epsf, _state), "MinQPSetAlgoBLEIC: EpsF is not finite number", _state); + ae_assert(ae_fp_greater_eq(epsf,0), "MinQPSetAlgoBLEIC: negative EpsF", _state); + ae_assert(ae_isfinite(epsx, _state), "MinQPSetAlgoBLEIC: EpsX is not finite number", _state); + ae_assert(ae_fp_greater_eq(epsx,0), "MinQPSetAlgoBLEIC: negative EpsX", _state); + ae_assert(maxits>=0, "MinQPSetAlgoBLEIC: negative MaxIts!", _state); + state->algokind = 2; + if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) + { + epsx = 1.0E-6; + } + state->bleicepsg = epsg; + state->bleicepsf = epsf; + state->bleicepsx = epsx; + state->bleicmaxits = maxits; +} + + +/************************************************************************* +This function sets boundary constraints for QP solver + +Boundary constraints are inactive by default (after initial creation). +After being set, they are preserved until explicitly turned off with +another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetbc(minqpstate* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n; + + + n = state->n; + ae_assert(bndl->cnt>=n, "MinQPSetBC: Length(BndL)cnt>=n, "MinQPSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "MinQPSetBC: BndL contains NAN or +INF", _state); + ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "MinQPSetBC: BndU contains NAN or -INF", _state); + state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; + state->havebndl.ptr.p_bool[i] = ae_isfinite(bndl->ptr.p_double[i], _state); + state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; + state->havebndu.ptr.p_bool[i] = ae_isfinite(bndu->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +This function sets linear constraints for QP optimizer. + +Linear constraints are inactive by default (after initial creation). + +INPUT PARAMETERS: + State - structure previously allocated with MinQPCreate call. + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + +NOTE 1: linear (non-bound) constraints are satisfied only approximately - + there always exists some minor violation (about 10^-10...10^-13) + due to numerical errors. + + -- ALGLIB -- + Copyright 19.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minqpsetlc(minqpstate* state, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* ct, + ae_int_t k, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + double v; + + + n = state->n; + + /* + * First, check for errors in the inputs + */ + ae_assert(k>=0, "MinQPSetLC: K<0", _state); + ae_assert(c->cols>=n+1||k==0, "MinQPSetLC: Cols(C)rows>=k, "MinQPSetLC: Rows(C)cnt>=k, "MinQPSetLC: Length(CT)nec = 0; + state->nic = 0; + return; + } + + /* + * Equality constraints are stored first, in the upper + * NEC rows of State.CLEIC matrix. Inequality constraints + * are stored in the next NIC rows. + * + * NOTE: we convert inequality constraints to the form + * A*x<=b before copying them. + */ + rmatrixsetlengthatleast(&state->cleic, k, n+1, _state); + state->nec = 0; + state->nic = 0; + for(i=0; i<=k-1; i++) + { + if( ct->ptr.p_int[i]==0 ) + { + ae_v_move(&state->cleic.ptr.pp_double[state->nec][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + state->nec = state->nec+1; + } + } + for(i=0; i<=k-1; i++) + { + if( ct->ptr.p_int[i]!=0 ) + { + if( ct->ptr.p_int[i]>0 ) + { + ae_v_moveneg(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + } + else + { + ae_v_move(&state->cleic.ptr.pp_double[state->nec+state->nic][0], 1, &c->ptr.pp_double[i][0], 1, ae_v_len(0,n)); + } + state->nic = state->nic+1; + } + } + + /* + * Normalize rows of State.CLEIC: each row must have unit norm. + * Norm is calculated using first N elements (i.e. right part is + * not counted when we calculate norm). + */ + for(i=0; i<=k-1; i++) + { + v = 0; + for(j=0; j<=n-1; j++) + { + v = v+ae_sqr(state->cleic.ptr.pp_double[i][j], _state); + } + if( ae_fp_eq(v,0) ) + { + continue; + } + v = 1/ae_sqrt(v, _state); + ae_v_muld(&state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n), v); + } +} + + +/************************************************************************* +This function solves quadratic programming problem. +You should call it after setting solver options with MinQPSet...() calls. + +INPUT PARAMETERS: + State - algorithm state + +You should use MinQPResults() function to access results after calls +to this function. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey. + Special thanks to Elvira Illarionova for important suggestions on + the linearly constrained QP algorithm. +*************************************************************************/ +void minqpoptimize(minqpstate* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t nbc; + double v0; + double v1; + double v; + double d2; + double d1; + double d0; + double noisetolerance; + double fprev; + double fcand; + double fcur; + ae_int_t nextaction; + ae_int_t actstatus; + double noiselevel; + ae_int_t badnewtonits; + double maxscaledgrad; + + + noisetolerance = 10; + n = state->n; + state->repterminationtype = -5; + state->repinneriterationscount = 0; + state->repouteriterationscount = 0; + state->repncholesky = 0; + state->repnmv = 0; + state->debugphase1flops = 0; + state->debugphase2flops = 0; + state->debugphase3flops = 0; + rvectorsetlengthatleast(&state->rctmpg, n, _state); + + /* + * check correctness of constraints + */ + for(i=0; i<=n-1; i++) + { + if( state->havebndl.ptr.p_bool[i]&&state->havebndu.ptr.p_bool[i] ) + { + if( ae_fp_greater(state->bndl.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->repterminationtype = -3; + return; + } + } + } + + /* + * count number of bound and linear constraints + */ + nbc = 0; + for(i=0; i<=n-1; i++) + { + if( state->havebndl.ptr.p_bool[i] ) + { + nbc = nbc+1; + } + if( state->havebndu.ptr.p_bool[i] ) + { + nbc = nbc+1; + } + } + + /* + * Initial point: + * * if we have starting point in StartX, we just have to bound it + * * if we do not have StartX, deduce initial point from boundary constraints + */ + if( state->havex ) + { + for(i=0; i<=n-1; i++) + { + state->xs.ptr.p_double[i] = state->startx.ptr.p_double[i]; + if( state->havebndl.ptr.p_bool[i]&&ae_fp_less(state->xs.ptr.p_double[i],state->bndl.ptr.p_double[i]) ) + { + state->xs.ptr.p_double[i] = state->bndl.ptr.p_double[i]; + } + if( state->havebndu.ptr.p_bool[i]&&ae_fp_greater(state->xs.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->xs.ptr.p_double[i] = state->bndu.ptr.p_double[i]; + } + } + } + else + { + for(i=0; i<=n-1; i++) + { + if( state->havebndl.ptr.p_bool[i]&&state->havebndu.ptr.p_bool[i] ) + { + state->xs.ptr.p_double[i] = 0.5*(state->bndl.ptr.p_double[i]+state->bndu.ptr.p_double[i]); + continue; + } + if( state->havebndl.ptr.p_bool[i] ) + { + state->xs.ptr.p_double[i] = state->bndl.ptr.p_double[i]; + continue; + } + if( state->havebndu.ptr.p_bool[i] ) + { + state->xs.ptr.p_double[i] = state->bndu.ptr.p_double[i]; + continue; + } + state->xs.ptr.p_double[i] = 0; + } + } + + /* + * Cholesky solver. + */ + if( state->algokind==1 ) + { + + /* + * Check matrix type. + * Cholesky solver supports only dense matrices. + */ + if( state->akind!=0 ) + { + state->repterminationtype = -5; + return; + } + + /* + * Our formulation of quadratic problem includes origin point, + * i.e. we have F(x-x_origin) which is minimized subject to + * constraints on x, instead of having simply F(x). + * + * Here we make transition from non-zero origin to zero one. + * In order to make such transition we have to: + * 1. subtract x_origin from x_start + * 2. modify constraints + * 3. solve problem + * 4. add x_origin to solution + * + * There is alternate solution - to modify quadratic function + * by expansion of multipliers containing (x-x_origin), but + * we prefer to modify constraints, because it is a) more precise + * and b) easier to to. + * + * Parts (1)-(2) are done here. After this block is over, + * we have: + * * XS, which stores shifted XStart (if we don't have XStart, + * value of XS will be ignored later) + * * WorkBndL, WorkBndU, which store modified boundary constraints. + */ + for(i=0; i<=n-1; i++) + { + if( state->havebndl.ptr.p_bool[i] ) + { + state->workbndl.ptr.p_double[i] = state->bndl.ptr.p_double[i]-state->xorigin.ptr.p_double[i]; + } + else + { + state->workbndl.ptr.p_double[i] = _state->v_neginf; + } + if( state->havebndu.ptr.p_bool[i] ) + { + state->workbndu.ptr.p_double[i] = state->bndu.ptr.p_double[i]-state->xorigin.ptr.p_double[i]; + } + else + { + state->workbndu.ptr.p_double[i] = _state->v_posinf; + } + } + rmatrixsetlengthatleast(&state->workcleic, state->nec+state->nic, n+1, _state); + for(i=0; i<=state->nec+state->nic-1; i++) + { + v = ae_v_dotproduct(&state->cleic.ptr.pp_double[i][0], 1, &state->xorigin.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->workcleic.ptr.pp_double[i][0], 1, &state->cleic.ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + state->workcleic.ptr.pp_double[i][n] = state->cleic.ptr.pp_double[i][n]-v; + } + + /* + * Starting point XS + */ + if( state->havex ) + { + + /* + * We have starting point in StartX, so we just have to shift and bound it + */ + for(i=0; i<=n-1; i++) + { + state->xs.ptr.p_double[i] = state->startx.ptr.p_double[i]-state->xorigin.ptr.p_double[i]; + if( state->havebndl.ptr.p_bool[i] ) + { + if( ae_fp_less(state->xs.ptr.p_double[i],state->workbndl.ptr.p_double[i]) ) + { + state->xs.ptr.p_double[i] = state->workbndl.ptr.p_double[i]; + } + } + if( state->havebndu.ptr.p_bool[i] ) + { + if( ae_fp_greater(state->xs.ptr.p_double[i],state->workbndu.ptr.p_double[i]) ) + { + state->xs.ptr.p_double[i] = state->workbndu.ptr.p_double[i]; + } + } + } + } + else + { + + /* + * We don't have starting point, so we deduce it from + * constraints (if they are present). + * + * NOTE: XS contains some meaningless values from previous block + * which are ignored by code below. + */ + for(i=0; i<=n-1; i++) + { + if( state->havebndl.ptr.p_bool[i]&&state->havebndu.ptr.p_bool[i] ) + { + state->xs.ptr.p_double[i] = 0.5*(state->workbndl.ptr.p_double[i]+state->workbndu.ptr.p_double[i]); + if( ae_fp_less(state->xs.ptr.p_double[i],state->workbndl.ptr.p_double[i]) ) + { + state->xs.ptr.p_double[i] = state->workbndl.ptr.p_double[i]; + } + if( ae_fp_greater(state->xs.ptr.p_double[i],state->workbndu.ptr.p_double[i]) ) + { + state->xs.ptr.p_double[i] = state->workbndu.ptr.p_double[i]; + } + continue; + } + if( state->havebndl.ptr.p_bool[i] ) + { + state->xs.ptr.p_double[i] = state->workbndl.ptr.p_double[i]; + continue; + } + if( state->havebndu.ptr.p_bool[i] ) + { + state->xs.ptr.p_double[i] = state->workbndu.ptr.p_double[i]; + continue; + } + state->xs.ptr.p_double[i] = 0; + } + } + + /* + * Handle special case - no constraints + */ + if( nbc==0&&state->nec+state->nic==0 ) + { + + /* + * "Simple" unconstrained Cholesky + */ + bvectorsetlengthatleast(&state->tmpb, n, _state); + for(i=0; i<=n-1; i++) + { + state->tmpb.ptr.p_bool[i] = ae_false; + } + state->repncholesky = state->repncholesky+1; + cqmsetb(&state->a, &state->b, _state); + cqmsetactiveset(&state->a, &state->xs, &state->tmpb, _state); + if( !cqmconstrainedoptimum(&state->a, &state->xn, _state) ) + { + state->repterminationtype = -5; + return; + } + ae_v_move(&state->xs.ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_add(&state->xs.ptr.p_double[0], 1, &state->xorigin.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->repinneriterationscount = 1; + state->repouteriterationscount = 1; + state->repterminationtype = 4; + return; + } + + /* + * Prepare "active set" structure + */ + sassetbc(&state->sas, &state->workbndl, &state->workbndu, _state); + sassetlcx(&state->sas, &state->workcleic, state->nec, state->nic, _state); + sassetscale(&state->sas, &state->s, _state); + if( !sasstartoptimization(&state->sas, &state->xs, _state) ) + { + state->repterminationtype = -3; + return; + } + + /* + * Main cycle of CQP algorithm + */ + state->repterminationtype = 4; + badnewtonits = 0; + maxscaledgrad = 0.0; + for(;;) + { + + /* + * Update iterations count + */ + inc(&state->repouteriterationscount, _state); + inc(&state->repinneriterationscount, _state); + + /* + * Phase 1. + * + * Determine active set. + * Update MaxScaledGrad. + */ + cqmadx(&state->a, &state->sas.xc, &state->rctmpg, _state); + ae_v_add(&state->rctmpg.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); + sasreactivateconstraints(&state->sas, &state->rctmpg, _state); + v = 0.0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->rctmpg.ptr.p_double[i]*state->s.ptr.p_double[i], _state); + } + maxscaledgrad = ae_maxreal(maxscaledgrad, ae_sqrt(v, _state), _state); + + /* + * Phase 2: perform penalized steepest descent step. + * + * NextAction control variable is set on exit from this loop: + * * NextAction>0 in case we have to proceed to Phase 3 (Newton step) + * * NextAction<0 in case we have to proceed to Phase 1 (recalculate active set) + * * NextAction=0 in case we found solution (step along projected gradient is small enough) + */ + for(;;) + { + + /* + * Calculate constrained descent direction, store to PG. + * Successful termination if PG is zero. + */ + cqmadx(&state->a, &state->sas.xc, &state->gc, _state); + ae_v_add(&state->gc.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); + sasconstraineddescent(&state->sas, &state->gc, &state->pg, _state); + state->debugphase2flops = state->debugphase2flops+4*(state->nec+state->nic)*n; + v0 = ae_v_dotproduct(&state->pg.ptr.p_double[0], 1, &state->pg.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_fp_eq(v0,0) ) + { + + /* + * Constrained derivative is zero. + * Solution found. + */ + nextaction = 0; + break; + } + + /* + * Build quadratic model of F along descent direction: + * F(xc+alpha*pg) = D2*alpha^2 + D1*alpha + D0 + * Store noise level in the XC (noise level is used to classify + * step as singificant or insignificant). + * + * In case function curvature is negative or product of descent + * direction and gradient is non-negative, iterations are terminated. + * + * NOTE: D0 is not actually used, but we prefer to maintain it. + */ + fprev = minqp_minqpmodelvalue(&state->a, &state->b, &state->sas.xc, n, &state->tmp0, _state); + fprev = fprev+minqp_penaltyfactor*maxscaledgrad*sasactivelcpenalty1(&state->sas, &state->sas.xc, _state); + cqmevalx(&state->a, &state->sas.xc, &v, &noiselevel, _state); + v0 = cqmxtadx2(&state->a, &state->pg, _state); + state->debugphase2flops = state->debugphase2flops+3*2*n*n; + d2 = v0; + v1 = ae_v_dotproduct(&state->pg.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + d1 = v1; + d0 = fprev; + if( ae_fp_less_eq(d2,0) ) + { + + /* + * Second derivative is non-positive, function is non-convex. + */ + state->repterminationtype = -5; + nextaction = 0; + break; + } + if( ae_fp_greater_eq(d1,0) ) + { + + /* + * Second derivative is positive, first derivative is non-negative. + * Solution found. + */ + nextaction = 0; + break; + } + + /* + * Modify quadratic model - add penalty for violation of the active + * constraints. + * + * Boundary constraints are always satisfied exactly, so we do not + * add penalty term for them. General equality constraint of the + * form a'*(xc+alpha*d)=b adds penalty term: + * P(alpha) = (a'*(xc+alpha*d)-b)^2 + * = (alpha*(a'*d) + (a'*xc-b))^2 + * = alpha^2*(a'*d)^2 + alpha*2*(a'*d)*(a'*xc-b) + (a'*xc-b)^2 + * Each penalty term is multiplied by 100*Anorm before adding it to + * the 1-dimensional quadratic model. + * + * Penalization of the quadratic model improves behavior of the + * algorithm in the presense of the multiple degenerate constraints. + * In particular, it prevents algorithm from making large steps in + * directions which violate equality constraints. + */ + for(i=0; i<=state->nec+state->nic-1; i++) + { + if( state->sas.activeset.ptr.p_int[n+i]>0 ) + { + v0 = ae_v_dotproduct(&state->workcleic.ptr.pp_double[i][0], 1, &state->pg.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v1 = ae_v_dotproduct(&state->workcleic.ptr.pp_double[i][0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v1 = v1-state->workcleic.ptr.pp_double[i][n]; + v = 100*state->anorm; + d2 = d2+v*ae_sqr(v0, _state); + d1 = d1+v*2*v0*v1; + d0 = d0+v*ae_sqr(v1, _state); + } + } + state->debugphase2flops = state->debugphase2flops+2*2*(state->nec+state->nic)*n; + + /* + * Try unbounded step. + * In case function change is dominated by noise or function actually increased + * instead of decreasing, we terminate iterations. + */ + v = -d1/(2*d2); + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->xn.ptr.p_double[0], 1, &state->pg.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + fcand = minqp_minqpmodelvalue(&state->a, &state->b, &state->xn, n, &state->tmp0, _state); + fcand = fcand+minqp_penaltyfactor*maxscaledgrad*sasactivelcpenalty1(&state->sas, &state->xn, _state); + state->debugphase2flops = state->debugphase2flops+2*n*n; + if( ae_fp_greater_eq(fcand,fprev-noiselevel*noisetolerance) ) + { + nextaction = 0; + break; + } + + /* + * Save active set + * Perform bounded step with (possible) activation + */ + actstatus = minqp_minqpboundedstepandactivation(state, &state->xn, &state->tmp0, _state); + fcur = minqp_minqpmodelvalue(&state->a, &state->b, &state->sas.xc, n, &state->tmp0, _state); + state->debugphase2flops = state->debugphase2flops+2*n*n; + + /* + * Depending on results, decide what to do: + * 1. In case step was performed without activation of constraints, + * we proceed to Newton method + * 2. In case there was activated at least one constraint with ActiveSet[I]<0, + * we proceed to Phase 1 and re-evaluate active set. + * 3. Otherwise (activation of the constraints with ActiveSet[I]=0) + * we try Phase 2 one more time. + */ + if( actstatus<0 ) + { + + /* + * Step without activation, proceed to Newton + */ + nextaction = 1; + break; + } + if( actstatus==0 ) + { + + /* + * No new constraints added during last activation - only + * ones which were at the boundary (ActiveSet[I]=0), but + * inactive due to numerical noise. + * + * Now, these constraints are added to the active set, and + * we try to perform steepest descent (Phase 2) one more time. + */ + continue; + } + else + { + + /* + * Last step activated at least one significantly new + * constraint (ActiveSet[I]<0), we have to re-evaluate + * active set (Phase 1). + */ + nextaction = -1; + break; + } + } + if( nextaction<0 ) + { + continue; + } + if( nextaction==0 ) + { + break; + } + + /* + * Phase 3: fast equality-constrained solver + * + * NOTE: this solver uses Augmented Lagrangian algorithm to solve + * equality-constrained subproblems. This algorithm may + * perform steps which increase function values instead of + * decreasing it (in hard cases, like overconstrained problems). + * + * Such non-monononic steps may create a loop, when Augmented + * Lagrangian algorithm performs uphill step, and steepest + * descent algorithm (Phase 2) performs downhill step in the + * opposite direction. + * + * In order to prevent iterations to continue forever we + * count iterations when AL algorithm increased function + * value instead of decreasing it. When number of such "bad" + * iterations will increase beyong MaxBadNewtonIts, we will + * terminate algorithm. + */ + fprev = minqp_minqpmodelvalue(&state->a, &state->b, &state->sas.xc, n, &state->tmp0, _state); + for(;;) + { + + /* + * Calculate optimum subject to presently active constraints + */ + state->repncholesky = state->repncholesky+1; + state->debugphase3flops = state->debugphase3flops+ae_pow(n, 3, _state)/3; + if( !minqp_minqpconstrainedoptimum(state, &state->a, state->anorm, &state->b, &state->xn, &state->tmp0, &state->tmpb, &state->tmp1, _state) ) + { + state->repterminationtype = -5; + sasstopoptimization(&state->sas, _state); + return; + } + + /* + * Add constraints. + * If no constraints was added, accept candidate point XN and move to next phase. + */ + if( minqp_minqpboundedstepandactivation(state, &state->xn, &state->tmp0, _state)<0 ) + { + break; + } + } + fcur = minqp_minqpmodelvalue(&state->a, &state->b, &state->sas.xc, n, &state->tmp0, _state); + if( ae_fp_greater_eq(fcur,fprev) ) + { + badnewtonits = badnewtonits+1; + } + if( badnewtonits>=minqp_maxbadnewtonits ) + { + + /* + * Algorithm found solution, but keeps iterating because Newton + * algorithm performs uphill steps (noise in the Augmented Lagrangian + * algorithm). We terminate algorithm; it is considered normal + * termination. + */ + break; + } + } + sasstopoptimization(&state->sas, _state); + + /* + * Post-process: add XOrigin to XC + */ + for(i=0; i<=n-1; i++) + { + if( state->havebndl.ptr.p_bool[i]&&ae_fp_eq(state->sas.xc.ptr.p_double[i],state->workbndl.ptr.p_double[i]) ) + { + state->xs.ptr.p_double[i] = state->bndl.ptr.p_double[i]; + continue; + } + if( state->havebndu.ptr.p_bool[i]&&ae_fp_eq(state->sas.xc.ptr.p_double[i],state->workbndu.ptr.p_double[i]) ) + { + state->xs.ptr.p_double[i] = state->bndu.ptr.p_double[i]; + continue; + } + state->xs.ptr.p_double[i] = boundval(state->sas.xc.ptr.p_double[i]+state->xorigin.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + return; + } + + /* + * BLEIC solver + */ + if( state->algokind==2 ) + { + ae_assert(state->akind==0||state->akind==1, "MinQPOptimize: unexpected AKind", _state); + ivectorsetlengthatleast(&state->tmpi, state->nec+state->nic, _state); + rvectorsetlengthatleast(&state->tmp0, n, _state); + rvectorsetlengthatleast(&state->tmp1, n, _state); + for(i=0; i<=state->nec-1; i++) + { + state->tmpi.ptr.p_int[i] = 0; + } + for(i=0; i<=state->nic-1; i++) + { + state->tmpi.ptr.p_int[state->nec+i] = -1; + } + minbleicsetlc(&state->solver, &state->cleic, &state->tmpi, state->nec+state->nic, _state); + minbleicsetbc(&state->solver, &state->bndl, &state->bndu, _state); + minbleicsetdrep(&state->solver, ae_true, _state); + minbleicsetcond(&state->solver, ae_minrealnumber, 0.0, 0.0, state->bleicmaxits, _state); + minbleicsetscale(&state->solver, &state->s, _state); + minbleicsetprecscale(&state->solver, _state); + minbleicrestartfrom(&state->solver, &state->xs, _state); + state->repterminationtype = 0; + while(minbleiciteration(&state->solver, _state)) + { + + /* + * Line search started + */ + if( state->solver.lsstart ) + { + + /* + * Iteration counters: + * * inner iterations count is increased on every line search + * * outer iterations count is increased only at steepest descent line search + */ + inc(&state->repinneriterationscount, _state); + if( !state->solver.lbfgssearch ) + { + inc(&state->repouteriterationscount, _state); + } + + /* + * Build quadratic model of F along descent direction: + * F(x+alpha*d) = D2*alpha^2 + D1*alpha + D0 + */ + d0 = state->solver.f; + d1 = ae_v_dotproduct(&state->solver.d.ptr.p_double[0], 1, &state->solver.g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + d2 = 0; + if( state->akind==0 ) + { + d2 = cqmxtadx2(&state->a, &state->solver.d, _state); + } + if( state->akind==1 ) + { + sparsesmv(&state->sparsea, state->sparseaupper, &state->solver.d, &state->tmp0, _state); + d2 = 0.0; + for(i=0; i<=n-1; i++) + { + d2 = d2+state->solver.d.ptr.p_double[i]*state->tmp0.ptr.p_double[i]; + } + d2 = 0.5*d2; + } + + /* + * Suggest new step + */ + if( ae_fp_less(d1,0)&&ae_fp_greater(d2,0) ) + { + state->solver.stp = safeminposrv(-d1, 2*d2, state->solver.curstpmax, _state); + } + + /* + * This line search may be started from steepest descent + * stage (stage 2) or from L-BFGS stage (stage 3) of the + * BLEIC algorithm. Depending on stage type, different + * checks are performed. + * + * Say, L-BFGS stage is an equality-constrained refinement + * stage of BLEIC. This stage refines current iterate + * under "frozen" equality constraints. We can terminate + * iterations at this stage only when we encounter + * unconstrained direction of negative curvature. In all + * other cases (say, when constrained gradient is zero) + * we should not terminate algorithm because everything may + * change after de-activating presently active constraints. + * + * At steepest descent stage of BLEIC we can terminate algorithm + * because it found minimum (steepest descent step is zero + * or too short). We also perform check for direction of + * negative curvature. + */ + if( (ae_fp_less(d2,0)||(ae_fp_eq(d2,0)&&ae_fp_less(d1,0)))&&!state->solver.boundedstep ) + { + + /* + * Function is unbounded from below: + * * function will decrease along D, i.e. either: + * * D2<0 + * * D2=0 and D1<0 + * * step is unconstrained + * + * If these conditions are true, we abnormally terminate QP + * algorithm with return code -4 (we can do so at any stage + * of BLEIC - whether it is L-BFGS or steepest descent one). + */ + state->repterminationtype = -4; + for(i=0; i<=n-1; i++) + { + state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; + } + break; + } + if( !state->solver.lbfgssearch&&ae_fp_greater_eq(d2,0) ) + { + + /* + * Tests for "normal" convergence. + * + * These tests are performed only at "steepest descent" stage + * of the BLEIC algorithm, and only when function is non-concave + * (D2>=0) along direction D. + * + * NOTE: we do not test iteration count (MaxIts) here, because + * this stopping condition is tested by BLEIC itself. + */ + if( ae_fp_greater_eq(d1,0) ) + { + + /* + * "Emergency" stopping condition: D is non-descent direction. + * Sometimes it is possible because of numerical noise in the + * target function. + */ + state->repterminationtype = 4; + for(i=0; i<=n-1; i++) + { + state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; + } + break; + } + if( ae_fp_greater(d2,0) ) + { + + /* + * Stopping condition #4 - gradient norm is small: + * + * 1. rescale State.Solver.D and State.Solver.G according to + * current scaling, store results to Tmp0 and Tmp1. + * 2. Normalize Tmp0 (scaled direction vector). + * 3. compute directional derivative (in scaled variables), + * which is equal to DOTPRODUCT(Tmp0,Tmp1). + */ + v = 0; + for(i=0; i<=n-1; i++) + { + state->tmp0.ptr.p_double[i] = state->solver.d.ptr.p_double[i]/state->s.ptr.p_double[i]; + state->tmp1.ptr.p_double[i] = state->solver.g.ptr.p_double[i]*state->s.ptr.p_double[i]; + v = v+ae_sqr(state->tmp0.ptr.p_double[i], _state); + } + ae_assert(ae_fp_greater(v,0), "MinQPOptimize: inernal errror (scaled direction is zero)", _state); + v = 1/ae_sqrt(v, _state); + ae_v_muld(&state->tmp0.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + v = ae_v_dotproduct(&state->tmp0.ptr.p_double[0], 1, &state->tmp1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_fp_less_eq(ae_fabs(v, _state),state->bleicepsg) ) + { + state->repterminationtype = 4; + for(i=0; i<=n-1; i++) + { + state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; + } + break; + } + + /* + * Stopping condition #1 - relative function improvement is small: + * + * 1. calculate steepest descent step: V = -D1/(2*D2) + * 2. calculate function change: V1= D2*V^2 + D1*V + * 3. stop if function change is small enough + */ + v = -d1/(2*d2); + v1 = d2*v*v+d1*v; + if( ae_fp_less_eq(ae_fabs(v1, _state),state->bleicepsf*ae_maxreal(d0, 1.0, _state)) ) + { + state->repterminationtype = 1; + for(i=0; i<=n-1; i++) + { + state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; + } + break; + } + + /* + * Stopping condition #2 - scaled step is small: + * + * 1. calculate step multiplier V0 (step itself is D*V0) + * 2. calculate scaled step length V + * 3. stop if step is small enough + */ + v0 = -d1/(2*d2); + v = 0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(v0*state->solver.d.ptr.p_double[i]/state->s.ptr.p_double[i], _state); + } + if( ae_fp_less_eq(ae_sqrt(v, _state),state->bleicepsx) ) + { + state->repterminationtype = 2; + for(i=0; i<=n-1; i++) + { + state->xs.ptr.p_double[i] = state->solver.x.ptr.p_double[i]; + } + break; + } + } + } + } + + /* + * Gradient evaluation + */ + if( state->solver.needfg ) + { + for(i=0; i<=n-1; i++) + { + state->tmp0.ptr.p_double[i] = state->solver.x.ptr.p_double[i]-state->xorigin.ptr.p_double[i]; + } + if( state->akind==0 ) + { + cqmadx(&state->a, &state->tmp0, &state->tmp1, _state); + } + if( state->akind==1 ) + { + sparsesmv(&state->sparsea, state->sparseaupper, &state->tmp0, &state->tmp1, _state); + } + v0 = ae_v_dotproduct(&state->tmp0.ptr.p_double[0], 1, &state->tmp1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v1 = ae_v_dotproduct(&state->tmp0.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->solver.f = 0.5*v0+v1; + ae_v_move(&state->solver.g.ptr.p_double[0], 1, &state->tmp1.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_add(&state->solver.g.ptr.p_double[0], 1, &state->b.ptr.p_double[0], 1, ae_v_len(0,n-1)); + } + } + if( state->repterminationtype==0 ) + { + + /* + * BLEIC optimizer was terminated by one of its inner stopping + * conditions. Usually it is iteration counter (if such + * stopping condition was specified by user). + */ + minbleicresults(&state->solver, &state->xs, &state->solverrep, _state); + state->repterminationtype = state->solverrep.terminationtype; + } + else + { + + /* + * BLEIC optimizer was terminated in "emergency" mode by QP + * solver. + * + * NOTE: such termination is "emergency" only when viewed from + * BLEIC's position. QP solver sees such termination as + * routine one, triggered by QP's stopping criteria. + */ + minbleicemergencytermination(&state->solver, _state); + } + return; + } +} + + +/************************************************************************* +QP solver results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution. + This array is allocated and initialized only when + Rep.TerminationType parameter is positive (success). + Rep - optimization report. You should check Rep.TerminationType, + which contains completion code, and you may check another + fields which contain another information about algorithm + functioning. + + Failure codes returned by algorithm are: + * -5 inappropriate solver was used: + * Cholesky solver for (semi)indefinite problems + * Cholesky solver for problems with sparse matrix + * -4 BLEIC-QP algorithm found unconstrained direction + of negative curvature (function is unbounded from + below even under constraints), no meaningful + minimum can be found. + * -3 inconsistent constraints (or maybe feasible point + is too hard to find). If you are sure that + constraints are feasible, try to restart optimizer + with better initial approximation. + + Completion codes specific for Cholesky algorithm: + * 4 successful completion + + Completion codes specific for BLEIC-based algorithm: + * 1 relative function improvement is no more than EpsF. + * 2 scaled step is no more than EpsX. + * 4 scaled gradient norm is no more than EpsG. + * 5 MaxIts steps was taken + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpresults(minqpstate* state, + /* Real */ ae_vector* x, + minqpreport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _minqpreport_clear(rep); + + minqpresultsbuf(state, x, rep, _state); +} + + +/************************************************************************* +QP results + +Buffered implementation of MinQPResults() which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpresultsbuf(minqpstate* state, + /* Real */ ae_vector* x, + minqpreport* rep, + ae_state *_state) +{ + + + if( x->cntn ) + { + ae_vector_set_length(x, state->n, _state); + } + ae_v_move(&x->ptr.p_double[0], 1, &state->xs.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + rep->inneriterationscount = state->repinneriterationscount; + rep->outeriterationscount = state->repouteriterationscount; + rep->nmv = state->repnmv; + rep->ncholesky = state->repncholesky; + rep->terminationtype = state->repterminationtype; +} + + +/************************************************************************* +Fast version of MinQPSetLinearTerm(), which doesn't check its arguments. +For internal use only. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetlineartermfast(minqpstate* state, + /* Real */ ae_vector* b, + ae_state *_state) +{ + + + ae_v_move(&state->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); +} + + +/************************************************************************* +Fast version of MinQPSetQuadraticTerm(), which doesn't check its arguments. + +It accepts additional parameter - shift S, which allows to "shift" matrix +A by adding s*I to A. S must be positive (although it is not checked). + +For internal use only. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetquadratictermfast(minqpstate* state, + /* Real */ ae_matrix* a, + ae_bool isupper, + double s, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t n; + + + n = state->n; + state->akind = 0; + cqmseta(&state->a, a, isupper, 1.0, _state); + if( ae_fp_greater(s,0) ) + { + rvectorsetlengthatleast(&state->tmp0, n, _state); + for(i=0; i<=n-1; i++) + { + state->tmp0.ptr.p_double[i] = a->ptr.pp_double[i][i]+s; + } + cqmrewritedensediagonal(&state->a, &state->tmp0, _state); + } + + /* + * Estimate norm of A + * (it will be used later in the quadratic penalty function) + */ + state->anorm = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + for(j=i; j<=n-1; j++) + { + state->anorm = ae_maxreal(state->anorm, ae_fabs(a->ptr.pp_double[i][j], _state), _state); + } + } + else + { + for(j=0; j<=i; j++) + { + state->anorm = ae_maxreal(state->anorm, ae_fabs(a->ptr.pp_double[i][j], _state), _state); + } + } + } + state->anorm = state->anorm*n; +} + + +/************************************************************************* +Internal function which allows to rewrite diagonal of quadratic term. +For internal use only. + +This function can be used only when you have dense A and already made +MinQPSetQuadraticTerm(Fast) call. + + -- ALGLIB -- + Copyright 16.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqprewritediagonal(minqpstate* state, + /* Real */ ae_vector* s, + ae_state *_state) +{ + + + cqmrewritedensediagonal(&state->a, s, _state); +} + + +/************************************************************************* +Fast version of MinQPSetStartingPoint(), which doesn't check its arguments. +For internal use only. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetstartingpointfast(minqpstate* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_int_t n; + + + n = state->n; + ae_v_move(&state->startx.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->havex = ae_true; +} + + +/************************************************************************* +Fast version of MinQPSetOrigin(), which doesn't check its arguments. +For internal use only. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetoriginfast(minqpstate* state, + /* Real */ ae_vector* xorigin, + ae_state *_state) +{ + ae_int_t n; + + + n = state->n; + ae_v_move(&state->xorigin.ptr.p_double[0], 1, &xorigin->ptr.p_double[0], 1, ae_v_len(0,n-1)); +} + + +/************************************************************************* +Having feasible current point XC and possibly infeasible candidate point +XN, this function performs longest step from XC to XN which retains +feasibility. In case XN is found to be infeasible, at least one constraint +is activated. + +For example, if we have: + XC=0.5 + XN=1.2 + x>=0, x<=1 +then this function will move us to X=1.0 and activate constraint "x<=1". + +INPUT PARAMETERS: + State - MinQP state. + XC - current point, must be feasible with respect to + all constraints + XN - candidate point, can be infeasible with respect to some + constraints. Must be located in the subspace of current + active set, i.e. it is feasible with respect to already + active constraints. + Buf - temporary buffer, automatically resized if needed + +OUTPUT PARAMETERS: + State - this function changes following fields of State: + * State.ActiveSet + * State.ActiveC - active linear constraints + XC - new position + +RESULT: + >0, in case at least one inactive non-candidate constraint was activated + =0, in case only "candidate" constraints were activated + <0, in case no constraints were activated by the step + + + -- ALGLIB -- + Copyright 29.02.2012 by Bochkanov Sergey +*************************************************************************/ +static ae_int_t minqp_minqpboundedstepandactivation(minqpstate* state, + /* Real */ ae_vector* xn, + /* Real */ ae_vector* buf, + ae_state *_state) +{ + ae_int_t n; + double stpmax; + ae_int_t cidx; + double cval; + ae_bool needact; + double v; + ae_int_t result; + + + n = state->n; + rvectorsetlengthatleast(buf, n, _state); + ae_v_move(&buf->ptr.p_double[0], 1, &xn->ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_sub(&buf->ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + sasexploredirection(&state->sas, buf, &stpmax, &cidx, &cval, _state); + needact = ae_fp_less_eq(stpmax,1); + v = ae_minreal(stpmax, 1.0, _state); + ae_v_muld(&buf->ptr.p_double[0], 1, ae_v_len(0,n-1), v); + ae_v_add(&buf->ptr.p_double[0], 1, &state->sas.xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + result = sasmoveto(&state->sas, buf, needact, cidx, cval, _state); + return result; +} + + +/************************************************************************* +Model value: f = 0.5*x'*A*x + b'*x + +INPUT PARAMETERS: + A - convex quadratic model; only main quadratic term is used, + other parts of the model (D/Q/linear term) are ignored. + This function does not modify model state. + B - right part + XC - evaluation point + Tmp - temporary buffer, automatically resized if needed + + -- ALGLIB -- + Copyright 20.06.2012 by Bochkanov Sergey +*************************************************************************/ +static double minqp_minqpmodelvalue(convexquadraticmodel* a, + /* Real */ ae_vector* b, + /* Real */ ae_vector* xc, + ae_int_t n, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + double v0; + double v1; + double result; + + + rvectorsetlengthatleast(tmp, n, _state); + cqmadx(a, xc, tmp, _state); + v0 = ae_v_dotproduct(&xc->ptr.p_double[0], 1, &tmp->ptr.p_double[0], 1, ae_v_len(0,n-1)); + v1 = ae_v_dotproduct(&xc->ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + result = 0.5*v0+v1; + return result; +} + + +/************************************************************************* +Optimum of A subject to: +a) active boundary constraints (given by ActiveSet[] and corresponding + elements of XC) +b) active linear constraints (given by C, R, LagrangeC) + +INPUT PARAMETERS: + A - main quadratic term of the model; + although structure may store linear and rank-K terms, + these terms are ignored and rewritten by this function. + ANorm - estimate of ||A|| (2-norm is used) + B - array[N], linear term of the model + XN - possibly preallocated buffer + Tmp - temporary buffer (automatically resized) + Tmp1 - temporary buffer (automatically resized) + +OUTPUT PARAMETERS: + A - modified quadratic model (this function changes rank-K + term and linear term of the model) + LagrangeC- current estimate of the Lagrange coefficients + XN - solution + +RESULT: + True on success, False on failure (non-SPD model) + + -- ALGLIB -- + Copyright 20.06.2012 by Bochkanov Sergey +*************************************************************************/ +static ae_bool minqp_minqpconstrainedoptimum(minqpstate* state, + convexquadraticmodel* a, + double anorm, + /* Real */ ae_vector* b, + /* Real */ ae_vector* xn, + /* Real */ ae_vector* tmp, + /* Boolean */ ae_vector* tmpb, + /* Real */ ae_vector* lagrangec, + ae_state *_state) +{ + ae_int_t itidx; + ae_int_t i; + double v; + double feaserrold; + double feaserrnew; + double theta; + ae_int_t n; + ae_bool result; + + + n = state->n; + + /* + * Rebuild basis accroding to current active set. + * We call SASRebuildBasis() to make sure that fields of SAS + * store up to date values. + */ + sasrebuildbasis(&state->sas, _state); + + /* + * Allocate temporaries. + */ + rvectorsetlengthatleast(tmp, ae_maxint(n, state->sas.basissize, _state), _state); + bvectorsetlengthatleast(tmpb, n, _state); + rvectorsetlengthatleast(lagrangec, state->sas.basissize, _state); + + /* + * Prepare model + */ + for(i=0; i<=state->sas.basissize-1; i++) + { + tmp->ptr.p_double[i] = state->sas.pbasis.ptr.pp_double[i][n]; + } + theta = 100.0*anorm; + for(i=0; i<=n-1; i++) + { + if( state->sas.activeset.ptr.p_int[i]>0 ) + { + tmpb->ptr.p_bool[i] = ae_true; + } + else + { + tmpb->ptr.p_bool[i] = ae_false; + } + } + cqmsetactiveset(a, &state->sas.xc, tmpb, _state); + cqmsetq(a, &state->sas.pbasis, tmp, state->sas.basissize, theta, _state); + + /* + * Iterate until optimal values of Lagrange multipliers are found + */ + for(i=0; i<=state->sas.basissize-1; i++) + { + lagrangec->ptr.p_double[i] = 0; + } + feaserrnew = ae_maxrealnumber; + result = ae_true; + for(itidx=1; itidx<=minqp_maxlagrangeits; itidx++) + { + + /* + * Generate right part B using linear term and current + * estimate of the Lagrange multipliers. + */ + ae_v_move(&tmp->ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=state->sas.basissize-1; i++) + { + v = lagrangec->ptr.p_double[i]; + ae_v_subd(&tmp->ptr.p_double[0], 1, &state->sas.pbasis.ptr.pp_double[i][0], 1, ae_v_len(0,n-1), v); + } + cqmsetb(a, tmp, _state); + + /* + * Solve + */ + result = cqmconstrainedoptimum(a, xn, _state); + if( !result ) + { + return result; + } + + /* + * Compare feasibility errors. + * Terminate if error decreased too slowly. + */ + feaserrold = feaserrnew; + feaserrnew = 0; + for(i=0; i<=state->sas.basissize-1; i++) + { + v = ae_v_dotproduct(&state->sas.pbasis.ptr.pp_double[i][0], 1, &xn->ptr.p_double[0], 1, ae_v_len(0,n-1)); + feaserrnew = feaserrnew+ae_sqr(v-state->sas.pbasis.ptr.pp_double[i][n], _state); + } + feaserrnew = ae_sqrt(feaserrnew, _state); + if( ae_fp_greater_eq(feaserrnew,0.2*feaserrold) ) + { + break; + } + + /* + * Update Lagrange multipliers + */ + for(i=0; i<=state->sas.basissize-1; i++) + { + v = ae_v_dotproduct(&state->sas.pbasis.ptr.pp_double[i][0], 1, &xn->ptr.p_double[0], 1, ae_v_len(0,n-1)); + lagrangec->ptr.p_double[i] = lagrangec->ptr.p_double[i]-theta*(v-state->sas.pbasis.ptr.pp_double[i][n]); + } + } + return result; +} + + +ae_bool _minqpstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minqpstate *p = (minqpstate*)_p; + ae_touch_ptr((void*)p); + if( !_convexquadraticmodel_init(&p->a, _state, make_automatic) ) + return ae_false; + if( !_sparsematrix_init(&p->sparsea, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->havebndl, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->havebndu, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xorigin, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->startx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->cleic, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_sactiveset_init(&p->sas, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gc, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->pg, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->workbndl, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->workbndu, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->workcleic, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xs, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpb, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rctmpg, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpi, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !_normestimatorstate_init(&p->estimator, _state, make_automatic) ) + return ae_false; + if( !_minbleicstate_init(&p->solver, _state, make_automatic) ) + return ae_false; + if( !_minbleicreport_init(&p->solverrep, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _minqpstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minqpstate *dst = (minqpstate*)_dst; + minqpstate *src = (minqpstate*)_src; + dst->n = src->n; + dst->algokind = src->algokind; + dst->akind = src->akind; + if( !_convexquadraticmodel_init_copy(&dst->a, &src->a, _state, make_automatic) ) + return ae_false; + if( !_sparsematrix_init_copy(&dst->sparsea, &src->sparsea, _state, make_automatic) ) + return ae_false; + dst->sparseaupper = src->sparseaupper; + dst->anorm = src->anorm; + if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->havebndl, &src->havebndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->havebndu, &src->havebndu, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xorigin, &src->xorigin, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->startx, &src->startx, _state, make_automatic) ) + return ae_false; + dst->havex = src->havex; + if( !ae_matrix_init_copy(&dst->cleic, &src->cleic, _state, make_automatic) ) + return ae_false; + dst->nec = src->nec; + dst->nic = src->nic; + dst->bleicepsg = src->bleicepsg; + dst->bleicepsf = src->bleicepsf; + dst->bleicepsx = src->bleicepsx; + dst->bleicmaxits = src->bleicmaxits; + if( !_sactiveset_init_copy(&dst->sas, &src->sas, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gc, &src->gc, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->pg, &src->pg, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->workbndl, &src->workbndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->workbndu, &src->workbndu, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->workcleic, &src->workcleic, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xs, &src->xs, _state, make_automatic) ) + return ae_false; + dst->repinneriterationscount = src->repinneriterationscount; + dst->repouteriterationscount = src->repouteriterationscount; + dst->repncholesky = src->repncholesky; + dst->repnmv = src->repnmv; + dst->repterminationtype = src->repterminationtype; + dst->debugphase1flops = src->debugphase1flops; + dst->debugphase2flops = src->debugphase2flops; + dst->debugphase3flops = src->debugphase3flops; + if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmp1, &src->tmp1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpb, &src->tmpb, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rctmpg, &src->rctmpg, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpi, &src->tmpi, _state, make_automatic) ) + return ae_false; + if( !_normestimatorstate_init_copy(&dst->estimator, &src->estimator, _state, make_automatic) ) + return ae_false; + if( !_minbleicstate_init_copy(&dst->solver, &src->solver, _state, make_automatic) ) + return ae_false; + if( !_minbleicreport_init_copy(&dst->solverrep, &src->solverrep, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _minqpstate_clear(void* _p) +{ + minqpstate *p = (minqpstate*)_p; + ae_touch_ptr((void*)p); + _convexquadraticmodel_clear(&p->a); + _sparsematrix_clear(&p->sparsea); + ae_vector_clear(&p->b); + ae_vector_clear(&p->bndl); + ae_vector_clear(&p->bndu); + ae_vector_clear(&p->s); + ae_vector_clear(&p->havebndl); + ae_vector_clear(&p->havebndu); + ae_vector_clear(&p->xorigin); + ae_vector_clear(&p->startx); + ae_matrix_clear(&p->cleic); + _sactiveset_clear(&p->sas); + ae_vector_clear(&p->gc); + ae_vector_clear(&p->xn); + ae_vector_clear(&p->pg); + ae_vector_clear(&p->workbndl); + ae_vector_clear(&p->workbndu); + ae_matrix_clear(&p->workcleic); + ae_vector_clear(&p->xs); + ae_vector_clear(&p->tmp0); + ae_vector_clear(&p->tmp1); + ae_vector_clear(&p->tmpb); + ae_vector_clear(&p->rctmpg); + ae_vector_clear(&p->tmpi); + _normestimatorstate_clear(&p->estimator); + _minbleicstate_clear(&p->solver); + _minbleicreport_clear(&p->solverrep); +} + + +void _minqpstate_destroy(void* _p) +{ + minqpstate *p = (minqpstate*)_p; + ae_touch_ptr((void*)p); + _convexquadraticmodel_destroy(&p->a); + _sparsematrix_destroy(&p->sparsea); + ae_vector_destroy(&p->b); + ae_vector_destroy(&p->bndl); + ae_vector_destroy(&p->bndu); + ae_vector_destroy(&p->s); + ae_vector_destroy(&p->havebndl); + ae_vector_destroy(&p->havebndu); + ae_vector_destroy(&p->xorigin); + ae_vector_destroy(&p->startx); + ae_matrix_destroy(&p->cleic); + _sactiveset_destroy(&p->sas); + ae_vector_destroy(&p->gc); + ae_vector_destroy(&p->xn); + ae_vector_destroy(&p->pg); + ae_vector_destroy(&p->workbndl); + ae_vector_destroy(&p->workbndu); + ae_matrix_destroy(&p->workcleic); + ae_vector_destroy(&p->xs); + ae_vector_destroy(&p->tmp0); + ae_vector_destroy(&p->tmp1); + ae_vector_destroy(&p->tmpb); + ae_vector_destroy(&p->rctmpg); + ae_vector_destroy(&p->tmpi); + _normestimatorstate_destroy(&p->estimator); + _minbleicstate_destroy(&p->solver); + _minbleicreport_destroy(&p->solverrep); +} + + +ae_bool _minqpreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minqpreport *p = (minqpreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _minqpreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minqpreport *dst = (minqpreport*)_dst; + minqpreport *src = (minqpreport*)_src; + dst->inneriterationscount = src->inneriterationscount; + dst->outeriterationscount = src->outeriterationscount; + dst->nmv = src->nmv; + dst->ncholesky = src->ncholesky; + dst->terminationtype = src->terminationtype; + return ae_true; +} + + +void _minqpreport_clear(void* _p) +{ + minqpreport *p = (minqpreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _minqpreport_destroy(void* _p) +{ + minqpreport *p = (minqpreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* + IMPROVED LEVENBERG-MARQUARDT METHOD FOR + NON-LINEAR LEAST SQUARES OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of function which is represented as +sum of squares: + F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) +using value of function vector f[] and Jacobian of f[]. + + +REQUIREMENTS: +This algorithm will request following information during its operation: + +* function vector f[] at given point X +* function vector f[] and Jacobian of f[] (simultaneously) at given point + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts fvec() and jac() callbacks. +First one is used to calculate f[] at given point, second one calculates +f[] and Jacobian df[i]/dx[j]. + +You can try to initialize MinLMState structure with VJ function and then +use incorrect version of MinLMOptimize() (for example, version which +works with general form function and does not provide Jacobian), but it +will lead to exception being thrown after first attempt to calculate +Jacobian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateVJ() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of functions f[i] + X - initial solution, array[0..N-1] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatevj(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state) +{ + + _minlmstate_clear(state); + + ae_assert(n>=1, "MinLMCreateVJ: N<1!", _state); + ae_assert(m>=1, "MinLMCreateVJ: M<1!", _state); + ae_assert(x->cnt>=n, "MinLMCreateVJ: Length(X)teststep = 0; + state->n = n; + state->m = m; + state->algomode = 1; + state->hasf = ae_false; + state->hasfi = ae_true; + state->hasg = ae_false; + + /* + * second stage of initialization + */ + minlm_lmprepare(n, m, ae_false, state, _state); + minlmsetacctype(state, 0, _state); + minlmsetcond(state, 0, 0, 0, 0, _state); + minlmsetxrep(state, ae_false, _state); + minlmsetstpmax(state, 0, _state); + minlmrestartfrom(state, x, _state); +} + + +/************************************************************************* + IMPROVED LEVENBERG-MARQUARDT METHOD FOR + NON-LINEAR LEAST SQUARES OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of function which is represented as +sum of squares: + F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) +using value of function vector f[] only. Finite differences are used to +calculate Jacobian. + + +REQUIREMENTS: +This algorithm will request following information during its operation: +* function vector f[] at given point X + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts fvec() callback. + +You can try to initialize MinLMState structure with VJ function and then +use incorrect version of MinLMOptimize() (for example, version which +works with general form function and does not accept function vector), but +it will lead to exception being thrown after first attempt to calculate +Jacobian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateV() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of functions f[i] + X - initial solution, array[0..N-1] + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +See also MinLMIteration, MinLMResults. + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatev(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + double diffstep, + minlmstate* state, + ae_state *_state) +{ + + _minlmstate_clear(state); + + ae_assert(ae_isfinite(diffstep, _state), "MinLMCreateV: DiffStep is not finite!", _state); + ae_assert(ae_fp_greater(diffstep,0), "MinLMCreateV: DiffStep<=0!", _state); + ae_assert(n>=1, "MinLMCreateV: N<1!", _state); + ae_assert(m>=1, "MinLMCreateV: M<1!", _state); + ae_assert(x->cnt>=n, "MinLMCreateV: Length(X)teststep = 0; + state->n = n; + state->m = m; + state->algomode = 0; + state->hasf = ae_false; + state->hasfi = ae_true; + state->hasg = ae_false; + state->diffstep = diffstep; + + /* + * Second stage of initialization + */ + minlm_lmprepare(n, m, ae_false, state, _state); + minlmsetacctype(state, 1, _state); + minlmsetcond(state, 0, 0, 0, 0, _state); + minlmsetxrep(state, ae_false, _state); + minlmsetstpmax(state, 0, _state); + minlmrestartfrom(state, x, _state); +} + + +/************************************************************************* + LEVENBERG-MARQUARDT-LIKE METHOD FOR NON-LINEAR OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of general form (not "sum-of- +-squares") function + F = F(x[0], ..., x[n-1]) +using its gradient and Hessian. Levenberg-Marquardt modification with +L-BFGS pre-optimization and internal pre-conditioned L-BFGS optimization +after each Levenberg-Marquardt step is used. + + +REQUIREMENTS: +This algorithm will request following information during its operation: + +* function value F at given point X +* F and gradient G (simultaneously) at given point X +* F, G and Hessian H (simultaneously) at given point X + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts func(), grad() and hess() +function pointers. First pointer is used to calculate F at given point, +second one calculates F(x) and grad F(x), third one calculates F(x), +grad F(x), hess F(x). + +You can try to initialize MinLMState structure with FGH-function and then +use incorrect version of MinLMOptimize() (for example, version which does +not provide Hessian matrix), but it will lead to exception being thrown +after first attempt to calculate Hessian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateFGH() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + pointers (delegates, etc.) to callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - initial solution, array[0..N-1] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefgh(ae_int_t n, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state) +{ + + _minlmstate_clear(state); + + ae_assert(n>=1, "MinLMCreateFGH: N<1!", _state); + ae_assert(x->cnt>=n, "MinLMCreateFGH: Length(X)teststep = 0; + state->n = n; + state->m = 0; + state->algomode = 2; + state->hasf = ae_true; + state->hasfi = ae_false; + state->hasg = ae_true; + + /* + * init2 + */ + minlm_lmprepare(n, 0, ae_true, state, _state); + minlmsetacctype(state, 2, _state); + minlmsetcond(state, 0, 0, 0, 0, _state); + minlmsetxrep(state, ae_false, _state); + minlmsetstpmax(state, 0, _state); + minlmrestartfrom(state, x, _state); +} + + +/************************************************************************* +This function sets stopping conditions for Levenberg-Marquardt optimization +algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinLMSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. Only Levenberg-Marquardt + iterations are counted (L-BFGS/CG iterations are NOT + counted because their cost is very low compared to that of + LM). + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetcond(minlmstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsg, _state), "MinLMSetCond: EpsG is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsg,0), "MinLMSetCond: negative EpsG!", _state); + ae_assert(ae_isfinite(epsf, _state), "MinLMSetCond: EpsF is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsf,0), "MinLMSetCond: negative EpsF!", _state); + ae_assert(ae_isfinite(epsx, _state), "MinLMSetCond: EpsX is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsx,0), "MinLMSetCond: negative EpsX!", _state); + ae_assert(maxits>=0, "MinLMSetCond: negative MaxIts!", _state); + if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) + { + epsx = 1.0E-6; + } + state->epsg = epsg; + state->epsf = epsf; + state->epsx = epsx; + state->maxits = maxits; +} + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinLMOptimize(). Both Levenberg-Marquardt and internal L-BFGS +iterations are reported. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetxrep(minlmstate* state, ae_bool needxrep, ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + +NOTE: non-zero StpMax leads to moderate performance degradation because +intermediate step of preconditioned L-BFGS optimization is incompatible +with limits on step size. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetstpmax(minlmstate* state, double stpmax, ae_state *_state) +{ + + + ae_assert(ae_isfinite(stpmax, _state), "MinLMSetStpMax: StpMax is not finite!", _state); + ae_assert(ae_fp_greater_eq(stpmax,0), "MinLMSetStpMax: StpMax<0!", _state); + state->stpmax = stpmax; +} + + +/************************************************************************* +This function sets scaling coefficients for LM optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Generally, scale is NOT considered to be a form of preconditioner. But LM +optimizer is unique in that it uses scaling matrix both in the stopping +condition tests and as Marquardt damping factor. + +Proper scaling is very important for the algorithm performance. It is less +important for the quality of results, but still has some influence (it is +easier to converge when variables are properly scaled, so premature +stopping is possible when very badly scalled variables are combined with +relaxed stopping conditions). + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlmsetscale(minlmstate* state, + /* Real */ ae_vector* s, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(s->cnt>=state->n, "MinLMSetScale: Length(S)n-1; i++) + { + ae_assert(ae_isfinite(s->ptr.p_double[i], _state), "MinLMSetScale: S contains infinite or NAN elements", _state); + ae_assert(ae_fp_neq(s->ptr.p_double[i],0), "MinLMSetScale: S contains zero elements", _state); + state->s.ptr.p_double[i] = ae_fabs(s->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +This function sets boundary constraints for LM optimizer + +Boundary constraints are inactive by default (after initial creation). +They are preserved until explicitly turned off with another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + +NOTE 2: this solver has following useful properties: +* bound constraints are always satisfied exactly +* function is evaluated only INSIDE area specified by bound constraints + or at its boundary + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlmsetbc(minlmstate* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state) +{ + ae_int_t i; + ae_int_t n; + + + n = state->n; + ae_assert(bndl->cnt>=n, "MinLMSetBC: Length(BndL)cnt>=n, "MinLMSetBC: Length(BndU)ptr.p_double[i], _state)||ae_isneginf(bndl->ptr.p_double[i], _state), "MinLMSetBC: BndL contains NAN or +INF", _state); + ae_assert(ae_isfinite(bndu->ptr.p_double[i], _state)||ae_isposinf(bndu->ptr.p_double[i], _state), "MinLMSetBC: BndU contains NAN or -INF", _state); + state->bndl.ptr.p_double[i] = bndl->ptr.p_double[i]; + state->havebndl.ptr.p_bool[i] = ae_isfinite(bndl->ptr.p_double[i], _state); + state->bndu.ptr.p_double[i] = bndu->ptr.p_double[i]; + state->havebndu.ptr.p_bool[i] = ae_isfinite(bndu->ptr.p_double[i], _state); + } +} + + +/************************************************************************* +This function is used to change acceleration settings + +You can choose between three acceleration strategies: +* AccType=0, no acceleration. +* AccType=1, secant updates are used to update quadratic model after each + iteration. After fixed number of iterations (or after model breakdown) + we recalculate quadratic model using analytic Jacobian or finite + differences. Number of secant-based iterations depends on optimization + settings: about 3 iterations - when we have analytic Jacobian, up to 2*N + iterations - when we use finite differences to calculate Jacobian. + +AccType=1 is recommended when Jacobian calculation cost is prohibitive +high (several Mx1 function vector calculations followed by several NxN +Cholesky factorizations are faster than calculation of one M*N Jacobian). +It should also be used when we have no Jacobian, because finite difference +approximation takes too much time to compute. + +Table below list optimization protocols (XYZ protocol corresponds to +MinLMCreateXYZ) and acceleration types they support (and use by default). + +ACCELERATION TYPES SUPPORTED BY OPTIMIZATION PROTOCOLS: + +protocol 0 1 comment +V + + +VJ + + +FGH + + +DAFAULT VALUES: + +protocol 0 1 comment +V x without acceleration it is so slooooooooow +VJ x +FGH x + +NOTE: this function should be called before optimization. Attempt to call +it during algorithm iterations may result in unexpected behavior. + +NOTE: attempt to call this function with unsupported protocol/acceleration +combination will result in exception being thrown. + + -- ALGLIB -- + Copyright 14.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetacctype(minlmstate* state, + ae_int_t acctype, + ae_state *_state) +{ + + + ae_assert((acctype==0||acctype==1)||acctype==2, "MinLMSetAccType: incorrect AccType!", _state); + if( acctype==2 ) + { + acctype = 0; + } + if( acctype==0 ) + { + state->maxmodelage = 0; + state->makeadditers = ae_false; + return; + } + if( acctype==1 ) + { + ae_assert(state->hasfi, "MinLMSetAccType: AccType=1 is incompatible with current protocol!", _state); + if( state->algomode==0 ) + { + state->maxmodelage = 2*state->n; + } + else + { + state->maxmodelage = minlm_smallmodelage; + } + state->makeadditers = ae_false; + return; + } +} + + +/************************************************************************* +NOTES: + +1. Depending on function used to create state structure, this algorithm + may accept Jacobian and/or Hessian and/or gradient. According to the + said above, there ase several versions of this function, which accept + different sets of callbacks. + + This flexibility opens way to subtle errors - you may create state with + MinLMCreateFGH() (optimization using Hessian), but call function which + does not accept Hessian. So when algorithm will request Hessian, there + will be no callback to call. In this case exception will be thrown. + + Be careful to avoid such errors because there is no way to find them at + compile time - you can see them at runtime only. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool minlmiteration(minlmstate* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t m; + ae_bool bflag; + ae_int_t iflag; + double v; + double s; + double t; + ae_int_t i; + ae_int_t k; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + m = state->rstate.ia.ptr.p_int[1]; + iflag = state->rstate.ia.ptr.p_int[2]; + i = state->rstate.ia.ptr.p_int[3]; + k = state->rstate.ia.ptr.p_int[4]; + bflag = state->rstate.ba.ptr.p_bool[0]; + v = state->rstate.ra.ptr.p_double[0]; + s = state->rstate.ra.ptr.p_double[1]; + t = state->rstate.ra.ptr.p_double[2]; + } + else + { + n = -983; + m = -989; + iflag = -834; + i = 900; + k = -287; + bflag = ae_false; + v = 214; + s = -338; + t = -686; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + if( state->rstate.stage==5 ) + { + goto lbl_5; + } + if( state->rstate.stage==6 ) + { + goto lbl_6; + } + if( state->rstate.stage==7 ) + { + goto lbl_7; + } + if( state->rstate.stage==8 ) + { + goto lbl_8; + } + if( state->rstate.stage==9 ) + { + goto lbl_9; + } + if( state->rstate.stage==10 ) + { + goto lbl_10; + } + if( state->rstate.stage==11 ) + { + goto lbl_11; + } + if( state->rstate.stage==12 ) + { + goto lbl_12; + } + if( state->rstate.stage==13 ) + { + goto lbl_13; + } + if( state->rstate.stage==14 ) + { + goto lbl_14; + } + if( state->rstate.stage==15 ) + { + goto lbl_15; + } + if( state->rstate.stage==16 ) + { + goto lbl_16; + } + if( state->rstate.stage==17 ) + { + goto lbl_17; + } + if( state->rstate.stage==18 ) + { + goto lbl_18; + } + + /* + * Routine body + */ + + /* + * prepare + */ + n = state->n; + m = state->m; + state->repiterationscount = 0; + state->repterminationtype = 0; + state->repfuncidx = -1; + state->repvaridx = -1; + state->repnfunc = 0; + state->repnjac = 0; + state->repngrad = 0; + state->repnhess = 0; + state->repncholesky = 0; + + /* + * check consistency of constraints, + * enforce feasibility of the solution + * set constraints + */ + if( !enforceboundaryconstraints(&state->xbase, &state->bndl, &state->havebndl, &state->bndu, &state->havebndu, n, 0, _state) ) + { + state->repterminationtype = -3; + result = ae_false; + return result; + } + minqpsetbc(&state->qpstate, &state->bndl, &state->bndu, _state); + + /* + * Check, that transferred derivative value is right + */ + minlm_clearrequestfields(state, _state); + if( !(state->algomode==1&&ae_fp_greater(state->teststep,0)) ) + { + goto lbl_19; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->needfij = ae_true; + i = 0; +lbl_21: + if( i>n-1 ) + { + goto lbl_23; + } + ae_assert((state->havebndl.ptr.p_bool[i]&&ae_fp_less_eq(state->bndl.ptr.p_double[i],state->x.ptr.p_double[i]))||!state->havebndl.ptr.p_bool[i], "MinLM: internal error(State.X is out of bounds)", _state); + ae_assert((state->havebndu.ptr.p_bool[i]&&ae_fp_less_eq(state->x.ptr.p_double[i],state->bndu.ptr.p_double[i]))||!state->havebndu.ptr.p_bool[i], "MinLMIteration: internal error(State.X is out of bounds)", _state); + v = state->x.ptr.p_double[i]; + state->x.ptr.p_double[i] = v-state->teststep*state->s.ptr.p_double[i]; + if( state->havebndl.ptr.p_bool[i] ) + { + state->x.ptr.p_double[i] = ae_maxreal(state->x.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); + } + state->xm1 = state->x.ptr.p_double[i]; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + ae_v_move(&state->fm1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + ae_v_move(&state->gm1.ptr.p_double[0], 1, &state->j.ptr.pp_double[0][i], state->j.stride, ae_v_len(0,m-1)); + state->x.ptr.p_double[i] = v+state->teststep*state->s.ptr.p_double[i]; + if( state->havebndu.ptr.p_bool[i] ) + { + state->x.ptr.p_double[i] = ae_minreal(state->x.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + state->xp1 = state->x.ptr.p_double[i]; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + ae_v_move(&state->fp1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + ae_v_move(&state->gp1.ptr.p_double[0], 1, &state->j.ptr.pp_double[0][i], state->j.stride, ae_v_len(0,m-1)); + state->x.ptr.p_double[i] = (state->xm1+state->xp1)/2; + if( state->havebndl.ptr.p_bool[i] ) + { + state->x.ptr.p_double[i] = ae_maxreal(state->x.ptr.p_double[i], state->bndl.ptr.p_double[i], _state); + } + if( state->havebndu.ptr.p_bool[i] ) + { + state->x.ptr.p_double[i] = ae_minreal(state->x.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + ae_v_move(&state->fc1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + ae_v_move(&state->gc1.ptr.p_double[0], 1, &state->j.ptr.pp_double[0][i], state->j.stride, ae_v_len(0,m-1)); + state->x.ptr.p_double[i] = v; + for(k=0; k<=m-1; k++) + { + if( !derivativecheck(state->fm1.ptr.p_double[k], state->gm1.ptr.p_double[k], state->fp1.ptr.p_double[k], state->gp1.ptr.p_double[k], state->fc1.ptr.p_double[k], state->gc1.ptr.p_double[k], state->xp1-state->xm1, _state) ) + { + state->repfuncidx = k; + state->repvaridx = i; + state->repterminationtype = -7; + result = ae_false; + return result; + } + } + i = i+1; + goto lbl_21; +lbl_23: + state->needfij = ae_false; +lbl_19: + + /* + * Initial report of current point + * + * Note 1: we rewrite State.X twice because + * user may accidentally change it after first call. + * + * Note 2: we set NeedF or NeedFI depending on what + * information about function we have. + */ + if( !state->xrep ) + { + goto lbl_24; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minlm_clearrequestfields(state, _state); + if( !state->hasf ) + { + goto lbl_26; + } + state->needf = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needf = ae_false; + goto lbl_27; +lbl_26: + ae_assert(state->hasfi, "MinLM: internal error 2!", _state); + state->needfi = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->needfi = ae_false; + v = ae_v_dotproduct(&state->fi.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + state->f = v; +lbl_27: + state->repnfunc = state->repnfunc+1; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minlm_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 5; + goto lbl_rcomm; +lbl_5: + state->xupdated = ae_false; +lbl_24: + + /* + * Prepare control variables + */ + state->nu = 1; + state->lambdav = -ae_maxrealnumber; + state->modelage = state->maxmodelage+1; + state->deltaxready = ae_false; + state->deltafready = ae_false; + + /* + * Main cycle. + * + * We move through it until either: + * * one of the stopping conditions is met + * * we decide that stopping conditions are too stringent + * and break from cycle + * + */ +lbl_28: + if( ae_false ) + { + goto lbl_29; + } + + /* + * First, we have to prepare quadratic model for our function. + * We use BFlag to ensure that model is prepared; + * if it is false at the end of this block, something went wrong. + * + * We may either calculate brand new model or update old one. + * + * Before this block we have: + * * State.XBase - current position. + * * State.DeltaX - if DeltaXReady is True + * * State.DeltaF - if DeltaFReady is True + * + * After this block is over, we will have: + * * State.XBase - base point (unchanged) + * * State.FBase - F(XBase) + * * State.GBase - linear term + * * State.QuadraticModel - quadratic term + * * State.LambdaV - current estimate for lambda + * + * We also clear DeltaXReady/DeltaFReady flags + * after initialization is done. + */ + bflag = ae_false; + if( !(state->algomode==0||state->algomode==1) ) + { + goto lbl_30; + } + + /* + * Calculate f[] and Jacobian + */ + if( !(state->modelage>state->maxmodelage||!(state->deltaxready&&state->deltafready)) ) + { + goto lbl_32; + } + + /* + * Refresh model (using either finite differences or analytic Jacobian) + */ + if( state->algomode!=0 ) + { + goto lbl_34; + } + + /* + * Optimization using F values only. + * Use finite differences to estimate Jacobian. + */ + ae_assert(state->hasfi, "MinLMIteration: internal error when estimating Jacobian (no f[])", _state); + k = 0; +lbl_36: + if( k>n-1 ) + { + goto lbl_38; + } + + /* + * We guard X[k] from leaving [BndL,BndU]. + * In case BndL=BndU, we assume that derivative in this direction is zero. + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->x.ptr.p_double[k] = state->x.ptr.p_double[k]-state->s.ptr.p_double[k]*state->diffstep; + if( state->havebndl.ptr.p_bool[k] ) + { + state->x.ptr.p_double[k] = ae_maxreal(state->x.ptr.p_double[k], state->bndl.ptr.p_double[k], _state); + } + if( state->havebndu.ptr.p_bool[k] ) + { + state->x.ptr.p_double[k] = ae_minreal(state->x.ptr.p_double[k], state->bndu.ptr.p_double[k], _state); + } + state->xm1 = state->x.ptr.p_double[k]; + minlm_clearrequestfields(state, _state); + state->needfi = ae_true; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->repnfunc = state->repnfunc+1; + ae_v_move(&state->fm1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->x.ptr.p_double[k] = state->x.ptr.p_double[k]+state->s.ptr.p_double[k]*state->diffstep; + if( state->havebndl.ptr.p_bool[k] ) + { + state->x.ptr.p_double[k] = ae_maxreal(state->x.ptr.p_double[k], state->bndl.ptr.p_double[k], _state); + } + if( state->havebndu.ptr.p_bool[k] ) + { + state->x.ptr.p_double[k] = ae_minreal(state->x.ptr.p_double[k], state->bndu.ptr.p_double[k], _state); + } + state->xp1 = state->x.ptr.p_double[k]; + minlm_clearrequestfields(state, _state); + state->needfi = ae_true; + state->rstate.stage = 7; + goto lbl_rcomm; +lbl_7: + state->repnfunc = state->repnfunc+1; + ae_v_move(&state->fp1.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + v = state->xp1-state->xm1; + if( ae_fp_neq(v,0) ) + { + v = 1/v; + ae_v_moved(&state->j.ptr.pp_double[0][k], state->j.stride, &state->fp1.ptr.p_double[0], 1, ae_v_len(0,m-1), v); + ae_v_subd(&state->j.ptr.pp_double[0][k], state->j.stride, &state->fm1.ptr.p_double[0], 1, ae_v_len(0,m-1), v); + } + else + { + for(i=0; i<=m-1; i++) + { + state->j.ptr.pp_double[i][k] = 0; + } + } + k = k+1; + goto lbl_36; +lbl_38: + + /* + * Calculate F(XBase) + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minlm_clearrequestfields(state, _state); + state->needfi = ae_true; + state->rstate.stage = 8; + goto lbl_rcomm; +lbl_8: + state->needfi = ae_false; + state->repnfunc = state->repnfunc+1; + state->repnjac = state->repnjac+1; + + /* + * New model + */ + state->modelage = 0; + goto lbl_35; +lbl_34: + + /* + * Obtain f[] and Jacobian + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minlm_clearrequestfields(state, _state); + state->needfij = ae_true; + state->rstate.stage = 9; + goto lbl_rcomm; +lbl_9: + state->needfij = ae_false; + state->repnfunc = state->repnfunc+1; + state->repnjac = state->repnjac+1; + + /* + * New model + */ + state->modelage = 0; +lbl_35: + goto lbl_33; +lbl_32: + + /* + * State.J contains Jacobian or its current approximation; + * refresh it using secant updates: + * + * f(x0+dx) = f(x0) + J*dx, + * J_new = J_old + u*h' + * h = x_new-x_old + * u = (f_new - f_old - J_old*h)/(h'h) + * + * We can explicitly generate h and u, but it is + * preferential to do in-place calculations. Only + * I-th row of J_old is needed to calculate u[I], + * so we can update J row by row in one pass. + * + * NOTE: we expect that State.XBase contains new point, + * State.FBase contains old point, State.DeltaX and + * State.DeltaY contain updates from last step. + */ + ae_assert(state->deltaxready&&state->deltafready, "MinLMIteration: uninitialized DeltaX/DeltaF", _state); + t = ae_v_dotproduct(&state->deltax.ptr.p_double[0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_assert(ae_fp_neq(t,0), "MinLM: internal error (T=0)", _state); + for(i=0; i<=m-1; i++) + { + v = ae_v_dotproduct(&state->j.ptr.pp_double[i][0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v = (state->deltaf.ptr.p_double[i]-v)/t; + ae_v_addd(&state->j.ptr.pp_double[i][0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + } + ae_v_move(&state->fi.ptr.p_double[0], 1, &state->fibase.ptr.p_double[0], 1, ae_v_len(0,m-1)); + ae_v_add(&state->fi.ptr.p_double[0], 1, &state->deltaf.ptr.p_double[0], 1, ae_v_len(0,m-1)); + + /* + * Increase model age + */ + state->modelage = state->modelage+1; +lbl_33: + + /* + * Generate quadratic model: + * f(xbase+dx) = + * = (f0 + J*dx)'(f0 + J*dx) + * = f0^2 + dx'J'f0 + f0*J*dx + dx'J'J*dx + * = f0^2 + 2*f0*J*dx + dx'J'J*dx + * + * Note that we calculate 2*(J'J) instead of J'J because + * our quadratic model is based on Tailor decomposition, + * i.e. it has 0.5 before quadratic term. + */ + rmatrixgemm(n, n, m, 2.0, &state->j, 0, 0, 1, &state->j, 0, 0, 0, 0.0, &state->quadraticmodel, 0, 0, _state); + rmatrixmv(n, m, &state->j, 0, 0, 1, &state->fi, 0, &state->gbase, 0, _state); + ae_v_muld(&state->gbase.ptr.p_double[0], 1, ae_v_len(0,n-1), 2); + v = ae_v_dotproduct(&state->fi.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + state->fbase = v; + ae_v_move(&state->fibase.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + + /* + * set control variables + */ + bflag = ae_true; +lbl_30: + if( state->algomode!=2 ) + { + goto lbl_39; + } + ae_assert(!state->hasfi, "MinLMIteration: internal error (HasFI is True in Hessian-based mode)", _state); + + /* + * Obtain F, G, H + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minlm_clearrequestfields(state, _state); + state->needfgh = ae_true; + state->rstate.stage = 10; + goto lbl_rcomm; +lbl_10: + state->needfgh = ae_false; + state->repnfunc = state->repnfunc+1; + state->repngrad = state->repngrad+1; + state->repnhess = state->repnhess+1; + rmatrixcopy(n, n, &state->h, 0, 0, &state->quadraticmodel, 0, 0, _state); + ae_v_move(&state->gbase.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fbase = state->f; + + /* + * set control variables + */ + bflag = ae_true; + state->modelage = 0; +lbl_39: + ae_assert(bflag, "MinLM: internal integrity check failed!", _state); + state->deltaxready = ae_false; + state->deltafready = ae_false; + + /* + * If Lambda is not initialized, initialize it using quadratic model + */ + if( ae_fp_less(state->lambdav,0) ) + { + state->lambdav = 0; + for(i=0; i<=n-1; i++) + { + state->lambdav = ae_maxreal(state->lambdav, ae_fabs(state->quadraticmodel.ptr.pp_double[i][i], _state)*ae_sqr(state->s.ptr.p_double[i], _state), _state); + } + state->lambdav = 0.001*state->lambdav; + if( ae_fp_eq(state->lambdav,0) ) + { + state->lambdav = 1; + } + } + + /* + * Test stopping conditions for function gradient + */ + if( ae_fp_greater(minlm_boundedscaledantigradnorm(state, &state->xbase, &state->gbase, _state),state->epsg) ) + { + goto lbl_41; + } + if( state->modelage!=0 ) + { + goto lbl_43; + } + + /* + * Model is fresh, we can rely on it and terminate algorithm + */ + state->repterminationtype = 4; + if( !state->xrep ) + { + goto lbl_45; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->f = state->fbase; + minlm_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 11; + goto lbl_rcomm; +lbl_11: + state->xupdated = ae_false; +lbl_45: + result = ae_false; + return result; + goto lbl_44; +lbl_43: + + /* + * Model is not fresh, we should refresh it and test + * conditions once more + */ + state->modelage = state->maxmodelage+1; + goto lbl_28; +lbl_44: +lbl_41: + + /* + * Find value of Levenberg-Marquardt damping parameter which: + * * leads to positive definite damped model + * * within bounds specified by StpMax + * * generates step which decreases function value + * + * After this block IFlag is set to: + * * -3, if constraints are infeasible + * * -2, if model update is needed (either Lambda growth is too large + * or step is too short, but we can't rely on model and stop iterations) + * * -1, if model is fresh, Lambda have grown too large, termination is needed + * * 0, if everything is OK, continue iterations + * + * State.Nu can have any value on enter, but after exit it is set to 1.0 + */ + iflag = -99; +lbl_47: + if( ae_false ) + { + goto lbl_48; + } + + /* + * Do we need model update? + */ + if( state->modelage>0&&ae_fp_greater_eq(state->nu,minlm_suspiciousnu) ) + { + iflag = -2; + goto lbl_48; + } + + /* + * Setup quadratic solver and solve quadratic programming problem. + * After problem is solved we'll try to bound step by StpMax + * (Lambda will be increased if step size is too large). + * + * We use BFlag variable to indicate that we have to increase Lambda. + * If it is False, we will try to increase Lambda and move to new iteration. + */ + bflag = ae_true; + minqpsetstartingpointfast(&state->qpstate, &state->xbase, _state); + minqpsetoriginfast(&state->qpstate, &state->xbase, _state); + minqpsetlineartermfast(&state->qpstate, &state->gbase, _state); + minqpsetquadratictermfast(&state->qpstate, &state->quadraticmodel, ae_true, 0.0, _state); + for(i=0; i<=n-1; i++) + { + state->tmp0.ptr.p_double[i] = state->quadraticmodel.ptr.pp_double[i][i]+state->lambdav/ae_sqr(state->s.ptr.p_double[i], _state); + } + minqprewritediagonal(&state->qpstate, &state->tmp0, _state); + minqpoptimize(&state->qpstate, _state); + minqpresultsbuf(&state->qpstate, &state->xdir, &state->qprep, _state); + if( state->qprep.terminationtype>0 ) + { + + /* + * successful solution of QP problem + */ + ae_v_sub(&state->xdir.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v = ae_v_dotproduct(&state->xdir.ptr.p_double[0], 1, &state->xdir.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_isfinite(v, _state) ) + { + v = ae_sqrt(v, _state); + if( ae_fp_greater(state->stpmax,0)&&ae_fp_greater(v,state->stpmax) ) + { + bflag = ae_false; + } + } + else + { + bflag = ae_false; + } + } + else + { + + /* + * Either problem is non-convex (increase LambdaV) or constraints are inconsistent + */ + ae_assert(state->qprep.terminationtype==-3||state->qprep.terminationtype==-5, "MinLM: unexpected completion code from QP solver", _state); + if( state->qprep.terminationtype==-3 ) + { + iflag = -3; + goto lbl_48; + } + bflag = ae_false; + } + if( !bflag ) + { + + /* + * Solution failed: + * try to increase lambda to make matrix positive definite and continue. + */ + if( !minlm_increaselambda(&state->lambdav, &state->nu, _state) ) + { + iflag = -1; + goto lbl_48; + } + goto lbl_47; + } + + /* + * Step in State.XDir and it is bounded by StpMax. + * + * We should check stopping conditions on step size here. + * DeltaX, which is used for secant updates, is initialized here. + * + * This code is a bit tricky because sometimes XDir<>0, but + * it is so small that XDir+XBase==XBase (in finite precision + * arithmetics). So we set DeltaX to XBase, then + * add XDir, and then subtract XBase to get exact value of + * DeltaX. + * + * Step length is estimated using DeltaX. + * + * NOTE: stopping conditions are tested + * for fresh models only (ModelAge=0) + */ + ae_v_move(&state->deltax.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_add(&state->deltax.ptr.p_double[0], 1, &state->xdir.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_sub(&state->deltax.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->deltaxready = ae_true; + v = 0.0; + for(i=0; i<=n-1; i++) + { + v = v+ae_sqr(state->deltax.ptr.p_double[i]/state->s.ptr.p_double[i], _state); + } + v = ae_sqrt(v, _state); + if( ae_fp_greater(v,state->epsx) ) + { + goto lbl_49; + } + if( state->modelage!=0 ) + { + goto lbl_51; + } + + /* + * Step is too short, model is fresh and we can rely on it. + * Terminating. + */ + state->repterminationtype = 2; + if( !state->xrep ) + { + goto lbl_53; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->f = state->fbase; + minlm_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 12; + goto lbl_rcomm; +lbl_12: + state->xupdated = ae_false; +lbl_53: + result = ae_false; + return result; + goto lbl_52; +lbl_51: + + /* + * Step is suspiciously short, but model is not fresh + * and we can't rely on it. + */ + iflag = -2; + goto lbl_48; +lbl_52: +lbl_49: + + /* + * Let's evaluate new step: + * a) if we have Fi vector, we evaluate it using rcomm, and + * then we manually calculate State.F as sum of squares of Fi[] + * b) if we have F value, we just evaluate it through rcomm interface + * + * We prefer (a) because we may need Fi vector for additional + * iterations + */ + ae_assert(state->hasfi||state->hasf, "MinLM: internal error 2!", _state); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_add(&state->x.ptr.p_double[0], 1, &state->xdir.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minlm_clearrequestfields(state, _state); + if( !state->hasfi ) + { + goto lbl_55; + } + state->needfi = ae_true; + state->rstate.stage = 13; + goto lbl_rcomm; +lbl_13: + state->needfi = ae_false; + v = ae_v_dotproduct(&state->fi.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + state->f = v; + ae_v_move(&state->deltaf.ptr.p_double[0], 1, &state->fi.ptr.p_double[0], 1, ae_v_len(0,m-1)); + ae_v_sub(&state->deltaf.ptr.p_double[0], 1, &state->fibase.ptr.p_double[0], 1, ae_v_len(0,m-1)); + state->deltafready = ae_true; + goto lbl_56; +lbl_55: + state->needf = ae_true; + state->rstate.stage = 14; + goto lbl_rcomm; +lbl_14: + state->needf = ae_false; +lbl_56: + state->repnfunc = state->repnfunc+1; + if( ae_fp_greater_eq(state->f,state->fbase) ) + { + + /* + * Increase lambda and continue + */ + if( !minlm_increaselambda(&state->lambdav, &state->nu, _state) ) + { + iflag = -1; + goto lbl_48; + } + goto lbl_47; + } + + /* + * We've found our step! + */ + iflag = 0; + goto lbl_48; + goto lbl_47; +lbl_48: + state->nu = 1; + ae_assert(iflag>=-3&&iflag<=0, "MinLM: internal integrity check failed!", _state); + if( iflag==-3 ) + { + state->repterminationtype = -3; + result = ae_false; + return result; + } + if( iflag==-2 ) + { + state->modelage = state->maxmodelage+1; + goto lbl_28; + } + if( iflag==-1 ) + { + goto lbl_29; + } + + /* + * Levenberg-Marquardt step is ready. + * Compare predicted vs. actual decrease and decide what to do with lambda. + * + * NOTE: we expect that State.DeltaX contains direction of step, + * State.F contains function value at new point. + */ + ae_assert(state->deltaxready, "MinLM: deltaX is not ready", _state); + t = 0; + for(i=0; i<=n-1; i++) + { + v = ae_v_dotproduct(&state->quadraticmodel.ptr.pp_double[i][0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1)); + t = t+state->deltax.ptr.p_double[i]*state->gbase.ptr.p_double[i]+0.5*state->deltax.ptr.p_double[i]*v; + } + state->predicteddecrease = -t; + state->actualdecrease = -(state->f-state->fbase); + if( ae_fp_less_eq(state->predicteddecrease,0) ) + { + goto lbl_29; + } + v = state->actualdecrease/state->predicteddecrease; + if( ae_fp_greater_eq(v,0.1) ) + { + goto lbl_57; + } + if( minlm_increaselambda(&state->lambdav, &state->nu, _state) ) + { + goto lbl_59; + } + + /* + * Lambda is too large, we have to break iterations. + */ + state->repterminationtype = 7; + if( !state->xrep ) + { + goto lbl_61; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->f = state->fbase; + minlm_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 15; + goto lbl_rcomm; +lbl_15: + state->xupdated = ae_false; +lbl_61: + result = ae_false; + return result; +lbl_59: +lbl_57: + if( ae_fp_greater(v,0.5) ) + { + minlm_decreaselambda(&state->lambdav, &state->nu, _state); + } + + /* + * Accept step, report it and + * test stopping conditions on iterations count and function decrease. + * + * NOTE: we expect that State.DeltaX contains direction of step, + * State.F contains function value at new point. + * + * NOTE2: we should update XBase ONLY. In the beginning of the next + * iteration we expect that State.FIBase is NOT updated and + * contains old value of a function vector. + */ + ae_v_add(&state->xbase.ptr.p_double[0], 1, &state->deltax.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( !state->xrep ) + { + goto lbl_63; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minlm_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 16; + goto lbl_rcomm; +lbl_16: + state->xupdated = ae_false; +lbl_63: + state->repiterationscount = state->repiterationscount+1; + if( state->repiterationscount>=state->maxits&&state->maxits>0 ) + { + state->repterminationtype = 5; + } + if( state->modelage==0 ) + { + if( ae_fp_less_eq(ae_fabs(state->f-state->fbase, _state),state->epsf*ae_maxreal(1, ae_maxreal(ae_fabs(state->f, _state), ae_fabs(state->fbase, _state), _state), _state)) ) + { + state->repterminationtype = 1; + } + } + if( state->repterminationtype<=0 ) + { + goto lbl_65; + } + if( !state->xrep ) + { + goto lbl_67; + } + + /* + * Report: XBase contains new point, F contains function value at new point + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + minlm_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 17; + goto lbl_rcomm; +lbl_17: + state->xupdated = ae_false; +lbl_67: + result = ae_false; + return result; +lbl_65: + state->modelage = state->modelage+1; + goto lbl_28; +lbl_29: + + /* + * Lambda is too large, we have to break iterations. + */ + state->repterminationtype = 7; + if( !state->xrep ) + { + goto lbl_69; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->f = state->fbase; + minlm_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 18; + goto lbl_rcomm; +lbl_18: + state->xupdated = ae_false; +lbl_69: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = m; + state->rstate.ia.ptr.p_int[2] = iflag; + state->rstate.ia.ptr.p_int[3] = i; + state->rstate.ia.ptr.p_int[4] = k; + state->rstate.ba.ptr.p_bool[0] = bflag; + state->rstate.ra.ptr.p_double[0] = v; + state->rstate.ra.ptr.p_double[1] = s; + state->rstate.ra.ptr.p_double[2] = t; + return result; +} + + +/************************************************************************* +Levenberg-Marquardt algorithm results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report; + see comments for this structure for more info. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmresults(minlmstate* state, + /* Real */ ae_vector* x, + minlmreport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _minlmreport_clear(rep); + + minlmresultsbuf(state, x, rep, _state); +} + + +/************************************************************************* +Levenberg-Marquardt algorithm results + +Buffered implementation of MinLMResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmresultsbuf(minlmstate* state, + /* Real */ ae_vector* x, + minlmreport* rep, + ae_state *_state) +{ + + + if( x->cntn ) + { + ae_vector_set_length(x, state->n, _state); + } + ae_v_move(&x->ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + rep->iterationscount = state->repiterationscount; + rep->terminationtype = state->repterminationtype; + rep->funcidx = state->repfuncidx; + rep->varidx = state->repvaridx; + rep->nfunc = state->repnfunc; + rep->njac = state->repnjac; + rep->ngrad = state->repngrad; + rep->nhess = state->repnhess; + rep->ncholesky = state->repncholesky; +} + + +/************************************************************************* +This subroutine restarts LM algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used for reverse communication previously + allocated with MinLMCreateXXX call. + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmrestartfrom(minlmstate* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + + + ae_assert(x->cnt>=state->n, "MinLMRestartFrom: Length(X)n, _state), "MinLMRestartFrom: X contains infinite or NaN values!", _state); + ae_v_move(&state->xbase.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + ae_vector_set_length(&state->rstate.ia, 4+1, _state); + ae_vector_set_length(&state->rstate.ba, 0+1, _state); + ae_vector_set_length(&state->rstate.ra, 2+1, _state); + state->rstate.stage = -1; + minlm_clearrequestfields(state, _state); +} + + +/************************************************************************* +This is obsolete function. + +Since ALGLIB 3.3 it is equivalent to MinLMCreateVJ(). + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatevgj(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state) +{ + + _minlmstate_clear(state); + + minlmcreatevj(n, m, x, state, _state); +} + + +/************************************************************************* +This is obsolete function. + +Since ALGLIB 3.3 it is equivalent to MinLMCreateFJ(). + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefgj(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state) +{ + + _minlmstate_clear(state); + + minlmcreatefj(n, m, x, state, _state); +} + + +/************************************************************************* +This function is considered obsolete since ALGLIB 3.1.0 and is present for +backward compatibility only. We recommend to use MinLMCreateVJ, which +provides similar, but more consistent and feature-rich interface. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefj(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state) +{ + + _minlmstate_clear(state); + + ae_assert(n>=1, "MinLMCreateFJ: N<1!", _state); + ae_assert(m>=1, "MinLMCreateFJ: M<1!", _state); + ae_assert(x->cnt>=n, "MinLMCreateFJ: Length(X)teststep = 0; + state->n = n; + state->m = m; + state->algomode = 1; + state->hasf = ae_true; + state->hasfi = ae_false; + state->hasg = ae_false; + + /* + * init 2 + */ + minlm_lmprepare(n, m, ae_true, state, _state); + minlmsetacctype(state, 0, _state); + minlmsetcond(state, 0, 0, 0, 0, _state); + minlmsetxrep(state, ae_false, _state); + minlmsetstpmax(state, 0, _state); + minlmrestartfrom(state, x, _state); +} + + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinLMOptimize() is called +* prior to actual optimization, for each function Fi and each component + of parameters being optimized X[j] algorithm performs following steps: + * two trial steps are made to X[j]-TestStep*S[j] and X[j]+TestStep*S[j], + where X[j] is j-th parameter and S[j] is a scale of j-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * Fi(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative, + Rep.FuncIdx is set to index of the function. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) Jacobian evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided + by some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinLMSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minlmsetgradientcheck(minlmstate* state, + double teststep, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(teststep, _state), "MinLMSetGradientCheck: TestStep contains NaN or Infinite", _state); + ae_assert(ae_fp_greater_eq(teststep,0), "MinLMSetGradientCheck: invalid argument TestStep(TestStep<0)", _state); + state->teststep = teststep; +} + + +/************************************************************************* +Prepare internal structures (except for RComm). + +Note: M must be zero for FGH mode, non-zero for V/VJ/FJ/FGJ mode. +*************************************************************************/ +static void minlm_lmprepare(ae_int_t n, + ae_int_t m, + ae_bool havegrad, + minlmstate* state, + ae_state *_state) +{ + ae_int_t i; + + + if( n<=0||m<0 ) + { + return; + } + if( havegrad ) + { + ae_vector_set_length(&state->g, n, _state); + } + if( m!=0 ) + { + ae_matrix_set_length(&state->j, m, n, _state); + ae_vector_set_length(&state->fi, m, _state); + ae_vector_set_length(&state->fibase, m, _state); + ae_vector_set_length(&state->deltaf, m, _state); + ae_vector_set_length(&state->fm1, m, _state); + ae_vector_set_length(&state->fp1, m, _state); + ae_vector_set_length(&state->fc1, m, _state); + ae_vector_set_length(&state->gm1, m, _state); + ae_vector_set_length(&state->gp1, m, _state); + ae_vector_set_length(&state->gc1, m, _state); + } + else + { + ae_matrix_set_length(&state->h, n, n, _state); + } + ae_vector_set_length(&state->x, n, _state); + ae_vector_set_length(&state->deltax, n, _state); + ae_matrix_set_length(&state->quadraticmodel, n, n, _state); + ae_vector_set_length(&state->xbase, n, _state); + ae_vector_set_length(&state->gbase, n, _state); + ae_vector_set_length(&state->xdir, n, _state); + ae_vector_set_length(&state->tmp0, n, _state); + + /* + * prepare internal L-BFGS + */ + for(i=0; i<=n-1; i++) + { + state->x.ptr.p_double[i] = 0; + } + minlbfgscreate(n, ae_minint(minlm_additers, n, _state), &state->x, &state->internalstate, _state); + minlbfgssetcond(&state->internalstate, 0.0, 0.0, 0.0, ae_minint(minlm_additers, n, _state), _state); + + /* + * Prepare internal QP solver + */ + minqpcreate(n, &state->qpstate, _state); + minqpsetalgocholesky(&state->qpstate, _state); + + /* + * Prepare boundary constraints + */ + ae_vector_set_length(&state->bndl, n, _state); + ae_vector_set_length(&state->bndu, n, _state); + ae_vector_set_length(&state->havebndl, n, _state); + ae_vector_set_length(&state->havebndu, n, _state); + for(i=0; i<=n-1; i++) + { + state->bndl.ptr.p_double[i] = _state->v_neginf; + state->havebndl.ptr.p_bool[i] = ae_false; + state->bndu.ptr.p_double[i] = _state->v_posinf; + state->havebndu.ptr.p_bool[i] = ae_false; + } + + /* + * Prepare scaling matrix + */ + ae_vector_set_length(&state->s, n, _state); + for(i=0; i<=n-1; i++) + { + state->s.ptr.p_double[i] = 1.0; + } +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forgot to clear something) +*************************************************************************/ +static void minlm_clearrequestfields(minlmstate* state, ae_state *_state) +{ + + + state->needf = ae_false; + state->needfg = ae_false; + state->needfgh = ae_false; + state->needfij = ae_false; + state->needfi = ae_false; + state->xupdated = ae_false; +} + + +/************************************************************************* +Increases lambda, returns False when there is a danger of overflow +*************************************************************************/ +static ae_bool minlm_increaselambda(double* lambdav, + double* nu, + ae_state *_state) +{ + double lnlambda; + double lnnu; + double lnlambdaup; + double lnmax; + ae_bool result; + + + result = ae_false; + lnlambda = ae_log(*lambdav, _state); + lnlambdaup = ae_log(minlm_lambdaup, _state); + lnnu = ae_log(*nu, _state); + lnmax = ae_log(ae_maxrealnumber, _state); + if( ae_fp_greater(lnlambda+lnlambdaup+lnnu,0.25*lnmax) ) + { + return result; + } + if( ae_fp_greater(lnnu+ae_log(2, _state),lnmax) ) + { + return result; + } + *lambdav = *lambdav*minlm_lambdaup*(*nu); + *nu = *nu*2; + result = ae_true; + return result; +} + + +/************************************************************************* +Decreases lambda, but leaves it unchanged when there is danger of underflow. +*************************************************************************/ +static void minlm_decreaselambda(double* lambdav, + double* nu, + ae_state *_state) +{ + + + *nu = 1; + if( ae_fp_less(ae_log(*lambdav, _state)+ae_log(minlm_lambdadown, _state),ae_log(ae_minrealnumber, _state)) ) + { + *lambdav = ae_minrealnumber; + } + else + { + *lambdav = *lambdav*minlm_lambdadown; + } +} + + +/************************************************************************* +Returns norm of bounded scaled anti-gradient. + +Bounded antigradient is a vector obtained from anti-gradient by zeroing +components which point outwards: + result = norm(v) + v[i]=0 if ((-g[i]<0)and(x[i]=bndl[i])) or + ((-g[i]>0)and(x[i]=bndu[i])) + v[i]=-g[i]*s[i] otherwise, where s[i] is a scale for I-th variable + +This function may be used to check a stopping criterion. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +static double minlm_boundedscaledantigradnorm(minlmstate* state, + /* Real */ ae_vector* x, + /* Real */ ae_vector* g, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + double v; + double result; + + + result = 0; + n = state->n; + for(i=0; i<=n-1; i++) + { + v = -g->ptr.p_double[i]*state->s.ptr.p_double[i]; + if( state->havebndl.ptr.p_bool[i] ) + { + if( ae_fp_less_eq(x->ptr.p_double[i],state->bndl.ptr.p_double[i])&&ae_fp_less(-g->ptr.p_double[i],0) ) + { + v = 0; + } + } + if( state->havebndu.ptr.p_bool[i] ) + { + if( ae_fp_greater_eq(x->ptr.p_double[i],state->bndu.ptr.p_double[i])&&ae_fp_greater(-g->ptr.p_double[i],0) ) + { + v = 0; + } + } + result = result+ae_sqr(v, _state); + } + result = ae_sqrt(result, _state); + return result; +} + + +ae_bool _minlmstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minlmstate *p = (minlmstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->fi, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->j, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->h, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xbase, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->fibase, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gbase, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->quadraticmodel, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->havebndl, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->havebndu, 0, DT_BOOL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->s, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xdir, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->deltax, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->deltaf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->choleskybuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmp0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->fm1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->fp1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->fc1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gm1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gp1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gc1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsstate_init(&p->internalstate, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsreport_init(&p->internalrep, _state, make_automatic) ) + return ae_false; + if( !_minqpstate_init(&p->qpstate, _state, make_automatic) ) + return ae_false; + if( !_minqpreport_init(&p->qprep, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _minlmstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minlmstate *dst = (minlmstate*)_dst; + minlmstate *src = (minlmstate*)_src; + dst->n = src->n; + dst->m = src->m; + dst->diffstep = src->diffstep; + dst->epsg = src->epsg; + dst->epsf = src->epsf; + dst->epsx = src->epsx; + dst->maxits = src->maxits; + dst->xrep = src->xrep; + dst->stpmax = src->stpmax; + dst->maxmodelage = src->maxmodelage; + dst->makeadditers = src->makeadditers; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + dst->f = src->f; + if( !ae_vector_init_copy(&dst->fi, &src->fi, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->j, &src->j, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->h, &src->h, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + dst->needf = src->needf; + dst->needfg = src->needfg; + dst->needfgh = src->needfgh; + dst->needfij = src->needfij; + dst->needfi = src->needfi; + dst->xupdated = src->xupdated; + dst->algomode = src->algomode; + dst->hasf = src->hasf; + dst->hasfi = src->hasfi; + dst->hasg = src->hasg; + if( !ae_vector_init_copy(&dst->xbase, &src->xbase, _state, make_automatic) ) + return ae_false; + dst->fbase = src->fbase; + if( !ae_vector_init_copy(&dst->fibase, &src->fibase, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gbase, &src->gbase, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->quadraticmodel, &src->quadraticmodel, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->havebndl, &src->havebndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->havebndu, &src->havebndu, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->s, &src->s, _state, make_automatic) ) + return ae_false; + dst->lambdav = src->lambdav; + dst->nu = src->nu; + dst->modelage = src->modelage; + if( !ae_vector_init_copy(&dst->xdir, &src->xdir, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->deltax, &src->deltax, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->deltaf, &src->deltaf, _state, make_automatic) ) + return ae_false; + dst->deltaxready = src->deltaxready; + dst->deltafready = src->deltafready; + dst->teststep = src->teststep; + dst->repiterationscount = src->repiterationscount; + dst->repterminationtype = src->repterminationtype; + dst->repfuncidx = src->repfuncidx; + dst->repvaridx = src->repvaridx; + dst->repnfunc = src->repnfunc; + dst->repnjac = src->repnjac; + dst->repngrad = src->repngrad; + dst->repnhess = src->repnhess; + dst->repncholesky = src->repncholesky; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->choleskybuf, &src->choleskybuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmp0, &src->tmp0, _state, make_automatic) ) + return ae_false; + dst->actualdecrease = src->actualdecrease; + dst->predicteddecrease = src->predicteddecrease; + dst->xm1 = src->xm1; + dst->xp1 = src->xp1; + if( !ae_vector_init_copy(&dst->fm1, &src->fm1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->fp1, &src->fp1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->fc1, &src->fc1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gm1, &src->gm1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gp1, &src->gp1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gc1, &src->gc1, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsstate_init_copy(&dst->internalstate, &src->internalstate, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsreport_init_copy(&dst->internalrep, &src->internalrep, _state, make_automatic) ) + return ae_false; + if( !_minqpstate_init_copy(&dst->qpstate, &src->qpstate, _state, make_automatic) ) + return ae_false; + if( !_minqpreport_init_copy(&dst->qprep, &src->qprep, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _minlmstate_clear(void* _p) +{ + minlmstate *p = (minlmstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x); + ae_vector_clear(&p->fi); + ae_matrix_clear(&p->j); + ae_matrix_clear(&p->h); + ae_vector_clear(&p->g); + ae_vector_clear(&p->xbase); + ae_vector_clear(&p->fibase); + ae_vector_clear(&p->gbase); + ae_matrix_clear(&p->quadraticmodel); + ae_vector_clear(&p->bndl); + ae_vector_clear(&p->bndu); + ae_vector_clear(&p->havebndl); + ae_vector_clear(&p->havebndu); + ae_vector_clear(&p->s); + ae_vector_clear(&p->xdir); + ae_vector_clear(&p->deltax); + ae_vector_clear(&p->deltaf); + _rcommstate_clear(&p->rstate); + ae_vector_clear(&p->choleskybuf); + ae_vector_clear(&p->tmp0); + ae_vector_clear(&p->fm1); + ae_vector_clear(&p->fp1); + ae_vector_clear(&p->fc1); + ae_vector_clear(&p->gm1); + ae_vector_clear(&p->gp1); + ae_vector_clear(&p->gc1); + _minlbfgsstate_clear(&p->internalstate); + _minlbfgsreport_clear(&p->internalrep); + _minqpstate_clear(&p->qpstate); + _minqpreport_clear(&p->qprep); +} + + +void _minlmstate_destroy(void* _p) +{ + minlmstate *p = (minlmstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->fi); + ae_matrix_destroy(&p->j); + ae_matrix_destroy(&p->h); + ae_vector_destroy(&p->g); + ae_vector_destroy(&p->xbase); + ae_vector_destroy(&p->fibase); + ae_vector_destroy(&p->gbase); + ae_matrix_destroy(&p->quadraticmodel); + ae_vector_destroy(&p->bndl); + ae_vector_destroy(&p->bndu); + ae_vector_destroy(&p->havebndl); + ae_vector_destroy(&p->havebndu); + ae_vector_destroy(&p->s); + ae_vector_destroy(&p->xdir); + ae_vector_destroy(&p->deltax); + ae_vector_destroy(&p->deltaf); + _rcommstate_destroy(&p->rstate); + ae_vector_destroy(&p->choleskybuf); + ae_vector_destroy(&p->tmp0); + ae_vector_destroy(&p->fm1); + ae_vector_destroy(&p->fp1); + ae_vector_destroy(&p->fc1); + ae_vector_destroy(&p->gm1); + ae_vector_destroy(&p->gp1); + ae_vector_destroy(&p->gc1); + _minlbfgsstate_destroy(&p->internalstate); + _minlbfgsreport_destroy(&p->internalrep); + _minqpstate_destroy(&p->qpstate); + _minqpreport_destroy(&p->qprep); +} + + +ae_bool _minlmreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minlmreport *p = (minlmreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _minlmreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minlmreport *dst = (minlmreport*)_dst; + minlmreport *src = (minlmreport*)_src; + dst->iterationscount = src->iterationscount; + dst->terminationtype = src->terminationtype; + dst->funcidx = src->funcidx; + dst->varidx = src->varidx; + dst->nfunc = src->nfunc; + dst->njac = src->njac; + dst->ngrad = src->ngrad; + dst->nhess = src->nhess; + dst->ncholesky = src->ncholesky; + return ae_true; +} + + +void _minlmreport_clear(void* _p) +{ + minlmreport *p = (minlmreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _minlmreport_destroy(void* _p) +{ + minlmreport *p = (minlmreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* +Obsolete function, use MinLBFGSSetPrecDefault() instead. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetdefaultpreconditioner(minlbfgsstate* state, + ae_state *_state) +{ + + + minlbfgssetprecdefault(state, _state); +} + + +/************************************************************************* +Obsolete function, use MinLBFGSSetCholeskyPreconditioner() instead. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetcholeskypreconditioner(minlbfgsstate* state, + /* Real */ ae_matrix* p, + ae_bool isupper, + ae_state *_state) +{ + + + minlbfgssetpreccholesky(state, p, isupper, _state); +} + + +/************************************************************************* +This is obsolete function which was used by previous version of the BLEIC +optimizer. It does nothing in the current version of BLEIC. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetbarrierwidth(minbleicstate* state, + double mu, + ae_state *_state) +{ + + +} + + +/************************************************************************* +This is obsolete function which was used by previous version of the BLEIC +optimizer. It does nothing in the current version of BLEIC. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetbarrierdecay(minbleicstate* state, + double mudecay, + ae_state *_state) +{ + + +} + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 25.03.2010 by Bochkanov Sergey +*************************************************************************/ +void minasacreate(ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + minasastate* state, + ae_state *_state) +{ + ae_int_t i; + + _minasastate_clear(state); + + ae_assert(n>=1, "MinASA: N too small!", _state); + ae_assert(x->cnt>=n, "MinCGCreate: Length(X)cnt>=n, "MinCGCreate: Length(BndL)cnt>=n, "MinCGCreate: Length(BndU)ptr.p_double[i],bndu->ptr.p_double[i]), "MinASA: inconsistent bounds!", _state); + ae_assert(ae_fp_less_eq(bndl->ptr.p_double[i],x->ptr.p_double[i]), "MinASA: infeasible X!", _state); + ae_assert(ae_fp_less_eq(x->ptr.p_double[i],bndu->ptr.p_double[i]), "MinASA: infeasible X!", _state); + } + + /* + * Initialize + */ + state->n = n; + minasasetcond(state, 0, 0, 0, 0, _state); + minasasetxrep(state, ae_false, _state); + minasasetstpmax(state, 0, _state); + minasasetalgorithm(state, -1, _state); + ae_vector_set_length(&state->bndl, n, _state); + ae_vector_set_length(&state->bndu, n, _state); + ae_vector_set_length(&state->ak, n, _state); + ae_vector_set_length(&state->xk, n, _state); + ae_vector_set_length(&state->dk, n, _state); + ae_vector_set_length(&state->an, n, _state); + ae_vector_set_length(&state->xn, n, _state); + ae_vector_set_length(&state->dn, n, _state); + ae_vector_set_length(&state->x, n, _state); + ae_vector_set_length(&state->d, n, _state); + ae_vector_set_length(&state->g, n, _state); + ae_vector_set_length(&state->gc, n, _state); + ae_vector_set_length(&state->work, n, _state); + ae_vector_set_length(&state->yk, n, _state); + minasarestartfrom(state, x, bndl, bndu, _state); +} + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetcond(minasastate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsg, _state), "MinASASetCond: EpsG is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsg,0), "MinASASetCond: negative EpsG!", _state); + ae_assert(ae_isfinite(epsf, _state), "MinASASetCond: EpsF is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsf,0), "MinASASetCond: negative EpsF!", _state); + ae_assert(ae_isfinite(epsx, _state), "MinASASetCond: EpsX is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsx,0), "MinASASetCond: negative EpsX!", _state); + ae_assert(maxits>=0, "MinASASetCond: negative MaxIts!", _state); + if( ((ae_fp_eq(epsg,0)&&ae_fp_eq(epsf,0))&&ae_fp_eq(epsx,0))&&maxits==0 ) + { + epsx = 1.0E-6; + } + state->epsg = epsg; + state->epsf = epsf; + state->epsx = epsx; + state->maxits = maxits; +} + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetxrep(minasastate* state, ae_bool needxrep, ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetalgorithm(minasastate* state, + ae_int_t algotype, + ae_state *_state) +{ + + + ae_assert(algotype>=-1&&algotype<=1, "MinASASetAlgorithm: incorrect AlgoType!", _state); + if( algotype==-1 ) + { + algotype = 1; + } + state->cgtype = algotype; +} + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetstpmax(minasastate* state, double stpmax, ae_state *_state) +{ + + + ae_assert(ae_isfinite(stpmax, _state), "MinASASetStpMax: StpMax is not finite!", _state); + ae_assert(ae_fp_greater_eq(stpmax,0), "MinASASetStpMax: StpMax<0!", _state); + state->stpmax = stpmax; +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool minasaiteration(minasastate* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + double betak; + double v; + double vv; + ae_int_t mcinfo; + ae_bool b; + ae_bool stepfound; + ae_int_t diffcnt; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + i = state->rstate.ia.ptr.p_int[1]; + mcinfo = state->rstate.ia.ptr.p_int[2]; + diffcnt = state->rstate.ia.ptr.p_int[3]; + b = state->rstate.ba.ptr.p_bool[0]; + stepfound = state->rstate.ba.ptr.p_bool[1]; + betak = state->rstate.ra.ptr.p_double[0]; + v = state->rstate.ra.ptr.p_double[1]; + vv = state->rstate.ra.ptr.p_double[2]; + } + else + { + n = -983; + i = -989; + mcinfo = -834; + diffcnt = 900; + b = ae_true; + stepfound = ae_false; + betak = 214; + v = -338; + vv = -686; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + if( state->rstate.stage==5 ) + { + goto lbl_5; + } + if( state->rstate.stage==6 ) + { + goto lbl_6; + } + if( state->rstate.stage==7 ) + { + goto lbl_7; + } + if( state->rstate.stage==8 ) + { + goto lbl_8; + } + if( state->rstate.stage==9 ) + { + goto lbl_9; + } + if( state->rstate.stage==10 ) + { + goto lbl_10; + } + if( state->rstate.stage==11 ) + { + goto lbl_11; + } + if( state->rstate.stage==12 ) + { + goto lbl_12; + } + if( state->rstate.stage==13 ) + { + goto lbl_13; + } + if( state->rstate.stage==14 ) + { + goto lbl_14; + } + + /* + * Routine body + */ + + /* + * Prepare + */ + n = state->n; + state->repterminationtype = 0; + state->repiterationscount = 0; + state->repnfev = 0; + state->debugrestartscount = 0; + state->cgtype = 1; + ae_v_move(&state->xk.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + if( ae_fp_eq(state->xk.ptr.p_double[i],state->bndl.ptr.p_double[i])||ae_fp_eq(state->xk.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->ak.ptr.p_double[i] = 0; + } + else + { + state->ak.ptr.p_double[i] = 1; + } + } + state->mu = 0.1; + state->curalgo = 0; + + /* + * Calculate F/G, initialize algorithm + */ + mincomp_clearrequestfields(state, _state); + state->needfg = ae_true; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->needfg = ae_false; + if( !state->xrep ) + { + goto lbl_15; + } + + /* + * progress report + */ + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->xupdated = ae_false; +lbl_15: + if( ae_fp_less_eq(mincomp_asaboundedantigradnorm(state, _state),state->epsg) ) + { + state->repterminationtype = 4; + result = ae_false; + return result; + } + state->repnfev = state->repnfev+1; + + /* + * Main cycle + * + * At the beginning of new iteration: + * * CurAlgo stores current algorithm selector + * * State.XK, State.F and State.G store current X/F/G + * * State.AK stores current set of active constraints + */ +lbl_17: + if( ae_false ) + { + goto lbl_18; + } + + /* + * GPA algorithm + */ + if( state->curalgo!=0 ) + { + goto lbl_19; + } + state->k = 0; + state->acount = 0; +lbl_21: + if( ae_false ) + { + goto lbl_22; + } + + /* + * Determine Dk = proj(xk - gk)-xk + */ + for(i=0; i<=n-1; i++) + { + state->d.ptr.p_double[i] = boundval(state->xk.ptr.p_double[i]-state->g.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state)-state->xk.ptr.p_double[i]; + } + + /* + * Armijo line search. + * * exact search with alpha=1 is tried first, + * 'exact' means that we evaluate f() EXACTLY at + * bound(x-g,bndl,bndu), without intermediate floating + * point operations. + * * alpha<1 are tried if explicit search wasn't successful + * Result is placed into XN. + * + * Two types of search are needed because we can't + * just use second type with alpha=1 because in finite + * precision arithmetics (x1-x0)+x0 may differ from x1. + * So while x1 is correctly bounded (it lie EXACTLY on + * boundary, if it is active), (x1-x0)+x0 may be + * not bounded. + */ + v = ae_v_dotproduct(&state->d.ptr.p_double[0], 1, &state->g.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->dginit = v; + state->finit = state->f; + if( !(ae_fp_less_eq(mincomp_asad1norm(state, _state),state->stpmax)||ae_fp_eq(state->stpmax,0)) ) + { + goto lbl_23; + } + + /* + * Try alpha=1 step first + */ + for(i=0; i<=n-1; i++) + { + state->x.ptr.p_double[i] = boundval(state->xk.ptr.p_double[i]-state->g.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + mincomp_clearrequestfields(state, _state); + state->needfg = ae_true; + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + state->needfg = ae_false; + state->repnfev = state->repnfev+1; + stepfound = ae_fp_less_eq(state->f,state->finit+mincomp_gpaftol*state->dginit); + goto lbl_24; +lbl_23: + stepfound = ae_false; +lbl_24: + if( !stepfound ) + { + goto lbl_25; + } + + /* + * we are at the boundary(ies) + */ + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->stp = 1; + goto lbl_26; +lbl_25: + + /* + * alpha=1 is too large, try smaller values + */ + state->stp = 1; + linminnormalized(&state->d, &state->stp, n, _state); + state->dginit = state->dginit/state->stp; + state->stp = mincomp_gpadecay*state->stp; + if( ae_fp_greater(state->stpmax,0) ) + { + state->stp = ae_minreal(state->stp, state->stpmax, _state); + } +lbl_27: + if( ae_false ) + { + goto lbl_28; + } + v = state->stp; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->x.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + mincomp_clearrequestfields(state, _state); + state->needfg = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needfg = ae_false; + state->repnfev = state->repnfev+1; + if( ae_fp_less_eq(state->stp,mincomp_stpmin) ) + { + goto lbl_28; + } + if( ae_fp_less_eq(state->f,state->finit+state->stp*mincomp_gpaftol*state->dginit) ) + { + goto lbl_28; + } + state->stp = state->stp*mincomp_gpadecay; + goto lbl_27; +lbl_28: + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); +lbl_26: + state->repiterationscount = state->repiterationscount+1; + if( !state->xrep ) + { + goto lbl_29; + } + + /* + * progress report + */ + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->xupdated = ae_false; +lbl_29: + + /* + * Calculate new set of active constraints. + * Reset counter if active set was changed. + * Prepare for the new iteration + */ + for(i=0; i<=n-1; i++) + { + if( ae_fp_eq(state->xn.ptr.p_double[i],state->bndl.ptr.p_double[i])||ae_fp_eq(state->xn.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->an.ptr.p_double[i] = 0; + } + else + { + state->an.ptr.p_double[i] = 1; + } + } + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(state->ak.ptr.p_double[i],state->an.ptr.p_double[i]) ) + { + state->acount = -1; + break; + } + } + state->acount = state->acount+1; + ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->ak.ptr.p_double[0], 1, &state->an.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * Stopping conditions + */ + if( !(state->repiterationscount>=state->maxits&&state->maxits>0) ) + { + goto lbl_31; + } + + /* + * Too many iterations + */ + state->repterminationtype = 5; + if( !state->xrep ) + { + goto lbl_33; + } + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 5; + goto lbl_rcomm; +lbl_5: + state->xupdated = ae_false; +lbl_33: + result = ae_false; + return result; +lbl_31: + if( ae_fp_greater(mincomp_asaboundedantigradnorm(state, _state),state->epsg) ) + { + goto lbl_35; + } + + /* + * Gradient is small enough + */ + state->repterminationtype = 4; + if( !state->xrep ) + { + goto lbl_37; + } + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->xupdated = ae_false; +lbl_37: + result = ae_false; + return result; +lbl_35: + v = ae_v_dotproduct(&state->d.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_fp_greater(ae_sqrt(v, _state)*state->stp,state->epsx) ) + { + goto lbl_39; + } + + /* + * Step size is too small, no further improvement is + * possible + */ + state->repterminationtype = 2; + if( !state->xrep ) + { + goto lbl_41; + } + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 7; + goto lbl_rcomm; +lbl_7: + state->xupdated = ae_false; +lbl_41: + result = ae_false; + return result; +lbl_39: + if( ae_fp_greater(state->finit-state->f,state->epsf*ae_maxreal(ae_fabs(state->finit, _state), ae_maxreal(ae_fabs(state->f, _state), 1.0, _state), _state)) ) + { + goto lbl_43; + } + + /* + * F(k+1)-F(k) is small enough + */ + state->repterminationtype = 1; + if( !state->xrep ) + { + goto lbl_45; + } + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 8; + goto lbl_rcomm; +lbl_8: + state->xupdated = ae_false; +lbl_45: + result = ae_false; + return result; +lbl_43: + + /* + * Decide - should we switch algorithm or not + */ + if( mincomp_asauisempty(state, _state) ) + { + if( ae_fp_greater_eq(mincomp_asaginorm(state, _state),state->mu*mincomp_asad1norm(state, _state)) ) + { + state->curalgo = 1; + goto lbl_22; + } + else + { + state->mu = state->mu*mincomp_asarho; + } + } + else + { + if( state->acount==mincomp_n1 ) + { + if( ae_fp_greater_eq(mincomp_asaginorm(state, _state),state->mu*mincomp_asad1norm(state, _state)) ) + { + state->curalgo = 1; + goto lbl_22; + } + } + } + + /* + * Next iteration + */ + state->k = state->k+1; + goto lbl_21; +lbl_22: +lbl_19: + + /* + * CG algorithm + */ + if( state->curalgo!=1 ) + { + goto lbl_47; + } + + /* + * first, check that there are non-active constraints. + * move to GPA algorithm, if all constraints are active + */ + b = ae_true; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(state->ak.ptr.p_double[i],0) ) + { + b = ae_false; + break; + } + } + if( b ) + { + state->curalgo = 0; + goto lbl_17; + } + + /* + * CG iterations + */ + state->fold = state->f; + ae_v_move(&state->xk.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + state->dk.ptr.p_double[i] = -state->g.ptr.p_double[i]*state->ak.ptr.p_double[i]; + state->gc.ptr.p_double[i] = state->g.ptr.p_double[i]*state->ak.ptr.p_double[i]; + } +lbl_49: + if( ae_false ) + { + goto lbl_50; + } + + /* + * Store G[k] for later calculation of Y[k] + */ + for(i=0; i<=n-1; i++) + { + state->yk.ptr.p_double[i] = -state->gc.ptr.p_double[i]; + } + + /* + * Make a CG step in direction given by DK[]: + * * calculate step. Step projection into feasible set + * is used. It has several benefits: a) step may be + * found with usual line search, b) multiple constraints + * may be activated with one step, c) activated constraints + * are detected in a natural way - just compare x[i] with + * bounds + * * update active set, set B to True, if there + * were changes in the set. + */ + ae_v_move(&state->d.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_move(&state->xn.ptr.p_double[0], 1, &state->xk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->mcstage = 0; + state->stp = 1; + linminnormalized(&state->d, &state->stp, n, _state); + if( ae_fp_neq(state->laststep,0) ) + { + state->stp = state->laststep; + } + mcsrch(n, &state->xn, &state->f, &state->gc, &state->d, &state->stp, state->stpmax, mincomp_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); +lbl_51: + if( state->mcstage==0 ) + { + goto lbl_52; + } + + /* + * preprocess data: bound State.XN so it belongs to the + * feasible set and store it in the State.X + */ + for(i=0; i<=n-1; i++) + { + state->x.ptr.p_double[i] = boundval(state->xn.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + } + + /* + * RComm + */ + mincomp_clearrequestfields(state, _state); + state->needfg = ae_true; + state->rstate.stage = 9; + goto lbl_rcomm; +lbl_9: + state->needfg = ae_false; + + /* + * postprocess data: zero components of G corresponding to + * the active constraints + */ + for(i=0; i<=n-1; i++) + { + if( ae_fp_eq(state->x.ptr.p_double[i],state->bndl.ptr.p_double[i])||ae_fp_eq(state->x.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->gc.ptr.p_double[i] = 0; + } + else + { + state->gc.ptr.p_double[i] = state->g.ptr.p_double[i]; + } + } + mcsrch(n, &state->xn, &state->f, &state->gc, &state->d, &state->stp, state->stpmax, mincomp_gtol, &mcinfo, &state->nfev, &state->work, &state->lstate, &state->mcstage, _state); + goto lbl_51; +lbl_52: + diffcnt = 0; + for(i=0; i<=n-1; i++) + { + + /* + * XN contains unprojected result, project it, + * save copy to X (will be used for progress reporting) + */ + state->xn.ptr.p_double[i] = boundval(state->xn.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state); + + /* + * update active set + */ + if( ae_fp_eq(state->xn.ptr.p_double[i],state->bndl.ptr.p_double[i])||ae_fp_eq(state->xn.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + state->an.ptr.p_double[i] = 0; + } + else + { + state->an.ptr.p_double[i] = 1; + } + if( ae_fp_neq(state->an.ptr.p_double[i],state->ak.ptr.p_double[i]) ) + { + diffcnt = diffcnt+1; + } + state->ak.ptr.p_double[i] = state->an.ptr.p_double[i]; + } + ae_v_move(&state->xk.ptr.p_double[0], 1, &state->xn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->repnfev = state->repnfev+state->nfev; + state->repiterationscount = state->repiterationscount+1; + if( !state->xrep ) + { + goto lbl_53; + } + + /* + * progress report + */ + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 10; + goto lbl_rcomm; +lbl_10: + state->xupdated = ae_false; +lbl_53: + + /* + * Update info about step length + */ + v = ae_v_dotproduct(&state->d.ptr.p_double[0], 1, &state->d.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->laststep = ae_sqrt(v, _state)*state->stp; + + /* + * Check stopping conditions. + */ + if( ae_fp_greater(mincomp_asaboundedantigradnorm(state, _state),state->epsg) ) + { + goto lbl_55; + } + + /* + * Gradient is small enough + */ + state->repterminationtype = 4; + if( !state->xrep ) + { + goto lbl_57; + } + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 11; + goto lbl_rcomm; +lbl_11: + state->xupdated = ae_false; +lbl_57: + result = ae_false; + return result; +lbl_55: + if( !(state->repiterationscount>=state->maxits&&state->maxits>0) ) + { + goto lbl_59; + } + + /* + * Too many iterations + */ + state->repterminationtype = 5; + if( !state->xrep ) + { + goto lbl_61; + } + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 12; + goto lbl_rcomm; +lbl_12: + state->xupdated = ae_false; +lbl_61: + result = ae_false; + return result; +lbl_59: + if( !(ae_fp_greater_eq(mincomp_asaginorm(state, _state),state->mu*mincomp_asad1norm(state, _state))&&diffcnt==0) ) + { + goto lbl_63; + } + + /* + * These conditions (EpsF/EpsX) are explicitly or implicitly + * related to the current step size and influenced + * by changes in the active constraints. + * + * For these reasons they are checked only when we don't + * want to 'unstick' at the end of the iteration and there + * were no changes in the active set. + * + * NOTE: consition |G|>=Mu*|D1| must be exactly opposite + * to the condition used to switch back to GPA. At least + * one inequality must be strict, otherwise infinite cycle + * may occur when |G|=Mu*|D1| (we DON'T test stopping + * conditions and we DON'T switch to GPA, so we cycle + * indefinitely). + */ + if( ae_fp_greater(state->fold-state->f,state->epsf*ae_maxreal(ae_fabs(state->fold, _state), ae_maxreal(ae_fabs(state->f, _state), 1.0, _state), _state)) ) + { + goto lbl_65; + } + + /* + * F(k+1)-F(k) is small enough + */ + state->repterminationtype = 1; + if( !state->xrep ) + { + goto lbl_67; + } + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 13; + goto lbl_rcomm; +lbl_13: + state->xupdated = ae_false; +lbl_67: + result = ae_false; + return result; +lbl_65: + if( ae_fp_greater(state->laststep,state->epsx) ) + { + goto lbl_69; + } + + /* + * X(k+1)-X(k) is small enough + */ + state->repterminationtype = 2; + if( !state->xrep ) + { + goto lbl_71; + } + mincomp_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 14; + goto lbl_rcomm; +lbl_14: + state->xupdated = ae_false; +lbl_71: + result = ae_false; + return result; +lbl_69: +lbl_63: + + /* + * Check conditions for switching + */ + if( ae_fp_less(mincomp_asaginorm(state, _state),state->mu*mincomp_asad1norm(state, _state)) ) + { + state->curalgo = 0; + goto lbl_50; + } + if( diffcnt>0 ) + { + if( mincomp_asauisempty(state, _state)||diffcnt>=mincomp_n2 ) + { + state->curalgo = 1; + } + else + { + state->curalgo = 0; + } + goto lbl_50; + } + + /* + * Calculate D(k+1) + * + * Line search may result in: + * * maximum feasible step being taken (already processed) + * * point satisfying Wolfe conditions + * * some kind of error (CG is restarted by assigning 0.0 to Beta) + */ + if( mcinfo==1 ) + { + + /* + * Standard Wolfe conditions are satisfied: + * * calculate Y[K] and BetaK + */ + ae_v_add(&state->yk.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + vv = ae_v_dotproduct(&state->yk.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + v = ae_v_dotproduct(&state->gc.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->betady = v/vv; + v = ae_v_dotproduct(&state->gc.ptr.p_double[0], 1, &state->yk.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->betahs = v/vv; + if( state->cgtype==0 ) + { + betak = state->betady; + } + if( state->cgtype==1 ) + { + betak = ae_maxreal(0, ae_minreal(state->betady, state->betahs, _state), _state); + } + } + else + { + + /* + * Something is wrong (may be function is too wild or too flat). + * + * We'll set BetaK=0, which will restart CG algorithm. + * We can stop later (during normal checks) if stopping conditions are met. + */ + betak = 0; + state->debugrestartscount = state->debugrestartscount+1; + } + ae_v_moveneg(&state->dn.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->dn.ptr.p_double[0], 1, &state->dk.ptr.p_double[0], 1, ae_v_len(0,n-1), betak); + ae_v_move(&state->dk.ptr.p_double[0], 1, &state->dn.ptr.p_double[0], 1, ae_v_len(0,n-1)); + + /* + * update other information + */ + state->fold = state->f; + state->k = state->k+1; + goto lbl_49; +lbl_50: +lbl_47: + goto lbl_17; +lbl_18: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = i; + state->rstate.ia.ptr.p_int[2] = mcinfo; + state->rstate.ia.ptr.p_int[3] = diffcnt; + state->rstate.ba.ptr.p_bool[0] = b; + state->rstate.ba.ptr.p_bool[1] = stepfound; + state->rstate.ra.ptr.p_double[0] = betak; + state->rstate.ra.ptr.p_double[1] = v; + state->rstate.ra.ptr.p_double[2] = vv; + return result; +} + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minasaresults(minasastate* state, + /* Real */ ae_vector* x, + minasareport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _minasareport_clear(rep); + + minasaresultsbuf(state, x, rep, _state); +} + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minasaresultsbuf(minasastate* state, + /* Real */ ae_vector* x, + minasareport* rep, + ae_state *_state) +{ + ae_int_t i; + + + if( x->cntn ) + { + ae_vector_set_length(x, state->n, _state); + } + ae_v_move(&x->ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + rep->iterationscount = state->repiterationscount; + rep->nfev = state->repnfev; + rep->terminationtype = state->repterminationtype; + rep->activeconstraints = 0; + for(i=0; i<=state->n-1; i++) + { + if( ae_fp_eq(state->ak.ptr.p_double[i],0) ) + { + rep->activeconstraints = rep->activeconstraints+1; + } + } +} + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minasarestartfrom(minasastate* state, + /* Real */ ae_vector* x, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state) +{ + + + ae_assert(x->cnt>=state->n, "MinASARestartFrom: Length(X)n, _state), "MinASARestartFrom: X contains infinite or NaN values!", _state); + ae_assert(bndl->cnt>=state->n, "MinASARestartFrom: Length(BndL)n, _state), "MinASARestartFrom: BndL contains infinite or NaN values!", _state); + ae_assert(bndu->cnt>=state->n, "MinASARestartFrom: Length(BndU)n, _state), "MinASARestartFrom: BndU contains infinite or NaN values!", _state); + ae_v_move(&state->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + ae_v_move(&state->bndl.ptr.p_double[0], 1, &bndl->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + ae_v_move(&state->bndu.ptr.p_double[0], 1, &bndu->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->laststep = 0; + ae_vector_set_length(&state->rstate.ia, 3+1, _state); + ae_vector_set_length(&state->rstate.ba, 1+1, _state); + ae_vector_set_length(&state->rstate.ra, 2+1, _state); + state->rstate.stage = -1; + mincomp_clearrequestfields(state, _state); +} + + +/************************************************************************* +Returns norm of bounded anti-gradient. + +Bounded antigradient is a vector obtained from anti-gradient by zeroing +components which point outwards: + result = norm(v) + v[i]=0 if ((-g[i]<0)and(x[i]=bndl[i])) or + ((-g[i]>0)and(x[i]=bndu[i])) + v[i]=-g[i] otherwise + +This function may be used to check a stopping criterion. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +static double mincomp_asaboundedantigradnorm(minasastate* state, + ae_state *_state) +{ + ae_int_t i; + double v; + double result; + + + result = 0; + for(i=0; i<=state->n-1; i++) + { + v = -state->g.ptr.p_double[i]; + if( ae_fp_eq(state->x.ptr.p_double[i],state->bndl.ptr.p_double[i])&&ae_fp_less(-state->g.ptr.p_double[i],0) ) + { + v = 0; + } + if( ae_fp_eq(state->x.ptr.p_double[i],state->bndu.ptr.p_double[i])&&ae_fp_greater(-state->g.ptr.p_double[i],0) ) + { + v = 0; + } + result = result+ae_sqr(v, _state); + } + result = ae_sqrt(result, _state); + return result; +} + + +/************************************************************************* +Returns norm of GI(x). + +GI(x) is a gradient vector whose components associated with active +constraints are zeroed. It differs from bounded anti-gradient because +components of GI(x) are zeroed independently of sign(g[i]), and +anti-gradient's components are zeroed with respect to both constraint and +sign. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +static double mincomp_asaginorm(minasastate* state, ae_state *_state) +{ + ae_int_t i; + double result; + + + result = 0; + for(i=0; i<=state->n-1; i++) + { + if( ae_fp_neq(state->x.ptr.p_double[i],state->bndl.ptr.p_double[i])&&ae_fp_neq(state->x.ptr.p_double[i],state->bndu.ptr.p_double[i]) ) + { + result = result+ae_sqr(state->g.ptr.p_double[i], _state); + } + } + result = ae_sqrt(result, _state); + return result; +} + + +/************************************************************************* +Returns norm(D1(State.X)) + +For a meaning of D1 see 'NEW ACTIVE SET ALGORITHM FOR BOX CONSTRAINED +OPTIMIZATION' by WILLIAM W. HAGER AND HONGCHAO ZHANG. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +static double mincomp_asad1norm(minasastate* state, ae_state *_state) +{ + ae_int_t i; + double result; + + + result = 0; + for(i=0; i<=state->n-1; i++) + { + result = result+ae_sqr(boundval(state->x.ptr.p_double[i]-state->g.ptr.p_double[i], state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i], _state)-state->x.ptr.p_double[i], _state); + } + result = ae_sqrt(result, _state); + return result; +} + + +/************************************************************************* +Returns True, if U set is empty. + +* State.X is used as point, +* State.G - as gradient, +* D is calculated within function (because State.D may have different + meaning depending on current optimization algorithm) + +For a meaning of U see 'NEW ACTIVE SET ALGORITHM FOR BOX CONSTRAINED +OPTIMIZATION' by WILLIAM W. HAGER AND HONGCHAO ZHANG. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +static ae_bool mincomp_asauisempty(minasastate* state, ae_state *_state) +{ + ae_int_t i; + double d; + double d2; + double d32; + ae_bool result; + + + d = mincomp_asad1norm(state, _state); + d2 = ae_sqrt(d, _state); + d32 = d*d2; + result = ae_true; + for(i=0; i<=state->n-1; i++) + { + if( ae_fp_greater_eq(ae_fabs(state->g.ptr.p_double[i], _state),d2)&&ae_fp_greater_eq(ae_minreal(state->x.ptr.p_double[i]-state->bndl.ptr.p_double[i], state->bndu.ptr.p_double[i]-state->x.ptr.p_double[i], _state),d32) ) + { + result = ae_false; + return result; + } + } + return result; +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forgot to clear something) +*************************************************************************/ +static void mincomp_clearrequestfields(minasastate* state, + ae_state *_state) +{ + + + state->needfg = ae_false; + state->xupdated = ae_false; +} + + +ae_bool _minasastate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minasastate *p = (minasastate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->bndl, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bndu, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ak, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->dk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->an, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->dn, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->work, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->yk, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->gc, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->g, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + if( !_linminstate_init(&p->lstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _minasastate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minasastate *dst = (minasastate*)_dst; + minasastate *src = (minasastate*)_src; + dst->n = src->n; + dst->epsg = src->epsg; + dst->epsf = src->epsf; + dst->epsx = src->epsx; + dst->maxits = src->maxits; + dst->xrep = src->xrep; + dst->stpmax = src->stpmax; + dst->cgtype = src->cgtype; + dst->k = src->k; + dst->nfev = src->nfev; + dst->mcstage = src->mcstage; + if( !ae_vector_init_copy(&dst->bndl, &src->bndl, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bndu, &src->bndu, _state, make_automatic) ) + return ae_false; + dst->curalgo = src->curalgo; + dst->acount = src->acount; + dst->mu = src->mu; + dst->finit = src->finit; + dst->dginit = src->dginit; + if( !ae_vector_init_copy(&dst->ak, &src->ak, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xk, &src->xk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->dk, &src->dk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->an, &src->an, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->xn, &src->xn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->dn, &src->dn, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) + return ae_false; + dst->fold = src->fold; + dst->stp = src->stp; + if( !ae_vector_init_copy(&dst->work, &src->work, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->yk, &src->yk, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->gc, &src->gc, _state, make_automatic) ) + return ae_false; + dst->laststep = src->laststep; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + dst->f = src->f; + if( !ae_vector_init_copy(&dst->g, &src->g, _state, make_automatic) ) + return ae_false; + dst->needfg = src->needfg; + dst->xupdated = src->xupdated; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + dst->repiterationscount = src->repiterationscount; + dst->repnfev = src->repnfev; + dst->repterminationtype = src->repterminationtype; + dst->debugrestartscount = src->debugrestartscount; + if( !_linminstate_init_copy(&dst->lstate, &src->lstate, _state, make_automatic) ) + return ae_false; + dst->betahs = src->betahs; + dst->betady = src->betady; + return ae_true; +} + + +void _minasastate_clear(void* _p) +{ + minasastate *p = (minasastate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->bndl); + ae_vector_clear(&p->bndu); + ae_vector_clear(&p->ak); + ae_vector_clear(&p->xk); + ae_vector_clear(&p->dk); + ae_vector_clear(&p->an); + ae_vector_clear(&p->xn); + ae_vector_clear(&p->dn); + ae_vector_clear(&p->d); + ae_vector_clear(&p->work); + ae_vector_clear(&p->yk); + ae_vector_clear(&p->gc); + ae_vector_clear(&p->x); + ae_vector_clear(&p->g); + _rcommstate_clear(&p->rstate); + _linminstate_clear(&p->lstate); +} + + +void _minasastate_destroy(void* _p) +{ + minasastate *p = (minasastate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->bndl); + ae_vector_destroy(&p->bndu); + ae_vector_destroy(&p->ak); + ae_vector_destroy(&p->xk); + ae_vector_destroy(&p->dk); + ae_vector_destroy(&p->an); + ae_vector_destroy(&p->xn); + ae_vector_destroy(&p->dn); + ae_vector_destroy(&p->d); + ae_vector_destroy(&p->work); + ae_vector_destroy(&p->yk); + ae_vector_destroy(&p->gc); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->g); + _rcommstate_destroy(&p->rstate); + _linminstate_destroy(&p->lstate); +} + + +ae_bool _minasareport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + minasareport *p = (minasareport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _minasareport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + minasareport *dst = (minasareport*)_dst; + minasareport *src = (minasareport*)_src; + dst->iterationscount = src->iterationscount; + dst->nfev = src->nfev; + dst->terminationtype = src->terminationtype; + dst->activeconstraints = src->activeconstraints; + return ae_true; +} + + +void _minasareport_clear(void* _p) +{ + minasareport *p = (minasareport*)_p; + ae_touch_ptr((void*)p); +} + + +void _minasareport_destroy(void* _p) +{ + minasareport *p = (minasareport*)_p; + ae_touch_ptr((void*)p); +} + + + +} + diff --git a/psdlag/src/optimization.h b/psdlag/src/optimization.h new file mode 100644 index 0000000..eb62e95 --- /dev/null +++ b/psdlag/src/optimization.h @@ -0,0 +1,4379 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _optimization_pkg_h +#define _optimization_pkg_h +#include "ap.h" +#include "alglibinternal.h" +#include "linalg.h" +#include "alglibmisc.h" +#include "solvers.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + ae_int_t n; + ae_int_t k; + double alpha; + double tau; + double theta; + ae_matrix a; + ae_matrix q; + ae_vector b; + ae_vector r; + ae_vector xc; + ae_vector d; + ae_vector activeset; + ae_matrix tq2dense; + ae_matrix tk2; + ae_vector tq2diag; + ae_vector tq1; + ae_vector tk1; + double tq0; + double tk0; + ae_vector txc; + ae_vector tb; + ae_int_t nfree; + ae_int_t ecakind; + ae_matrix ecadense; + ae_matrix eq; + ae_matrix eccm; + ae_vector ecadiag; + ae_vector eb; + double ec; + ae_vector tmp0; + ae_vector tmp1; + ae_vector tmpg; + ae_matrix tmp2; + ae_bool ismaintermchanged; + ae_bool issecondarytermchanged; + ae_bool islineartermchanged; + ae_bool isactivesetchanged; +} convexquadraticmodel; +typedef struct +{ + ae_int_t ns; + ae_int_t nd; + ae_int_t nr; + ae_matrix densea; + ae_vector b; + ae_vector nnc; + ae_int_t refinementits; + double debugflops; + ae_int_t debugmaxnewton; + ae_vector xn; + ae_matrix tmpz; + ae_matrix tmpca; + ae_vector g; + ae_vector d; + ae_vector dx; + ae_vector diagaa; + ae_vector cb; + ae_vector cx; + ae_vector cborg; + ae_vector columnmap; + ae_vector rowmap; + ae_vector tmpcholesky; + ae_vector r; +} snnlssolver; +typedef struct +{ + ae_int_t n; + ae_int_t algostate; + ae_vector xc; + ae_bool hasxc; + ae_vector s; + ae_vector h; + ae_vector activeset; + ae_bool basisisready; + ae_matrix sbasis; + ae_matrix pbasis; + ae_matrix ibasis; + ae_int_t basissize; + ae_bool constraintschanged; + ae_vector hasbndl; + ae_vector hasbndu; + ae_vector bndl; + ae_vector bndu; + ae_matrix cleic; + ae_int_t nec; + ae_int_t nic; + ae_vector mtx; + ae_vector mtas; + ae_vector cdtmp; + ae_vector corrtmp; + ae_vector unitdiagonal; + snnlssolver solver; + ae_vector scntmp; + ae_vector tmp0; + ae_vector tmpfeas; + ae_matrix tmpm0; + ae_vector rctmps; + ae_vector rctmpg; + ae_vector rctmprightpart; + ae_matrix rctmpdense0; + ae_matrix rctmpdense1; + ae_vector rctmpisequality; + ae_vector rctmpconstraintidx; + ae_vector rctmplambdas; + ae_matrix tmpbasis; +} sactiveset; +typedef struct +{ + ae_int_t n; + double epsg; + double epsf; + double epsx; + ae_int_t maxits; + double stpmax; + double suggestedstep; + ae_bool xrep; + ae_bool drep; + ae_int_t cgtype; + ae_int_t prectype; + ae_vector diagh; + ae_vector diaghl2; + ae_matrix vcorr; + ae_int_t vcnt; + ae_vector s; + double diffstep; + ae_int_t nfev; + ae_int_t mcstage; + ae_int_t k; + ae_vector xk; + ae_vector dk; + ae_vector xn; + ae_vector dn; + ae_vector d; + double fold; + double stp; + double curstpmax; + ae_vector yk; + double lastgoodstep; + double lastscaledstep; + ae_int_t mcinfo; + ae_bool innerresetneeded; + ae_bool terminationneeded; + double trimthreshold; + ae_int_t rstimer; + ae_vector x; + double f; + ae_vector g; + ae_bool needf; + ae_bool needfg; + ae_bool xupdated; + ae_bool algpowerup; + ae_bool lsstart; + ae_bool lsend; + double teststep; + rcommstate rstate; + ae_int_t repiterationscount; + ae_int_t repnfev; + ae_int_t repvaridx; + ae_int_t repterminationtype; + ae_int_t debugrestartscount; + linminstate lstate; + double fbase; + double fm2; + double fm1; + double fp1; + double fp2; + double betahs; + double betady; + ae_vector work0; + ae_vector work1; +} mincgstate; +typedef struct +{ + ae_int_t iterationscount; + ae_int_t nfev; + ae_int_t varidx; + ae_int_t terminationtype; +} mincgreport; +typedef struct +{ + ae_int_t nmain; + ae_int_t nslack; + double epsg; + double epsf; + double epsx; + ae_int_t maxits; + ae_bool xrep; + ae_bool drep; + double stpmax; + double diffstep; + sactiveset sas; + ae_vector s; + ae_int_t prectype; + ae_vector diagh; + ae_vector x; + double f; + ae_vector g; + ae_bool needf; + ae_bool needfg; + ae_bool xupdated; + ae_bool lsstart; + ae_bool lbfgssearch; + ae_bool boundedstep; + double teststep; + rcommstate rstate; + ae_vector gc; + ae_vector xn; + ae_vector gn; + ae_vector xp; + ae_vector gp; + double fc; + double fn; + double fp; + ae_vector d; + ae_matrix cleic; + ae_int_t nec; + ae_int_t nic; + double lastgoodstep; + double lastscaledgoodstep; + double maxscaledgrad; + ae_vector hasbndl; + ae_vector hasbndu; + ae_vector bndl; + ae_vector bndu; + ae_int_t repinneriterationscount; + ae_int_t repouteriterationscount; + ae_int_t repnfev; + ae_int_t repvaridx; + ae_int_t repterminationtype; + double repdebugeqerr; + double repdebugfs; + double repdebugff; + double repdebugdx; + ae_int_t repdebugfeasqpits; + ae_int_t repdebugfeasgpaits; + ae_vector xstart; + snnlssolver solver; + double fbase; + double fm2; + double fm1; + double fp1; + double fp2; + double xm1; + double xp1; + double gm1; + double gp1; + ae_int_t cidx; + double cval; + ae_vector tmpprec; + ae_int_t nfev; + ae_int_t mcstage; + double stp; + double curstpmax; + double activationstep; + ae_vector work; + linminstate lstate; + double trimthreshold; + ae_int_t nonmonotoniccnt; + ae_int_t k; + ae_int_t q; + ae_int_t p; + ae_vector rho; + ae_matrix yk; + ae_matrix sk; + ae_vector theta; +} minbleicstate; +typedef struct +{ + ae_int_t iterationscount; + ae_int_t nfev; + ae_int_t varidx; + ae_int_t terminationtype; + double debugeqerr; + double debugfs; + double debugff; + double debugdx; + ae_int_t debugfeasqpits; + ae_int_t debugfeasgpaits; + ae_int_t inneriterationscount; + ae_int_t outeriterationscount; +} minbleicreport; +typedef struct +{ + ae_int_t n; + ae_int_t m; + double epsg; + double epsf; + double epsx; + ae_int_t maxits; + ae_bool xrep; + double stpmax; + ae_vector s; + double diffstep; + ae_int_t nfev; + ae_int_t mcstage; + ae_int_t k; + ae_int_t q; + ae_int_t p; + ae_vector rho; + ae_matrix yk; + ae_matrix sk; + ae_vector theta; + ae_vector d; + double stp; + ae_vector work; + double fold; + double trimthreshold; + ae_int_t prectype; + double gammak; + ae_matrix denseh; + ae_vector diagh; + double fbase; + double fm2; + double fm1; + double fp1; + double fp2; + ae_vector autobuf; + ae_vector x; + double f; + ae_vector g; + ae_bool needf; + ae_bool needfg; + ae_bool xupdated; + double teststep; + rcommstate rstate; + ae_int_t repiterationscount; + ae_int_t repnfev; + ae_int_t repvaridx; + ae_int_t repterminationtype; + linminstate lstate; +} minlbfgsstate; +typedef struct +{ + ae_int_t iterationscount; + ae_int_t nfev; + ae_int_t varidx; + ae_int_t terminationtype; +} minlbfgsreport; +typedef struct +{ + ae_int_t n; + ae_int_t algokind; + ae_int_t akind; + convexquadraticmodel a; + sparsematrix sparsea; + ae_bool sparseaupper; + double anorm; + ae_vector b; + ae_vector bndl; + ae_vector bndu; + ae_vector s; + ae_vector havebndl; + ae_vector havebndu; + ae_vector xorigin; + ae_vector startx; + ae_bool havex; + ae_matrix cleic; + ae_int_t nec; + ae_int_t nic; + double bleicepsg; + double bleicepsf; + double bleicepsx; + ae_int_t bleicmaxits; + sactiveset sas; + ae_vector gc; + ae_vector xn; + ae_vector pg; + ae_vector workbndl; + ae_vector workbndu; + ae_matrix workcleic; + ae_vector xs; + ae_int_t repinneriterationscount; + ae_int_t repouteriterationscount; + ae_int_t repncholesky; + ae_int_t repnmv; + ae_int_t repterminationtype; + double debugphase1flops; + double debugphase2flops; + double debugphase3flops; + ae_vector tmp0; + ae_vector tmp1; + ae_vector tmpb; + ae_vector rctmpg; + ae_vector tmpi; + normestimatorstate estimator; + minbleicstate solver; + minbleicreport solverrep; +} minqpstate; +typedef struct +{ + ae_int_t inneriterationscount; + ae_int_t outeriterationscount; + ae_int_t nmv; + ae_int_t ncholesky; + ae_int_t terminationtype; +} minqpreport; +typedef struct +{ + ae_int_t n; + ae_int_t m; + double diffstep; + double epsg; + double epsf; + double epsx; + ae_int_t maxits; + ae_bool xrep; + double stpmax; + ae_int_t maxmodelage; + ae_bool makeadditers; + ae_vector x; + double f; + ae_vector fi; + ae_matrix j; + ae_matrix h; + ae_vector g; + ae_bool needf; + ae_bool needfg; + ae_bool needfgh; + ae_bool needfij; + ae_bool needfi; + ae_bool xupdated; + ae_int_t algomode; + ae_bool hasf; + ae_bool hasfi; + ae_bool hasg; + ae_vector xbase; + double fbase; + ae_vector fibase; + ae_vector gbase; + ae_matrix quadraticmodel; + ae_vector bndl; + ae_vector bndu; + ae_vector havebndl; + ae_vector havebndu; + ae_vector s; + double lambdav; + double nu; + ae_int_t modelage; + ae_vector xdir; + ae_vector deltax; + ae_vector deltaf; + ae_bool deltaxready; + ae_bool deltafready; + double teststep; + ae_int_t repiterationscount; + ae_int_t repterminationtype; + ae_int_t repfuncidx; + ae_int_t repvaridx; + ae_int_t repnfunc; + ae_int_t repnjac; + ae_int_t repngrad; + ae_int_t repnhess; + ae_int_t repncholesky; + rcommstate rstate; + ae_vector choleskybuf; + ae_vector tmp0; + double actualdecrease; + double predicteddecrease; + double xm1; + double xp1; + ae_vector fm1; + ae_vector fp1; + ae_vector fc1; + ae_vector gm1; + ae_vector gp1; + ae_vector gc1; + minlbfgsstate internalstate; + minlbfgsreport internalrep; + minqpstate qpstate; + minqpreport qprep; +} minlmstate; +typedef struct +{ + ae_int_t iterationscount; + ae_int_t terminationtype; + ae_int_t funcidx; + ae_int_t varidx; + ae_int_t nfunc; + ae_int_t njac; + ae_int_t ngrad; + ae_int_t nhess; + ae_int_t ncholesky; +} minlmreport; +typedef struct +{ + ae_int_t n; + double epsg; + double epsf; + double epsx; + ae_int_t maxits; + ae_bool xrep; + double stpmax; + ae_int_t cgtype; + ae_int_t k; + ae_int_t nfev; + ae_int_t mcstage; + ae_vector bndl; + ae_vector bndu; + ae_int_t curalgo; + ae_int_t acount; + double mu; + double finit; + double dginit; + ae_vector ak; + ae_vector xk; + ae_vector dk; + ae_vector an; + ae_vector xn; + ae_vector dn; + ae_vector d; + double fold; + double stp; + ae_vector work; + ae_vector yk; + ae_vector gc; + double laststep; + ae_vector x; + double f; + ae_vector g; + ae_bool needfg; + ae_bool xupdated; + rcommstate rstate; + ae_int_t repiterationscount; + ae_int_t repnfev; + ae_int_t repterminationtype; + ae_int_t debugrestartscount; + linminstate lstate; + double betahs; + double betady; +} minasastate; +typedef struct +{ + ae_int_t iterationscount; + ae_int_t nfev; + ae_int_t terminationtype; + ae_int_t activeconstraints; +} minasareport; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + + + + + + + + +/************************************************************************* +This object stores state of the nonlinear CG optimizer. + +You should use ALGLIB functions to work with this object. +*************************************************************************/ +class _mincgstate_owner +{ +public: + _mincgstate_owner(); + _mincgstate_owner(const _mincgstate_owner &rhs); + _mincgstate_owner& operator=(const _mincgstate_owner &rhs); + virtual ~_mincgstate_owner(); + alglib_impl::mincgstate* c_ptr(); + alglib_impl::mincgstate* c_ptr() const; +protected: + alglib_impl::mincgstate *p_struct; +}; +class mincgstate : public _mincgstate_owner +{ +public: + mincgstate(); + mincgstate(const mincgstate &rhs); + mincgstate& operator=(const mincgstate &rhs); + virtual ~mincgstate(); + ae_bool &needf; + ae_bool &needfg; + ae_bool &xupdated; + double &f; + real_1d_array g; + real_1d_array x; + +}; + + +/************************************************************************* + +*************************************************************************/ +class _mincgreport_owner +{ +public: + _mincgreport_owner(); + _mincgreport_owner(const _mincgreport_owner &rhs); + _mincgreport_owner& operator=(const _mincgreport_owner &rhs); + virtual ~_mincgreport_owner(); + alglib_impl::mincgreport* c_ptr(); + alglib_impl::mincgreport* c_ptr() const; +protected: + alglib_impl::mincgreport *p_struct; +}; +class mincgreport : public _mincgreport_owner +{ +public: + mincgreport(); + mincgreport(const mincgreport &rhs); + mincgreport& operator=(const mincgreport &rhs); + virtual ~mincgreport(); + ae_int_t &iterationscount; + ae_int_t &nfev; + ae_int_t &varidx; + ae_int_t &terminationtype; + +}; + +/************************************************************************* +This object stores nonlinear optimizer state. +You should use functions provided by MinBLEIC subpackage to work with this +object +*************************************************************************/ +class _minbleicstate_owner +{ +public: + _minbleicstate_owner(); + _minbleicstate_owner(const _minbleicstate_owner &rhs); + _minbleicstate_owner& operator=(const _minbleicstate_owner &rhs); + virtual ~_minbleicstate_owner(); + alglib_impl::minbleicstate* c_ptr(); + alglib_impl::minbleicstate* c_ptr() const; +protected: + alglib_impl::minbleicstate *p_struct; +}; +class minbleicstate : public _minbleicstate_owner +{ +public: + minbleicstate(); + minbleicstate(const minbleicstate &rhs); + minbleicstate& operator=(const minbleicstate &rhs); + virtual ~minbleicstate(); + ae_bool &needf; + ae_bool &needfg; + ae_bool &xupdated; + double &f; + real_1d_array g; + real_1d_array x; + +}; + + +/************************************************************************* +This structure stores optimization report: +* IterationsCount number of iterations +* NFEV number of gradient evaluations +* TerminationType termination type (see below) + +TERMINATION CODES + +TerminationType field contains completion code, which can be: + -7 gradient verification failed. + See MinBLEICSetGradientCheck() for more information. + -3 inconsistent constraints. Feasible point is + either nonexistent or too hard to find. Try to + restart optimizer with better initial approximation + 1 relative function improvement is no more than EpsF. + 2 relative step is no more than EpsX. + 4 gradient norm is no more than EpsG + 5 MaxIts steps was taken + 7 stopping conditions are too stringent, + further improvement is impossible, + X contains best point found so far. + +ADDITIONAL FIELDS + +There are additional fields which can be used for debugging: +* DebugEqErr error in the equality constraints (2-norm) +* DebugFS f, calculated at projection of initial point + to the feasible set +* DebugFF f, calculated at the final point +* DebugDX |X_start-X_final| +*************************************************************************/ +class _minbleicreport_owner +{ +public: + _minbleicreport_owner(); + _minbleicreport_owner(const _minbleicreport_owner &rhs); + _minbleicreport_owner& operator=(const _minbleicreport_owner &rhs); + virtual ~_minbleicreport_owner(); + alglib_impl::minbleicreport* c_ptr(); + alglib_impl::minbleicreport* c_ptr() const; +protected: + alglib_impl::minbleicreport *p_struct; +}; +class minbleicreport : public _minbleicreport_owner +{ +public: + minbleicreport(); + minbleicreport(const minbleicreport &rhs); + minbleicreport& operator=(const minbleicreport &rhs); + virtual ~minbleicreport(); + ae_int_t &iterationscount; + ae_int_t &nfev; + ae_int_t &varidx; + ae_int_t &terminationtype; + double &debugeqerr; + double &debugfs; + double &debugff; + double &debugdx; + ae_int_t &debugfeasqpits; + ae_int_t &debugfeasgpaits; + ae_int_t &inneriterationscount; + ae_int_t &outeriterationscount; + +}; + +/************************************************************************* + +*************************************************************************/ +class _minlbfgsstate_owner +{ +public: + _minlbfgsstate_owner(); + _minlbfgsstate_owner(const _minlbfgsstate_owner &rhs); + _minlbfgsstate_owner& operator=(const _minlbfgsstate_owner &rhs); + virtual ~_minlbfgsstate_owner(); + alglib_impl::minlbfgsstate* c_ptr(); + alglib_impl::minlbfgsstate* c_ptr() const; +protected: + alglib_impl::minlbfgsstate *p_struct; +}; +class minlbfgsstate : public _minlbfgsstate_owner +{ +public: + minlbfgsstate(); + minlbfgsstate(const minlbfgsstate &rhs); + minlbfgsstate& operator=(const minlbfgsstate &rhs); + virtual ~minlbfgsstate(); + ae_bool &needf; + ae_bool &needfg; + ae_bool &xupdated; + double &f; + real_1d_array g; + real_1d_array x; + +}; + + +/************************************************************************* + +*************************************************************************/ +class _minlbfgsreport_owner +{ +public: + _minlbfgsreport_owner(); + _minlbfgsreport_owner(const _minlbfgsreport_owner &rhs); + _minlbfgsreport_owner& operator=(const _minlbfgsreport_owner &rhs); + virtual ~_minlbfgsreport_owner(); + alglib_impl::minlbfgsreport* c_ptr(); + alglib_impl::minlbfgsreport* c_ptr() const; +protected: + alglib_impl::minlbfgsreport *p_struct; +}; +class minlbfgsreport : public _minlbfgsreport_owner +{ +public: + minlbfgsreport(); + minlbfgsreport(const minlbfgsreport &rhs); + minlbfgsreport& operator=(const minlbfgsreport &rhs); + virtual ~minlbfgsreport(); + ae_int_t &iterationscount; + ae_int_t &nfev; + ae_int_t &varidx; + ae_int_t &terminationtype; + +}; + +/************************************************************************* +This object stores nonlinear optimizer state. +You should use functions provided by MinQP subpackage to work with this +object +*************************************************************************/ +class _minqpstate_owner +{ +public: + _minqpstate_owner(); + _minqpstate_owner(const _minqpstate_owner &rhs); + _minqpstate_owner& operator=(const _minqpstate_owner &rhs); + virtual ~_minqpstate_owner(); + alglib_impl::minqpstate* c_ptr(); + alglib_impl::minqpstate* c_ptr() const; +protected: + alglib_impl::minqpstate *p_struct; +}; +class minqpstate : public _minqpstate_owner +{ +public: + minqpstate(); + minqpstate(const minqpstate &rhs); + minqpstate& operator=(const minqpstate &rhs); + virtual ~minqpstate(); + +}; + + +/************************************************************************* +This structure stores optimization report: +* InnerIterationsCount number of inner iterations +* OuterIterationsCount number of outer iterations +* NCholesky number of Cholesky decomposition +* NMV number of matrix-vector products + (only products calculated as part of iterative + process are counted) +* TerminationType completion code (see below) + +Completion codes: +* -5 inappropriate solver was used: + * Cholesky solver for semidefinite or indefinite problems + * Cholesky solver for problems with non-boundary constraints +* -4 BLEIC-QP algorithm found unconstrained direction + of negative curvature (function is unbounded from + below even under constraints), no meaningful + minimum can be found. +* -3 inconsistent constraints (or, maybe, feasible point is + too hard to find). If you are sure that constraints are feasible, + try to restart optimizer with better initial approximation. +* -1 solver error +* 4 successful completion +* 5 MaxIts steps was taken +* 7 stopping conditions are too stringent, + further improvement is impossible, + X contains best point found so far. +*************************************************************************/ +class _minqpreport_owner +{ +public: + _minqpreport_owner(); + _minqpreport_owner(const _minqpreport_owner &rhs); + _minqpreport_owner& operator=(const _minqpreport_owner &rhs); + virtual ~_minqpreport_owner(); + alglib_impl::minqpreport* c_ptr(); + alglib_impl::minqpreport* c_ptr() const; +protected: + alglib_impl::minqpreport *p_struct; +}; +class minqpreport : public _minqpreport_owner +{ +public: + minqpreport(); + minqpreport(const minqpreport &rhs); + minqpreport& operator=(const minqpreport &rhs); + virtual ~minqpreport(); + ae_int_t &inneriterationscount; + ae_int_t &outeriterationscount; + ae_int_t &nmv; + ae_int_t &ncholesky; + ae_int_t &terminationtype; + +}; + +/************************************************************************* +Levenberg-Marquardt optimizer. + +This structure should be created using one of the MinLMCreate???() +functions. You should not access its fields directly; use ALGLIB functions +to work with it. +*************************************************************************/ +class _minlmstate_owner +{ +public: + _minlmstate_owner(); + _minlmstate_owner(const _minlmstate_owner &rhs); + _minlmstate_owner& operator=(const _minlmstate_owner &rhs); + virtual ~_minlmstate_owner(); + alglib_impl::minlmstate* c_ptr(); + alglib_impl::minlmstate* c_ptr() const; +protected: + alglib_impl::minlmstate *p_struct; +}; +class minlmstate : public _minlmstate_owner +{ +public: + minlmstate(); + minlmstate(const minlmstate &rhs); + minlmstate& operator=(const minlmstate &rhs); + virtual ~minlmstate(); + ae_bool &needf; + ae_bool &needfg; + ae_bool &needfgh; + ae_bool &needfi; + ae_bool &needfij; + ae_bool &xupdated; + double &f; + real_1d_array fi; + real_1d_array g; + real_2d_array h; + real_2d_array j; + real_1d_array x; + +}; + + +/************************************************************************* +Optimization report, filled by MinLMResults() function + +FIELDS: +* TerminationType, completetion code: + * -7 derivative correctness check failed; + see Rep.WrongNum, Rep.WrongI, Rep.WrongJ for + more information. + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient is no more than EpsG. + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible +* IterationsCount, contains iterations count +* NFunc, number of function calculations +* NJac, number of Jacobi matrix calculations +* NGrad, number of gradient calculations +* NHess, number of Hessian calculations +* NCholesky, number of Cholesky decomposition calculations +*************************************************************************/ +class _minlmreport_owner +{ +public: + _minlmreport_owner(); + _minlmreport_owner(const _minlmreport_owner &rhs); + _minlmreport_owner& operator=(const _minlmreport_owner &rhs); + virtual ~_minlmreport_owner(); + alglib_impl::minlmreport* c_ptr(); + alglib_impl::minlmreport* c_ptr() const; +protected: + alglib_impl::minlmreport *p_struct; +}; +class minlmreport : public _minlmreport_owner +{ +public: + minlmreport(); + minlmreport(const minlmreport &rhs); + minlmreport& operator=(const minlmreport &rhs); + virtual ~minlmreport(); + ae_int_t &iterationscount; + ae_int_t &terminationtype; + ae_int_t &funcidx; + ae_int_t &varidx; + ae_int_t &nfunc; + ae_int_t &njac; + ae_int_t &ngrad; + ae_int_t &nhess; + ae_int_t &ncholesky; + +}; + +/************************************************************************* + +*************************************************************************/ +class _minasastate_owner +{ +public: + _minasastate_owner(); + _minasastate_owner(const _minasastate_owner &rhs); + _minasastate_owner& operator=(const _minasastate_owner &rhs); + virtual ~_minasastate_owner(); + alglib_impl::minasastate* c_ptr(); + alglib_impl::minasastate* c_ptr() const; +protected: + alglib_impl::minasastate *p_struct; +}; +class minasastate : public _minasastate_owner +{ +public: + minasastate(); + minasastate(const minasastate &rhs); + minasastate& operator=(const minasastate &rhs); + virtual ~minasastate(); + ae_bool &needfg; + ae_bool &xupdated; + double &f; + real_1d_array g; + real_1d_array x; + +}; + + +/************************************************************************* + +*************************************************************************/ +class _minasareport_owner +{ +public: + _minasareport_owner(); + _minasareport_owner(const _minasareport_owner &rhs); + _minasareport_owner& operator=(const _minasareport_owner &rhs); + virtual ~_minasareport_owner(); + alglib_impl::minasareport* c_ptr(); + alglib_impl::minasareport* c_ptr() const; +protected: + alglib_impl::minasareport *p_struct; +}; +class minasareport : public _minasareport_owner +{ +public: + minasareport(); + minasareport(const minasareport &rhs); + minasareport& operator=(const minasareport &rhs); + virtual ~minasareport(); + ae_int_t &iterationscount; + ae_int_t &nfev; + ae_int_t &terminationtype; + ae_int_t &activeconstraints; + +}; + + + + + + + + + +/************************************************************************* + NONLINEAR CONJUGATE GRADIENT METHOD + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments by using one of the +nonlinear conjugate gradient methods. + +These CG methods are globally convergent (even on non-convex functions) as +long as grad(f) is Lipschitz continuous in a some neighborhood of the +L = { x : f(x)<=f(x0) }. + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function value F and its gradient G (simultaneously) at given point X + + +USAGE: +1. User initializes algorithm state with MinCGCreate() call +2. User tunes solver parameters with MinCGSetCond(), MinCGSetStpMax() and + other functions +3. User calls MinCGOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. +4. User calls MinCGResults() to get solution +5. Optionally, user may call MinCGRestartFrom() to solve another problem + with same N but another starting point and/or another function. + MinCGRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 25.03.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgcreate(const ae_int_t n, const real_1d_array &x, mincgstate &state); +void mincgcreate(const real_1d_array &x, mincgstate &state); + + +/************************************************************************* +The subroutine is finite difference variant of MinCGCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinCGCreate() in order to get more +information about creation of CG optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinCGSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. L-BFGS needs exact gradient values. + Imprecise gradient may slow down convergence, especially on highly + nonlinear problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void mincgcreatef(const ae_int_t n, const real_1d_array &x, const double diffstep, mincgstate &state); +void mincgcreatef(const real_1d_array &x, const double diffstep, mincgstate &state); + + +/************************************************************************* +This function sets stopping conditions for CG optimization algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinCGSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetcond(const mincgstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); + + +/************************************************************************* +This function sets scaling coefficients for CG optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of CG optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the CG too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinCGSetPrec...() functions. + +There is special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void mincgsetscale(const mincgstate &state, const real_1d_array &s); + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetxrep(const mincgstate &state, const bool needxrep); + + +/************************************************************************* +This function sets CG algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + CGType - algorithm type: + * -1 automatic selection of the best algorithm + * 0 DY (Dai and Yuan) algorithm + * 1 Hybrid DY-HS algorithm + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetcgtype(const mincgstate &state, const ae_int_t cgtype); + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetstpmax(const mincgstate &state, const double stpmax); + + +/************************************************************************* +This function allows to suggest initial step length to the CG algorithm. + +Suggested step length is used as starting point for the line search. It +can be useful when you have badly scaled problem, i.e. when ||grad|| +(which is used as initial estimate for the first step) is many orders of +magnitude different from the desired step. + +Line search may fail on such problems without good estimate of initial +step length. Imagine, for example, problem with ||grad||=10^50 and desired +step equal to 0.1 Line search function will use 10^50 as initial step, +then it will decrease step length by 2 (up to 20 attempts) and will get +10^44, which is still too large. + +This function allows us to tell than line search should be started from +some moderate step length, like 1.0, so algorithm will be able to detect +desired step length in a several searches. + +Default behavior (when no step is suggested) is to use preconditioner, if +it is available, to generate initial estimate of step length. + +This function influences only first iteration of algorithm. It should be +called between MinCGCreate/MinCGRestartFrom() call and MinCGOptimize call. +Suggested step is ignored if you have preconditioner. + +INPUT PARAMETERS: + State - structure used to store algorithm state. + Stp - initial estimate of the step length. + Can be zero (no estimate). + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsuggeststep(const mincgstate &state, const double stp); + + +/************************************************************************* +Modification of the preconditioner: preconditioning is turned off. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecdefault(const mincgstate &state); + + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecdiag(const mincgstate &state, const real_1d_array &d); + + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinCGSetScale() call +(before or after MinCGSetPrecScale() call). Without knowledge of the scale +of your variables scale-based preconditioner will be just unit matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgsetprecscale(const mincgstate &state); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool mincgiteration(const mincgstate &state); + + +/************************************************************************* +This family of functions is used to launcn iterations of nonlinear optimizer + +These functions accept following parameters: + state - algorithm state + func - callback which calculates function (or merit function) + value func at given point x + grad - callback which calculates function (or merit function) + value func and gradient grad at given point x + rep - optional callback which is called after each iteration + can be NULL + ptr - optional pointer which is passed to func/grad/hess/jac/rep + can be NULL + +NOTES: + +1. This function has two different implementations: one which uses exact + (analytical) user-supplied gradient, and one which uses function value + only and numerically differentiates function in order to obtain + gradient. + + Depending on the specific function used to create optimizer object + (either MinCGCreate() for analytical gradient or MinCGCreateF() for + numerical differentiation) you should choose appropriate variant of + MinCGOptimize() - one which accepts function AND gradient or one which + accepts function ONLY. + + Be careful to choose variant of MinCGOptimize() which corresponds to + your optimization scheme! Table below lists different combinations of + callback (function/gradient) passed to MinCGOptimize() and specific + function used to create optimizer. + + + | USER PASSED TO MinCGOptimize() + CREATED WITH | function only | function and gradient + ------------------------------------------------------------ + MinCGCreateF() | work FAIL + MinCGCreate() | FAIL work + + Here "FAIL" denotes inappropriate combinations of optimizer creation + function and MinCGOptimize() version. Attemps to use such combination + (for example, to create optimizer with MinCGCreateF() and to pass + gradient information to MinCGOptimize()) will lead to exception being + thrown. Either you did not pass gradient when it WAS needed or you + passed gradient when it was NOT needed. + + -- ALGLIB -- + Copyright 20.04.2009 by Bochkanov Sergey + +*************************************************************************/ +void mincgoptimize(mincgstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); +void mincgoptimize(mincgstate &state, + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); + + +/************************************************************************* +Conjugate gradient results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -7 gradient verification failed. + See MinCGSetGradientCheck() for more information. + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible, + we return best X found so far + * 8 terminated by user + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + + -- ALGLIB -- + Copyright 20.04.2009 by Bochkanov Sergey +*************************************************************************/ +void mincgresults(const mincgstate &state, real_1d_array &x, mincgreport &rep); + + +/************************************************************************* +Conjugate gradient results + +Buffered implementation of MinCGResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.04.2009 by Bochkanov Sergey +*************************************************************************/ +void mincgresultsbuf(const mincgstate &state, real_1d_array &x, mincgreport &rep); + + +/************************************************************************* +This subroutine restarts CG algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used to store algorithm state. + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void mincgrestartfrom(const mincgstate &state, const real_1d_array &x); + + +/************************************************************************* + +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinCGOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinCGSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 31.05.2012 by Bochkanov Sergey +*************************************************************************/ +void mincgsetgradientcheck(const mincgstate &state, const double teststep); + +/************************************************************************* + BOUND CONSTRAINED OPTIMIZATION + WITH ADDITIONAL LINEAR EQUALITY AND INEQUALITY CONSTRAINTS + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments subject to any +combination of: +* bound constraints +* linear inequality constraints +* linear equality constraints + +REQUIREMENTS: +* user must provide function value and gradient +* starting point X0 must be feasible or + not too far away from the feasible set +* grad(f) must be Lipschitz continuous on a level set: + L = { x : f(x)<=f(x0) } +* function must be defined everywhere on the feasible set F + +USAGE: + +Constrained optimization if far more complex than the unconstrained one. +Here we give very brief outline of the BLEIC optimizer. We strongly recommend +you to read examples in the ALGLIB Reference Manual and to read ALGLIB User Guide +on optimization, which is available at http://www.alglib.net/optimization/ + +1. User initializes algorithm state with MinBLEICCreate() call + +2. USer adds boundary and/or linear constraints by calling + MinBLEICSetBC() and MinBLEICSetLC() functions. + +3. User sets stopping conditions with MinBLEICSetCond(). + +4. User calls MinBLEICOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. + +5. User calls MinBLEICResults() to get solution + +6. Optionally user may call MinBLEICRestartFrom() to solve another problem + with same N but another starting point. + MinBLEICRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size ofX + X - starting point, array[N]: + * it is better to set X to a feasible point + * but X can be infeasible, in which case algorithm will try + to find feasible point first, using X as initial + approximation. + +OUTPUT PARAMETERS: + State - structure stores algorithm state + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleiccreate(const ae_int_t n, const real_1d_array &x, minbleicstate &state); +void minbleiccreate(const real_1d_array &x, minbleicstate &state); + + +/************************************************************************* +The subroutine is finite difference variant of MinBLEICCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinBLEICCreate() in order to get +more information about creation of BLEIC optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinBLEICSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. CG needs exact gradient values. Imprecise + gradient may slow down convergence, especially on highly nonlinear + problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void minbleiccreatef(const ae_int_t n, const real_1d_array &x, const double diffstep, minbleicstate &state); +void minbleiccreatef(const real_1d_array &x, const double diffstep, minbleicstate &state); + + +/************************************************************************* +This function sets boundary constraints for BLEIC optimizer. + +Boundary constraints are inactive by default (after initial creation). +They are preserved after algorithm restart with MinBLEICRestartFrom(). + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF. + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF. + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + +NOTE 2: this solver has following useful properties: +* bound constraints are always satisfied exactly +* function is evaluated only INSIDE area specified by bound constraints, + even when numerical differentiation is used (algorithm adjusts nodes + according to boundary constraints) + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetbc(const minbleicstate &state, const real_1d_array &bndl, const real_1d_array &bndu); + + +/************************************************************************* +This function sets linear constraints for BLEIC optimizer. + +Linear constraints are inactive by default (after initial creation). +They are preserved after algorithm restart with MinBLEICRestartFrom(). + +INPUT PARAMETERS: + State - structure previously allocated with MinBLEICCreate call. + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + +NOTE 1: linear (non-bound) constraints are satisfied only approximately: +* there always exists some minor violation (about Epsilon in magnitude) + due to rounding errors +* numerical differentiation, if used, may lead to function evaluations + outside of the feasible area, because algorithm does NOT change + numerical differentiation formula according to linear constraints. +If you want constraints to be satisfied exactly, try to reformulate your +problem in such manner that all constraints will become boundary ones +(this kind of constraints is always satisfied exactly, both in the final +solution and in all intermediate points). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetlc(const minbleicstate &state, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k); +void minbleicsetlc(const minbleicstate &state, const real_2d_array &c, const integer_1d_array &ct); + + +/************************************************************************* +This function sets stopping conditions for the optimizer. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - step vector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinBLEICSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead +to automatic stopping criterion selection. + +NOTE: when SetCond() called with non-zero MaxIts, BLEIC solver may perform + slightly more than MaxIts iterations. I.e., MaxIts sets non-strict + limit on iterations count. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetcond(const minbleicstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); + + +/************************************************************************* +This function sets scaling coefficients for BLEIC optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of the optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the BLEIC too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinBLEICSetPrec...() +functions. + +There is a special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetscale(const minbleicstate &state, const real_1d_array &s); + + +/************************************************************************* +Modification of the preconditioner: preconditioning is turned off. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecdefault(const minbleicstate &state); + + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE 1: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 2: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecdiag(const minbleicstate &state, const real_1d_array &d); + + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinBLEICSetScale() +call (before or after MinBLEICSetPrecScale() call). Without knowledge of +the scale of your variables scale-based preconditioner will be just unit +matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetprecscale(const minbleicstate &state); + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinBLEICOptimize(). + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetxrep(const minbleicstate &state, const bool needxrep); + + +/************************************************************************* +This function sets maximum step length + +IMPORTANT: this feature is hard to combine with preconditioning. You can't +set upper limit on step length, when you solve optimization problem with +linear (non-boundary) constraints AND preconditioner turned on. + +When non-boundary constraints are present, you have to either a) use +preconditioner, or b) use upper limit on step length. YOU CAN'T USE BOTH! +In this case algorithm will terminate with appropriate error code. + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which lead to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetstpmax(const minbleicstate &state, const double stpmax); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool minbleiciteration(const minbleicstate &state); + + +/************************************************************************* +This family of functions is used to launcn iterations of nonlinear optimizer + +These functions accept following parameters: + state - algorithm state + func - callback which calculates function (or merit function) + value func at given point x + grad - callback which calculates function (or merit function) + value func and gradient grad at given point x + rep - optional callback which is called after each iteration + can be NULL + ptr - optional pointer which is passed to func/grad/hess/jac/rep + can be NULL + +NOTES: + +1. This function has two different implementations: one which uses exact + (analytical) user-supplied gradient, and one which uses function value + only and numerically differentiates function in order to obtain + gradient. + + Depending on the specific function used to create optimizer object + (either MinBLEICCreate() for analytical gradient or MinBLEICCreateF() + for numerical differentiation) you should choose appropriate variant of + MinBLEICOptimize() - one which accepts function AND gradient or one + which accepts function ONLY. + + Be careful to choose variant of MinBLEICOptimize() which corresponds to + your optimization scheme! Table below lists different combinations of + callback (function/gradient) passed to MinBLEICOptimize() and specific + function used to create optimizer. + + + | USER PASSED TO MinBLEICOptimize() + CREATED WITH | function only | function and gradient + ------------------------------------------------------------ + MinBLEICCreateF() | work FAIL + MinBLEICCreate() | FAIL work + + Here "FAIL" denotes inappropriate combinations of optimizer creation + function and MinBLEICOptimize() version. Attemps to use such + combination (for example, to create optimizer with MinBLEICCreateF() + and to pass gradient information to MinCGOptimize()) will lead to + exception being thrown. Either you did not pass gradient when it WAS + needed or you passed gradient when it was NOT needed. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey + +*************************************************************************/ +void minbleicoptimize(minbleicstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); +void minbleicoptimize(minbleicstate &state, + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); + + +/************************************************************************* +BLEIC results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report. You should check Rep.TerminationType + in order to distinguish successful termination from + unsuccessful one: + * -7 gradient verification failed. + See MinBLEICSetGradientCheck() for more information. + * -3 inconsistent constraints. Feasible point is + either nonexistent or too hard to find. Try to + restart optimizer with better initial approximation + * 1 relative function improvement is no more than EpsF. + * 2 scaled step is no more than EpsX. + * 4 scaled gradient norm is no more than EpsG. + * 5 MaxIts steps was taken + More information about fields of this structure can be + found in the comments on MinBLEICReport datatype. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicresults(const minbleicstate &state, real_1d_array &x, minbleicreport &rep); + + +/************************************************************************* +BLEIC results + +Buffered implementation of MinBLEICResults() which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicresultsbuf(const minbleicstate &state, real_1d_array &x, minbleicreport &rep); + + +/************************************************************************* +This subroutine restarts algorithm from new point. +All optimization parameters (including constraints) are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure previously allocated with MinBLEICCreate call. + X - new starting point. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicrestartfrom(const minbleicstate &state, const real_1d_array &x); + + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinBLEICOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinBLEICSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetgradientcheck(const minbleicstate &state, const double teststep); + +/************************************************************************* + LIMITED MEMORY BFGS METHOD FOR LARGE SCALE OPTIMIZATION + +DESCRIPTION: +The subroutine minimizes function F(x) of N arguments by using a quasi- +Newton method (LBFGS scheme) which is optimized to use a minimum amount +of memory. +The subroutine generates the approximation of an inverse Hessian matrix by +using information about the last M steps of the algorithm (instead of N). +It lessens a required amount of memory from a value of order N^2 to a +value of order 2*N*M. + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function value F and its gradient G (simultaneously) at given point X + + +USAGE: +1. User initializes algorithm state with MinLBFGSCreate() call +2. User tunes solver parameters with MinLBFGSSetCond() MinLBFGSSetStpMax() + and other functions +3. User calls MinLBFGSOptimize() function which takes algorithm state and + pointer (delegate, etc.) to callback function which calculates F/G. +4. User calls MinLBFGSResults() to get solution +5. Optionally user may call MinLBFGSRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLBFGSRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - problem dimension. N>0 + M - number of corrections in the BFGS scheme of Hessian + approximation update. Recommended value: 3<=M<=7. The smaller + value causes worse convergence, the bigger will not cause a + considerably better convergence, but will cause a fall in the + performance. M<=N. + X - initial solution approximation, array[0..N-1]. + + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + +NOTES: +1. you may tune stopping conditions with MinLBFGSSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLBFGSSetStpMax() function to bound algorithm's steps. However, + L-BFGS rarely needs such a tuning. + + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreate(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlbfgsstate &state); +void minlbfgscreate(const ae_int_t m, const real_1d_array &x, minlbfgsstate &state); + + +/************************************************************************* +The subroutine is finite difference variant of MinLBFGSCreate(). It uses +finite differences in order to differentiate target function. + +Description below contains information which is specific to this function +only. We recommend to read comments on MinLBFGSCreate() in order to get +more information about creation of LBFGS optimizer. + +INPUT PARAMETERS: + N - problem dimension, N>0: + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of corrections in the BFGS scheme of Hessian + approximation update. Recommended value: 3<=M<=7. The smaller + value causes worse convergence, the bigger will not cause a + considerably better convergence, but will cause a fall in the + performance. M<=N. + X - starting point, array[0..N-1]. + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. algorithm uses 4-point central formula for differentiation. +2. differentiation step along I-th axis is equal to DiffStep*S[I] where + S[] is scaling vector which can be set by MinLBFGSSetScale() call. +3. we recommend you to use moderate values of differentiation step. Too + large step will result in too large truncation errors, while too small + step will result in too large numerical errors. 1.0E-6 can be good + value to start with. +4. Numerical differentiation is very inefficient - one gradient + calculation needs 4*N function evaluations. This function will work for + any N - either small (1...10), moderate (10...100) or large (100...). + However, performance penalty will be too severe for any N's except for + small ones. + We should also say that code which relies on numerical differentiation + is less robust and precise. LBFGS needs exact gradient values. + Imprecise gradient may slow down convergence, especially on highly + nonlinear problems. + Thus we recommend to use this function for fast prototyping on small- + dimensional problems only, and to implement analytical gradient as soon + as possible. + + -- ALGLIB -- + Copyright 16.05.2011 by Bochkanov Sergey +*************************************************************************/ +void minlbfgscreatef(const ae_int_t n, const ae_int_t m, const real_1d_array &x, const double diffstep, minlbfgsstate &state); +void minlbfgscreatef(const ae_int_t m, const real_1d_array &x, const double diffstep, minlbfgsstate &state); + + +/************************************************************************* +This function sets stopping conditions for L-BFGS optimization algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinLBFGSSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetcond(const minlbfgsstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinLBFGSOptimize(). + + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetxrep(const minlbfgsstate &state, const bool needxrep); + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0 (default), if + you don't want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetstpmax(const minlbfgsstate &state, const double stpmax); + + +/************************************************************************* +This function sets scaling coefficients for LBFGS optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Scaling is also used by finite difference variant of the optimizer - step +along I-th axis is equal to DiffStep*S[I]. + +In most optimizers (and in the LBFGS too) scaling is NOT a form of +preconditioning. It just affects stopping conditions. You should set +preconditioner by separate call to one of the MinLBFGSSetPrec...() +functions. + +There is special preconditioning mode, however, which uses scaling +coefficients to form diagonal preconditioning matrix. You can turn this +mode on, if you want. But you should understand that scaling is not the +same thing as preconditioning - these are two different, although related +forms of tuning solver. + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetscale(const minlbfgsstate &state, const real_1d_array &s); + + +/************************************************************************* +Modification of the preconditioner: default preconditioner (simple +scaling, same for all elements of X) is used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecdefault(const minlbfgsstate &state); + + +/************************************************************************* +Modification of the preconditioner: Cholesky factorization of approximate +Hessian is used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + P - triangular preconditioner, Cholesky factorization of + the approximate Hessian. array[0..N-1,0..N-1], + (if larger, only leading N elements are used). + IsUpper - whether upper or lower triangle of P is given + (other triangle is not referenced) + +After call to this function preconditioner is changed to P (P is copied +into the internal buffer). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: P should be nonsingular. Exception will be thrown otherwise. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetpreccholesky(const minlbfgsstate &state, const real_2d_array &p, const bool isupper); + + +/************************************************************************* +Modification of the preconditioner: diagonal of approximate Hessian is +used. + +INPUT PARAMETERS: + State - structure which stores algorithm state + D - diagonal of the approximate Hessian, array[0..N-1], + (if larger, only leading N elements are used). + +NOTE: you can change preconditioner "on the fly", during algorithm +iterations. + +NOTE 2: D[i] should be positive. Exception will be thrown otherwise. + +NOTE 3: you should pass diagonal of approximate Hessian - NOT ITS INVERSE. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecdiag(const minlbfgsstate &state, const real_1d_array &d); + + +/************************************************************************* +Modification of the preconditioner: scale-based diagonal preconditioning. + +This preconditioning mode can be useful when you don't have approximate +diagonal of Hessian, but you know that your variables are badly scaled +(for example, one variable is in [1,10], and another in [1000,100000]), +and most part of the ill-conditioning comes from different scales of vars. + +In this case simple scale-based preconditioner, with H[i] = 1/(s[i]^2), +can greatly improve convergence. + +IMPRTANT: you should set scale of your variables with MinLBFGSSetScale() +call (before or after MinLBFGSSetPrecScale() call). Without knowledge of +the scale of your variables scale-based preconditioner will be just unit +matrix. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetprecscale(const minlbfgsstate &state); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool minlbfgsiteration(const minlbfgsstate &state); + + +/************************************************************************* +This family of functions is used to launcn iterations of nonlinear optimizer + +These functions accept following parameters: + state - algorithm state + func - callback which calculates function (or merit function) + value func at given point x + grad - callback which calculates function (or merit function) + value func and gradient grad at given point x + rep - optional callback which is called after each iteration + can be NULL + ptr - optional pointer which is passed to func/grad/hess/jac/rep + can be NULL + +NOTES: + +1. This function has two different implementations: one which uses exact + (analytical) user-supplied gradient, and one which uses function value + only and numerically differentiates function in order to obtain + gradient. + + Depending on the specific function used to create optimizer object + (either MinLBFGSCreate() for analytical gradient or MinLBFGSCreateF() + for numerical differentiation) you should choose appropriate variant of + MinLBFGSOptimize() - one which accepts function AND gradient or one + which accepts function ONLY. + + Be careful to choose variant of MinLBFGSOptimize() which corresponds to + your optimization scheme! Table below lists different combinations of + callback (function/gradient) passed to MinLBFGSOptimize() and specific + function used to create optimizer. + + + | USER PASSED TO MinLBFGSOptimize() + CREATED WITH | function only | function and gradient + ------------------------------------------------------------ + MinLBFGSCreateF() | work FAIL + MinLBFGSCreate() | FAIL work + + Here "FAIL" denotes inappropriate combinations of optimizer creation + function and MinLBFGSOptimize() version. Attemps to use such + combination (for example, to create optimizer with MinLBFGSCreateF() and + to pass gradient information to MinCGOptimize()) will lead to exception + being thrown. Either you did not pass gradient when it WAS needed or + you passed gradient when it was NOT needed. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey + +*************************************************************************/ +void minlbfgsoptimize(minlbfgsstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); +void minlbfgsoptimize(minlbfgsstate &state, + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); + + +/************************************************************************* +L-BFGS algorithm results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -7 gradient verification failed. + See MinLBFGSSetGradientCheck() for more information. + * -2 rounding errors prevent further improvement. + X contains best point found. + * -1 incorrect parameters were specified + * 1 relative function improvement is no more than + EpsF. + * 2 relative step is no more than EpsX. + * 4 gradient norm is no more than EpsG + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsresults(const minlbfgsstate &state, real_1d_array &x, minlbfgsreport &rep); + + +/************************************************************************* +L-BFGS algorithm results + +Buffered implementation of MinLBFGSResults which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsresultsbuf(const minlbfgsstate &state, real_1d_array &x, minlbfgsreport &rep); + + +/************************************************************************* +This subroutine restarts LBFGS algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used to store algorithm state + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgsrestartfrom(const minlbfgsstate &state, const real_1d_array &x); + + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinLBFGSOptimize() is called +* prior to actual optimization, for each component of parameters being + optimized X[i] algorithm performs following steps: + * two trial steps are made to X[i]-TestStep*S[i] and X[i]+TestStep*S[i], + where X[i] is i-th component of the initial point and S[i] is a scale + of i-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * F(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) gradient evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided by + some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinLBFGSSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 24.05.2012 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetgradientcheck(const minlbfgsstate &state, const double teststep); + +/************************************************************************* + CONSTRAINED QUADRATIC PROGRAMMING + +The subroutine creates QP optimizer. After initial creation, it contains +default optimization problem with zero quadratic and linear terms and no +constraints. You should set quadratic/linear terms with calls to functions +provided by MinQP subpackage. + +INPUT PARAMETERS: + N - problem size + +OUTPUT PARAMETERS: + State - optimizer with zero quadratic/linear terms + and no constraints + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpcreate(const ae_int_t n, minqpstate &state); + + +/************************************************************************* +This function sets linear term for QP solver. + +By default, linear term is zero. + +INPUT PARAMETERS: + State - structure which stores algorithm state + B - linear term, array[N]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetlinearterm(const minqpstate &state, const real_1d_array &b); + + +/************************************************************************* +This function sets dense quadratic term for QP solver. By default, +quadratic term is zero. + +SUPPORT BY ALGLIB QP ALGORITHMS: + +Dense quadratic term can be handled by any of the QP algorithms supported +by ALGLIB QP Solver. + +IMPORTANT: + +This solver minimizes following function: + f(x) = 0.5*x'*A*x + b'*x. +Note that quadratic term has 0.5 before it. So if you want to minimize + f(x) = x^2 + x +you should rewrite your problem as follows: + f(x) = 0.5*(2*x^2) + x +and your matrix A will be equal to [[2.0]], not to [[1.0]] + +INPUT PARAMETERS: + State - structure which stores algorithm state + A - matrix, array[N,N] + IsUpper - (optional) storage type: + * if True, symmetric matrix A is given by its upper + triangle, and the lower triangle isn’t used + * if False, symmetric matrix A is given by its lower + triangle, and the upper triangle isn’t used + * if not given, both lower and upper triangles must be + filled. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetquadraticterm(const minqpstate &state, const real_2d_array &a, const bool isupper); +void minqpsetquadraticterm(const minqpstate &state, const real_2d_array &a); + + +/************************************************************************* +This function sets sparse quadratic term for QP solver. By default, +quadratic term is zero. + +SUPPORT BY ALGLIB QP ALGORITHMS: + +Sparse quadratic term is supported only by BLEIC-based QP algorithm (one +which is activated by MinQPSetAlgoBLEIC function). Cholesky-based QP algo +won't be able to deal with sparse quadratic term and will terminate +abnormally. + +IF YOU CALLED THIS FUNCTION, YOU MUST SWITCH TO BLEIC-BASED QP ALGORITHM +BEFORE CALLING MINQPOPTIMIZE() FUNCTION. + +IMPORTANT: + +This solver minimizes following function: + f(x) = 0.5*x'*A*x + b'*x. +Note that quadratic term has 0.5 before it. So if you want to minimize + f(x) = x^2 + x +you should rewrite your problem as follows: + f(x) = 0.5*(2*x^2) + x +and your matrix A will be equal to [[2.0]], not to [[1.0]] + +INPUT PARAMETERS: + State - structure which stores algorithm state + A - matrix, array[N,N] + IsUpper - (optional) storage type: + * if True, symmetric matrix A is given by its upper + triangle, and the lower triangle isn’t used + * if False, symmetric matrix A is given by its lower + triangle, and the upper triangle isn’t used + * if not given, both lower and upper triangles must be + filled. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetquadratictermsparse(const minqpstate &state, const sparsematrix &a, const bool isupper); + + +/************************************************************************* +This function sets starting point for QP solver. It is useful to have +good initial approximation to the solution, because it will increase +speed of convergence and identification of active constraints. + +INPUT PARAMETERS: + State - structure which stores algorithm state + X - starting point, array[N]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetstartingpoint(const minqpstate &state, const real_1d_array &x); + + +/************************************************************************* +This function sets origin for QP solver. By default, following QP program +is solved: + + min(0.5*x'*A*x+b'*x) + +This function allows to solve different problem: + + min(0.5*(x-x_origin)'*A*(x-x_origin)+b'*(x-x_origin)) + +INPUT PARAMETERS: + State - structure which stores algorithm state + XOrigin - origin, array[N]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetorigin(const minqpstate &state, const real_1d_array &xorigin); + + +/************************************************************************* +This function sets scaling coefficients. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +BLEIC-based QP solver uses scale for two purposes: +* to evaluate stopping conditions +* for preconditioning of the underlying BLEIC solver + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetscale(const minqpstate &state, const real_1d_array &s); + + +/************************************************************************* +This function tells solver to use Cholesky-based algorithm. This algorithm +is active by default. + +DESCRIPTION: + +Cholesky-based algorithm can be used only for problems which: +* have dense quadratic term, set by MinQPSetQuadraticTerm(), sparse or + structured problems are not supported. +* are strictly convex, i.e. quadratic term is symmetric positive definite, + indefinite or semidefinite problems are not supported by this algorithm. + +If anything of what listed above is violated, you may use BLEIC-based QP +algorithm which can be activated by MinQPSetAlgoBLEIC(). + +BENEFITS AND DRAWBACKS: + +This algorithm gives best precision amongst all QP solvers provided by +ALGLIB (Newton iterations have much higher precision than any other +optimization algorithm). This solver also gracefully handles problems with +very large amount of constraints. + +Performance of the algorithm is good because internally it uses Level 3 +Dense BLAS for its performance-critical parts. + + +From the other side, algorithm has O(N^3) complexity for unconstrained +problems and up to orders of magnitude slower on constrained problems +(these additional iterations are needed to identify active constraints). +So, its running time depends on number of constraints active at solution. + +Furthermore, this algorithm can not solve problems with sparse matrices or +problems with semidefinite/indefinite matrices of any kind (dense/sparse). + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetalgocholesky(const minqpstate &state); + + +/************************************************************************* +This function tells solver to use BLEIC-based algorithm and sets stopping +criteria for the algorithm. + +DESCRIPTION: + +BLEIC-based QP algorithm can be used for any kind of QP problems: +* problems with both dense and sparse quadratic terms +* problems with positive definite, semidefinite, indefinite terms + +BLEIC-based algorithm can solve even indefinite problems - as long as they +are bounded from below on the feasible set. Of course, global minimum is +found only for positive definite and semidefinite problems. As for +indefinite ones - only local minimum is found. + +BENEFITS AND DRAWBACKS: + +This algorithm can be used to solve both convex and indefinite QP problems +and it can utilize sparsity of the quadratic term (algorithm calculates +matrix-vector products, which can be performed efficiently in case of +sparse matrix). + +Algorithm has iteration cost, which (assuming fixed amount of non-boundary +linear constraints) linearly depends on problem size. Boundary constraints +does not significantly change iteration cost. + +Thus, it outperforms Cholesky-based QP algorithm (CQP) on high-dimensional +sparse problems with moderate amount of constraints. + + +From the other side, unlike CQP solver, this algorithm does NOT make use +of Level 3 Dense BLAS. Thus, its performance on dense problems is inferior +to that of CQP solver. + +Its precision is also inferior to that of CQP. CQP performs Newton steps +which are know to achieve very good precision. In many cases Newton step +leads us exactly to the solution. BLEIC-QP performs LBFGS steps, which are +good at detecting neighborhood of the solution, buy need many iterations +to find solution with 6 digits of precision. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if exploratory steepest + descent step on k+1-th iteration satisfies following + condition: |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + EpsX - >=0 + The subroutine finishes its work if exploratory steepest + descent step on k+1-th iteration satisfies following + condition: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - step vector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinQPSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsG=0, EpsF=0 and EpsX=0 and MaxIts=0 (simultaneously) will lead +to automatic stopping criterion selection (presently it is small step +length, but it may change in the future versions of ALGLIB). + +IT IS VERY IMPORTANT THAT YOU CALL MinQPSetScale() WHEN YOU USE THIS ALGO! + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetalgobleic(const minqpstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); + + +/************************************************************************* +This function sets boundary constraints for QP solver + +Boundary constraints are inactive by default (after initial creation). +After being set, they are preserved until explicitly turned off with +another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetbc(const minqpstate &state, const real_1d_array &bndl, const real_1d_array &bndu); + + +/************************************************************************* +This function sets linear constraints for QP optimizer. + +Linear constraints are inactive by default (after initial creation). + +INPUT PARAMETERS: + State - structure previously allocated with MinQPCreate call. + C - linear constraints, array[K,N+1]. + Each row of C represents one constraint, either equality + or inequality (see below): + * first N elements correspond to coefficients, + * last element corresponds to the right part. + All elements of C (including right part) must be finite. + CT - type of constraints, array[K]: + * if CT[i]>0, then I-th constraint is C[i,*]*x >= C[i,n+1] + * if CT[i]=0, then I-th constraint is C[i,*]*x = C[i,n+1] + * if CT[i]<0, then I-th constraint is C[i,*]*x <= C[i,n+1] + K - number of equality/inequality constraints, K>=0: + * if given, only leading K elements of C/CT are used + * if not given, automatically determined from sizes of C/CT + +NOTE 1: linear (non-bound) constraints are satisfied only approximately - + there always exists some minor violation (about 10^-10...10^-13) + due to numerical errors. + + -- ALGLIB -- + Copyright 19.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minqpsetlc(const minqpstate &state, const real_2d_array &c, const integer_1d_array &ct, const ae_int_t k); +void minqpsetlc(const minqpstate &state, const real_2d_array &c, const integer_1d_array &ct); + + +/************************************************************************* +This function solves quadratic programming problem. +You should call it after setting solver options with MinQPSet...() calls. + +INPUT PARAMETERS: + State - algorithm state + +You should use MinQPResults() function to access results after calls +to this function. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey. + Special thanks to Elvira Illarionova for important suggestions on + the linearly constrained QP algorithm. +*************************************************************************/ +void minqpoptimize(const minqpstate &state); + + +/************************************************************************* +QP solver results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution. + This array is allocated and initialized only when + Rep.TerminationType parameter is positive (success). + Rep - optimization report. You should check Rep.TerminationType, + which contains completion code, and you may check another + fields which contain another information about algorithm + functioning. + + Failure codes returned by algorithm are: + * -5 inappropriate solver was used: + * Cholesky solver for (semi)indefinite problems + * Cholesky solver for problems with sparse matrix + * -4 BLEIC-QP algorithm found unconstrained direction + of negative curvature (function is unbounded from + below even under constraints), no meaningful + minimum can be found. + * -3 inconsistent constraints (or maybe feasible point + is too hard to find). If you are sure that + constraints are feasible, try to restart optimizer + with better initial approximation. + + Completion codes specific for Cholesky algorithm: + * 4 successful completion + + Completion codes specific for BLEIC-based algorithm: + * 1 relative function improvement is no more than EpsF. + * 2 scaled step is no more than EpsX. + * 4 scaled gradient norm is no more than EpsG. + * 5 MaxIts steps was taken + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpresults(const minqpstate &state, real_1d_array &x, minqpreport &rep); + + +/************************************************************************* +QP results + +Buffered implementation of MinQPResults() which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpresultsbuf(const minqpstate &state, real_1d_array &x, minqpreport &rep); + +/************************************************************************* + IMPROVED LEVENBERG-MARQUARDT METHOD FOR + NON-LINEAR LEAST SQUARES OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of function which is represented as +sum of squares: + F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) +using value of function vector f[] and Jacobian of f[]. + + +REQUIREMENTS: +This algorithm will request following information during its operation: + +* function vector f[] at given point X +* function vector f[] and Jacobian of f[] (simultaneously) at given point + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts fvec() and jac() callbacks. +First one is used to calculate f[] at given point, second one calculates +f[] and Jacobian df[i]/dx[j]. + +You can try to initialize MinLMState structure with VJ function and then +use incorrect version of MinLMOptimize() (for example, version which +works with general form function and does not provide Jacobian), but it +will lead to exception being thrown after first attempt to calculate +Jacobian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateVJ() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of functions f[i] + X - initial solution, array[0..N-1] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatevj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state); +void minlmcreatevj(const ae_int_t m, const real_1d_array &x, minlmstate &state); + + +/************************************************************************* + IMPROVED LEVENBERG-MARQUARDT METHOD FOR + NON-LINEAR LEAST SQUARES OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of function which is represented as +sum of squares: + F(x) = f[0]^2(x[0],...,x[n-1]) + ... + f[m-1]^2(x[0],...,x[n-1]) +using value of function vector f[] only. Finite differences are used to +calculate Jacobian. + + +REQUIREMENTS: +This algorithm will request following information during its operation: +* function vector f[] at given point X + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts fvec() callback. + +You can try to initialize MinLMState structure with VJ function and then +use incorrect version of MinLMOptimize() (for example, version which +works with general form function and does not accept function vector), but +it will lead to exception being thrown after first attempt to calculate +Jacobian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateV() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N/M but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + M - number of functions f[i] + X - initial solution, array[0..N-1] + DiffStep- differentiation step, >0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +See also MinLMIteration, MinLMResults. + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatev(const ae_int_t n, const ae_int_t m, const real_1d_array &x, const double diffstep, minlmstate &state); +void minlmcreatev(const ae_int_t m, const real_1d_array &x, const double diffstep, minlmstate &state); + + +/************************************************************************* + LEVENBERG-MARQUARDT-LIKE METHOD FOR NON-LINEAR OPTIMIZATION + +DESCRIPTION: +This function is used to find minimum of general form (not "sum-of- +-squares") function + F = F(x[0], ..., x[n-1]) +using its gradient and Hessian. Levenberg-Marquardt modification with +L-BFGS pre-optimization and internal pre-conditioned L-BFGS optimization +after each Levenberg-Marquardt step is used. + + +REQUIREMENTS: +This algorithm will request following information during its operation: + +* function value F at given point X +* F and gradient G (simultaneously) at given point X +* F, G and Hessian H (simultaneously) at given point X + +There are several overloaded versions of MinLMOptimize() function which +correspond to different LM-like optimization algorithms provided by this +unit. You should choose version which accepts func(), grad() and hess() +function pointers. First pointer is used to calculate F at given point, +second one calculates F(x) and grad F(x), third one calculates F(x), +grad F(x), hess F(x). + +You can try to initialize MinLMState structure with FGH-function and then +use incorrect version of MinLMOptimize() (for example, version which does +not provide Hessian matrix), but it will lead to exception being thrown +after first attempt to calculate Hessian. + + +USAGE: +1. User initializes algorithm state with MinLMCreateFGH() call +2. User tunes solver parameters with MinLMSetCond(), MinLMSetStpMax() and + other functions +3. User calls MinLMOptimize() function which takes algorithm state and + pointers (delegates, etc.) to callback functions. +4. User calls MinLMResults() to get solution +5. Optionally, user may call MinLMRestartFrom() to solve another problem + with same N but another starting point and/or another function. + MinLMRestartFrom() allows to reuse already initialized structure. + + +INPUT PARAMETERS: + N - dimension, N>1 + * if given, only leading N elements of X are used + * if not given, automatically determined from size of X + X - initial solution, array[0..N-1] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +1. you may tune stopping conditions with MinLMSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use MinLMSetStpMax() function to bound algorithm's steps. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefgh(const ae_int_t n, const real_1d_array &x, minlmstate &state); +void minlmcreatefgh(const real_1d_array &x, minlmstate &state); + + +/************************************************************************* +This function sets stopping conditions for Levenberg-Marquardt optimization +algorithm. + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsG - >=0 + The subroutine finishes its work if the condition + |v|=0 + The subroutine finishes its work if on k+1-th iteration + the condition |F(k+1)-F(k)|<=EpsF*max{|F(k)|,|F(k+1)|,1} + is satisfied. + EpsX - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition |v|<=EpsX is fulfilled, where: + * |.| means Euclidian norm + * v - scaled step vector, v[i]=dx[i]/s[i] + * dx - ste pvector, dx=X(k+1)-X(k) + * s - scaling coefficients set by MinLMSetScale() + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. Only Levenberg-Marquardt + iterations are counted (L-BFGS/CG iterations are NOT + counted because their cost is very low compared to that of + LM). + +Passing EpsG=0, EpsF=0, EpsX=0 and MaxIts=0 (simultaneously) will lead to +automatic stopping criterion selection (small EpsX). + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetcond(const minlmstate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinLMOptimize(). Both Levenberg-Marquardt and internal L-BFGS +iterations are reported. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetxrep(const minlmstate &state, const bool needxrep); + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when you optimize target function which contains exp() +or other fast growing functions, and optimization algorithm makes too +large steps which leads to overflow. This function allows us to reject +steps that are too large (and therefore expose us to the possible +overflow) without actually calculating function value at the x+stp*d. + +NOTE: non-zero StpMax leads to moderate performance degradation because +intermediate step of preconditioned L-BFGS optimization is incompatible +with limits on step size. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetstpmax(const minlmstate &state, const double stpmax); + + +/************************************************************************* +This function sets scaling coefficients for LM optimizer. + +ALGLIB optimizers use scaling matrices to test stopping conditions (step +size and gradient are scaled before comparison with tolerances). Scale of +the I-th variable is a translation invariant measure of: +a) "how large" the variable is +b) how large the step should be to make significant changes in the function + +Generally, scale is NOT considered to be a form of preconditioner. But LM +optimizer is unique in that it uses scaling matrix both in the stopping +condition tests and as Marquardt damping factor. + +Proper scaling is very important for the algorithm performance. It is less +important for the quality of results, but still has some influence (it is +easier to converge when variables are properly scaled, so premature +stopping is possible when very badly scalled variables are combined with +relaxed stopping conditions). + +INPUT PARAMETERS: + State - structure stores algorithm state + S - array[N], non-zero scaling coefficients + S[i] may be negative, sign doesn't matter. + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlmsetscale(const minlmstate &state, const real_1d_array &s); + + +/************************************************************************* +This function sets boundary constraints for LM optimizer + +Boundary constraints are inactive by default (after initial creation). +They are preserved until explicitly turned off with another SetBC() call. + +INPUT PARAMETERS: + State - structure stores algorithm state + BndL - lower bounds, array[N]. + If some (all) variables are unbounded, you may specify + very small number or -INF (latter is recommended because + it will allow solver to use better algorithm). + BndU - upper bounds, array[N]. + If some (all) variables are unbounded, you may specify + very large number or +INF (latter is recommended because + it will allow solver to use better algorithm). + +NOTE 1: it is possible to specify BndL[i]=BndU[i]. In this case I-th +variable will be "frozen" at X[i]=BndL[i]=BndU[i]. + +NOTE 2: this solver has following useful properties: +* bound constraints are always satisfied exactly +* function is evaluated only INSIDE area specified by bound constraints + or at its boundary + + -- ALGLIB -- + Copyright 14.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minlmsetbc(const minlmstate &state, const real_1d_array &bndl, const real_1d_array &bndu); + + +/************************************************************************* +This function is used to change acceleration settings + +You can choose between three acceleration strategies: +* AccType=0, no acceleration. +* AccType=1, secant updates are used to update quadratic model after each + iteration. After fixed number of iterations (or after model breakdown) + we recalculate quadratic model using analytic Jacobian or finite + differences. Number of secant-based iterations depends on optimization + settings: about 3 iterations - when we have analytic Jacobian, up to 2*N + iterations - when we use finite differences to calculate Jacobian. + +AccType=1 is recommended when Jacobian calculation cost is prohibitive +high (several Mx1 function vector calculations followed by several NxN +Cholesky factorizations are faster than calculation of one M*N Jacobian). +It should also be used when we have no Jacobian, because finite difference +approximation takes too much time to compute. + +Table below list optimization protocols (XYZ protocol corresponds to +MinLMCreateXYZ) and acceleration types they support (and use by default). + +ACCELERATION TYPES SUPPORTED BY OPTIMIZATION PROTOCOLS: + +protocol 0 1 comment +V + + +VJ + + +FGH + + +DAFAULT VALUES: + +protocol 0 1 comment +V x without acceleration it is so slooooooooow +VJ x +FGH x + +NOTE: this function should be called before optimization. Attempt to call +it during algorithm iterations may result in unexpected behavior. + +NOTE: attempt to call this function with unsupported protocol/acceleration +combination will result in exception being thrown. + + -- ALGLIB -- + Copyright 14.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmsetacctype(const minlmstate &state, const ae_int_t acctype); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool minlmiteration(const minlmstate &state); + + +/************************************************************************* +This family of functions is used to launcn iterations of nonlinear optimizer + +These functions accept following parameters: + state - algorithm state + func - callback which calculates function (or merit function) + value func at given point x + grad - callback which calculates function (or merit function) + value func and gradient grad at given point x + hess - callback which calculates function (or merit function) + value func, gradient grad and Hessian hess at given point x + fvec - callback which calculates function vector fi[] + at given point x + jac - callback which calculates function vector fi[] + and Jacobian jac at given point x + rep - optional callback which is called after each iteration + can be NULL + ptr - optional pointer which is passed to func/grad/hess/jac/rep + can be NULL + +NOTES: + +1. Depending on function used to create state structure, this algorithm + may accept Jacobian and/or Hessian and/or gradient. According to the + said above, there ase several versions of this function, which accept + different sets of callbacks. + + This flexibility opens way to subtle errors - you may create state with + MinLMCreateFGH() (optimization using Hessian), but call function which + does not accept Hessian. So when algorithm will request Hessian, there + will be no callback to call. In this case exception will be thrown. + + Be careful to avoid such errors because there is no way to find them at + compile time - you can see them at runtime only. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey + +*************************************************************************/ +void minlmoptimize(minlmstate &state, + void (*fvec)(const real_1d_array &x, real_1d_array &fi, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); +void minlmoptimize(minlmstate &state, + void (*fvec)(const real_1d_array &x, real_1d_array &fi, void *ptr), + void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); +void minlmoptimize(minlmstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*hess)(const real_1d_array &x, double &func, real_1d_array &grad, real_2d_array &hess, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); +void minlmoptimize(minlmstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); +void minlmoptimize(minlmstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); + + +/************************************************************************* +Levenberg-Marquardt algorithm results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report; + see comments for this structure for more info. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmresults(const minlmstate &state, real_1d_array &x, minlmreport &rep); + + +/************************************************************************* +Levenberg-Marquardt algorithm results + +Buffered implementation of MinLMResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 10.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmresultsbuf(const minlmstate &state, real_1d_array &x, minlmreport &rep); + + +/************************************************************************* +This subroutine restarts LM algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used for reverse communication previously + allocated with MinLMCreateXXX call. + X - new starting point. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minlmrestartfrom(const minlmstate &state, const real_1d_array &x); + + +/************************************************************************* +This is obsolete function. + +Since ALGLIB 3.3 it is equivalent to MinLMCreateVJ(). + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatevgj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state); +void minlmcreatevgj(const ae_int_t m, const real_1d_array &x, minlmstate &state); + + +/************************************************************************* +This is obsolete function. + +Since ALGLIB 3.3 it is equivalent to MinLMCreateFJ(). + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefgj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state); +void minlmcreatefgj(const ae_int_t m, const real_1d_array &x, minlmstate &state); + + +/************************************************************************* +This function is considered obsolete since ALGLIB 3.1.0 and is present for +backward compatibility only. We recommend to use MinLMCreateVJ, which +provides similar, but more consistent and feature-rich interface. + + -- ALGLIB -- + Copyright 30.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minlmcreatefj(const ae_int_t n, const ae_int_t m, const real_1d_array &x, minlmstate &state); +void minlmcreatefj(const ae_int_t m, const real_1d_array &x, minlmstate &state); + + +/************************************************************************* +This subroutine turns on verification of the user-supplied analytic +gradient: +* user calls this subroutine before optimization begins +* MinLMOptimize() is called +* prior to actual optimization, for each function Fi and each component + of parameters being optimized X[j] algorithm performs following steps: + * two trial steps are made to X[j]-TestStep*S[j] and X[j]+TestStep*S[j], + where X[j] is j-th parameter and S[j] is a scale of j-th parameter + * if needed, steps are bounded with respect to constraints on X[] + * Fi(X) is evaluated at these trial points + * we perform one more evaluation in the middle point of the interval + * we build cubic model using function values and derivatives at trial + points and we compare its prediction with actual value in the middle + point + * in case difference between prediction and actual value is higher than + some predetermined threshold, algorithm stops with completion code -7; + Rep.VarIdx is set to index of the parameter with incorrect derivative, + Rep.FuncIdx is set to index of the function. +* after verification is over, algorithm proceeds to the actual optimization. + +NOTE 1: verification needs N (parameters count) Jacobian evaluations. It + is very costly and you should use it only for low dimensional + problems, when you want to be sure that you've correctly + calculated analytic derivatives. You should not use it in the + production code (unless you want to check derivatives provided + by some third party). + +NOTE 2: you should carefully choose TestStep. Value which is too large + (so large that function behaviour is significantly non-cubic) will + lead to false alarms. You may use different step for different + parameters by means of setting scale with MinLMSetScale(). + +NOTE 3: this function may lead to false positives. In case it reports that + I-th derivative was calculated incorrectly, you may decrease test + step and try one more time - maybe your function changes too + sharply and your step is too large for such rapidly chanding + function. + +INPUT PARAMETERS: + State - structure used to store algorithm state + TestStep - verification step: + * TestStep=0 turns verification off + * TestStep>0 activates verification + + -- ALGLIB -- + Copyright 15.06.2012 by Bochkanov Sergey +*************************************************************************/ +void minlmsetgradientcheck(const minlmstate &state, const double teststep); + +/************************************************************************* +Obsolete function, use MinLBFGSSetPrecDefault() instead. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetdefaultpreconditioner(const minlbfgsstate &state); + + +/************************************************************************* +Obsolete function, use MinLBFGSSetCholeskyPreconditioner() instead. + + -- ALGLIB -- + Copyright 13.10.2010 by Bochkanov Sergey +*************************************************************************/ +void minlbfgssetcholeskypreconditioner(const minlbfgsstate &state, const real_2d_array &p, const bool isupper); + + +/************************************************************************* +This is obsolete function which was used by previous version of the BLEIC +optimizer. It does nothing in the current version of BLEIC. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetbarrierwidth(const minbleicstate &state, const double mu); + + +/************************************************************************* +This is obsolete function which was used by previous version of the BLEIC +optimizer. It does nothing in the current version of BLEIC. + + -- ALGLIB -- + Copyright 28.11.2010 by Bochkanov Sergey +*************************************************************************/ +void minbleicsetbarrierdecay(const minbleicstate &state, const double mudecay); + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 25.03.2010 by Bochkanov Sergey +*************************************************************************/ +void minasacreate(const ae_int_t n, const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu, minasastate &state); +void minasacreate(const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu, minasastate &state); + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetcond(const minasastate &state, const double epsg, const double epsf, const double epsx, const ae_int_t maxits); + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetxrep(const minasastate &state, const bool needxrep); + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetalgorithm(const minasastate &state, const ae_int_t algotype); + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 02.04.2010 by Bochkanov Sergey +*************************************************************************/ +void minasasetstpmax(const minasastate &state, const double stpmax); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool minasaiteration(const minasastate &state); + + +/************************************************************************* +This family of functions is used to launcn iterations of nonlinear optimizer + +These functions accept following parameters: + state - algorithm state + grad - callback which calculates function (or merit function) + value func and gradient grad at given point x + rep - optional callback which is called after each iteration + can be NULL + ptr - optional pointer which is passed to func/grad/hess/jac/rep + can be NULL + + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey + +*************************************************************************/ +void minasaoptimize(minasastate &state, + void (*grad)(const real_1d_array &x, double &func, real_1d_array &grad, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minasaresults(const minasastate &state, real_1d_array &x, minasareport &rep); + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +void minasaresultsbuf(const minasastate &state, real_1d_array &x, minasareport &rep); + + +/************************************************************************* +Obsolete optimization algorithm. +Was replaced by MinBLEIC subpackage. + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void minasarestartfrom(const minasastate &state, const real_1d_array &x, const real_1d_array &bndl, const real_1d_array &bndu); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void trimprepare(double f, double* threshold, ae_state *_state); +void trimfunction(double* f, + /* Real */ ae_vector* g, + ae_int_t n, + double threshold, + ae_state *_state); +ae_bool enforceboundaryconstraints(/* Real */ ae_vector* x, + /* Real */ ae_vector* bl, + /* Boolean */ ae_vector* havebl, + /* Real */ ae_vector* bu, + /* Boolean */ ae_vector* havebu, + ae_int_t nmain, + ae_int_t nslack, + ae_state *_state); +void projectgradientintobc(/* Real */ ae_vector* x, + /* Real */ ae_vector* g, + /* Real */ ae_vector* bl, + /* Boolean */ ae_vector* havebl, + /* Real */ ae_vector* bu, + /* Boolean */ ae_vector* havebu, + ae_int_t nmain, + ae_int_t nslack, + ae_state *_state); +void calculatestepbound(/* Real */ ae_vector* x, + /* Real */ ae_vector* d, + double alpha, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + ae_int_t nmain, + ae_int_t nslack, + ae_int_t* variabletofreeze, + double* valuetofreeze, + double* maxsteplen, + ae_state *_state); +ae_int_t postprocessboundedstep(/* Real */ ae_vector* x, + /* Real */ ae_vector* xprev, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + ae_int_t nmain, + ae_int_t nslack, + ae_int_t variabletofreeze, + double valuetofreeze, + double steptaken, + double maxsteplen, + ae_state *_state); +void filterdirection(/* Real */ ae_vector* d, + /* Real */ ae_vector* x, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + /* Real */ ae_vector* s, + ae_int_t nmain, + ae_int_t nslack, + double droptol, + ae_state *_state); +ae_int_t numberofchangedconstraints(/* Real */ ae_vector* x, + /* Real */ ae_vector* xprev, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + ae_int_t nmain, + ae_int_t nslack, + ae_state *_state); +ae_bool findfeasiblepoint(/* Real */ ae_vector* x, + /* Real */ ae_vector* bndl, + /* Boolean */ ae_vector* havebndl, + /* Real */ ae_vector* bndu, + /* Boolean */ ae_vector* havebndu, + ae_int_t nmain, + ae_int_t nslack, + /* Real */ ae_matrix* ce, + ae_int_t k, + double epsi, + ae_int_t* qpits, + ae_int_t* gpaits, + ae_state *_state); +ae_bool derivativecheck(double f0, + double df0, + double f1, + double df1, + double f, + double df, + double width, + ae_state *_state); +void cqminit(ae_int_t n, convexquadraticmodel* s, ae_state *_state); +void cqmseta(convexquadraticmodel* s, + /* Real */ ae_matrix* a, + ae_bool isupper, + double alpha, + ae_state *_state); +void cqmrewritedensediagonal(convexquadraticmodel* s, + /* Real */ ae_vector* z, + ae_state *_state); +void cqmsetd(convexquadraticmodel* s, + /* Real */ ae_vector* d, + double tau, + ae_state *_state); +void cqmdropa(convexquadraticmodel* s, ae_state *_state); +void cqmsetb(convexquadraticmodel* s, + /* Real */ ae_vector* b, + ae_state *_state); +void cqmsetq(convexquadraticmodel* s, + /* Real */ ae_matrix* q, + /* Real */ ae_vector* r, + ae_int_t k, + double theta, + ae_state *_state); +void cqmsetactiveset(convexquadraticmodel* s, + /* Real */ ae_vector* x, + /* Boolean */ ae_vector* activeset, + ae_state *_state); +double cqmeval(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state); +void cqmevalx(convexquadraticmodel* s, + /* Real */ ae_vector* x, + double* r, + double* noise, + ae_state *_state); +void cqmgradunconstrained(convexquadraticmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* g, + ae_state *_state); +double cqmxtadx2(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state); +void cqmadx(convexquadraticmodel* s, + /* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_state *_state); +ae_bool cqmconstrainedoptimum(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state); +void cqmscalevector(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state); +double cqmdebugconstrainedevalt(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state); +double cqmdebugconstrainedevale(convexquadraticmodel* s, + /* Real */ ae_vector* x, + ae_state *_state); +ae_bool _convexquadraticmodel_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _convexquadraticmodel_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _convexquadraticmodel_clear(void* _p); +void _convexquadraticmodel_destroy(void* _p); +void snnlsinit(ae_int_t nsmax, + ae_int_t ndmax, + ae_int_t nrmax, + snnlssolver* s, + ae_state *_state); +void snnlssetproblem(snnlssolver* s, + /* Real */ ae_matrix* a, + /* Real */ ae_vector* b, + ae_int_t ns, + ae_int_t nd, + ae_int_t nr, + ae_state *_state); +void snnlsdropnnc(snnlssolver* s, ae_int_t idx, ae_state *_state); +void snnlssolve(snnlssolver* s, + /* Real */ ae_vector* x, + ae_state *_state); +ae_bool _snnlssolver_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _snnlssolver_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _snnlssolver_clear(void* _p); +void _snnlssolver_destroy(void* _p); +void sasinit(ae_int_t n, sactiveset* s, ae_state *_state); +void sassetscale(sactiveset* state, + /* Real */ ae_vector* s, + ae_state *_state); +void sassetprecdiag(sactiveset* state, + /* Real */ ae_vector* d, + ae_state *_state); +void sassetbc(sactiveset* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state); +void sassetlc(sactiveset* state, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* ct, + ae_int_t k, + ae_state *_state); +void sassetlcx(sactiveset* state, + /* Real */ ae_matrix* cleic, + ae_int_t nec, + ae_int_t nic, + ae_state *_state); +ae_bool sasstartoptimization(sactiveset* state, + /* Real */ ae_vector* x, + ae_state *_state); +void sasexploredirection(sactiveset* state, + /* Real */ ae_vector* d, + double* stpmax, + ae_int_t* cidx, + double* vval, + ae_state *_state); +ae_int_t sasmoveto(sactiveset* state, + /* Real */ ae_vector* xn, + ae_bool needact, + ae_int_t cidx, + double cval, + ae_state *_state); +void sasimmediateactivation(sactiveset* state, + ae_int_t cidx, + double cval, + ae_state *_state); +void sasconstraineddescent(sactiveset* state, + /* Real */ ae_vector* g, + /* Real */ ae_vector* d, + ae_state *_state); +void sasconstraineddescentprec(sactiveset* state, + /* Real */ ae_vector* g, + /* Real */ ae_vector* d, + ae_state *_state); +void sasconstraineddirection(sactiveset* state, + /* Real */ ae_vector* d, + ae_state *_state); +void sasconstraineddirectionprec(sactiveset* state, + /* Real */ ae_vector* d, + ae_state *_state); +void sascorrection(sactiveset* state, + /* Real */ ae_vector* x, + double* penalty, + ae_state *_state); +double sasactivelcpenalty1(sactiveset* state, + /* Real */ ae_vector* x, + ae_state *_state); +double sasscaledconstrainednorm(sactiveset* state, + /* Real */ ae_vector* d, + ae_state *_state); +void sasstopoptimization(sactiveset* state, ae_state *_state); +void sasreactivateconstraints(sactiveset* state, + /* Real */ ae_vector* gc, + ae_state *_state); +void sasreactivateconstraintsprec(sactiveset* state, + /* Real */ ae_vector* gc, + ae_state *_state); +void sasrebuildbasis(sactiveset* state, ae_state *_state); +ae_bool _sactiveset_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _sactiveset_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _sactiveset_clear(void* _p); +void _sactiveset_destroy(void* _p); +void mincgcreate(ae_int_t n, + /* Real */ ae_vector* x, + mincgstate* state, + ae_state *_state); +void mincgcreatef(ae_int_t n, + /* Real */ ae_vector* x, + double diffstep, + mincgstate* state, + ae_state *_state); +void mincgsetcond(mincgstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state); +void mincgsetscale(mincgstate* state, + /* Real */ ae_vector* s, + ae_state *_state); +void mincgsetxrep(mincgstate* state, ae_bool needxrep, ae_state *_state); +void mincgsetdrep(mincgstate* state, ae_bool needdrep, ae_state *_state); +void mincgsetcgtype(mincgstate* state, ae_int_t cgtype, ae_state *_state); +void mincgsetstpmax(mincgstate* state, double stpmax, ae_state *_state); +void mincgsuggeststep(mincgstate* state, double stp, ae_state *_state); +void mincgsetprecdefault(mincgstate* state, ae_state *_state); +void mincgsetprecdiag(mincgstate* state, + /* Real */ ae_vector* d, + ae_state *_state); +void mincgsetprecscale(mincgstate* state, ae_state *_state); +ae_bool mincgiteration(mincgstate* state, ae_state *_state); +void mincgresults(mincgstate* state, + /* Real */ ae_vector* x, + mincgreport* rep, + ae_state *_state); +void mincgresultsbuf(mincgstate* state, + /* Real */ ae_vector* x, + mincgreport* rep, + ae_state *_state); +void mincgrestartfrom(mincgstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +void mincgsetprecdiagfast(mincgstate* state, + /* Real */ ae_vector* d, + ae_state *_state); +void mincgsetpreclowrankfast(mincgstate* state, + /* Real */ ae_vector* d1, + /* Real */ ae_vector* c, + /* Real */ ae_matrix* v, + ae_int_t vcnt, + ae_state *_state); +void mincgsetprecvarpart(mincgstate* state, + /* Real */ ae_vector* d2, + ae_state *_state); +void mincgsetgradientcheck(mincgstate* state, + double teststep, + ae_state *_state); +ae_bool _mincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mincgstate_clear(void* _p); +void _mincgstate_destroy(void* _p); +ae_bool _mincgreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _mincgreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _mincgreport_clear(void* _p); +void _mincgreport_destroy(void* _p); +void minbleiccreate(ae_int_t n, + /* Real */ ae_vector* x, + minbleicstate* state, + ae_state *_state); +void minbleiccreatef(ae_int_t n, + /* Real */ ae_vector* x, + double diffstep, + minbleicstate* state, + ae_state *_state); +void minbleicsetbc(minbleicstate* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state); +void minbleicsetlc(minbleicstate* state, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* ct, + ae_int_t k, + ae_state *_state); +void minbleicsetcond(minbleicstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state); +void minbleicsetscale(minbleicstate* state, + /* Real */ ae_vector* s, + ae_state *_state); +void minbleicsetprecdefault(minbleicstate* state, ae_state *_state); +void minbleicsetprecdiag(minbleicstate* state, + /* Real */ ae_vector* d, + ae_state *_state); +void minbleicsetprecscale(minbleicstate* state, ae_state *_state); +void minbleicsetxrep(minbleicstate* state, + ae_bool needxrep, + ae_state *_state); +void minbleicsetdrep(minbleicstate* state, + ae_bool needdrep, + ae_state *_state); +void minbleicsetstpmax(minbleicstate* state, + double stpmax, + ae_state *_state); +ae_bool minbleiciteration(minbleicstate* state, ae_state *_state); +void minbleicresults(minbleicstate* state, + /* Real */ ae_vector* x, + minbleicreport* rep, + ae_state *_state); +void minbleicresultsbuf(minbleicstate* state, + /* Real */ ae_vector* x, + minbleicreport* rep, + ae_state *_state); +void minbleicrestartfrom(minbleicstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +void minbleicemergencytermination(minbleicstate* state, ae_state *_state); +void minbleicsetgradientcheck(minbleicstate* state, + double teststep, + ae_state *_state); +ae_bool _minbleicstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minbleicstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minbleicstate_clear(void* _p); +void _minbleicstate_destroy(void* _p); +ae_bool _minbleicreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minbleicreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minbleicreport_clear(void* _p); +void _minbleicreport_destroy(void* _p); +void minlbfgscreate(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlbfgsstate* state, + ae_state *_state); +void minlbfgscreatef(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + double diffstep, + minlbfgsstate* state, + ae_state *_state); +void minlbfgssetcond(minlbfgsstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state); +void minlbfgssetxrep(minlbfgsstate* state, + ae_bool needxrep, + ae_state *_state); +void minlbfgssetstpmax(minlbfgsstate* state, + double stpmax, + ae_state *_state); +void minlbfgssetscale(minlbfgsstate* state, + /* Real */ ae_vector* s, + ae_state *_state); +void minlbfgscreatex(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + ae_int_t flags, + double diffstep, + minlbfgsstate* state, + ae_state *_state); +void minlbfgssetprecdefault(minlbfgsstate* state, ae_state *_state); +void minlbfgssetpreccholesky(minlbfgsstate* state, + /* Real */ ae_matrix* p, + ae_bool isupper, + ae_state *_state); +void minlbfgssetprecdiag(minlbfgsstate* state, + /* Real */ ae_vector* d, + ae_state *_state); +void minlbfgssetprecscale(minlbfgsstate* state, ae_state *_state); +ae_bool minlbfgsiteration(minlbfgsstate* state, ae_state *_state); +void minlbfgsresults(minlbfgsstate* state, + /* Real */ ae_vector* x, + minlbfgsreport* rep, + ae_state *_state); +void minlbfgsresultsbuf(minlbfgsstate* state, + /* Real */ ae_vector* x, + minlbfgsreport* rep, + ae_state *_state); +void minlbfgsrestartfrom(minlbfgsstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +void minlbfgssetgradientcheck(minlbfgsstate* state, + double teststep, + ae_state *_state); +ae_bool _minlbfgsstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minlbfgsstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minlbfgsstate_clear(void* _p); +void _minlbfgsstate_destroy(void* _p); +ae_bool _minlbfgsreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minlbfgsreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minlbfgsreport_clear(void* _p); +void _minlbfgsreport_destroy(void* _p); +void minqpcreate(ae_int_t n, minqpstate* state, ae_state *_state); +void minqpsetlinearterm(minqpstate* state, + /* Real */ ae_vector* b, + ae_state *_state); +void minqpsetquadraticterm(minqpstate* state, + /* Real */ ae_matrix* a, + ae_bool isupper, + ae_state *_state); +void minqpsetquadratictermsparse(minqpstate* state, + sparsematrix* a, + ae_bool isupper, + ae_state *_state); +void minqpsetstartingpoint(minqpstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +void minqpsetorigin(minqpstate* state, + /* Real */ ae_vector* xorigin, + ae_state *_state); +void minqpsetscale(minqpstate* state, + /* Real */ ae_vector* s, + ae_state *_state); +void minqpsetalgocholesky(minqpstate* state, ae_state *_state); +void minqpsetalgobleic(minqpstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state); +void minqpsetbc(minqpstate* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state); +void minqpsetlc(minqpstate* state, + /* Real */ ae_matrix* c, + /* Integer */ ae_vector* ct, + ae_int_t k, + ae_state *_state); +void minqpoptimize(minqpstate* state, ae_state *_state); +void minqpresults(minqpstate* state, + /* Real */ ae_vector* x, + minqpreport* rep, + ae_state *_state); +void minqpresultsbuf(minqpstate* state, + /* Real */ ae_vector* x, + minqpreport* rep, + ae_state *_state); +void minqpsetlineartermfast(minqpstate* state, + /* Real */ ae_vector* b, + ae_state *_state); +void minqpsetquadratictermfast(minqpstate* state, + /* Real */ ae_matrix* a, + ae_bool isupper, + double s, + ae_state *_state); +void minqprewritediagonal(minqpstate* state, + /* Real */ ae_vector* s, + ae_state *_state); +void minqpsetstartingpointfast(minqpstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +void minqpsetoriginfast(minqpstate* state, + /* Real */ ae_vector* xorigin, + ae_state *_state); +ae_bool _minqpstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minqpstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minqpstate_clear(void* _p); +void _minqpstate_destroy(void* _p); +ae_bool _minqpreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minqpreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minqpreport_clear(void* _p); +void _minqpreport_destroy(void* _p); +void minlmcreatevj(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state); +void minlmcreatev(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + double diffstep, + minlmstate* state, + ae_state *_state); +void minlmcreatefgh(ae_int_t n, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state); +void minlmsetcond(minlmstate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state); +void minlmsetxrep(minlmstate* state, ae_bool needxrep, ae_state *_state); +void minlmsetstpmax(minlmstate* state, double stpmax, ae_state *_state); +void minlmsetscale(minlmstate* state, + /* Real */ ae_vector* s, + ae_state *_state); +void minlmsetbc(minlmstate* state, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state); +void minlmsetacctype(minlmstate* state, + ae_int_t acctype, + ae_state *_state); +ae_bool minlmiteration(minlmstate* state, ae_state *_state); +void minlmresults(minlmstate* state, + /* Real */ ae_vector* x, + minlmreport* rep, + ae_state *_state); +void minlmresultsbuf(minlmstate* state, + /* Real */ ae_vector* x, + minlmreport* rep, + ae_state *_state); +void minlmrestartfrom(minlmstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +void minlmcreatevgj(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state); +void minlmcreatefgj(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state); +void minlmcreatefj(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + minlmstate* state, + ae_state *_state); +void minlmsetgradientcheck(minlmstate* state, + double teststep, + ae_state *_state); +ae_bool _minlmstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minlmstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minlmstate_clear(void* _p); +void _minlmstate_destroy(void* _p); +ae_bool _minlmreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minlmreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minlmreport_clear(void* _p); +void _minlmreport_destroy(void* _p); +void minlbfgssetdefaultpreconditioner(minlbfgsstate* state, + ae_state *_state); +void minlbfgssetcholeskypreconditioner(minlbfgsstate* state, + /* Real */ ae_matrix* p, + ae_bool isupper, + ae_state *_state); +void minbleicsetbarrierwidth(minbleicstate* state, + double mu, + ae_state *_state); +void minbleicsetbarrierdecay(minbleicstate* state, + double mudecay, + ae_state *_state); +void minasacreate(ae_int_t n, + /* Real */ ae_vector* x, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + minasastate* state, + ae_state *_state); +void minasasetcond(minasastate* state, + double epsg, + double epsf, + double epsx, + ae_int_t maxits, + ae_state *_state); +void minasasetxrep(minasastate* state, ae_bool needxrep, ae_state *_state); +void minasasetalgorithm(minasastate* state, + ae_int_t algotype, + ae_state *_state); +void minasasetstpmax(minasastate* state, double stpmax, ae_state *_state); +ae_bool minasaiteration(minasastate* state, ae_state *_state); +void minasaresults(minasastate* state, + /* Real */ ae_vector* x, + minasareport* rep, + ae_state *_state); +void minasaresultsbuf(minasastate* state, + /* Real */ ae_vector* x, + minasareport* rep, + ae_state *_state); +void minasarestartfrom(minasastate* state, + /* Real */ ae_vector* x, + /* Real */ ae_vector* bndl, + /* Real */ ae_vector* bndu, + ae_state *_state); +ae_bool _minasastate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minasastate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minasastate_clear(void* _p); +void _minasastate_destroy(void* _p); +ae_bool _minasareport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _minasareport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _minasareport_clear(void* _p); +void _minasareport_destroy(void* _p); + +} +#endif + diff --git a/psdlag/src/psd.cpp b/psdlag/src/psd.cpp new file mode 100644 index 0000000..25ec0df --- /dev/null +++ b/psdlag/src/psd.cpp @@ -0,0 +1,105 @@ +/* + * psd.cpp + * + * Created on: May 31, 2013 + * Author: azoghbi + */ + +#include "inc/psd.hpp" + +psd::psd( lcurve inlc , vec fqL ) { + + // ----------- initial parameters ------------ // + n = inlc.len; + dt = inlc.dt; + // ------------------------------------------ // + + + // ----------- light curve setup ------------ // + setlc(); + inlc.demean(); + int i; + for( i=0 ; i3 ){dpar[i] = 3;} if( dpar[i]<-3 ){dpar[i] = -3;} + pars[i] += dpar[i]; + } +} diff --git a/psdlag/src/psdlag.cpp b/psdlag/src/psdlag.cpp new file mode 100644 index 0000000..79f68fd --- /dev/null +++ b/psdlag/src/psdlag.cpp @@ -0,0 +1,252 @@ +/* + * psdlag.cpp + * + * Created on: Jun 1, 2013 + * Author: azoghbi + */ + +#include "inc/psdlag.hpp" + +psdlag::psdlag( lcurve lc1, lcurve lc2 , vec fqL ) { + + // ----------- initial parameters ------------ // + n1 = lc1.len; + n = n1 + lc2.len; + dt = lc1.dt; + // ------------------------------------------ // + + + // ----------- light curve setup ------------ // + setlc(); + lc1.demean(); lc2.demean(); + int i; + for( i=0 ; i3000 ){dpar[i] = 3000;} if( dpar[i]<-3000 ){dpar[i] = -3000;} + pars[i] += dpar[i]/((n<10)?10:1); + } +} + + +void psdlag::print_pars( vec& pars , vec& errs ){ + for( int i=0 ; i M_PI ){ pars[i+3*nfq] -= 2*M_PI; } + while( pars[i+3*nfq] <-M_PI ){ pars[i+3*nfq] += 2*M_PI; } + mod::print_pars( pars , errs ); + } +} + +// ++++++++++++++++++++++++++++++++++++++++++++++++++++++ // + +psdlag10::psdlag10( lcurve lc1, lcurve lc2 , vec fqL ) { + + // ----------- initial parameters ------------ // + n1 = lc1.len; + n = n1 + lc2.len; + dt = lc1.dt; + // ------------------------------------------ // + + + // ----------- light curve setup ------------ // + setlc(); + lc1.demean(); lc2.demean(); + int i; + for( i=0 ; i3 ){dpar[i] = 3;} if( dpar[i]<-3 ){dpar[i] = -3;} + //pars[i] += dpar[i]; + pars[i] += dpar[i]/((n<5)?10:1); + } +} + + +void psdlag10::print_pars( vec& pars , vec& errs ){ + for( int i=0 ; i M_PI ){ pars[i+3*nfq] -= 2*M_PI; } + while( pars[i+3*nfq] <-M_PI ){ pars[i+3*nfq] += 2*M_PI; } + } + mod::print_pars( pars , errs ); +} + +void psdlag10::what_pars( int& ip1 , int& ip2 ){ + ip1 = 3*nfq; ip2 = 4*nfq; +} diff --git a/psdlag/src/solvers.cpp b/psdlag/src/solvers.cpp new file mode 100644 index 0000000..f1632cd --- /dev/null +++ b/psdlag/src/solvers.cpp @@ -0,0 +1,8709 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "solvers.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* + +*************************************************************************/ +_densesolverreport_owner::_densesolverreport_owner() +{ + p_struct = (alglib_impl::densesolverreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::densesolverreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_densesolverreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_densesolverreport_owner::_densesolverreport_owner(const _densesolverreport_owner &rhs) +{ + p_struct = (alglib_impl::densesolverreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::densesolverreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_densesolverreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_densesolverreport_owner& _densesolverreport_owner::operator=(const _densesolverreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_densesolverreport_clear(p_struct); + if( !alglib_impl::_densesolverreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_densesolverreport_owner::~_densesolverreport_owner() +{ + alglib_impl::_densesolverreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::densesolverreport* _densesolverreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::densesolverreport* _densesolverreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +densesolverreport::densesolverreport() : _densesolverreport_owner() ,r1(p_struct->r1),rinf(p_struct->rinf) +{ +} + +densesolverreport::densesolverreport(const densesolverreport &rhs):_densesolverreport_owner(rhs) ,r1(p_struct->r1),rinf(p_struct->rinf) +{ +} + +densesolverreport& densesolverreport::operator=(const densesolverreport &rhs) +{ + if( this==&rhs ) + return *this; + _densesolverreport_owner::operator=(rhs); + return *this; +} + +densesolverreport::~densesolverreport() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_densesolverlsreport_owner::_densesolverlsreport_owner() +{ + p_struct = (alglib_impl::densesolverlsreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::densesolverlsreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_densesolverlsreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_densesolverlsreport_owner::_densesolverlsreport_owner(const _densesolverlsreport_owner &rhs) +{ + p_struct = (alglib_impl::densesolverlsreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::densesolverlsreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_densesolverlsreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_densesolverlsreport_owner& _densesolverlsreport_owner::operator=(const _densesolverlsreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_densesolverlsreport_clear(p_struct); + if( !alglib_impl::_densesolverlsreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_densesolverlsreport_owner::~_densesolverlsreport_owner() +{ + alglib_impl::_densesolverlsreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::densesolverlsreport* _densesolverlsreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::densesolverlsreport* _densesolverlsreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +densesolverlsreport::densesolverlsreport() : _densesolverlsreport_owner() ,r2(p_struct->r2),cx(&p_struct->cx),n(p_struct->n),k(p_struct->k) +{ +} + +densesolverlsreport::densesolverlsreport(const densesolverlsreport &rhs):_densesolverlsreport_owner(rhs) ,r2(p_struct->r2),cx(&p_struct->cx),n(p_struct->n),k(p_struct->k) +{ +} + +densesolverlsreport& densesolverlsreport::operator=(const densesolverlsreport &rhs) +{ + if( this==&rhs ) + return *this; + _densesolverlsreport_owner::operator=(rhs); + return *this; +} + +densesolverlsreport::~densesolverlsreport() +{ +} + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*x=b, where A is NxN non-denegerate +real matrix, x and b are vectors. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - return code: + * -3 A is singular, or VERY close to singular. + X is filled by zeros in such cases. + * -1 N<=0 was passed + * 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 + X - array[0..N-1], it contains: + * solution of A*x=b if A is non-singular (well-conditioned + or ill-conditioned, but not very close to singular) + * zeros, if A is singular or VERY close to singular + (in this case Info=-3). + +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. + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolve(const real_2d_array &a, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixsolve(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. + +Similar to RMatrixSolve() but solves task with multiple right parts (where +b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* optional iterative refinement +* O(N^3+M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + RFS - iterative refinement switch: + * True - refinement is used. + Less performance, more precision. + * False - refinement is not used. + More performance, less precision. + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolvem(const real_2d_array &a, const ae_int_t n, const real_2d_array &b, const ae_int_t m, const bool rfs, ae_int_t &info, densesolverreport &rep, real_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixsolvem(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), m, rfs, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*X=B, where A is NxN non-denegerate +real matrix given by its LU decomposition, X and B are NxM real matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixlusolve(const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixlusolve(const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. + +Similar to RMatrixLUSolve() but solves task with multiple right parts +(where b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixlusolvem(const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixlusolvem(const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*x=b, where BOTH ORIGINAL A AND ITS +LU DECOMPOSITION ARE KNOWN. You can use it if for some reasons you have +both A and its LU decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixmixedsolve(const real_2d_array &a, const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixmixedsolve(const_cast(a.c_ptr()), const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. + +Similar to RMatrixMixedSolve() but solves task with multiple right parts +(where b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixmixedsolvem(const real_2d_array &a, const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixmixedsolvem(const_cast(a.c_ptr()), const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3+M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + RFS - iterative refinement switch: + * True - refinement is used. + Less performance, more precision. + * False - refinement is not used. + More performance, less precision. + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixsolvem(const complex_2d_array &a, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, const bool rfs, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixsolvem(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), m, rfs, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixsolve(const complex_2d_array &a, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixsolve(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixlusolvem(const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixlusolvem(const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixlusolve(const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixlusolve(const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixMixedSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixmixedsolvem(const complex_2d_array &a, const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixmixedsolvem(const_cast(a.c_ptr()), const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixMixedSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixmixedsolve(const complex_2d_array &a, const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::cmatrixmixedsolve(const_cast(a.c_ptr()), const_cast(lua.c_ptr()), const_cast(p.c_ptr()), n, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for symmetric positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3+M*N^2) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve. + Returns -3 for non-SPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixsolvem(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixsolvem(const_cast(a.c_ptr()), n, isupper, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for SPD matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Returns -3 for non-SPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixsolve(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixsolve(const_cast(a.c_ptr()), n, isupper, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for SPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of CHA + IsUpper - what half of CHA is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskysolvem(const real_2d_array &cha, const ae_int_t n, const bool isupper, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixcholeskysolvem(const_cast(cha.c_ptr()), n, isupper, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for SPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of A + IsUpper - what half of CHA is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskysolve(const real_2d_array &cha, const ae_int_t n, const bool isupper, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spdmatrixcholeskysolve(const_cast(cha.c_ptr()), n, isupper, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for Hermitian positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3+M*N^2) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve. + Returns -3 for non-HPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixsolvem(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixsolvem(const_cast(a.c_ptr()), n, isupper, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for Hermitian positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Returns -3 for non-HPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixsolve(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixsolve(const_cast(a.c_ptr()), n, isupper, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for HPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + HPDMatrixCholesky result + N - size of CHA + IsUpper - what half of CHA is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskysolvem(const complex_2d_array &cha, const ae_int_t n, const bool isupper, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixcholeskysolvem(const_cast(cha.c_ptr()), n, isupper, const_cast(b.c_ptr()), m, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for HPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of A + IsUpper - what half of CHA is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskysolve(const complex_2d_array &cha, const ae_int_t n, const bool isupper, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hpdmatrixcholeskysolve(const_cast(cha.c_ptr()), n, isupper, const_cast(b.c_ptr()), &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dense solver. + +This subroutine finds solution of the linear system A*X=B with non-square, +possibly degenerate A. System is solved in the least squares sense, and +general least squares solution X = X0 + CX*y which minimizes |A*X-B| is +returned. If A is non-degenerate, solution in the usual sense is returned. + +Algorithm features: +* automatic detection (and correct handling!) of degenerate cases +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..NRows-1,0..NCols-1], system matrix + NRows - vertical size of A + NCols - horizontal size of A + B - array[0..NCols-1], right part + Threshold- a number in [0,1]. Singular values beyond Threshold are + considered zero. Set it to 0.0, if you don't understand + what it means, so the solver will choose good value on its + own. + +OUTPUT PARAMETERS + Info - return code: + * -4 SVD subroutine failed + * -1 if NRows<=0 or NCols<=0 or Threshold<0 was passed + * 1 if task is solved + Rep - solver report, see below for more info + X - array[0..N-1,0..M-1], it contains: + * solution of A*X=B (even for singular A) + * zeros, if SVD subroutine failed + +SOLVER REPORT + +Subroutine sets following fields of the Rep structure: +* R2 reciprocal of condition number: 1/cond(A), 2-norm. +* N = NCols +* K dim(Null(A)) +* CX array[0..N-1,0..K-1], kernel of A. + Columns of CX store such vectors that A*CX[i]=0. + + -- ALGLIB -- + Copyright 24.08.2009 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolvels(const real_2d_array &a, const ae_int_t nrows, const ae_int_t ncols, const real_1d_array &b, const double threshold, ae_int_t &info, densesolverlsreport &rep, real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rmatrixsolvels(const_cast(a.c_ptr()), nrows, ncols, const_cast(b.c_ptr()), threshold, &info, const_cast(rep.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This object stores state of the LinLSQR method. + +You should use ALGLIB functions to work with this object. +*************************************************************************/ +_linlsqrstate_owner::_linlsqrstate_owner() +{ + p_struct = (alglib_impl::linlsqrstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::linlsqrstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_linlsqrstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_linlsqrstate_owner::_linlsqrstate_owner(const _linlsqrstate_owner &rhs) +{ + p_struct = (alglib_impl::linlsqrstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::linlsqrstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_linlsqrstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_linlsqrstate_owner& _linlsqrstate_owner::operator=(const _linlsqrstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_linlsqrstate_clear(p_struct); + if( !alglib_impl::_linlsqrstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_linlsqrstate_owner::~_linlsqrstate_owner() +{ + alglib_impl::_linlsqrstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::linlsqrstate* _linlsqrstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::linlsqrstate* _linlsqrstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +linlsqrstate::linlsqrstate() : _linlsqrstate_owner() +{ +} + +linlsqrstate::linlsqrstate(const linlsqrstate &rhs):_linlsqrstate_owner(rhs) +{ +} + +linlsqrstate& linlsqrstate::operator=(const linlsqrstate &rhs) +{ + if( this==&rhs ) + return *this; + _linlsqrstate_owner::operator=(rhs); + return *this; +} + +linlsqrstate::~linlsqrstate() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_linlsqrreport_owner::_linlsqrreport_owner() +{ + p_struct = (alglib_impl::linlsqrreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::linlsqrreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_linlsqrreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_linlsqrreport_owner::_linlsqrreport_owner(const _linlsqrreport_owner &rhs) +{ + p_struct = (alglib_impl::linlsqrreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::linlsqrreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_linlsqrreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_linlsqrreport_owner& _linlsqrreport_owner::operator=(const _linlsqrreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_linlsqrreport_clear(p_struct); + if( !alglib_impl::_linlsqrreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_linlsqrreport_owner::~_linlsqrreport_owner() +{ + alglib_impl::_linlsqrreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::linlsqrreport* _linlsqrreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::linlsqrreport* _linlsqrreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +linlsqrreport::linlsqrreport() : _linlsqrreport_owner() ,iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype) +{ +} + +linlsqrreport::linlsqrreport(const linlsqrreport &rhs):_linlsqrreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype) +{ +} + +linlsqrreport& linlsqrreport::operator=(const linlsqrreport &rhs) +{ + if( this==&rhs ) + return *this; + _linlsqrreport_owner::operator=(rhs); + return *this; +} + +linlsqrreport::~linlsqrreport() +{ +} + +/************************************************************************* +This function initializes linear LSQR Solver. This solver is used to solve +non-symmetric (and, possibly, non-square) problems. Least squares solution +is returned for non-compatible systems. + +USAGE: +1. User initializes algorithm state with LinLSQRCreate() call +2. User tunes solver parameters with LinLSQRSetCond() and other functions +3. User calls LinLSQRSolveSparse() function which takes algorithm state + and SparseMatrix object. +4. User calls LinLSQRResults() to get solution +5. Optionally, user may call LinLSQRSolveSparse() again to solve another + problem with different matrix and/or right part without reinitializing + LinLSQRState structure. + +INPUT PARAMETERS: + M - number of rows in A + N - number of variables, N>0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrcreate(const ae_int_t m, const ae_int_t n, linlsqrstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::linlsqrcreate(m, n, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function changes preconditioning settings of LinLSQQSolveSparse() +function. By default, SolveSparse() uses diagonal preconditioner, but if +you want to use solver without preconditioning, you can call this function +which forces solver to use unit matrix for preconditioning. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetprecunit(const linlsqrstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::linlsqrsetprecunit(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. LinCGSolveSparse() will use diagonal of the system matrix as +preconditioner. This preconditioning mode is active by default. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetprecdiag(const linlsqrstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::linlsqrsetprecdiag(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets optional Tikhonov regularization coefficient. +It is zero by default. + +INPUT PARAMETERS: + LambdaI - regularization factor, LambdaI>=0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetlambdai(const linlsqrstate &state, const double lambdai) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::linlsqrsetlambdai(const_cast(state.c_ptr()), lambdai, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Procedure for solution of A*x=b with sparse A. + +INPUT PARAMETERS: + State - algorithm state + A - sparse M*N matrix in the CRS format (you MUST contvert it + to CRS format by calling SparseConvertToCRS() function + BEFORE you pass it to this function). + B - right part, array[M] + +RESULT: + This function returns no result. + You can get solution by calling LinCGResults() + +NOTE: this function uses lightweight preconditioning - multiplication by + inverse of diag(A). If you want, you can turn preconditioning off by + calling LinLSQRSetPrecUnit(). However, preconditioning cost is low + and preconditioner is very important for solution of badly scaled + problems. + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsolvesparse(const linlsqrstate &state, const sparsematrix &a, const real_1d_array &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::linlsqrsolvesparse(const_cast(state.c_ptr()), const_cast(a.c_ptr()), const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets stopping criteria. + +INPUT PARAMETERS: + EpsA - algorithm will be stopped if ||A^T*Rk||/(||A||*||Rk||)<=EpsA. + EpsB - algorithm will be stopped if ||Rk||<=EpsB*||B|| + MaxIts - algorithm will be stopped if number of iterations + more than MaxIts. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: if EpsA,EpsB,EpsC and MaxIts are zero then these variables will +be setted as default values. + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetcond(const linlsqrstate &state, const double epsa, const double epsb, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::linlsqrsetcond(const_cast(state.c_ptr()), epsa, epsb, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +LSQR solver: results. + +This function must be called after LinLSQRSolve + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[N], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * 1 ||Rk||<=EpsB*||B|| + * 4 ||A^T*Rk||/(||A||*||Rk||)<=EpsA + * 5 MaxIts steps was taken + * 7 rounding errors prevent further progress, + X contains best point found so far. + (sometimes returned on singular systems) + * Rep.IterationsCount contains iterations count + * NMV countains number of matrix-vector calculations + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrresults(const linlsqrstate &state, real_1d_array &x, linlsqrreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::linlsqrresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetxrep(const linlsqrstate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::linlsqrsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This object stores state of the linear CG method. + +You should use ALGLIB functions to work with this object. +Never try to access its fields directly! +*************************************************************************/ +_lincgstate_owner::_lincgstate_owner() +{ + p_struct = (alglib_impl::lincgstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::lincgstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lincgstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lincgstate_owner::_lincgstate_owner(const _lincgstate_owner &rhs) +{ + p_struct = (alglib_impl::lincgstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::lincgstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lincgstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lincgstate_owner& _lincgstate_owner::operator=(const _lincgstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_lincgstate_clear(p_struct); + if( !alglib_impl::_lincgstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_lincgstate_owner::~_lincgstate_owner() +{ + alglib_impl::_lincgstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::lincgstate* _lincgstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::lincgstate* _lincgstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +lincgstate::lincgstate() : _lincgstate_owner() +{ +} + +lincgstate::lincgstate(const lincgstate &rhs):_lincgstate_owner(rhs) +{ +} + +lincgstate& lincgstate::operator=(const lincgstate &rhs) +{ + if( this==&rhs ) + return *this; + _lincgstate_owner::operator=(rhs); + return *this; +} + +lincgstate::~lincgstate() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_lincgreport_owner::_lincgreport_owner() +{ + p_struct = (alglib_impl::lincgreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lincgreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lincgreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lincgreport_owner::_lincgreport_owner(const _lincgreport_owner &rhs) +{ + p_struct = (alglib_impl::lincgreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::lincgreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_lincgreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_lincgreport_owner& _lincgreport_owner::operator=(const _lincgreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_lincgreport_clear(p_struct); + if( !alglib_impl::_lincgreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_lincgreport_owner::~_lincgreport_owner() +{ + alglib_impl::_lincgreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::lincgreport* _lincgreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::lincgreport* _lincgreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +lincgreport::lincgreport() : _lincgreport_owner() ,iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype),r2(p_struct->r2) +{ +} + +lincgreport::lincgreport(const lincgreport &rhs):_lincgreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nmv(p_struct->nmv),terminationtype(p_struct->terminationtype),r2(p_struct->r2) +{ +} + +lincgreport& lincgreport::operator=(const lincgreport &rhs) +{ + if( this==&rhs ) + return *this; + _lincgreport_owner::operator=(rhs); + return *this; +} + +lincgreport::~lincgreport() +{ +} + +/************************************************************************* +This function initializes linear CG Solver. This solver is used to solve +symmetric positive definite problems. If you want to solve nonsymmetric +(or non-positive definite) problem you may use LinLSQR solver provided by +ALGLIB. + +USAGE: +1. User initializes algorithm state with LinCGCreate() call +2. User tunes solver parameters with LinCGSetCond() and other functions +3. Optionally, user sets starting point with LinCGSetStartingPoint() +4. User calls LinCGSolveSparse() function which takes algorithm state and + SparseMatrix object. +5. User calls LinCGResults() to get solution +6. Optionally, user may call LinCGSolveSparse() again to solve another + problem with different matrix and/or right part without reinitializing + LinCGState structure. + +INPUT PARAMETERS: + N - problem dimension, N>0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgcreate(const ae_int_t n, lincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgcreate(n, const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets starting point. +By default, zero starting point is used. + +INPUT PARAMETERS: + X - starting point, array[N] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetstartingpoint(const lincgstate &state, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgsetstartingpoint(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. By default, SolveSparse() uses diagonal preconditioner, but if +you want to use solver without preconditioning, you can call this function +which forces solver to use unit matrix for preconditioning. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void lincgsetprecunit(const lincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgsetprecunit(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. LinCGSolveSparse() will use diagonal of the system matrix as +preconditioner. This preconditioning mode is active by default. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void lincgsetprecdiag(const lincgstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgsetprecdiag(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets stopping criteria. + +INPUT PARAMETERS: + EpsF - algorithm will be stopped if norm of residual is less than + EpsF*||b||. + MaxIts - algorithm will be stopped if number of iterations is more + than MaxIts. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +If both EpsF and MaxIts are zero then small EpsF will be set to small +value. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetcond(const lincgstate &state, const double epsf, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgsetcond(const_cast(state.c_ptr()), epsf, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Procedure for solution of A*x=b with sparse A. + +INPUT PARAMETERS: + State - algorithm state + A - sparse matrix in the CRS format (you MUST contvert it to + CRS format by calling SparseConvertToCRS() function). + IsUpper - whether upper or lower triangle of A is used: + * IsUpper=True => only upper triangle is used and lower + triangle is not referenced at all + * IsUpper=False => only lower triangle is used and upper + triangle is not referenced at all + B - right part, array[N] + +RESULT: + This function returns no result. + You can get solution by calling LinCGResults() + +NOTE: this function uses lightweight preconditioning - multiplication by + inverse of diag(A). If you want, you can turn preconditioning off by + calling LinCGSetPrecUnit(). However, preconditioning cost is low and + preconditioner is very important for solution of badly scaled + problems. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsolvesparse(const lincgstate &state, const sparsematrix &a, const bool isupper, const real_1d_array &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgsolvesparse(const_cast(state.c_ptr()), const_cast(a.c_ptr()), isupper, const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +CG-solver: results. + +This function must be called after LinCGSolve + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[N], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -5 input matrix is either not positive definite, + too large or too small + * -4 overflow/underflow during solution + (ill conditioned problem) + * 1 ||residual||<=EpsF*||b|| + * 5 MaxIts steps was taken + * 7 rounding errors prevent further progress, + best point found is returned + * Rep.IterationsCount contains iterations count + * NMV countains number of matrix-vector calculations + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgresults(const lincgstate &state, real_1d_array &x, lincgreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets restart frequency. By default, algorithm is restarted +after N subsequent iterations. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetrestartfreq(const lincgstate &state, const ae_int_t srf) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgsetrestartfreq(const_cast(state.c_ptr()), srf, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets frequency of residual recalculations. + +Algorithm updates residual r_k using iterative formula, but recalculates +it from scratch after each 10 iterations. It is done to avoid accumulation +of numerical errors and to stop algorithm when r_k starts to grow. + +Such low update frequence (1/10) gives very little overhead, but makes +algorithm a bit more robust against numerical errors. However, you may +change it + +INPUT PARAMETERS: + Freq - desired update frequency, Freq>=0. + Zero value means that no updates will be done. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetrupdatefreq(const lincgstate &state, const ae_int_t freq) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgsetrupdatefreq(const_cast(state.c_ptr()), freq, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetxrep(const lincgstate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::lincgsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +_nleqstate_owner::_nleqstate_owner() +{ + p_struct = (alglib_impl::nleqstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::nleqstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_nleqstate_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_nleqstate_owner::_nleqstate_owner(const _nleqstate_owner &rhs) +{ + p_struct = (alglib_impl::nleqstate*)alglib_impl::ae_malloc(sizeof(alglib_impl::nleqstate), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_nleqstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_nleqstate_owner& _nleqstate_owner::operator=(const _nleqstate_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_nleqstate_clear(p_struct); + if( !alglib_impl::_nleqstate_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_nleqstate_owner::~_nleqstate_owner() +{ + alglib_impl::_nleqstate_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::nleqstate* _nleqstate_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::nleqstate* _nleqstate_owner::c_ptr() const +{ + return const_cast(p_struct); +} +nleqstate::nleqstate() : _nleqstate_owner() ,needf(p_struct->needf),needfij(p_struct->needfij),xupdated(p_struct->xupdated),f(p_struct->f),fi(&p_struct->fi),j(&p_struct->j),x(&p_struct->x) +{ +} + +nleqstate::nleqstate(const nleqstate &rhs):_nleqstate_owner(rhs) ,needf(p_struct->needf),needfij(p_struct->needfij),xupdated(p_struct->xupdated),f(p_struct->f),fi(&p_struct->fi),j(&p_struct->j),x(&p_struct->x) +{ +} + +nleqstate& nleqstate::operator=(const nleqstate &rhs) +{ + if( this==&rhs ) + return *this; + _nleqstate_owner::operator=(rhs); + return *this; +} + +nleqstate::~nleqstate() +{ +} + + +/************************************************************************* + +*************************************************************************/ +_nleqreport_owner::_nleqreport_owner() +{ + p_struct = (alglib_impl::nleqreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::nleqreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_nleqreport_init(p_struct, NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_nleqreport_owner::_nleqreport_owner(const _nleqreport_owner &rhs) +{ + p_struct = (alglib_impl::nleqreport*)alglib_impl::ae_malloc(sizeof(alglib_impl::nleqreport), NULL); + if( p_struct==NULL ) + throw ap_error("ALGLIB: malloc error"); + if( !alglib_impl::_nleqreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); +} + +_nleqreport_owner& _nleqreport_owner::operator=(const _nleqreport_owner &rhs) +{ + if( this==&rhs ) + return *this; + alglib_impl::_nleqreport_clear(p_struct); + if( !alglib_impl::_nleqreport_init_copy(p_struct, const_cast(rhs.p_struct), NULL, ae_false) ) + throw ap_error("ALGLIB: malloc error"); + return *this; +} + +_nleqreport_owner::~_nleqreport_owner() +{ + alglib_impl::_nleqreport_clear(p_struct); + ae_free(p_struct); +} + +alglib_impl::nleqreport* _nleqreport_owner::c_ptr() +{ + return p_struct; +} + +alglib_impl::nleqreport* _nleqreport_owner::c_ptr() const +{ + return const_cast(p_struct); +} +nleqreport::nleqreport() : _nleqreport_owner() ,iterationscount(p_struct->iterationscount),nfunc(p_struct->nfunc),njac(p_struct->njac),terminationtype(p_struct->terminationtype) +{ +} + +nleqreport::nleqreport(const nleqreport &rhs):_nleqreport_owner(rhs) ,iterationscount(p_struct->iterationscount),nfunc(p_struct->nfunc),njac(p_struct->njac),terminationtype(p_struct->terminationtype) +{ +} + +nleqreport& nleqreport::operator=(const nleqreport &rhs) +{ + if( this==&rhs ) + return *this; + _nleqreport_owner::operator=(rhs); + return *this; +} + +nleqreport::~nleqreport() +{ +} + +/************************************************************************* + LEVENBERG-MARQUARDT-LIKE NONLINEAR SOLVER + +DESCRIPTION: +This algorithm solves system of nonlinear equations + F[0](x[0], ..., x[n-1]) = 0 + F[1](x[0], ..., x[n-1]) = 0 + ... + F[M-1](x[0], ..., x[n-1]) = 0 +with M/N do not necessarily coincide. Algorithm converges quadratically +under following conditions: + * the solution set XS is nonempty + * for some xs in XS there exist such neighbourhood N(xs) that: + * vector function F(x) and its Jacobian J(x) are continuously + differentiable on N + * ||F(x)|| provides local error bound on N, i.e. there exists such + c1, that ||F(x)||>c1*distance(x,XS) +Note that these conditions are much more weaker than usual non-singularity +conditions. For example, algorithm will converge for any affine function +F (whether its Jacobian singular or not). + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function vector F[] and Jacobian matrix at given point X +* value of merit function f(x)=F[0]^2(x)+...+F[M-1]^2(x) at given point X + + +USAGE: +1. User initializes algorithm state with NLEQCreateLM() call +2. User tunes solver parameters with NLEQSetCond(), NLEQSetStpMax() and + other functions +3. User calls NLEQSolve() function which takes algorithm state and + pointers (delegates, etc.) to callback functions which calculate merit + function value and Jacobian. +4. User calls NLEQResults() to get solution +5. Optionally, user may call NLEQRestartFrom() to solve another problem + with same parameters (N/M) but another starting point and/or another + function vector. NLEQRestartFrom() allows to reuse already initialized + structure. + + +INPUT PARAMETERS: + N - space dimension, N>1: + * if provided, only leading N elements of X are used + * if not provided, determined automatically from size of X + M - system size + X - starting point + + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + +NOTES: +1. you may tune stopping conditions with NLEQSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use NLEQSetStpMax() function to bound algorithm's steps. +3. this algorithm is a slightly modified implementation of the method + described in 'Levenberg-Marquardt method for constrained nonlinear + equations with strong local convergence properties' by Christian Kanzow + Nobuo Yamashita and Masao Fukushima and further developed in 'On the + convergence of a New Levenberg-Marquardt Method' by Jin-yan Fan and + Ya-Xiang Yuan. + + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqcreatelm(const ae_int_t n, const ae_int_t m, const real_1d_array &x, nleqstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::nleqcreatelm(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + LEVENBERG-MARQUARDT-LIKE NONLINEAR SOLVER + +DESCRIPTION: +This algorithm solves system of nonlinear equations + F[0](x[0], ..., x[n-1]) = 0 + F[1](x[0], ..., x[n-1]) = 0 + ... + F[M-1](x[0], ..., x[n-1]) = 0 +with M/N do not necessarily coincide. Algorithm converges quadratically +under following conditions: + * the solution set XS is nonempty + * for some xs in XS there exist such neighbourhood N(xs) that: + * vector function F(x) and its Jacobian J(x) are continuously + differentiable on N + * ||F(x)|| provides local error bound on N, i.e. there exists such + c1, that ||F(x)||>c1*distance(x,XS) +Note that these conditions are much more weaker than usual non-singularity +conditions. For example, algorithm will converge for any affine function +F (whether its Jacobian singular or not). + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function vector F[] and Jacobian matrix at given point X +* value of merit function f(x)=F[0]^2(x)+...+F[M-1]^2(x) at given point X + + +USAGE: +1. User initializes algorithm state with NLEQCreateLM() call +2. User tunes solver parameters with NLEQSetCond(), NLEQSetStpMax() and + other functions +3. User calls NLEQSolve() function which takes algorithm state and + pointers (delegates, etc.) to callback functions which calculate merit + function value and Jacobian. +4. User calls NLEQResults() to get solution +5. Optionally, user may call NLEQRestartFrom() to solve another problem + with same parameters (N/M) but another starting point and/or another + function vector. NLEQRestartFrom() allows to reuse already initialized + structure. + + +INPUT PARAMETERS: + N - space dimension, N>1: + * if provided, only leading N elements of X are used + * if not provided, determined automatically from size of X + M - system size + X - starting point + + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + +NOTES: +1. you may tune stopping conditions with NLEQSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use NLEQSetStpMax() function to bound algorithm's steps. +3. this algorithm is a slightly modified implementation of the method + described in 'Levenberg-Marquardt method for constrained nonlinear + equations with strong local convergence properties' by Christian Kanzow + Nobuo Yamashita and Masao Fukushima and further developed in 'On the + convergence of a New Levenberg-Marquardt Method' by Jin-yan Fan and + Ya-Xiang Yuan. + + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqcreatelm(const ae_int_t m, const real_1d_array &x, nleqstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::nleqcreatelm(n, m, const_cast(x.c_ptr()), const_cast(state.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets stopping conditions for the nonlinear solver + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsF - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition ||F||<=EpsF is satisfied + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsF=0 and MaxIts=0 simultaneously will lead to automatic +stopping criterion selection (small EpsF). + +NOTES: + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetcond(const nleqstate &state, const double epsf, const ae_int_t maxits) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::nleqsetcond(const_cast(state.c_ptr()), epsf, maxits, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to NLEQSolve(). + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetxrep(const nleqstate &state, const bool needxrep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::nleqsetxrep(const_cast(state.c_ptr()), needxrep, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when target function contains exp() or other fast +growing functions, and algorithm makes too large steps which lead to +overflow. This function allows us to reject steps that are too large (and +therefore expose us to the possible overflow) without actually calculating +function value at the x+stp*d. + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetstpmax(const nleqstate &state, const double stpmax) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::nleqsetstpmax(const_cast(state.c_ptr()), stpmax, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool nleqiteration(const nleqstate &state) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + ae_bool result = alglib_impl::nleqiteration(const_cast(state.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void nleqsolve(nleqstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr), + void *ptr) +{ + alglib_impl::ae_state _alglib_env_state; + if( func==NULL ) + throw ap_error("ALGLIB: error in 'nleqsolve()' (func is NULL)"); + if( jac==NULL ) + throw ap_error("ALGLIB: error in 'nleqsolve()' (jac is NULL)"); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + while( alglib_impl::nleqiteration(state.c_ptr(), &_alglib_env_state) ) + { + if( state.needf ) + { + func(state.x, state.f, ptr); + continue; + } + if( state.needfij ) + { + jac(state.x, state.fi, state.j, ptr); + continue; + } + if( state.xupdated ) + { + if( rep!=NULL ) + rep(state.x, state.f, ptr); + continue; + } + throw ap_error("ALGLIB: error in 'nleqsolve' (some derivatives were not provided?)"); + } + alglib_impl::ae_state_clear(&_alglib_env_state); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + + +/************************************************************************* +NLEQ solver results + +INPUT PARAMETERS: + State - algorithm state. + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -4 ERROR: algorithm has converged to the + stationary point Xf which is local minimum of + f=F[0]^2+...+F[m-1]^2, but is not solution of + nonlinear system. + * 1 sqrt(f)<=EpsF. + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + * ActiveConstraints contains number of active constraints + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqresults(const nleqstate &state, real_1d_array &x, nleqreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::nleqresults(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +NLEQ solver results + +Buffered implementation of NLEQResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqresultsbuf(const nleqstate &state, real_1d_array &x, nleqreport &rep) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::nleqresultsbuf(const_cast(state.c_ptr()), const_cast(x.c_ptr()), const_cast(rep.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +This subroutine restarts CG algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used for reverse communication previously + allocated with MinCGCreate call. + X - new starting point. + BndL - new lower bounds + BndU - new upper bounds + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqrestartfrom(const nleqstate &state, const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::nleqrestartfrom(const_cast(state.c_ptr()), const_cast(x.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +static void densesolver_rmatrixlusolveinternal(/* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + double scalea, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_bool havea, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state); +static void densesolver_spdmatrixcholeskysolveinternal(/* Real */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_matrix* a, + ae_bool havea, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state); +static void densesolver_cmatrixlusolveinternal(/* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + double scalea, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_bool havea, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state); +static void densesolver_hpdmatrixcholeskysolveinternal(/* Complex */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_matrix* a, + ae_bool havea, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state); +static ae_int_t densesolver_densesolverrfsmax(ae_int_t n, + double r1, + double rinf, + ae_state *_state); +static ae_int_t densesolver_densesolverrfsmaxv2(ae_int_t n, + double r2, + ae_state *_state); +static void densesolver_rbasiclusolve(/* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + double scalea, + ae_int_t n, + /* Real */ ae_vector* xb, + /* Real */ ae_vector* tmp, + ae_state *_state); +static void densesolver_spdbasiccholeskysolve(/* Real */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* xb, + /* Real */ ae_vector* tmp, + ae_state *_state); +static void densesolver_cbasiclusolve(/* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + double scalea, + ae_int_t n, + /* Complex */ ae_vector* xb, + /* Complex */ ae_vector* tmp, + ae_state *_state); +static void densesolver_hpdbasiccholeskysolve(/* Complex */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* xb, + /* Complex */ ae_vector* tmp, + ae_state *_state); + + +static double linlsqr_atol = 1.0E-6; +static double linlsqr_btol = 1.0E-6; +static void linlsqr_clearrfields(linlsqrstate* state, ae_state *_state); + + +static double lincg_defaultprecision = 1.0E-6; +static void lincg_clearrfields(lincgstate* state, ae_state *_state); +static void lincg_updateitersdata(lincgstate* state, ae_state *_state); + + +static void nleq_clearrequestfields(nleqstate* state, ae_state *_state); +static ae_bool nleq_increaselambda(double* lambdav, + double* nu, + double lambdaup, + ae_state *_state); +static void nleq_decreaselambda(double* lambdav, + double* nu, + double lambdadown, + ae_state *_state); + + + + + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*x=b, where A is NxN non-denegerate +real matrix, x and b are vectors. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - return code: + * -3 A is singular, or VERY close to singular. + X is filled by zeros in such cases. + * -1 N<=0 was passed + * 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 + X - array[0..N-1], it contains: + * solution of A*x=b if A is non-singular (well-conditioned + or ill-conditioned, but not very close to singular) + * zeros, if A is singular or VERY close to singular + (in this case Info=-3). + +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. + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolve(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + rmatrixsolvem(a, n, &bm, 1, ae_true, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. + +Similar to RMatrixSolve() but solves task with multiple right parts (where +b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* optional iterative refinement +* O(N^3+M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + RFS - iterative refinement switch: + * True - refinement is used. + Less performance, more precision. + * False - refinement is not used. + More performance, less precision. + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolvem(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_bool rfs, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix da; + ae_matrix emptya; + ae_vector p; + double scalea; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_matrix_init(&da, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&emptya, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&da, n, n, _state); + + /* + * 1. scale matrix, max(|A[i,j]|) + * 2. factorize scaled matrix + * 3. solve + */ + scalea = 0; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + scalea = ae_maxreal(scalea, ae_fabs(a->ptr.pp_double[i][j], _state), _state); + } + } + if( ae_fp_eq(scalea,0) ) + { + scalea = 1; + } + scalea = 1/scalea; + for(i=0; i<=n-1; i++) + { + ae_v_move(&da.ptr.pp_double[i][0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1)); + } + rmatrixlu(&da, n, n, &p, _state); + if( rfs ) + { + densesolver_rmatrixlusolveinternal(&da, &p, scalea, n, a, ae_true, b, m, info, rep, x, _state); + } + else + { + densesolver_rmatrixlusolveinternal(&da, &p, scalea, n, &emptya, ae_false, b, m, info, rep, x, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*X=B, where A is NxN non-denegerate +real matrix given by its LU decomposition, X and B are NxM real matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixlusolve(/* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + rmatrixlusolvem(lua, p, n, &bm, 1, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. + +Similar to RMatrixLUSolve() but solves task with multiple right parts +(where b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixlusolvem(/* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix emptya; + ae_int_t i; + ae_int_t j; + double scalea; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_matrix_init(&emptya, 0, 0, DT_REAL, _state, ae_true); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + + /* + * 1. scale matrix, max(|U[i,j]|) + * we assume that LU is in its normal form, i.e. |L[i,j]|<=1 + * 2. solve + */ + scalea = 0; + for(i=0; i<=n-1; i++) + { + for(j=i; j<=n-1; j++) + { + scalea = ae_maxreal(scalea, ae_fabs(lua->ptr.pp_double[i][j], _state), _state); + } + } + if( ae_fp_eq(scalea,0) ) + { + scalea = 1; + } + scalea = 1/scalea; + densesolver_rmatrixlusolveinternal(lua, p, scalea, n, &emptya, ae_false, b, m, info, rep, x, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*x=b, where BOTH ORIGINAL A AND ITS +LU DECOMPOSITION ARE KNOWN. You can use it if for some reasons you have +both A and its LU decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixmixedsolve(/* Real */ ae_matrix* a, + /* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + rmatrixmixedsolvem(a, lua, p, n, &bm, 1, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. + +Similar to RMatrixMixedSolve() but solves task with multiple right parts +(where b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixmixedsolvem(/* Real */ ae_matrix* a, + /* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + double scalea; + ae_int_t i; + ae_int_t j; + + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + return; + } + + /* + * 1. scale matrix, max(|A[i,j]|) + * 2. factorize scaled matrix + * 3. solve + */ + scalea = 0; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + scalea = ae_maxreal(scalea, ae_fabs(a->ptr.pp_double[i][j], _state), _state); + } + } + if( ae_fp_eq(scalea,0) ) + { + scalea = 1; + } + scalea = 1/scalea; + densesolver_rmatrixlusolveinternal(lua, p, scalea, n, a, ae_true, b, m, info, rep, x, _state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3+M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + RFS - iterative refinement switch: + * True - refinement is used. + Less performance, more precision. + * False - refinement is not used. + More performance, less precision. + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixsolvem(/* Complex */ ae_matrix* a, + ae_int_t n, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_bool rfs, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix da; + ae_matrix emptya; + ae_vector p; + double scalea; + ae_int_t i; + ae_int_t j; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_matrix_init(&da, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&emptya, 0, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&p, 0, DT_INT, _state, ae_true); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&da, n, n, _state); + + /* + * 1. scale matrix, max(|A[i,j]|) + * 2. factorize scaled matrix + * 3. solve + */ + scalea = 0; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + scalea = ae_maxreal(scalea, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); + } + } + if( ae_fp_eq(scalea,0) ) + { + scalea = 1; + } + scalea = 1/scalea; + for(i=0; i<=n-1; i++) + { + ae_v_cmove(&da.ptr.pp_complex[i][0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,n-1)); + } + cmatrixlu(&da, n, n, &p, _state); + if( rfs ) + { + densesolver_cmatrixlusolveinternal(&da, &p, scalea, n, a, ae_true, b, m, info, rep, x, _state); + } + else + { + densesolver_cmatrixlusolveinternal(&da, &p, scalea, n, &emptya, ae_false, b, m, info, rep, x, _state); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixsolve(/* Complex */ ae_matrix* a, + ae_int_t n, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); + cmatrixsolvem(a, n, &bm, 1, ae_true, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixlusolvem(/* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix emptya; + ae_int_t i; + ae_int_t j; + double scalea; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_matrix_init(&emptya, 0, 0, DT_COMPLEX, _state, ae_true); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + + /* + * 1. scale matrix, max(|U[i,j]|) + * we assume that LU is in its normal form, i.e. |L[i,j]|<=1 + * 2. solve + */ + scalea = 0; + for(i=0; i<=n-1; i++) + { + for(j=i; j<=n-1; j++) + { + scalea = ae_maxreal(scalea, ae_c_abs(lua->ptr.pp_complex[i][j], _state), _state); + } + } + if( ae_fp_eq(scalea,0) ) + { + scalea = 1; + } + scalea = 1/scalea; + densesolver_cmatrixlusolveinternal(lua, p, scalea, n, &emptya, ae_false, b, m, info, rep, x, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixlusolve(/* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); + cmatrixlusolvem(lua, p, n, &bm, 1, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixMixedSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixmixedsolvem(/* Complex */ ae_matrix* a, + /* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state) +{ + double scalea; + ae_int_t i; + ae_int_t j; + + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + return; + } + + /* + * 1. scale matrix, max(|A[i,j]|) + * 2. factorize scaled matrix + * 3. solve + */ + scalea = 0; + for(i=0; i<=n-1; i++) + { + for(j=0; j<=n-1; j++) + { + scalea = ae_maxreal(scalea, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); + } + } + if( ae_fp_eq(scalea,0) ) + { + scalea = 1; + } + scalea = 1/scalea; + densesolver_cmatrixlusolveinternal(lua, p, scalea, n, a, ae_true, b, m, info, rep, x, _state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixMixedSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixmixedsolve(/* Complex */ ae_matrix* a, + /* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); + cmatrixmixedsolvem(a, lua, p, n, &bm, 1, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for symmetric positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3+M*N^2) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve. + Returns -3 for non-SPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixsolvem(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix da; + double sqrtscalea; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_matrix_init(&da, 0, 0, DT_REAL, _state, ae_true); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&da, n, n, _state); + + /* + * 1. scale matrix, max(|A[i,j]|) + * 2. factorize scaled matrix + * 3. solve + */ + sqrtscalea = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + sqrtscalea = ae_maxreal(sqrtscalea, ae_fabs(a->ptr.pp_double[i][j], _state), _state); + } + } + if( ae_fp_eq(sqrtscalea,0) ) + { + sqrtscalea = 1; + } + sqrtscalea = 1/sqrtscalea; + sqrtscalea = ae_sqrt(sqrtscalea, _state); + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + ae_v_move(&da.ptr.pp_double[i][j1], 1, &a->ptr.pp_double[i][j1], 1, ae_v_len(j1,j2)); + } + if( !spdmatrixcholesky(&da, n, isupper, _state) ) + { + ae_matrix_set_length(x, n, m, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=m-1; j++) + { + x->ptr.pp_double[i][j] = 0; + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + *info = 1; + densesolver_spdmatrixcholeskysolveinternal(&da, sqrtscalea, n, isupper, a, ae_true, b, m, info, rep, x, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for SPD matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Returns -3 for non-SPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixsolve(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + spdmatrixsolvem(a, n, isupper, &bm, 1, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for SPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of CHA + IsUpper - what half of CHA is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskysolvem(/* Real */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix emptya; + double sqrtscalea; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_matrix_init(&emptya, 0, 0, DT_REAL, _state, ae_true); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + + /* + * 1. scale matrix, max(|U[i,j]|) + * 2. factorize scaled matrix + * 3. solve + */ + sqrtscalea = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + sqrtscalea = ae_maxreal(sqrtscalea, ae_fabs(cha->ptr.pp_double[i][j], _state), _state); + } + } + if( ae_fp_eq(sqrtscalea,0) ) + { + sqrtscalea = 1; + } + sqrtscalea = 1/sqrtscalea; + densesolver_spdmatrixcholeskysolveinternal(cha, sqrtscalea, n, isupper, &emptya, ae_false, b, m, info, rep, x, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for SPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of A + IsUpper - what half of CHA is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskysolve(/* Real */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_REAL, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_move(&bm.ptr.pp_double[0][0], bm.stride, &b->ptr.p_double[0], 1, ae_v_len(0,n-1)); + spdmatrixcholeskysolvem(cha, n, isupper, &bm, 1, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_move(&x->ptr.p_double[0], 1, &xm.ptr.pp_double[0][0], xm.stride, ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for Hermitian positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3+M*N^2) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve. + Returns -3 for non-HPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixsolvem(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix da; + double sqrtscalea; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_matrix_init(&da, 0, 0, DT_COMPLEX, _state, ae_true); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&da, n, n, _state); + + /* + * 1. scale matrix, max(|A[i,j]|) + * 2. factorize scaled matrix + * 3. solve + */ + sqrtscalea = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + sqrtscalea = ae_maxreal(sqrtscalea, ae_c_abs(a->ptr.pp_complex[i][j], _state), _state); + } + } + if( ae_fp_eq(sqrtscalea,0) ) + { + sqrtscalea = 1; + } + sqrtscalea = 1/sqrtscalea; + sqrtscalea = ae_sqrt(sqrtscalea, _state); + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + ae_v_cmove(&da.ptr.pp_complex[i][j1], 1, &a->ptr.pp_complex[i][j1], 1, "N", ae_v_len(j1,j2)); + } + if( !hpdmatrixcholesky(&da, n, isupper, _state) ) + { + ae_matrix_set_length(x, n, m, _state); + for(i=0; i<=n-1; i++) + { + for(j=0; j<=m-1; j++) + { + x->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + *info = 1; + densesolver_hpdmatrixcholeskysolveinternal(&da, sqrtscalea, n, isupper, a, ae_true, b, m, info, rep, x, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for Hermitian positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Returns -3 for non-HPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixsolve(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); + hpdmatrixsolvem(a, n, isupper, &bm, 1, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for HPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + HPDMatrixCholesky result + N - size of CHA + IsUpper - what half of CHA is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskysolvem(/* Complex */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix emptya; + double sqrtscalea; + ae_int_t i; + ae_int_t j; + ae_int_t j1; + ae_int_t j2; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_matrix_init(&emptya, 0, 0, DT_COMPLEX, _state, ae_true); + + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + + /* + * 1. scale matrix, max(|U[i,j]|) + * 2. factorize scaled matrix + * 3. solve + */ + sqrtscalea = 0; + for(i=0; i<=n-1; i++) + { + if( isupper ) + { + j1 = i; + j2 = n-1; + } + else + { + j1 = 0; + j2 = i; + } + for(j=j1; j<=j2; j++) + { + sqrtscalea = ae_maxreal(sqrtscalea, ae_c_abs(cha->ptr.pp_complex[i][j], _state), _state); + } + } + if( ae_fp_eq(sqrtscalea,0) ) + { + sqrtscalea = 1; + } + sqrtscalea = 1/sqrtscalea; + densesolver_hpdmatrixcholeskysolveinternal(cha, sqrtscalea, n, isupper, &emptya, ae_false, b, m, info, rep, x, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for HPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of A + IsUpper - what half of CHA is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskysolve(/* Complex */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix bm; + ae_matrix xm; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_vector_clear(x); + ae_matrix_init(&bm, 0, 0, DT_COMPLEX, _state, ae_true); + ae_matrix_init(&xm, 0, 0, DT_COMPLEX, _state, ae_true); + + if( n<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(&bm, n, 1, _state); + ae_v_cmove(&bm.ptr.pp_complex[0][0], bm.stride, &b->ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); + hpdmatrixcholeskysolvem(cha, n, isupper, &bm, 1, info, rep, &xm, _state); + ae_vector_set_length(x, n, _state); + ae_v_cmove(&x->ptr.p_complex[0], 1, &xm.ptr.pp_complex[0][0], xm.stride, "N", ae_v_len(0,n-1)); + ae_frame_leave(_state); +} + + +/************************************************************************* +Dense solver. + +This subroutine finds solution of the linear system A*X=B with non-square, +possibly degenerate A. System is solved in the least squares sense, and +general least squares solution X = X0 + CX*y which minimizes |A*X-B| is +returned. If A is non-degenerate, solution in the usual sense is returned. + +Algorithm features: +* automatic detection (and correct handling!) of degenerate cases +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..NRows-1,0..NCols-1], system matrix + NRows - vertical size of A + NCols - horizontal size of A + B - array[0..NCols-1], right part + Threshold- a number in [0,1]. Singular values beyond Threshold are + considered zero. Set it to 0.0, if you don't understand + what it means, so the solver will choose good value on its + own. + +OUTPUT PARAMETERS + Info - return code: + * -4 SVD subroutine failed + * -1 if NRows<=0 or NCols<=0 or Threshold<0 was passed + * 1 if task is solved + Rep - solver report, see below for more info + X - array[0..N-1,0..M-1], it contains: + * solution of A*X=B (even for singular A) + * zeros, if SVD subroutine failed + +SOLVER REPORT + +Subroutine sets following fields of the Rep structure: +* R2 reciprocal of condition number: 1/cond(A), 2-norm. +* N = NCols +* K dim(Null(A)) +* CX array[0..N-1,0..K-1], kernel of A. + Columns of CX store such vectors that A*CX[i]=0. + + -- ALGLIB -- + Copyright 24.08.2009 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolvels(/* Real */ ae_matrix* a, + ae_int_t nrows, + ae_int_t ncols, + /* Real */ ae_vector* b, + double threshold, + ae_int_t* info, + densesolverlsreport* rep, + /* Real */ ae_vector* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector sv; + ae_matrix u; + ae_matrix vt; + ae_vector rp; + ae_vector utb; + ae_vector sutb; + ae_vector tmp; + ae_vector ta; + ae_vector tx; + ae_vector buf; + ae_vector w; + ae_int_t i; + ae_int_t j; + ae_int_t nsv; + ae_int_t kernelidx; + double v; + double verr; + ae_bool svdfailed; + ae_bool zeroa; + ae_int_t rfs; + ae_int_t nrfs; + ae_bool terminatenexttime; + ae_bool smallerr; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverlsreport_clear(rep); + ae_vector_clear(x); + ae_vector_init(&sv, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&u, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&vt, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&rp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&utb, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sutb, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + ae_vector_init(&ta, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&w, 0, DT_REAL, _state, ae_true); + + if( (nrows<=0||ncols<=0)||ae_fp_less(threshold,0) ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + if( ae_fp_eq(threshold,0) ) + { + threshold = 1000*ae_machineepsilon; + } + + /* + * Factorize A first + */ + svdfailed = !rmatrixsvd(a, nrows, ncols, 1, 2, 2, &sv, &u, &vt, _state); + zeroa = ae_fp_eq(sv.ptr.p_double[0],0); + if( svdfailed||zeroa ) + { + if( svdfailed ) + { + *info = -4; + } + else + { + *info = 1; + } + ae_vector_set_length(x, ncols, _state); + for(i=0; i<=ncols-1; i++) + { + x->ptr.p_double[i] = 0; + } + rep->n = ncols; + rep->k = ncols; + ae_matrix_set_length(&rep->cx, ncols, ncols, _state); + for(i=0; i<=ncols-1; i++) + { + for(j=0; j<=ncols-1; j++) + { + if( i==j ) + { + rep->cx.ptr.pp_double[i][j] = 1; + } + else + { + rep->cx.ptr.pp_double[i][j] = 0; + } + } + } + rep->r2 = 0; + ae_frame_leave(_state); + return; + } + nsv = ae_minint(ncols, nrows, _state); + if( nsv==ncols ) + { + rep->r2 = sv.ptr.p_double[nsv-1]/sv.ptr.p_double[0]; + } + else + { + rep->r2 = 0; + } + rep->n = ncols; + *info = 1; + + /* + * Iterative refinement of xc combined with solution: + * 1. xc = 0 + * 2. calculate r = bc-A*xc using extra-precise dot product + * 3. solve A*y = r + * 4. update x:=x+r + * 5. goto 2 + * + * This cycle is executed until one of two things happens: + * 1. maximum number of iterations reached + * 2. last iteration decreased error to the lower limit + */ + ae_vector_set_length(&utb, nsv, _state); + ae_vector_set_length(&sutb, nsv, _state); + ae_vector_set_length(x, ncols, _state); + ae_vector_set_length(&tmp, ncols, _state); + ae_vector_set_length(&ta, ncols+1, _state); + ae_vector_set_length(&tx, ncols+1, _state); + ae_vector_set_length(&buf, ncols+1, _state); + for(i=0; i<=ncols-1; i++) + { + x->ptr.p_double[i] = 0; + } + kernelidx = nsv; + for(i=0; i<=nsv-1; i++) + { + if( ae_fp_less_eq(sv.ptr.p_double[i],threshold*sv.ptr.p_double[0]) ) + { + kernelidx = i; + break; + } + } + rep->k = ncols-kernelidx; + nrfs = densesolver_densesolverrfsmaxv2(ncols, rep->r2, _state); + terminatenexttime = ae_false; + ae_vector_set_length(&rp, nrows, _state); + for(rfs=0; rfs<=nrfs; rfs++) + { + if( terminatenexttime ) + { + break; + } + + /* + * calculate right part + */ + if( rfs==0 ) + { + ae_v_move(&rp.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,nrows-1)); + } + else + { + smallerr = ae_true; + for(i=0; i<=nrows-1; i++) + { + ae_v_move(&ta.ptr.p_double[0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,ncols-1)); + ta.ptr.p_double[ncols] = -1; + ae_v_move(&tx.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,ncols-1)); + tx.ptr.p_double[ncols] = b->ptr.p_double[i]; + xdot(&ta, &tx, ncols+1, &buf, &v, &verr, _state); + rp.ptr.p_double[i] = -v; + smallerr = smallerr&&ae_fp_less(ae_fabs(v, _state),4*verr); + } + if( smallerr ) + { + terminatenexttime = ae_true; + } + } + + /* + * solve A*dx = rp + */ + for(i=0; i<=ncols-1; i++) + { + tmp.ptr.p_double[i] = 0; + } + for(i=0; i<=nsv-1; i++) + { + utb.ptr.p_double[i] = 0; + } + for(i=0; i<=nrows-1; i++) + { + v = rp.ptr.p_double[i]; + ae_v_addd(&utb.ptr.p_double[0], 1, &u.ptr.pp_double[i][0], 1, ae_v_len(0,nsv-1), v); + } + for(i=0; i<=nsv-1; i++) + { + if( iptr.p_double[0], 1, &tmp.ptr.p_double[0], 1, ae_v_len(0,ncols-1)); + } + + /* + * fill CX + */ + if( rep->k>0 ) + { + ae_matrix_set_length(&rep->cx, ncols, rep->k, _state); + for(i=0; i<=rep->k-1; i++) + { + ae_v_move(&rep->cx.ptr.pp_double[0][i], rep->cx.stride, &vt.ptr.pp_double[kernelidx+i][0], 1, ae_v_len(0,ncols-1)); + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal LU solver + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static void densesolver_rmatrixlusolveinternal(/* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + double scalea, + ae_int_t n, + /* Real */ ae_matrix* a, + ae_bool havea, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t rfs; + ae_int_t nrfs; + ae_vector xc; + ae_vector y; + ae_vector bc; + ae_vector xa; + ae_vector xb; + ae_vector tx; + double v; + double verr; + double mxb; + double scaleright; + ae_bool smallerr; + ae_bool terminatenexttime; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xa, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xb, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tx, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_fp_greater(scalea,0), "Assertion failed", _state); + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=n-1; i++) + { + if( p->ptr.p_int[i]>n-1||p->ptr.p_int[i]r1 = rmatrixlurcond1(lua, n, _state); + rep->rinf = rmatrixlurcondinf(lua, n, _state); + if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=m-1; j++) + { + x->ptr.pp_double[i][j] = 0; + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * solve + */ + for(k=0; k<=m-1; k++) + { + + /* + * copy B to contiguous storage + */ + ae_v_move(&bc.ptr.p_double[0], 1, &b->ptr.pp_double[0][k], b->stride, ae_v_len(0,n-1)); + + /* + * Scale right part: + * * MX stores max(|Bi|) + * * ScaleRight stores actual scaling applied to B when solving systems + * it is chosen to make |scaleRight*b| close to 1. + */ + mxb = 0; + for(i=0; i<=n-1; i++) + { + mxb = ae_maxreal(mxb, ae_fabs(bc.ptr.p_double[i], _state), _state); + } + if( ae_fp_eq(mxb,0) ) + { + mxb = 1; + } + scaleright = 1/mxb; + + /* + * First, non-iterative part of solution process. + * We use separate code for this task because + * XDot is quite slow and we want to save time. + */ + ae_v_moved(&xc.ptr.p_double[0], 1, &bc.ptr.p_double[0], 1, ae_v_len(0,n-1), scaleright); + densesolver_rbasiclusolve(lua, p, scalea, n, &xc, &tx, _state); + + /* + * Iterative refinement of xc: + * * calculate r = bc-A*xc using extra-precise dot product + * * solve A*y = r + * * update x:=x+r + * + * This cycle is executed until one of two things happens: + * 1. maximum number of iterations reached + * 2. last iteration decreased error to the lower limit + */ + if( havea ) + { + nrfs = densesolver_densesolverrfsmax(n, rep->r1, rep->rinf, _state); + terminatenexttime = ae_false; + for(rfs=0; rfs<=nrfs-1; rfs++) + { + if( terminatenexttime ) + { + break; + } + + /* + * generate right part + */ + smallerr = ae_true; + ae_v_move(&xb.ptr.p_double[0], 1, &xc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + ae_v_moved(&xa.ptr.p_double[0], 1, &a->ptr.pp_double[i][0], 1, ae_v_len(0,n-1), scalea); + xa.ptr.p_double[n] = -1; + xb.ptr.p_double[n] = scaleright*bc.ptr.p_double[i]; + xdot(&xa, &xb, n+1, &tx, &v, &verr, _state); + y.ptr.p_double[i] = -v; + smallerr = smallerr&&ae_fp_less(ae_fabs(v, _state),4*verr); + } + if( smallerr ) + { + terminatenexttime = ae_true; + } + + /* + * solve and update + */ + densesolver_rbasiclusolve(lua, p, scalea, n, &y, &tx, _state); + ae_v_add(&xc.ptr.p_double[0], 1, &y.ptr.p_double[0], 1, ae_v_len(0,n-1)); + } + } + + /* + * Store xc. + * Post-scale result. + */ + v = scalea*mxb; + ae_v_moved(&x->ptr.pp_double[0][k], x->stride, &xc.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal Cholesky solver + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static void densesolver_spdmatrixcholeskysolveinternal(/* Real */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_matrix* a, + ae_bool havea, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_vector xc; + ae_vector y; + ae_vector bc; + ae_vector xa; + ae_vector xb; + ae_vector tx; + double v; + double mxb; + double scaleright; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_vector_init(&xc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y, 0, DT_REAL, _state, ae_true); + ae_vector_init(&bc, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xa, 0, DT_REAL, _state, ae_true); + ae_vector_init(&xb, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tx, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_fp_greater(sqrtscalea,0), "Assertion failed", _state); + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(x, n, m, _state); + ae_vector_set_length(&y, n, _state); + ae_vector_set_length(&xc, n, _state); + ae_vector_set_length(&bc, n, _state); + ae_vector_set_length(&tx, n+1, _state); + ae_vector_set_length(&xa, n+1, _state); + ae_vector_set_length(&xb, n+1, _state); + + /* + * estimate condition number, test for near singularity + */ + rep->r1 = spdmatrixcholeskyrcond(cha, n, isupper, _state); + rep->rinf = rep->r1; + if( ae_fp_less(rep->r1,rcondthreshold(_state)) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=m-1; j++) + { + x->ptr.pp_double[i][j] = 0; + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * solve + */ + for(k=0; k<=m-1; k++) + { + + /* + * copy B to contiguous storage + */ + ae_v_move(&bc.ptr.p_double[0], 1, &b->ptr.pp_double[0][k], b->stride, ae_v_len(0,n-1)); + + /* + * Scale right part: + * * MX stores max(|Bi|) + * * ScaleRight stores actual scaling applied to B when solving systems + * it is chosen to make |scaleRight*b| close to 1. + */ + mxb = 0; + for(i=0; i<=n-1; i++) + { + mxb = ae_maxreal(mxb, ae_fabs(bc.ptr.p_double[i], _state), _state); + } + if( ae_fp_eq(mxb,0) ) + { + mxb = 1; + } + scaleright = 1/mxb; + + /* + * First, non-iterative part of solution process. + * We use separate code for this task because + * XDot is quite slow and we want to save time. + */ + ae_v_moved(&xc.ptr.p_double[0], 1, &bc.ptr.p_double[0], 1, ae_v_len(0,n-1), scaleright); + densesolver_spdbasiccholeskysolve(cha, sqrtscalea, n, isupper, &xc, &tx, _state); + + /* + * Store xc. + * Post-scale result. + */ + v = ae_sqr(sqrtscalea, _state)*mxb; + ae_v_moved(&x->ptr.pp_double[0][k], x->stride, &xc.ptr.p_double[0], 1, ae_v_len(0,n-1), v); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal LU solver + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static void densesolver_cmatrixlusolveinternal(/* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + double scalea, + ae_int_t n, + /* Complex */ ae_matrix* a, + ae_bool havea, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t rfs; + ae_int_t nrfs; + ae_vector xc; + ae_vector y; + ae_vector bc; + ae_vector xa; + ae_vector xb; + ae_vector tx; + ae_vector tmpbuf; + ae_complex v; + double verr; + double mxb; + double scaleright; + ae_bool smallerr; + ae_bool terminatenexttime; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_vector_init(&xc, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&y, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&bc, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&xa, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&xb, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&tx, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&tmpbuf, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_fp_greater(scalea,0), "Assertion failed", _state); + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + for(i=0; i<=n-1; i++) + { + if( p->ptr.p_int[i]>n-1||p->ptr.p_int[i]r1 = cmatrixlurcond1(lua, n, _state); + rep->rinf = cmatrixlurcondinf(lua, n, _state); + if( ae_fp_less(rep->r1,rcondthreshold(_state))||ae_fp_less(rep->rinf,rcondthreshold(_state)) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=m-1; j++) + { + x->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * solve + */ + for(k=0; k<=m-1; k++) + { + + /* + * copy B to contiguous storage + */ + ae_v_cmove(&bc.ptr.p_complex[0], 1, &b->ptr.pp_complex[0][k], b->stride, "N", ae_v_len(0,n-1)); + + /* + * Scale right part: + * * MX stores max(|Bi|) + * * ScaleRight stores actual scaling applied to B when solving systems + * it is chosen to make |scaleRight*b| close to 1. + */ + mxb = 0; + for(i=0; i<=n-1; i++) + { + mxb = ae_maxreal(mxb, ae_c_abs(bc.ptr.p_complex[i], _state), _state); + } + if( ae_fp_eq(mxb,0) ) + { + mxb = 1; + } + scaleright = 1/mxb; + + /* + * First, non-iterative part of solution process. + * We use separate code for this task because + * XDot is quite slow and we want to save time. + */ + ae_v_cmoved(&xc.ptr.p_complex[0], 1, &bc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1), scaleright); + densesolver_cbasiclusolve(lua, p, scalea, n, &xc, &tx, _state); + + /* + * Iterative refinement of xc: + * * calculate r = bc-A*xc using extra-precise dot product + * * solve A*y = r + * * update x:=x+r + * + * This cycle is executed until one of two things happens: + * 1. maximum number of iterations reached + * 2. last iteration decreased error to the lower limit + */ + if( havea ) + { + nrfs = densesolver_densesolverrfsmax(n, rep->r1, rep->rinf, _state); + terminatenexttime = ae_false; + for(rfs=0; rfs<=nrfs-1; rfs++) + { + if( terminatenexttime ) + { + break; + } + + /* + * generate right part + */ + smallerr = ae_true; + ae_v_cmove(&xb.ptr.p_complex[0], 1, &xc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); + for(i=0; i<=n-1; i++) + { + ae_v_cmoved(&xa.ptr.p_complex[0], 1, &a->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,n-1), scalea); + xa.ptr.p_complex[n] = ae_complex_from_d(-1); + xb.ptr.p_complex[n] = ae_c_mul_d(bc.ptr.p_complex[i],scaleright); + xcdot(&xa, &xb, n+1, &tmpbuf, &v, &verr, _state); + y.ptr.p_complex[i] = ae_c_neg(v); + smallerr = smallerr&&ae_fp_less(ae_c_abs(v, _state),4*verr); + } + if( smallerr ) + { + terminatenexttime = ae_true; + } + + /* + * solve and update + */ + densesolver_cbasiclusolve(lua, p, scalea, n, &y, &tx, _state); + ae_v_cadd(&xc.ptr.p_complex[0], 1, &y.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1)); + } + } + + /* + * Store xc. + * Post-scale result. + */ + v = ae_complex_from_d(scalea*mxb); + ae_v_cmovec(&x->ptr.pp_complex[0][k], x->stride, &xc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1), v); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal Cholesky solver + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static void densesolver_hpdmatrixcholeskysolveinternal(/* Complex */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_matrix* a, + ae_bool havea, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_vector xc; + ae_vector y; + ae_vector bc; + ae_vector xa; + ae_vector xb; + ae_vector tx; + double v; + double mxb; + double scaleright; + + ae_frame_make(_state, &_frame_block); + *info = 0; + _densesolverreport_clear(rep); + ae_matrix_clear(x); + ae_vector_init(&xc, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&y, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&bc, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&xa, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&xb, 0, DT_COMPLEX, _state, ae_true); + ae_vector_init(&tx, 0, DT_COMPLEX, _state, ae_true); + + ae_assert(ae_fp_greater(sqrtscalea,0), "Assertion failed", _state); + + /* + * prepare: check inputs, allocate space... + */ + if( n<=0||m<=0 ) + { + *info = -1; + ae_frame_leave(_state); + return; + } + ae_matrix_set_length(x, n, m, _state); + ae_vector_set_length(&y, n, _state); + ae_vector_set_length(&xc, n, _state); + ae_vector_set_length(&bc, n, _state); + ae_vector_set_length(&tx, n+1, _state); + ae_vector_set_length(&xa, n+1, _state); + ae_vector_set_length(&xb, n+1, _state); + + /* + * estimate condition number, test for near singularity + */ + rep->r1 = hpdmatrixcholeskyrcond(cha, n, isupper, _state); + rep->rinf = rep->r1; + if( ae_fp_less(rep->r1,rcondthreshold(_state)) ) + { + for(i=0; i<=n-1; i++) + { + for(j=0; j<=m-1; j++) + { + x->ptr.pp_complex[i][j] = ae_complex_from_d(0); + } + } + rep->r1 = 0; + rep->rinf = 0; + *info = -3; + ae_frame_leave(_state); + return; + } + *info = 1; + + /* + * solve + */ + for(k=0; k<=m-1; k++) + { + + /* + * copy B to contiguous storage + */ + ae_v_cmove(&bc.ptr.p_complex[0], 1, &b->ptr.pp_complex[0][k], b->stride, "N", ae_v_len(0,n-1)); + + /* + * Scale right part: + * * MX stores max(|Bi|) + * * ScaleRight stores actual scaling applied to B when solving systems + * it is chosen to make |scaleRight*b| close to 1. + */ + mxb = 0; + for(i=0; i<=n-1; i++) + { + mxb = ae_maxreal(mxb, ae_c_abs(bc.ptr.p_complex[i], _state), _state); + } + if( ae_fp_eq(mxb,0) ) + { + mxb = 1; + } + scaleright = 1/mxb; + + /* + * First, non-iterative part of solution process. + * We use separate code for this task because + * XDot is quite slow and we want to save time. + */ + ae_v_cmoved(&xc.ptr.p_complex[0], 1, &bc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1), scaleright); + densesolver_hpdbasiccholeskysolve(cha, sqrtscalea, n, isupper, &xc, &tx, _state); + + /* + * Store xc. + * Post-scale result. + */ + v = ae_sqr(sqrtscalea, _state)*mxb; + ae_v_cmoved(&x->ptr.pp_complex[0][k], x->stride, &xc.ptr.p_complex[0], 1, "N", ae_v_len(0,n-1), v); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Internal subroutine. +Returns maximum count of RFS iterations as function of: +1. machine epsilon +2. task size. +3. condition number + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static ae_int_t densesolver_densesolverrfsmax(ae_int_t n, + double r1, + double rinf, + ae_state *_state) +{ + ae_int_t result; + + + result = 5; + return result; +} + + +/************************************************************************* +Internal subroutine. +Returns maximum count of RFS iterations as function of: +1. machine epsilon +2. task size. +3. norm-2 condition number + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static ae_int_t densesolver_densesolverrfsmaxv2(ae_int_t n, + double r2, + ae_state *_state) +{ + ae_int_t result; + + + result = densesolver_densesolverrfsmax(n, 0, 0, _state); + return result; +} + + +/************************************************************************* +Basic LU solver for ScaleA*PLU*x = y. + +This subroutine assumes that: +* L is well-scaled, and it is U which needs scaling by ScaleA. +* A=PLU is well-conditioned, so no zero divisions or overflow may occur + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static void densesolver_rbasiclusolve(/* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + double scalea, + ae_int_t n, + /* Real */ ae_vector* xb, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + double v; + + + for(i=0; i<=n-1; i++) + { + if( p->ptr.p_int[i]!=i ) + { + v = xb->ptr.p_double[i]; + xb->ptr.p_double[i] = xb->ptr.p_double[p->ptr.p_int[i]]; + xb->ptr.p_double[p->ptr.p_int[i]] = v; + } + } + for(i=1; i<=n-1; i++) + { + v = ae_v_dotproduct(&lua->ptr.pp_double[i][0], 1, &xb->ptr.p_double[0], 1, ae_v_len(0,i-1)); + xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; + } + xb->ptr.p_double[n-1] = xb->ptr.p_double[n-1]/(scalea*lua->ptr.pp_double[n-1][n-1]); + for(i=n-2; i>=0; i--) + { + ae_v_moved(&tmp->ptr.p_double[i+1], 1, &lua->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), scalea); + v = ae_v_dotproduct(&tmp->ptr.p_double[i+1], 1, &xb->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); + xb->ptr.p_double[i] = (xb->ptr.p_double[i]-v)/(scalea*lua->ptr.pp_double[i][i]); + } +} + + +/************************************************************************* +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 + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static void densesolver_spdbasiccholeskysolve(/* Real */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* xb, + /* Real */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + double v; + + + + /* + * A = L*L' or A=U'*U + */ + if( isupper ) + { + + /* + * Solve U'*y=b first. + */ + for(i=0; i<=n-1; i++) + { + xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); + if( iptr.p_double[i]; + ae_v_moved(&tmp->ptr.p_double[i+1], 1, &cha->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sqrtscalea); + ae_v_subd(&xb->ptr.p_double[i+1], 1, &tmp->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1), v); + } + } + + /* + * Solve U*x=y then. + */ + for(i=n-1; i>=0; i--) + { + if( iptr.p_double[i+1], 1, &cha->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,n-1), sqrtscalea); + v = ae_v_dotproduct(&tmp->ptr.p_double[i+1], 1, &xb->ptr.p_double[i+1], 1, ae_v_len(i+1,n-1)); + xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; + } + xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); + } + } + else + { + + /* + * Solve L*y=b first + */ + for(i=0; i<=n-1; i++) + { + if( i>0 ) + { + ae_v_moved(&tmp->ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sqrtscalea); + v = ae_v_dotproduct(&tmp->ptr.p_double[0], 1, &xb->ptr.p_double[0], 1, ae_v_len(0,i-1)); + xb->ptr.p_double[i] = xb->ptr.p_double[i]-v; + } + xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); + } + + /* + * Solve L'*x=y then. + */ + for(i=n-1; i>=0; i--) + { + xb->ptr.p_double[i] = xb->ptr.p_double[i]/(sqrtscalea*cha->ptr.pp_double[i][i]); + if( i>0 ) + { + v = xb->ptr.p_double[i]; + ae_v_moved(&tmp->ptr.p_double[0], 1, &cha->ptr.pp_double[i][0], 1, ae_v_len(0,i-1), sqrtscalea); + ae_v_subd(&xb->ptr.p_double[0], 1, &tmp->ptr.p_double[0], 1, ae_v_len(0,i-1), v); + } + } + } +} + + +/************************************************************************* +Basic LU solver for ScaleA*PLU*x = y. + +This subroutine assumes that: +* L is well-scaled, and it is U which needs scaling by ScaleA. +* A=PLU is well-conditioned, so no zero divisions or overflow may occur + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static void densesolver_cbasiclusolve(/* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + double scalea, + ae_int_t n, + /* Complex */ ae_vector* xb, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_complex v; + + + for(i=0; i<=n-1; i++) + { + if( p->ptr.p_int[i]!=i ) + { + v = xb->ptr.p_complex[i]; + xb->ptr.p_complex[i] = xb->ptr.p_complex[p->ptr.p_int[i]]; + xb->ptr.p_complex[p->ptr.p_int[i]] = v; + } + } + for(i=1; i<=n-1; i++) + { + v = ae_v_cdotproduct(&lua->ptr.pp_complex[i][0], 1, "N", &xb->ptr.p_complex[0], 1, "N", ae_v_len(0,i-1)); + xb->ptr.p_complex[i] = ae_c_sub(xb->ptr.p_complex[i],v); + } + xb->ptr.p_complex[n-1] = ae_c_div(xb->ptr.p_complex[n-1],ae_c_mul_d(lua->ptr.pp_complex[n-1][n-1],scalea)); + for(i=n-2; i>=0; i--) + { + ae_v_cmoved(&tmp->ptr.p_complex[i+1], 1, &lua->ptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1), scalea); + v = ae_v_cdotproduct(&tmp->ptr.p_complex[i+1], 1, "N", &xb->ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1)); + xb->ptr.p_complex[i] = ae_c_div(ae_c_sub(xb->ptr.p_complex[i],v),ae_c_mul_d(lua->ptr.pp_complex[i][i],scalea)); + } +} + + +/************************************************************************* +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 + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +static void densesolver_hpdbasiccholeskysolve(/* Complex */ ae_matrix* cha, + double sqrtscalea, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* xb, + /* Complex */ ae_vector* tmp, + ae_state *_state) +{ + ae_int_t i; + ae_complex v; + + + + /* + * A = L*L' or A=U'*U + */ + if( isupper ) + { + + /* + * Solve U'*y=b first. + */ + for(i=0; i<=n-1; i++) + { + xb->ptr.p_complex[i] = ae_c_div(xb->ptr.p_complex[i],ae_c_mul_d(ae_c_conj(cha->ptr.pp_complex[i][i], _state),sqrtscalea)); + if( iptr.p_complex[i]; + ae_v_cmoved(&tmp->ptr.p_complex[i+1], 1, &cha->ptr.pp_complex[i][i+1], 1, "Conj", ae_v_len(i+1,n-1), sqrtscalea); + ae_v_csubc(&xb->ptr.p_complex[i+1], 1, &tmp->ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1), v); + } + } + + /* + * Solve U*x=y then. + */ + for(i=n-1; i>=0; i--) + { + if( iptr.p_complex[i+1], 1, &cha->ptr.pp_complex[i][i+1], 1, "N", ae_v_len(i+1,n-1), sqrtscalea); + v = ae_v_cdotproduct(&tmp->ptr.p_complex[i+1], 1, "N", &xb->ptr.p_complex[i+1], 1, "N", ae_v_len(i+1,n-1)); + xb->ptr.p_complex[i] = ae_c_sub(xb->ptr.p_complex[i],v); + } + xb->ptr.p_complex[i] = ae_c_div(xb->ptr.p_complex[i],ae_c_mul_d(cha->ptr.pp_complex[i][i],sqrtscalea)); + } + } + else + { + + /* + * Solve L*y=b first + */ + for(i=0; i<=n-1; i++) + { + if( i>0 ) + { + ae_v_cmoved(&tmp->ptr.p_complex[0], 1, &cha->ptr.pp_complex[i][0], 1, "N", ae_v_len(0,i-1), sqrtscalea); + v = ae_v_cdotproduct(&tmp->ptr.p_complex[0], 1, "N", &xb->ptr.p_complex[0], 1, "N", ae_v_len(0,i-1)); + xb->ptr.p_complex[i] = ae_c_sub(xb->ptr.p_complex[i],v); + } + xb->ptr.p_complex[i] = ae_c_div(xb->ptr.p_complex[i],ae_c_mul_d(cha->ptr.pp_complex[i][i],sqrtscalea)); + } + + /* + * Solve L'*x=y then. + */ + for(i=n-1; i>=0; i--) + { + xb->ptr.p_complex[i] = ae_c_div(xb->ptr.p_complex[i],ae_c_mul_d(ae_c_conj(cha->ptr.pp_complex[i][i], _state),sqrtscalea)); + if( i>0 ) + { + v = xb->ptr.p_complex[i]; + ae_v_cmoved(&tmp->ptr.p_complex[0], 1, &cha->ptr.pp_complex[i][0], 1, "Conj", ae_v_len(0,i-1), sqrtscalea); + ae_v_csubc(&xb->ptr.p_complex[0], 1, &tmp->ptr.p_complex[0], 1, "N", ae_v_len(0,i-1), v); + } + } + } +} + + +ae_bool _densesolverreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + densesolverreport *p = (densesolverreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _densesolverreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + densesolverreport *dst = (densesolverreport*)_dst; + densesolverreport *src = (densesolverreport*)_src; + dst->r1 = src->r1; + dst->rinf = src->rinf; + return ae_true; +} + + +void _densesolverreport_clear(void* _p) +{ + densesolverreport *p = (densesolverreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _densesolverreport_destroy(void* _p) +{ + densesolverreport *p = (densesolverreport*)_p; + ae_touch_ptr((void*)p); +} + + +ae_bool _densesolverlsreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + densesolverlsreport *p = (densesolverlsreport*)_p; + ae_touch_ptr((void*)p); + if( !ae_matrix_init(&p->cx, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _densesolverlsreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + densesolverlsreport *dst = (densesolverlsreport*)_dst; + densesolverlsreport *src = (densesolverlsreport*)_src; + dst->r2 = src->r2; + if( !ae_matrix_init_copy(&dst->cx, &src->cx, _state, make_automatic) ) + return ae_false; + dst->n = src->n; + dst->k = src->k; + return ae_true; +} + + +void _densesolverlsreport_clear(void* _p) +{ + densesolverlsreport *p = (densesolverlsreport*)_p; + ae_touch_ptr((void*)p); + ae_matrix_clear(&p->cx); +} + + +void _densesolverlsreport_destroy(void* _p) +{ + densesolverlsreport *p = (densesolverlsreport*)_p; + ae_touch_ptr((void*)p); + ae_matrix_destroy(&p->cx); +} + + + + +/************************************************************************* +This function initializes linear LSQR Solver. This solver is used to solve +non-symmetric (and, possibly, non-square) problems. Least squares solution +is returned for non-compatible systems. + +USAGE: +1. User initializes algorithm state with LinLSQRCreate() call +2. User tunes solver parameters with LinLSQRSetCond() and other functions +3. User calls LinLSQRSolveSparse() function which takes algorithm state + and SparseMatrix object. +4. User calls LinLSQRResults() to get solution +5. Optionally, user may call LinLSQRSolveSparse() again to solve another + problem with different matrix and/or right part without reinitializing + LinLSQRState structure. + +INPUT PARAMETERS: + M - number of rows in A + N - number of variables, N>0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrcreate(ae_int_t m, + ae_int_t n, + linlsqrstate* state, + ae_state *_state) +{ + ae_int_t i; + + _linlsqrstate_clear(state); + + ae_assert(m>0, "LinLSQRCreate: M<=0", _state); + ae_assert(n>0, "LinLSQRCreate: N<=0", _state); + state->m = m; + state->n = n; + state->prectype = 0; + state->epsa = linlsqr_atol; + state->epsb = linlsqr_btol; + state->epsc = 1/ae_sqrt(ae_machineepsilon, _state); + state->maxits = 0; + state->lambdai = 0; + state->xrep = ae_false; + state->running = ae_false; + + /* + * * allocate arrays + * * set RX to NAN (just for the case user calls Results() without + * calling SolveSparse() + * * set B to zero + */ + normestimatorcreate(m, n, 2, 2, &state->nes, _state); + ae_vector_set_length(&state->rx, state->n, _state); + ae_vector_set_length(&state->ui, state->m+state->n, _state); + ae_vector_set_length(&state->uip1, state->m+state->n, _state); + ae_vector_set_length(&state->vip1, state->n, _state); + ae_vector_set_length(&state->vi, state->n, _state); + ae_vector_set_length(&state->omegai, state->n, _state); + ae_vector_set_length(&state->omegaip1, state->n, _state); + ae_vector_set_length(&state->d, state->n, _state); + ae_vector_set_length(&state->x, state->m+state->n, _state); + ae_vector_set_length(&state->mv, state->m+state->n, _state); + ae_vector_set_length(&state->mtv, state->n, _state); + ae_vector_set_length(&state->b, state->m, _state); + for(i=0; i<=n-1; i++) + { + state->rx.ptr.p_double[i] = _state->v_nan; + } + for(i=0; i<=m-1; i++) + { + state->b.ptr.p_double[i] = 0; + } + ae_vector_set_length(&state->rstate.ia, 1+1, _state); + ae_vector_set_length(&state->rstate.ra, 0+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +This function sets right part. By default, right part is zero. + +INPUT PARAMETERS: + B - right part, array[N]. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetb(linlsqrstate* state, + /* Real */ ae_vector* b, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(!state->running, "LinLSQRSetB: you can not change B when LinLSQRIteration is running", _state); + ae_assert(state->m<=b->cnt, "LinLSQRSetB: Length(B)m, _state), "LinLSQRSetB: B contains infinite or NaN values", _state); + state->bnorm2 = 0; + for(i=0; i<=state->m-1; i++) + { + state->b.ptr.p_double[i] = b->ptr.p_double[i]; + state->bnorm2 = state->bnorm2+b->ptr.p_double[i]*b->ptr.p_double[i]; + } +} + + +/************************************************************************* +This function changes preconditioning settings of LinLSQQSolveSparse() +function. By default, SolveSparse() uses diagonal preconditioner, but if +you want to use solver without preconditioning, you can call this function +which forces solver to use unit matrix for preconditioning. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetprecunit(linlsqrstate* state, ae_state *_state) +{ + + + ae_assert(!state->running, "LinLSQRSetPrecUnit: you can not change preconditioner, because function LinLSQRIteration is running!", _state); + state->prectype = -1; +} + + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. LinCGSolveSparse() will use diagonal of the system matrix as +preconditioner. This preconditioning mode is active by default. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetprecdiag(linlsqrstate* state, ae_state *_state) +{ + + + ae_assert(!state->running, "LinLSQRSetPrecDiag: you can not change preconditioner, because function LinCGIteration is running!", _state); + state->prectype = 0; +} + + +/************************************************************************* +This function sets optional Tikhonov regularization coefficient. +It is zero by default. + +INPUT PARAMETERS: + LambdaI - regularization factor, LambdaI>=0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetlambdai(linlsqrstate* state, + double lambdai, + ae_state *_state) +{ + + + ae_assert(!state->running, "LinLSQRSetLambdaI: you can not set LambdaI, because function LinLSQRIteration is running", _state); + ae_assert(ae_isfinite(lambdai, _state)&&ae_fp_greater_eq(lambdai,0), "LinLSQRSetLambdaI: LambdaI is infinite or NaN", _state); + state->lambdai = lambdai; +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +ae_bool linlsqriteration(linlsqrstate* state, ae_state *_state) +{ + ae_int_t summn; + double bnorm; + ae_int_t i; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + summn = state->rstate.ia.ptr.p_int[0]; + i = state->rstate.ia.ptr.p_int[1]; + bnorm = state->rstate.ra.ptr.p_double[0]; + } + else + { + summn = -983; + i = -989; + bnorm = -834; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + if( state->rstate.stage==5 ) + { + goto lbl_5; + } + if( state->rstate.stage==6 ) + { + goto lbl_6; + } + + /* + * Routine body + */ + ae_assert(state->b.cnt>0, "LinLSQRIteration: using non-allocated array B", _state); + bnorm = ae_sqrt(state->bnorm2, _state); + state->running = ae_true; + state->repnmv = 0; + linlsqr_clearrfields(state, _state); + state->repiterationscount = 0; + summn = state->m+state->n; + state->r2 = state->bnorm2; + + /* + *estimate for ANorm + */ + normestimatorrestart(&state->nes, _state); +lbl_7: + if( !normestimatoriteration(&state->nes, _state) ) + { + goto lbl_8; + } + if( !state->nes.needmv ) + { + goto lbl_9; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->nes.x.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->repnmv = state->repnmv+1; + linlsqr_clearrfields(state, _state); + state->needmv = ae_true; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->needmv = ae_false; + ae_v_move(&state->nes.mv.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,state->m-1)); + goto lbl_7; +lbl_9: + if( !state->nes.needmtv ) + { + goto lbl_11; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->nes.x.ptr.p_double[0], 1, ae_v_len(0,state->m-1)); + + /* + *matrix-vector multiplication + */ + state->repnmv = state->repnmv+1; + linlsqr_clearrfields(state, _state); + state->needmtv = ae_true; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->needmtv = ae_false; + ae_v_move(&state->nes.mtv.ptr.p_double[0], 1, &state->mtv.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + goto lbl_7; +lbl_11: + goto lbl_7; +lbl_8: + normestimatorresults(&state->nes, &state->anorm, _state); + + /* + *initialize .RX by zeros + */ + for(i=0; i<=state->n-1; i++) + { + state->rx.ptr.p_double[i] = 0; + } + + /* + *output first report + */ + if( !state->xrep ) + { + goto lbl_13; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + linlsqr_clearrfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + state->xupdated = ae_false; +lbl_13: + + /* + * LSQR, Step 0. + * + * Algorithm outline corresponds to one which was described at p.50 of + * "LSQR - an algorithm for sparse linear equations and sparse least + * squares" by C.Paige and M.Saunders with one small addition - we + * explicitly extend system matrix by additional N lines in order + * to handle non-zero lambda, i.e. original A is replaced by + * [ A ] + * A_mod = [ ] + * [ lambda*I ]. + * + * Step 0: + * x[0] = 0 + * beta[1]*u[1] = b + * alpha[1]*v[1] = A_mod'*u[1] + * w[1] = v[1] + * phiBar[1] = beta[1] + * rhoBar[1] = alpha[1] + * d[0] = 0 + * + * NOTE: + * There are three criteria for stopping: + * (S0) maximum number of iterations + * (S1) ||Rk||<=EpsB*||B||; + * (S2) ||A^T*Rk||/(||A||*||Rk||)<=EpsA. + * It is very important that S2 always checked AFTER S1. It is necessary + * to avoid division by zero when Rk=0. + */ + state->betai = bnorm; + if( ae_fp_eq(state->betai,0) ) + { + + /* + * Zero right part + */ + state->running = ae_false; + state->repterminationtype = 1; + result = ae_false; + return result; + } + for(i=0; i<=summn-1; i++) + { + if( im ) + { + state->ui.ptr.p_double[i] = state->b.ptr.p_double[i]/state->betai; + } + else + { + state->ui.ptr.p_double[i] = 0; + } + state->x.ptr.p_double[i] = state->ui.ptr.p_double[i]; + } + state->repnmv = state->repnmv+1; + linlsqr_clearrfields(state, _state); + state->needmtv = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needmtv = ae_false; + for(i=0; i<=state->n-1; i++) + { + state->mtv.ptr.p_double[i] = state->mtv.ptr.p_double[i]+state->lambdai*state->ui.ptr.p_double[state->m+i]; + } + state->alphai = 0; + for(i=0; i<=state->n-1; i++) + { + state->alphai = state->alphai+state->mtv.ptr.p_double[i]*state->mtv.ptr.p_double[i]; + } + state->alphai = ae_sqrt(state->alphai, _state); + if( ae_fp_eq(state->alphai,0) ) + { + + /* + * Orthogonality stopping criterion is met + */ + state->running = ae_false; + state->repterminationtype = 4; + result = ae_false; + return result; + } + for(i=0; i<=state->n-1; i++) + { + state->vi.ptr.p_double[i] = state->mtv.ptr.p_double[i]/state->alphai; + state->omegai.ptr.p_double[i] = state->vi.ptr.p_double[i]; + } + state->phibari = state->betai; + state->rhobari = state->alphai; + for(i=0; i<=state->n-1; i++) + { + state->d.ptr.p_double[i] = 0; + } + state->dnorm = 0; + + /* + * Steps I=1, 2, ... + */ +lbl_15: + if( ae_false ) + { + goto lbl_16; + } + + /* + * At I-th step State.RepIterationsCount=I. + */ + state->repiterationscount = state->repiterationscount+1; + + /* + * Bidiagonalization part: + * beta[i+1]*u[i+1] = A_mod*v[i]-alpha[i]*u[i] + * alpha[i+1]*v[i+1] = A_mod'*u[i+1] - beta[i+1]*v[i] + * + * NOTE: beta[i+1]=0 or alpha[i+1]=0 will lead to successful termination + * in the end of the current iteration. In this case u/v are zero. + * NOTE2: algorithm won't fail on zero alpha or beta (there will be no + * division by zero because it will be stopped BEFORE division + * occurs). However, near-zero alpha and beta won't stop algorithm + * and, although no division by zero will happen, orthogonality + * in U and V will be lost. + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->vi.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->repnmv = state->repnmv+1; + linlsqr_clearrfields(state, _state); + state->needmv = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->needmv = ae_false; + for(i=0; i<=state->n-1; i++) + { + state->mv.ptr.p_double[state->m+i] = state->lambdai*state->vi.ptr.p_double[i]; + } + state->betaip1 = 0; + for(i=0; i<=summn-1; i++) + { + state->uip1.ptr.p_double[i] = state->mv.ptr.p_double[i]-state->alphai*state->ui.ptr.p_double[i]; + state->betaip1 = state->betaip1+state->uip1.ptr.p_double[i]*state->uip1.ptr.p_double[i]; + } + if( ae_fp_neq(state->betaip1,0) ) + { + state->betaip1 = ae_sqrt(state->betaip1, _state); + for(i=0; i<=summn-1; i++) + { + state->uip1.ptr.p_double[i] = state->uip1.ptr.p_double[i]/state->betaip1; + } + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->uip1.ptr.p_double[0], 1, ae_v_len(0,state->m-1)); + state->repnmv = state->repnmv+1; + linlsqr_clearrfields(state, _state); + state->needmtv = ae_true; + state->rstate.stage = 5; + goto lbl_rcomm; +lbl_5: + state->needmtv = ae_false; + for(i=0; i<=state->n-1; i++) + { + state->mtv.ptr.p_double[i] = state->mtv.ptr.p_double[i]+state->lambdai*state->uip1.ptr.p_double[state->m+i]; + } + state->alphaip1 = 0; + for(i=0; i<=state->n-1; i++) + { + state->vip1.ptr.p_double[i] = state->mtv.ptr.p_double[i]-state->betaip1*state->vi.ptr.p_double[i]; + state->alphaip1 = state->alphaip1+state->vip1.ptr.p_double[i]*state->vip1.ptr.p_double[i]; + } + if( ae_fp_neq(state->alphaip1,0) ) + { + state->alphaip1 = ae_sqrt(state->alphaip1, _state); + for(i=0; i<=state->n-1; i++) + { + state->vip1.ptr.p_double[i] = state->vip1.ptr.p_double[i]/state->alphaip1; + } + } + + /* + * Build next orthogonal transformation + */ + state->rhoi = safepythag2(state->rhobari, state->betaip1, _state); + state->ci = state->rhobari/state->rhoi; + state->si = state->betaip1/state->rhoi; + state->theta = state->si*state->alphaip1; + state->rhobarip1 = -state->ci*state->alphaip1; + state->phii = state->ci*state->phibari; + state->phibarip1 = state->si*state->phibari; + + /* + * Update .RNorm + * + * This tricky formula is necessary because simply writing + * State.R2:=State.PhiBarIP1*State.PhiBarIP1 does NOT guarantees + * monotonic decrease of R2. Roundoff error combined with 80-bit + * precision used internally by Intel chips allows R2 to increase + * slightly in some rare, but possible cases. This property is + * undesirable, so we prefer to guard against R increase. + */ + state->r2 = ae_minreal(state->r2, state->phibarip1*state->phibarip1, _state); + + /* + * Update d and DNorm, check condition-related stopping criteria + */ + for(i=0; i<=state->n-1; i++) + { + state->d.ptr.p_double[i] = 1/state->rhoi*(state->vi.ptr.p_double[i]-state->theta*state->d.ptr.p_double[i]); + state->dnorm = state->dnorm+state->d.ptr.p_double[i]*state->d.ptr.p_double[i]; + } + if( ae_fp_greater_eq(ae_sqrt(state->dnorm, _state)*state->anorm,state->epsc) ) + { + state->running = ae_false; + state->repterminationtype = 7; + result = ae_false; + return result; + } + + /* + * Update x, output report + */ + for(i=0; i<=state->n-1; i++) + { + state->rx.ptr.p_double[i] = state->rx.ptr.p_double[i]+state->phii/state->rhoi*state->omegai.ptr.p_double[i]; + } + if( !state->xrep ) + { + goto lbl_17; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + linlsqr_clearrfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->xupdated = ae_false; +lbl_17: + + /* + * Check stopping criteria + * 1. achieved required number of iterations; + * 2. ||Rk||<=EpsB*||B||; + * 3. ||A^T*Rk||/(||A||*||Rk||)<=EpsA; + */ + if( state->maxits>0&&state->repiterationscount>=state->maxits ) + { + + /* + * Achieved required number of iterations + */ + state->running = ae_false; + state->repterminationtype = 5; + result = ae_false; + return result; + } + if( ae_fp_less_eq(state->phibarip1,state->epsb*bnorm) ) + { + + /* + * ||Rk||<=EpsB*||B||, here ||Rk||=PhiBar + */ + state->running = ae_false; + state->repterminationtype = 1; + result = ae_false; + return result; + } + if( ae_fp_less_eq(state->alphaip1*ae_fabs(state->ci, _state)/state->anorm,state->epsa) ) + { + + /* + * ||A^T*Rk||/(||A||*||Rk||)<=EpsA, here ||A^T*Rk||=PhiBar*Alpha[i+1]*|.C| + */ + state->running = ae_false; + state->repterminationtype = 4; + result = ae_false; + return result; + } + + /* + * Update omega + */ + for(i=0; i<=state->n-1; i++) + { + state->omegaip1.ptr.p_double[i] = state->vip1.ptr.p_double[i]-state->theta/state->rhoi*state->omegai.ptr.p_double[i]; + } + + /* + * Prepare for the next iteration - rename variables: + * u[i] := u[i+1] + * v[i] := v[i+1] + * rho[i] := rho[i+1] + * ... + */ + ae_v_move(&state->ui.ptr.p_double[0], 1, &state->uip1.ptr.p_double[0], 1, ae_v_len(0,summn-1)); + ae_v_move(&state->vi.ptr.p_double[0], 1, &state->vip1.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + ae_v_move(&state->omegai.ptr.p_double[0], 1, &state->omegaip1.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->alphai = state->alphaip1; + state->betai = state->betaip1; + state->phibari = state->phibarip1; + state->rhobari = state->rhobarip1; + goto lbl_15; +lbl_16: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = summn; + state->rstate.ia.ptr.p_int[1] = i; + state->rstate.ra.ptr.p_double[0] = bnorm; + return result; +} + + +/************************************************************************* +Procedure for solution of A*x=b with sparse A. + +INPUT PARAMETERS: + State - algorithm state + A - sparse M*N matrix in the CRS format (you MUST contvert it + to CRS format by calling SparseConvertToCRS() function + BEFORE you pass it to this function). + B - right part, array[M] + +RESULT: + This function returns no result. + You can get solution by calling LinCGResults() + +NOTE: this function uses lightweight preconditioning - multiplication by + inverse of diag(A). If you want, you can turn preconditioning off by + calling LinLSQRSetPrecUnit(). However, preconditioning cost is low + and preconditioner is very important for solution of badly scaled + problems. + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsolvesparse(linlsqrstate* state, + sparsematrix* a, + /* Real */ ae_vector* b, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + ae_int_t j; + ae_int_t t0; + ae_int_t t1; + double v; + + + n = state->n; + ae_assert(!state->running, "LinLSQRSolveSparse: you can not call this function when LinLSQRIteration is running", _state); + ae_assert(b->cnt>=state->m, "LinLSQRSolveSparse: Length(B)m, _state), "LinLSQRSolveSparse: B contains infinite or NaN values", _state); + + /* + * Allocate temporaries + */ + rvectorsetlengthatleast(&state->tmpd, n, _state); + rvectorsetlengthatleast(&state->tmpx, n, _state); + + /* + * Compute diagonal scaling matrix D + */ + if( state->prectype==0 ) + { + + /* + * Default preconditioner - inverse of column norms + */ + for(i=0; i<=n-1; i++) + { + state->tmpd.ptr.p_double[i] = 0; + } + t0 = 0; + t1 = 0; + while(sparseenumerate(a, &t0, &t1, &i, &j, &v, _state)) + { + state->tmpd.ptr.p_double[j] = state->tmpd.ptr.p_double[j]+ae_sqr(v, _state); + } + for(i=0; i<=n-1; i++) + { + if( ae_fp_greater(state->tmpd.ptr.p_double[i],0) ) + { + state->tmpd.ptr.p_double[i] = 1/ae_sqrt(state->tmpd.ptr.p_double[i], _state); + } + else + { + state->tmpd.ptr.p_double[i] = 1; + } + } + } + else + { + + /* + * No diagonal scaling + */ + for(i=0; i<=n-1; i++) + { + state->tmpd.ptr.p_double[i] = 1; + } + } + + /* + * Solve. + * + * Instead of solving A*x=b we solve preconditioned system (A*D)*(inv(D)*x)=b. + * Transformed A is not calculated explicitly, we just modify multiplication + * by A or A'. After solution we modify State.RX so it will store untransformed + * variables + */ + linlsqrsetb(state, b, _state); + linlsqrrestart(state, _state); + while(linlsqriteration(state, _state)) + { + if( state->needmv ) + { + for(i=0; i<=n-1; i++) + { + state->tmpx.ptr.p_double[i] = state->tmpd.ptr.p_double[i]*state->x.ptr.p_double[i]; + } + sparsemv(a, &state->tmpx, &state->mv, _state); + } + if( state->needmtv ) + { + sparsemtv(a, &state->x, &state->mtv, _state); + for(i=0; i<=n-1; i++) + { + state->mtv.ptr.p_double[i] = state->tmpd.ptr.p_double[i]*state->mtv.ptr.p_double[i]; + } + } + } + for(i=0; i<=n-1; i++) + { + state->rx.ptr.p_double[i] = state->tmpd.ptr.p_double[i]*state->rx.ptr.p_double[i]; + } +} + + +/************************************************************************* +This function sets stopping criteria. + +INPUT PARAMETERS: + EpsA - algorithm will be stopped if ||A^T*Rk||/(||A||*||Rk||)<=EpsA. + EpsB - algorithm will be stopped if ||Rk||<=EpsB*||B|| + MaxIts - algorithm will be stopped if number of iterations + more than MaxIts. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: if EpsA,EpsB,EpsC and MaxIts are zero then these variables will +be setted as default values. + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetcond(linlsqrstate* state, + double epsa, + double epsb, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(!state->running, "LinLSQRSetCond: you can not call this function when LinLSQRIteration is running", _state); + ae_assert(ae_isfinite(epsa, _state)&&ae_fp_greater_eq(epsa,0), "LinLSQRSetCond: EpsA is negative, INF or NAN", _state); + ae_assert(ae_isfinite(epsb, _state)&&ae_fp_greater_eq(epsb,0), "LinLSQRSetCond: EpsB is negative, INF or NAN", _state); + ae_assert(maxits>=0, "LinLSQRSetCond: MaxIts is negative", _state); + if( (ae_fp_eq(epsa,0)&&ae_fp_eq(epsb,0))&&maxits==0 ) + { + state->epsa = linlsqr_atol; + state->epsb = linlsqr_btol; + state->maxits = state->n; + } + else + { + state->epsa = epsa; + state->epsb = epsb; + state->maxits = maxits; + } +} + + +/************************************************************************* +LSQR solver: results. + +This function must be called after LinLSQRSolve + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[N], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * 1 ||Rk||<=EpsB*||B|| + * 4 ||A^T*Rk||/(||A||*||Rk||)<=EpsA + * 5 MaxIts steps was taken + * 7 rounding errors prevent further progress, + X contains best point found so far. + (sometimes returned on singular systems) + * Rep.IterationsCount contains iterations count + * NMV countains number of matrix-vector calculations + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrresults(linlsqrstate* state, + /* Real */ ae_vector* x, + linlsqrreport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _linlsqrreport_clear(rep); + + ae_assert(!state->running, "LinLSQRResult: you can not call this function when LinLSQRIteration is running", _state); + if( x->cntn ) + { + ae_vector_set_length(x, state->n, _state); + } + ae_v_move(&x->ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + rep->iterationscount = state->repiterationscount; + rep->nmv = state->repnmv; + rep->terminationtype = state->repterminationtype; +} + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetxrep(linlsqrstate* state, + ae_bool needxrep, + ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +This function restarts LinLSQRIteration + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrrestart(linlsqrstate* state, ae_state *_state) +{ + + + ae_vector_set_length(&state->rstate.ia, 1+1, _state); + ae_vector_set_length(&state->rstate.ra, 0+1, _state); + state->rstate.stage = -1; + linlsqr_clearrfields(state, _state); +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forgot to clear something) +*************************************************************************/ +static void linlsqr_clearrfields(linlsqrstate* state, ae_state *_state) +{ + + + state->xupdated = ae_false; + state->needmv = ae_false; + state->needmtv = ae_false; + state->needmv2 = ae_false; + state->needvmv = ae_false; + state->needprec = ae_false; +} + + +ae_bool _linlsqrstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + linlsqrstate *p = (linlsqrstate*)_p; + ae_touch_ptr((void*)p); + if( !_normestimatorstate_init(&p->nes, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->ui, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->uip1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->vi, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->vip1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->omegai, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->omegaip1, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->d, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->mv, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->mtv, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpd, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _linlsqrstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + linlsqrstate *dst = (linlsqrstate*)_dst; + linlsqrstate *src = (linlsqrstate*)_src; + if( !_normestimatorstate_init_copy(&dst->nes, &src->nes, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rx, &src->rx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) + return ae_false; + dst->n = src->n; + dst->m = src->m; + dst->prectype = src->prectype; + if( !ae_vector_init_copy(&dst->ui, &src->ui, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->uip1, &src->uip1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->vi, &src->vi, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->vip1, &src->vip1, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->omegai, &src->omegai, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->omegaip1, &src->omegaip1, _state, make_automatic) ) + return ae_false; + dst->alphai = src->alphai; + dst->alphaip1 = src->alphaip1; + dst->betai = src->betai; + dst->betaip1 = src->betaip1; + dst->phibari = src->phibari; + dst->phibarip1 = src->phibarip1; + dst->phii = src->phii; + dst->rhobari = src->rhobari; + dst->rhobarip1 = src->rhobarip1; + dst->rhoi = src->rhoi; + dst->ci = src->ci; + dst->si = src->si; + dst->theta = src->theta; + dst->lambdai = src->lambdai; + if( !ae_vector_init_copy(&dst->d, &src->d, _state, make_automatic) ) + return ae_false; + dst->anorm = src->anorm; + dst->bnorm2 = src->bnorm2; + dst->dnorm = src->dnorm; + dst->r2 = src->r2; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->mv, &src->mv, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->mtv, &src->mtv, _state, make_automatic) ) + return ae_false; + dst->epsa = src->epsa; + dst->epsb = src->epsb; + dst->epsc = src->epsc; + dst->maxits = src->maxits; + dst->xrep = src->xrep; + dst->xupdated = src->xupdated; + dst->needmv = src->needmv; + dst->needmtv = src->needmtv; + dst->needmv2 = src->needmv2; + dst->needvmv = src->needvmv; + dst->needprec = src->needprec; + dst->repiterationscount = src->repiterationscount; + dst->repnmv = src->repnmv; + dst->repterminationtype = src->repterminationtype; + dst->running = src->running; + if( !ae_vector_init_copy(&dst->tmpd, &src->tmpd, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpx, &src->tmpx, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _linlsqrstate_clear(void* _p) +{ + linlsqrstate *p = (linlsqrstate*)_p; + ae_touch_ptr((void*)p); + _normestimatorstate_clear(&p->nes); + ae_vector_clear(&p->rx); + ae_vector_clear(&p->b); + ae_vector_clear(&p->ui); + ae_vector_clear(&p->uip1); + ae_vector_clear(&p->vi); + ae_vector_clear(&p->vip1); + ae_vector_clear(&p->omegai); + ae_vector_clear(&p->omegaip1); + ae_vector_clear(&p->d); + ae_vector_clear(&p->x); + ae_vector_clear(&p->mv); + ae_vector_clear(&p->mtv); + ae_vector_clear(&p->tmpd); + ae_vector_clear(&p->tmpx); + _rcommstate_clear(&p->rstate); +} + + +void _linlsqrstate_destroy(void* _p) +{ + linlsqrstate *p = (linlsqrstate*)_p; + ae_touch_ptr((void*)p); + _normestimatorstate_destroy(&p->nes); + ae_vector_destroy(&p->rx); + ae_vector_destroy(&p->b); + ae_vector_destroy(&p->ui); + ae_vector_destroy(&p->uip1); + ae_vector_destroy(&p->vi); + ae_vector_destroy(&p->vip1); + ae_vector_destroy(&p->omegai); + ae_vector_destroy(&p->omegaip1); + ae_vector_destroy(&p->d); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->mv); + ae_vector_destroy(&p->mtv); + ae_vector_destroy(&p->tmpd); + ae_vector_destroy(&p->tmpx); + _rcommstate_destroy(&p->rstate); +} + + +ae_bool _linlsqrreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + linlsqrreport *p = (linlsqrreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _linlsqrreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + linlsqrreport *dst = (linlsqrreport*)_dst; + linlsqrreport *src = (linlsqrreport*)_src; + dst->iterationscount = src->iterationscount; + dst->nmv = src->nmv; + dst->terminationtype = src->terminationtype; + return ae_true; +} + + +void _linlsqrreport_clear(void* _p) +{ + linlsqrreport *p = (linlsqrreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _linlsqrreport_destroy(void* _p) +{ + linlsqrreport *p = (linlsqrreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* +This function initializes linear CG Solver. This solver is used to solve +symmetric positive definite problems. If you want to solve nonsymmetric +(or non-positive definite) problem you may use LinLSQR solver provided by +ALGLIB. + +USAGE: +1. User initializes algorithm state with LinCGCreate() call +2. User tunes solver parameters with LinCGSetCond() and other functions +3. Optionally, user sets starting point with LinCGSetStartingPoint() +4. User calls LinCGSolveSparse() function which takes algorithm state and + SparseMatrix object. +5. User calls LinCGResults() to get solution +6. Optionally, user may call LinCGSolveSparse() again to solve another + problem with different matrix and/or right part without reinitializing + LinCGState structure. + +INPUT PARAMETERS: + N - problem dimension, N>0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgcreate(ae_int_t n, lincgstate* state, ae_state *_state) +{ + ae_int_t i; + + _lincgstate_clear(state); + + ae_assert(n>0, "LinCGCreate: N<=0", _state); + state->n = n; + state->prectype = 0; + state->itsbeforerestart = n; + state->itsbeforerupdate = 10; + state->epsf = lincg_defaultprecision; + state->maxits = 0; + state->xrep = ae_false; + state->running = ae_false; + + /* + * * allocate arrays + * * set RX to NAN (just for the case user calls Results() without + * calling SolveSparse() + * * set starting point to zero + * * we do NOT initialize B here because we assume that user should + * initializate it using LinCGSetB() function. In case he forgets + * to do so, exception will be thrown in the LinCGIteration(). + */ + ae_vector_set_length(&state->rx, state->n, _state); + ae_vector_set_length(&state->startx, state->n, _state); + ae_vector_set_length(&state->b, state->n, _state); + for(i=0; i<=state->n-1; i++) + { + state->rx.ptr.p_double[i] = _state->v_nan; + state->startx.ptr.p_double[i] = 0.0; + state->b.ptr.p_double[i] = 0; + } + ae_vector_set_length(&state->cx, state->n, _state); + ae_vector_set_length(&state->p, state->n, _state); + ae_vector_set_length(&state->r, state->n, _state); + ae_vector_set_length(&state->cr, state->n, _state); + ae_vector_set_length(&state->z, state->n, _state); + ae_vector_set_length(&state->cz, state->n, _state); + ae_vector_set_length(&state->x, state->n, _state); + ae_vector_set_length(&state->mv, state->n, _state); + ae_vector_set_length(&state->pv, state->n, _state); + lincg_updateitersdata(state, _state); + ae_vector_set_length(&state->rstate.ia, 0+1, _state); + ae_vector_set_length(&state->rstate.ra, 2+1, _state); + state->rstate.stage = -1; +} + + +/************************************************************************* +This function sets starting point. +By default, zero starting point is used. + +INPUT PARAMETERS: + X - starting point, array[N] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetstartingpoint(lincgstate* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + + + ae_assert(!state->running, "LinCGSetStartingPoint: you can not change starting point because LinCGIteration() function is running", _state); + ae_assert(state->n<=x->cnt, "LinCGSetStartingPoint: Length(X)n, _state), "LinCGSetStartingPoint: X contains infinite or NaN values!", _state); + ae_v_move(&state->startx.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); +} + + +/************************************************************************* +This function sets right part. By default, right part is zero. + +INPUT PARAMETERS: + B - right part, array[N]. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetb(lincgstate* state, + /* Real */ ae_vector* b, + ae_state *_state) +{ + + + ae_assert(!state->running, "LinCGSetB: you can not set B, because function LinCGIteration is running!", _state); + ae_assert(b->cnt>=state->n, "LinCGSetB: Length(B)n, _state), "LinCGSetB: B contains infinite or NaN values!", _state); + ae_v_move(&state->b.ptr.p_double[0], 1, &b->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); +} + + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. By default, SolveSparse() uses diagonal preconditioner, but if +you want to use solver without preconditioning, you can call this function +which forces solver to use unit matrix for preconditioning. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void lincgsetprecunit(lincgstate* state, ae_state *_state) +{ + + + ae_assert(!state->running, "LinCGSetPrecUnit: you can not change preconditioner, because function LinCGIteration is running!", _state); + state->prectype = -1; +} + + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. LinCGSolveSparse() will use diagonal of the system matrix as +preconditioner. This preconditioning mode is active by default. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void lincgsetprecdiag(lincgstate* state, ae_state *_state) +{ + + + ae_assert(!state->running, "LinCGSetPrecDiag: you can not change preconditioner, because function LinCGIteration is running!", _state); + state->prectype = 0; +} + + +/************************************************************************* +This function sets stopping criteria. + +INPUT PARAMETERS: + EpsF - algorithm will be stopped if norm of residual is less than + EpsF*||b||. + MaxIts - algorithm will be stopped if number of iterations is more + than MaxIts. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +If both EpsF and MaxIts are zero then small EpsF will be set to small +value. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetcond(lincgstate* state, + double epsf, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(!state->running, "LinCGSetCond: you can not change stopping criteria when LinCGIteration() is running", _state); + ae_assert(ae_isfinite(epsf, _state)&&ae_fp_greater_eq(epsf,0), "LinCGSetCond: EpsF is negative or contains infinite or NaN values", _state); + ae_assert(maxits>=0, "LinCGSetCond: MaxIts is negative", _state); + if( ae_fp_eq(epsf,0)&&maxits==0 ) + { + state->epsf = lincg_defaultprecision; + state->maxits = maxits; + } + else + { + state->epsf = epsf; + state->maxits = maxits; + } +} + + +/************************************************************************* +Reverse communication version of linear CG. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +ae_bool lincgiteration(lincgstate* state, ae_state *_state) +{ + ae_int_t i; + double uvar; + double bnorm; + double v; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + i = state->rstate.ia.ptr.p_int[0]; + uvar = state->rstate.ra.ptr.p_double[0]; + bnorm = state->rstate.ra.ptr.p_double[1]; + v = state->rstate.ra.ptr.p_double[2]; + } + else + { + i = -983; + uvar = -989; + bnorm = -834; + v = 900; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + if( state->rstate.stage==5 ) + { + goto lbl_5; + } + if( state->rstate.stage==6 ) + { + goto lbl_6; + } + if( state->rstate.stage==7 ) + { + goto lbl_7; + } + + /* + * Routine body + */ + ae_assert(state->b.cnt>0, "LinCGIteration: B is not initialized (you must initialize B by LinCGSetB() call", _state); + state->running = ae_true; + state->repnmv = 0; + lincg_clearrfields(state, _state); + lincg_updateitersdata(state, _state); + + /* + * Start 0-th iteration + */ + ae_v_move(&state->rx.ptr.p_double[0], 1, &state->startx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->repnmv = state->repnmv+1; + lincg_clearrfields(state, _state); + state->needvmv = ae_true; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->needvmv = ae_false; + bnorm = 0; + state->r2 = 0; + state->meritfunction = 0; + for(i=0; i<=state->n-1; i++) + { + state->r.ptr.p_double[i] = state->b.ptr.p_double[i]-state->mv.ptr.p_double[i]; + state->r2 = state->r2+state->r.ptr.p_double[i]*state->r.ptr.p_double[i]; + state->meritfunction = state->meritfunction+state->mv.ptr.p_double[i]*state->rx.ptr.p_double[i]-2*state->b.ptr.p_double[i]*state->rx.ptr.p_double[i]; + bnorm = bnorm+state->b.ptr.p_double[i]*state->b.ptr.p_double[i]; + } + bnorm = ae_sqrt(bnorm, _state); + + /* + * Output first report + */ + if( !state->xrep ) + { + goto lbl_8; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + lincg_clearrfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->xupdated = ae_false; +lbl_8: + + /* + * Is x0 a solution? + */ + if( !ae_isfinite(state->r2, _state)||ae_fp_less_eq(ae_sqrt(state->r2, _state),state->epsf*bnorm) ) + { + state->running = ae_false; + if( ae_isfinite(state->r2, _state) ) + { + state->repterminationtype = 1; + } + else + { + state->repterminationtype = -4; + } + result = ae_false; + return result; + } + + /* + * Calculate Z and P + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->r.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->repnmv = state->repnmv+1; + lincg_clearrfields(state, _state); + state->needprec = ae_true; + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + state->needprec = ae_false; + for(i=0; i<=state->n-1; i++) + { + state->z.ptr.p_double[i] = state->pv.ptr.p_double[i]; + state->p.ptr.p_double[i] = state->z.ptr.p_double[i]; + } + + /* + * Other iterations(1..N) + */ + state->repiterationscount = 0; +lbl_10: + if( ae_false ) + { + goto lbl_11; + } + state->repiterationscount = state->repiterationscount+1; + + /* + * Calculate Alpha + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->p.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->repnmv = state->repnmv+1; + lincg_clearrfields(state, _state); + state->needvmv = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needvmv = ae_false; + if( !ae_isfinite(state->vmv, _state)||ae_fp_less_eq(state->vmv,0) ) + { + + /* + * a) Overflow when calculating VMV + * b) non-positive VMV (non-SPD matrix) + */ + state->running = ae_false; + if( ae_isfinite(state->vmv, _state) ) + { + state->repterminationtype = -5; + } + else + { + state->repterminationtype = -4; + } + result = ae_false; + return result; + } + state->alpha = 0; + for(i=0; i<=state->n-1; i++) + { + state->alpha = state->alpha+state->r.ptr.p_double[i]*state->z.ptr.p_double[i]; + } + state->alpha = state->alpha/state->vmv; + if( !ae_isfinite(state->alpha, _state) ) + { + + /* + * Overflow when calculating Alpha + */ + state->running = ae_false; + state->repterminationtype = -4; + result = ae_false; + return result; + } + + /* + * Next step toward solution + */ + for(i=0; i<=state->n-1; i++) + { + state->cx.ptr.p_double[i] = state->rx.ptr.p_double[i]+state->alpha*state->p.ptr.p_double[i]; + } + + /* + * Calculate R: + * * use recurrent relation to update R + * * at every ItsBeforeRUpdate-th iteration recalculate it from scratch, using matrix-vector product + * in case R grows instead of decreasing, algorithm is terminated with positive completion code + */ + if( !(state->itsbeforerupdate==0||state->repiterationscount%state->itsbeforerupdate!=0) ) + { + goto lbl_12; + } + + /* + * Calculate R using recurrent formula + */ + for(i=0; i<=state->n-1; i++) + { + state->cr.ptr.p_double[i] = state->r.ptr.p_double[i]-state->alpha*state->mv.ptr.p_double[i]; + state->x.ptr.p_double[i] = state->cr.ptr.p_double[i]; + } + goto lbl_13; +lbl_12: + + /* + * Calculate R using matrix-vector multiplication + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->cx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->repnmv = state->repnmv+1; + lincg_clearrfields(state, _state); + state->needmv = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->needmv = ae_false; + for(i=0; i<=state->n-1; i++) + { + state->cr.ptr.p_double[i] = state->b.ptr.p_double[i]-state->mv.ptr.p_double[i]; + state->x.ptr.p_double[i] = state->cr.ptr.p_double[i]; + } + + /* + * Calculating merit function + * Check emergency stopping criterion + */ + v = 0; + for(i=0; i<=state->n-1; i++) + { + v = v+state->mv.ptr.p_double[i]*state->cx.ptr.p_double[i]-2*state->b.ptr.p_double[i]*state->cx.ptr.p_double[i]; + } + if( ae_fp_less(v,state->meritfunction) ) + { + goto lbl_14; + } + for(i=0; i<=state->n-1; i++) + { + if( !ae_isfinite(state->rx.ptr.p_double[i], _state) ) + { + state->running = ae_false; + state->repterminationtype = -4; + result = ae_false; + return result; + } + } + + /* + *output last report + */ + if( !state->xrep ) + { + goto lbl_16; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + lincg_clearrfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 5; + goto lbl_rcomm; +lbl_5: + state->xupdated = ae_false; +lbl_16: + state->running = ae_false; + state->repterminationtype = 7; + result = ae_false; + return result; +lbl_14: + state->meritfunction = v; +lbl_13: + ae_v_move(&state->rx.ptr.p_double[0], 1, &state->cx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + + /* + * calculating RNorm + * + * NOTE: monotonic decrease of R2 is not guaranteed by algorithm. + */ + state->r2 = 0; + for(i=0; i<=state->n-1; i++) + { + state->r2 = state->r2+state->cr.ptr.p_double[i]*state->cr.ptr.p_double[i]; + } + + /* + *output report + */ + if( !state->xrep ) + { + goto lbl_18; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + lincg_clearrfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->xupdated = ae_false; +lbl_18: + + /* + *stopping criterion + *achieved the required precision + */ + if( !ae_isfinite(state->r2, _state)||ae_fp_less_eq(ae_sqrt(state->r2, _state),state->epsf*bnorm) ) + { + state->running = ae_false; + if( ae_isfinite(state->r2, _state) ) + { + state->repterminationtype = 1; + } + else + { + state->repterminationtype = -4; + } + result = ae_false; + return result; + } + if( state->repiterationscount>=state->maxits&&state->maxits>0 ) + { + for(i=0; i<=state->n-1; i++) + { + if( !ae_isfinite(state->rx.ptr.p_double[i], _state) ) + { + state->running = ae_false; + state->repterminationtype = -4; + result = ae_false; + return result; + } + } + + /* + *if X is finite number + */ + state->running = ae_false; + state->repterminationtype = 5; + result = ae_false; + return result; + } + ae_v_move(&state->x.ptr.p_double[0], 1, &state->cr.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + + /* + *prepere of parameters for next iteration + */ + state->repnmv = state->repnmv+1; + lincg_clearrfields(state, _state); + state->needprec = ae_true; + state->rstate.stage = 7; + goto lbl_rcomm; +lbl_7: + state->needprec = ae_false; + ae_v_move(&state->cz.ptr.p_double[0], 1, &state->pv.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + if( state->repiterationscount%state->itsbeforerestart!=0 ) + { + state->beta = 0; + uvar = 0; + for(i=0; i<=state->n-1; i++) + { + state->beta = state->beta+state->cz.ptr.p_double[i]*state->cr.ptr.p_double[i]; + uvar = uvar+state->z.ptr.p_double[i]*state->r.ptr.p_double[i]; + } + + /* + *check that UVar is't INF or is't zero + */ + if( !ae_isfinite(uvar, _state)||ae_fp_eq(uvar,0) ) + { + state->running = ae_false; + state->repterminationtype = -4; + result = ae_false; + return result; + } + + /* + *calculate .BETA + */ + state->beta = state->beta/uvar; + + /* + *check that .BETA neither INF nor NaN + */ + if( !ae_isfinite(state->beta, _state) ) + { + state->running = ae_false; + state->repterminationtype = -1; + result = ae_false; + return result; + } + for(i=0; i<=state->n-1; i++) + { + state->p.ptr.p_double[i] = state->cz.ptr.p_double[i]+state->beta*state->p.ptr.p_double[i]; + } + } + else + { + ae_v_move(&state->p.ptr.p_double[0], 1, &state->cz.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + } + + /* + *prepere data for next iteration + */ + for(i=0; i<=state->n-1; i++) + { + + /* + *write (k+1)th iteration to (k )th iteration + */ + state->r.ptr.p_double[i] = state->cr.ptr.p_double[i]; + state->z.ptr.p_double[i] = state->cz.ptr.p_double[i]; + } + goto lbl_10; +lbl_11: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = i; + state->rstate.ra.ptr.p_double[0] = uvar; + state->rstate.ra.ptr.p_double[1] = bnorm; + state->rstate.ra.ptr.p_double[2] = v; + return result; +} + + +/************************************************************************* +Procedure for solution of A*x=b with sparse A. + +INPUT PARAMETERS: + State - algorithm state + A - sparse matrix in the CRS format (you MUST contvert it to + CRS format by calling SparseConvertToCRS() function). + IsUpper - whether upper or lower triangle of A is used: + * IsUpper=True => only upper triangle is used and lower + triangle is not referenced at all + * IsUpper=False => only lower triangle is used and upper + triangle is not referenced at all + B - right part, array[N] + +RESULT: + This function returns no result. + You can get solution by calling LinCGResults() + +NOTE: this function uses lightweight preconditioning - multiplication by + inverse of diag(A). If you want, you can turn preconditioning off by + calling LinCGSetPrecUnit(). However, preconditioning cost is low and + preconditioner is very important for solution of badly scaled + problems. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsolvesparse(lincgstate* state, + sparsematrix* a, + ae_bool isupper, + /* Real */ ae_vector* b, + ae_state *_state) +{ + ae_int_t n; + ae_int_t i; + double v; + double vmv; + + + n = state->n; + ae_assert(b->cnt>=state->n, "LinCGSetB: Length(B)n, _state), "LinCGSetB: B contains infinite or NaN values!", _state); + + /* + * Allocate temporaries + */ + rvectorsetlengthatleast(&state->tmpd, n, _state); + + /* + * Compute diagonal scaling matrix D + */ + if( state->prectype==0 ) + { + + /* + * Default preconditioner - inverse of matrix diagonal + */ + for(i=0; i<=n-1; i++) + { + v = sparsegetdiagonal(a, i, _state); + if( ae_fp_greater(v,0) ) + { + state->tmpd.ptr.p_double[i] = 1/ae_sqrt(v, _state); + } + else + { + state->tmpd.ptr.p_double[i] = 1; + } + } + } + else + { + + /* + * No diagonal scaling + */ + for(i=0; i<=n-1; i++) + { + state->tmpd.ptr.p_double[i] = 1; + } + } + + /* + * Solve + */ + lincgrestart(state, _state); + lincgsetb(state, b, _state); + while(lincgiteration(state, _state)) + { + + /* + * Process different requests from optimizer + */ + if( state->needmv ) + { + sparsesmv(a, isupper, &state->x, &state->mv, _state); + } + if( state->needvmv ) + { + sparsesmv(a, isupper, &state->x, &state->mv, _state); + vmv = ae_v_dotproduct(&state->x.ptr.p_double[0], 1, &state->mv.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + state->vmv = vmv; + } + if( state->needprec ) + { + for(i=0; i<=n-1; i++) + { + state->pv.ptr.p_double[i] = state->x.ptr.p_double[i]*ae_sqr(state->tmpd.ptr.p_double[i], _state); + } + } + } +} + + +/************************************************************************* +CG-solver: results. + +This function must be called after LinCGSolve + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[N], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -5 input matrix is either not positive definite, + too large or too small + * -4 overflow/underflow during solution + (ill conditioned problem) + * 1 ||residual||<=EpsF*||b|| + * 5 MaxIts steps was taken + * 7 rounding errors prevent further progress, + best point found is returned + * Rep.IterationsCount contains iterations count + * NMV countains number of matrix-vector calculations + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgresults(lincgstate* state, + /* Real */ ae_vector* x, + lincgreport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _lincgreport_clear(rep); + + ae_assert(!state->running, "LinCGResult: you can not get result, because function LinCGIteration has been launched!", _state); + if( x->cntn ) + { + ae_vector_set_length(x, state->n, _state); + } + ae_v_move(&x->ptr.p_double[0], 1, &state->rx.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + rep->iterationscount = state->repiterationscount; + rep->nmv = state->repnmv; + rep->terminationtype = state->repterminationtype; + rep->r2 = state->r2; +} + + +/************************************************************************* +This function sets restart frequency. By default, algorithm is restarted +after N subsequent iterations. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetrestartfreq(lincgstate* state, + ae_int_t srf, + ae_state *_state) +{ + + + ae_assert(!state->running, "LinCGSetRestartFreq: you can not change restart frequency when LinCGIteration() is running", _state); + ae_assert(srf>0, "LinCGSetRestartFreq: non-positive SRF", _state); + state->itsbeforerestart = srf; +} + + +/************************************************************************* +This function sets frequency of residual recalculations. + +Algorithm updates residual r_k using iterative formula, but recalculates +it from scratch after each 10 iterations. It is done to avoid accumulation +of numerical errors and to stop algorithm when r_k starts to grow. + +Such low update frequence (1/10) gives very little overhead, but makes +algorithm a bit more robust against numerical errors. However, you may +change it + +INPUT PARAMETERS: + Freq - desired update frequency, Freq>=0. + Zero value means that no updates will be done. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetrupdatefreq(lincgstate* state, + ae_int_t freq, + ae_state *_state) +{ + + + ae_assert(!state->running, "LinCGSetRUpdateFreq: you can not change update frequency when LinCGIteration() is running", _state); + ae_assert(freq>=0, "LinCGSetRUpdateFreq: non-positive Freq", _state); + state->itsbeforerupdate = freq; +} + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetxrep(lincgstate* state, ae_bool needxrep, ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +Procedure for restart function LinCGIteration + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgrestart(lincgstate* state, ae_state *_state) +{ + + + ae_vector_set_length(&state->rstate.ia, 0+1, _state); + ae_vector_set_length(&state->rstate.ra, 2+1, _state); + state->rstate.stage = -1; + lincg_clearrfields(state, _state); +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forgot to clear something) +*************************************************************************/ +static void lincg_clearrfields(lincgstate* state, ae_state *_state) +{ + + + state->xupdated = ae_false; + state->needmv = ae_false; + state->needmtv = ae_false; + state->needmv2 = ae_false; + state->needvmv = ae_false; + state->needprec = ae_false; +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forgot to clear something) +*************************************************************************/ +static void lincg_updateitersdata(lincgstate* state, ae_state *_state) +{ + + + state->repiterationscount = 0; + state->repnmv = 0; + state->repterminationtype = 0; +} + + +ae_bool _lincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + lincgstate *p = (lincgstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->rx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->b, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cr, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cz, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->p, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->r, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->z, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->mv, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->pv, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->startx, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpd, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _lincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + lincgstate *dst = (lincgstate*)_dst; + lincgstate *src = (lincgstate*)_src; + if( !ae_vector_init_copy(&dst->rx, &src->rx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->b, &src->b, _state, make_automatic) ) + return ae_false; + dst->n = src->n; + dst->prectype = src->prectype; + if( !ae_vector_init_copy(&dst->cx, &src->cx, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->cr, &src->cr, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->cz, &src->cz, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->p, &src->p, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->r, &src->r, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->z, &src->z, _state, make_automatic) ) + return ae_false; + dst->alpha = src->alpha; + dst->beta = src->beta; + dst->r2 = src->r2; + dst->meritfunction = src->meritfunction; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->mv, &src->mv, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->pv, &src->pv, _state, make_automatic) ) + return ae_false; + dst->vmv = src->vmv; + if( !ae_vector_init_copy(&dst->startx, &src->startx, _state, make_automatic) ) + return ae_false; + dst->epsf = src->epsf; + dst->maxits = src->maxits; + dst->itsbeforerestart = src->itsbeforerestart; + dst->itsbeforerupdate = src->itsbeforerupdate; + dst->xrep = src->xrep; + dst->xupdated = src->xupdated; + dst->needmv = src->needmv; + dst->needmtv = src->needmtv; + dst->needmv2 = src->needmv2; + dst->needvmv = src->needvmv; + dst->needprec = src->needprec; + dst->repiterationscount = src->repiterationscount; + dst->repnmv = src->repnmv; + dst->repterminationtype = src->repterminationtype; + dst->running = src->running; + if( !ae_vector_init_copy(&dst->tmpd, &src->tmpd, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _lincgstate_clear(void* _p) +{ + lincgstate *p = (lincgstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->rx); + ae_vector_clear(&p->b); + ae_vector_clear(&p->cx); + ae_vector_clear(&p->cr); + ae_vector_clear(&p->cz); + ae_vector_clear(&p->p); + ae_vector_clear(&p->r); + ae_vector_clear(&p->z); + ae_vector_clear(&p->x); + ae_vector_clear(&p->mv); + ae_vector_clear(&p->pv); + ae_vector_clear(&p->startx); + ae_vector_clear(&p->tmpd); + _rcommstate_clear(&p->rstate); +} + + +void _lincgstate_destroy(void* _p) +{ + lincgstate *p = (lincgstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->rx); + ae_vector_destroy(&p->b); + ae_vector_destroy(&p->cx); + ae_vector_destroy(&p->cr); + ae_vector_destroy(&p->cz); + ae_vector_destroy(&p->p); + ae_vector_destroy(&p->r); + ae_vector_destroy(&p->z); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->mv); + ae_vector_destroy(&p->pv); + ae_vector_destroy(&p->startx); + ae_vector_destroy(&p->tmpd); + _rcommstate_destroy(&p->rstate); +} + + +ae_bool _lincgreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + lincgreport *p = (lincgreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _lincgreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + lincgreport *dst = (lincgreport*)_dst; + lincgreport *src = (lincgreport*)_src; + dst->iterationscount = src->iterationscount; + dst->nmv = src->nmv; + dst->terminationtype = src->terminationtype; + dst->r2 = src->r2; + return ae_true; +} + + +void _lincgreport_clear(void* _p) +{ + lincgreport *p = (lincgreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _lincgreport_destroy(void* _p) +{ + lincgreport *p = (lincgreport*)_p; + ae_touch_ptr((void*)p); +} + + + + +/************************************************************************* + LEVENBERG-MARQUARDT-LIKE NONLINEAR SOLVER + +DESCRIPTION: +This algorithm solves system of nonlinear equations + F[0](x[0], ..., x[n-1]) = 0 + F[1](x[0], ..., x[n-1]) = 0 + ... + F[M-1](x[0], ..., x[n-1]) = 0 +with M/N do not necessarily coincide. Algorithm converges quadratically +under following conditions: + * the solution set XS is nonempty + * for some xs in XS there exist such neighbourhood N(xs) that: + * vector function F(x) and its Jacobian J(x) are continuously + differentiable on N + * ||F(x)|| provides local error bound on N, i.e. there exists such + c1, that ||F(x)||>c1*distance(x,XS) +Note that these conditions are much more weaker than usual non-singularity +conditions. For example, algorithm will converge for any affine function +F (whether its Jacobian singular or not). + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function vector F[] and Jacobian matrix at given point X +* value of merit function f(x)=F[0]^2(x)+...+F[M-1]^2(x) at given point X + + +USAGE: +1. User initializes algorithm state with NLEQCreateLM() call +2. User tunes solver parameters with NLEQSetCond(), NLEQSetStpMax() and + other functions +3. User calls NLEQSolve() function which takes algorithm state and + pointers (delegates, etc.) to callback functions which calculate merit + function value and Jacobian. +4. User calls NLEQResults() to get solution +5. Optionally, user may call NLEQRestartFrom() to solve another problem + with same parameters (N/M) but another starting point and/or another + function vector. NLEQRestartFrom() allows to reuse already initialized + structure. + + +INPUT PARAMETERS: + N - space dimension, N>1: + * if provided, only leading N elements of X are used + * if not provided, determined automatically from size of X + M - system size + X - starting point + + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + +NOTES: +1. you may tune stopping conditions with NLEQSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use NLEQSetStpMax() function to bound algorithm's steps. +3. this algorithm is a slightly modified implementation of the method + described in 'Levenberg-Marquardt method for constrained nonlinear + equations with strong local convergence properties' by Christian Kanzow + Nobuo Yamashita and Masao Fukushima and further developed in 'On the + convergence of a New Levenberg-Marquardt Method' by Jin-yan Fan and + Ya-Xiang Yuan. + + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqcreatelm(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + nleqstate* state, + ae_state *_state) +{ + + _nleqstate_clear(state); + + ae_assert(n>=1, "NLEQCreateLM: N<1!", _state); + ae_assert(m>=1, "NLEQCreateLM: M<1!", _state); + ae_assert(x->cnt>=n, "NLEQCreateLM: Length(X)n = n; + state->m = m; + nleqsetcond(state, 0, 0, _state); + nleqsetxrep(state, ae_false, _state); + nleqsetstpmax(state, 0, _state); + ae_vector_set_length(&state->x, n, _state); + ae_vector_set_length(&state->xbase, n, _state); + ae_matrix_set_length(&state->j, m, n, _state); + ae_vector_set_length(&state->fi, m, _state); + ae_vector_set_length(&state->rightpart, n, _state); + ae_vector_set_length(&state->candstep, n, _state); + nleqrestartfrom(state, x, _state); +} + + +/************************************************************************* +This function sets stopping conditions for the nonlinear solver + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsF - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition ||F||<=EpsF is satisfied + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsF=0 and MaxIts=0 simultaneously will lead to automatic +stopping criterion selection (small EpsF). + +NOTES: + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetcond(nleqstate* state, + double epsf, + ae_int_t maxits, + ae_state *_state) +{ + + + ae_assert(ae_isfinite(epsf, _state), "NLEQSetCond: EpsF is not finite number!", _state); + ae_assert(ae_fp_greater_eq(epsf,0), "NLEQSetCond: negative EpsF!", _state); + ae_assert(maxits>=0, "NLEQSetCond: negative MaxIts!", _state); + if( ae_fp_eq(epsf,0)&&maxits==0 ) + { + epsf = 1.0E-6; + } + state->epsf = epsf; + state->maxits = maxits; +} + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to NLEQSolve(). + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetxrep(nleqstate* state, ae_bool needxrep, ae_state *_state) +{ + + + state->xrep = needxrep; +} + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when target function contains exp() or other fast +growing functions, and algorithm makes too large steps which lead to +overflow. This function allows us to reject steps that are too large (and +therefore expose us to the possible overflow) without actually calculating +function value at the x+stp*d. + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetstpmax(nleqstate* state, double stpmax, ae_state *_state) +{ + + + ae_assert(ae_isfinite(stpmax, _state), "NLEQSetStpMax: StpMax is not finite!", _state); + ae_assert(ae_fp_greater_eq(stpmax,0), "NLEQSetStpMax: StpMax<0!", _state); + state->stpmax = stpmax; +} + + +/************************************************************************* + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey +*************************************************************************/ +ae_bool nleqiteration(nleqstate* state, ae_state *_state) +{ + ae_int_t n; + ae_int_t m; + ae_int_t i; + double lambdaup; + double lambdadown; + double lambdav; + double rho; + double mu; + double stepnorm; + ae_bool b; + ae_bool result; + + + + /* + * 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->rstate.stage>=0 ) + { + n = state->rstate.ia.ptr.p_int[0]; + m = state->rstate.ia.ptr.p_int[1]; + i = state->rstate.ia.ptr.p_int[2]; + b = state->rstate.ba.ptr.p_bool[0]; + lambdaup = state->rstate.ra.ptr.p_double[0]; + lambdadown = state->rstate.ra.ptr.p_double[1]; + lambdav = state->rstate.ra.ptr.p_double[2]; + rho = state->rstate.ra.ptr.p_double[3]; + mu = state->rstate.ra.ptr.p_double[4]; + stepnorm = state->rstate.ra.ptr.p_double[5]; + } + else + { + n = -983; + m = -989; + i = -834; + b = ae_false; + lambdaup = -287; + lambdadown = 364; + lambdav = 214; + rho = -338; + mu = -686; + stepnorm = 912; + } + if( state->rstate.stage==0 ) + { + goto lbl_0; + } + if( state->rstate.stage==1 ) + { + goto lbl_1; + } + if( state->rstate.stage==2 ) + { + goto lbl_2; + } + if( state->rstate.stage==3 ) + { + goto lbl_3; + } + if( state->rstate.stage==4 ) + { + goto lbl_4; + } + + /* + * Routine body + */ + + /* + * Prepare + */ + n = state->n; + m = state->m; + state->repterminationtype = 0; + state->repiterationscount = 0; + state->repnfunc = 0; + state->repnjac = 0; + + /* + * Calculate F/G, initialize algorithm + */ + nleq_clearrequestfields(state, _state); + state->needf = ae_true; + state->rstate.stage = 0; + goto lbl_rcomm; +lbl_0: + state->needf = ae_false; + state->repnfunc = state->repnfunc+1; + ae_v_move(&state->xbase.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->fbase = state->f; + state->fprev = ae_maxrealnumber; + if( !state->xrep ) + { + goto lbl_5; + } + + /* + * progress report + */ + nleq_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->rstate.stage = 1; + goto lbl_rcomm; +lbl_1: + state->xupdated = ae_false; +lbl_5: + if( ae_fp_less_eq(state->f,ae_sqr(state->epsf, _state)) ) + { + state->repterminationtype = 1; + result = ae_false; + return result; + } + + /* + * Main cycle + */ + lambdaup = 10; + lambdadown = 0.3; + lambdav = 0.001; + rho = 1; +lbl_7: + if( ae_false ) + { + goto lbl_8; + } + + /* + * Get Jacobian; + * before we get to this point we already have State.XBase filled + * with current point and State.FBase filled with function value + * at XBase + */ + nleq_clearrequestfields(state, _state); + state->needfij = ae_true; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->rstate.stage = 2; + goto lbl_rcomm; +lbl_2: + state->needfij = ae_false; + state->repnfunc = state->repnfunc+1; + state->repnjac = state->repnjac+1; + rmatrixmv(n, m, &state->j, 0, 0, 1, &state->fi, 0, &state->rightpart, 0, _state); + ae_v_muld(&state->rightpart.ptr.p_double[0], 1, ae_v_len(0,n-1), -1); + + /* + * Inner cycle: find good lambda + */ +lbl_9: + if( ae_false ) + { + goto lbl_10; + } + + /* + * Solve (J^T*J + (Lambda+Mu)*I)*y = J^T*F + * to get step d=-y where: + * * Mu=||F|| - is damping parameter for nonlinear system + * * Lambda - is additional Levenberg-Marquardt parameter + * for better convergence when far away from minimum + */ + for(i=0; i<=n-1; i++) + { + state->candstep.ptr.p_double[i] = 0; + } + fblssolvecgx(&state->j, m, n, lambdav, &state->rightpart, &state->candstep, &state->cgbuf, _state); + + /* + * Normalize step (it must be no more than StpMax) + */ + stepnorm = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(state->candstep.ptr.p_double[i],0) ) + { + stepnorm = 1; + break; + } + } + linminnormalized(&state->candstep, &stepnorm, n, _state); + if( ae_fp_neq(state->stpmax,0) ) + { + stepnorm = ae_minreal(stepnorm, state->stpmax, _state); + } + + /* + * Test new step - is it good enough? + * * if not, Lambda is increased and we try again. + * * if step is good, we decrease Lambda and move on. + * + * We can break this cycle on two occasions: + * * step is so small that x+step==x (in floating point arithmetics) + * * lambda is so large + */ + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ae_v_addd(&state->x.ptr.p_double[0], 1, &state->candstep.ptr.p_double[0], 1, ae_v_len(0,n-1), stepnorm); + b = ae_true; + for(i=0; i<=n-1; i++) + { + if( ae_fp_neq(state->x.ptr.p_double[i],state->xbase.ptr.p_double[i]) ) + { + b = ae_false; + break; + } + } + if( b ) + { + + /* + * Step is too small, force zero step and break + */ + stepnorm = 0; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->f = state->fbase; + goto lbl_10; + } + nleq_clearrequestfields(state, _state); + state->needf = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needf = ae_false; + state->repnfunc = state->repnfunc+1; + if( ae_fp_less(state->f,state->fbase) ) + { + + /* + * function value decreased, move on + */ + nleq_decreaselambda(&lambdav, &rho, lambdadown, _state); + goto lbl_10; + } + if( !nleq_increaselambda(&lambdav, &rho, lambdaup, _state) ) + { + + /* + * Lambda is too large (near overflow), force zero step and break + */ + stepnorm = 0; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->f = state->fbase; + goto lbl_10; + } + goto lbl_9; +lbl_10: + + /* + * Accept step: + * * new position + * * new function value + */ + state->fbase = state->f; + ae_v_addd(&state->xbase.ptr.p_double[0], 1, &state->candstep.ptr.p_double[0], 1, ae_v_len(0,n-1), stepnorm); + state->repiterationscount = state->repiterationscount+1; + + /* + * Report new iteration + */ + if( !state->xrep ) + { + goto lbl_11; + } + nleq_clearrequestfields(state, _state); + state->xupdated = ae_true; + state->f = state->fbase; + ae_v_move(&state->x.ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,n-1)); + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->xupdated = ae_false; +lbl_11: + + /* + * Test stopping conditions on F, step (zero/non-zero) and MaxIts; + * If one of the conditions is met, RepTerminationType is changed. + */ + if( ae_fp_less_eq(ae_sqrt(state->f, _state),state->epsf) ) + { + state->repterminationtype = 1; + } + if( ae_fp_eq(stepnorm,0)&&state->repterminationtype==0 ) + { + state->repterminationtype = -4; + } + if( state->repiterationscount>=state->maxits&&state->maxits>0 ) + { + state->repterminationtype = 5; + } + if( state->repterminationtype!=0 ) + { + goto lbl_8; + } + + /* + * Now, iteration is finally over + */ + goto lbl_7; +lbl_8: + result = ae_false; + return result; + + /* + * Saving state + */ +lbl_rcomm: + result = ae_true; + state->rstate.ia.ptr.p_int[0] = n; + state->rstate.ia.ptr.p_int[1] = m; + state->rstate.ia.ptr.p_int[2] = i; + state->rstate.ba.ptr.p_bool[0] = b; + state->rstate.ra.ptr.p_double[0] = lambdaup; + state->rstate.ra.ptr.p_double[1] = lambdadown; + state->rstate.ra.ptr.p_double[2] = lambdav; + state->rstate.ra.ptr.p_double[3] = rho; + state->rstate.ra.ptr.p_double[4] = mu; + state->rstate.ra.ptr.p_double[5] = stepnorm; + return result; +} + + +/************************************************************************* +NLEQ solver results + +INPUT PARAMETERS: + State - algorithm state. + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -4 ERROR: algorithm has converged to the + stationary point Xf which is local minimum of + f=F[0]^2+...+F[m-1]^2, but is not solution of + nonlinear system. + * 1 sqrt(f)<=EpsF. + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + * ActiveConstraints contains number of active constraints + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqresults(nleqstate* state, + /* Real */ ae_vector* x, + nleqreport* rep, + ae_state *_state) +{ + + ae_vector_clear(x); + _nleqreport_clear(rep); + + nleqresultsbuf(state, x, rep, _state); +} + + +/************************************************************************* +NLEQ solver results + +Buffered implementation of NLEQResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqresultsbuf(nleqstate* state, + /* Real */ ae_vector* x, + nleqreport* rep, + ae_state *_state) +{ + + + if( x->cntn ) + { + ae_vector_set_length(x, state->n, _state); + } + ae_v_move(&x->ptr.p_double[0], 1, &state->xbase.ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + rep->iterationscount = state->repiterationscount; + rep->nfunc = state->repnfunc; + rep->njac = state->repnjac; + rep->terminationtype = state->repterminationtype; +} + + +/************************************************************************* +This subroutine restarts CG algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used for reverse communication previously + allocated with MinCGCreate call. + X - new starting point. + BndL - new lower bounds + BndU - new upper bounds + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqrestartfrom(nleqstate* state, + /* Real */ ae_vector* x, + ae_state *_state) +{ + + + ae_assert(x->cnt>=state->n, "NLEQRestartFrom: Length(X)n, _state), "NLEQRestartFrom: X contains infinite or NaN values!", _state); + ae_v_move(&state->x.ptr.p_double[0], 1, &x->ptr.p_double[0], 1, ae_v_len(0,state->n-1)); + ae_vector_set_length(&state->rstate.ia, 2+1, _state); + ae_vector_set_length(&state->rstate.ba, 0+1, _state); + ae_vector_set_length(&state->rstate.ra, 5+1, _state); + state->rstate.stage = -1; + nleq_clearrequestfields(state, _state); +} + + +/************************************************************************* +Clears request fileds (to be sure that we don't forgot to clear something) +*************************************************************************/ +static void nleq_clearrequestfields(nleqstate* state, ae_state *_state) +{ + + + state->needf = ae_false; + state->needfij = ae_false; + state->xupdated = ae_false; +} + + +/************************************************************************* +Increases lambda, returns False when there is a danger of overflow +*************************************************************************/ +static ae_bool nleq_increaselambda(double* lambdav, + double* nu, + double lambdaup, + ae_state *_state) +{ + double lnlambda; + double lnnu; + double lnlambdaup; + double lnmax; + ae_bool result; + + + result = ae_false; + lnlambda = ae_log(*lambdav, _state); + lnlambdaup = ae_log(lambdaup, _state); + lnnu = ae_log(*nu, _state); + lnmax = 0.5*ae_log(ae_maxrealnumber, _state); + if( ae_fp_greater(lnlambda+lnlambdaup+lnnu,lnmax) ) + { + return result; + } + if( ae_fp_greater(lnnu+ae_log(2, _state),lnmax) ) + { + return result; + } + *lambdav = *lambdav*lambdaup*(*nu); + *nu = *nu*2; + result = ae_true; + return result; +} + + +/************************************************************************* +Decreases lambda, but leaves it unchanged when there is danger of underflow. +*************************************************************************/ +static void nleq_decreaselambda(double* lambdav, + double* nu, + double lambdadown, + ae_state *_state) +{ + + + *nu = 1; + if( ae_fp_less(ae_log(*lambdav, _state)+ae_log(lambdadown, _state),ae_log(ae_minrealnumber, _state)) ) + { + *lambdav = ae_minrealnumber; + } + else + { + *lambdav = *lambdav*lambdadown; + } +} + + +ae_bool _nleqstate_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + nleqstate *p = (nleqstate*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->x, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->fi, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init(&p->j, 0, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !_rcommstate_init(&p->rstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->xbase, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->candstep, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->rightpart, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->cgbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _nleqstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + nleqstate *dst = (nleqstate*)_dst; + nleqstate *src = (nleqstate*)_src; + dst->n = src->n; + dst->m = src->m; + dst->epsf = src->epsf; + dst->maxits = src->maxits; + dst->xrep = src->xrep; + dst->stpmax = src->stpmax; + if( !ae_vector_init_copy(&dst->x, &src->x, _state, make_automatic) ) + return ae_false; + dst->f = src->f; + if( !ae_vector_init_copy(&dst->fi, &src->fi, _state, make_automatic) ) + return ae_false; + if( !ae_matrix_init_copy(&dst->j, &src->j, _state, make_automatic) ) + return ae_false; + dst->needf = src->needf; + dst->needfij = src->needfij; + dst->xupdated = src->xupdated; + if( !_rcommstate_init_copy(&dst->rstate, &src->rstate, _state, make_automatic) ) + return ae_false; + dst->repiterationscount = src->repiterationscount; + dst->repnfunc = src->repnfunc; + dst->repnjac = src->repnjac; + dst->repterminationtype = src->repterminationtype; + if( !ae_vector_init_copy(&dst->xbase, &src->xbase, _state, make_automatic) ) + return ae_false; + dst->fbase = src->fbase; + dst->fprev = src->fprev; + if( !ae_vector_init_copy(&dst->candstep, &src->candstep, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->rightpart, &src->rightpart, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->cgbuf, &src->cgbuf, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _nleqstate_clear(void* _p) +{ + nleqstate *p = (nleqstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->x); + ae_vector_clear(&p->fi); + ae_matrix_clear(&p->j); + _rcommstate_clear(&p->rstate); + ae_vector_clear(&p->xbase); + ae_vector_clear(&p->candstep); + ae_vector_clear(&p->rightpart); + ae_vector_clear(&p->cgbuf); +} + + +void _nleqstate_destroy(void* _p) +{ + nleqstate *p = (nleqstate*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->x); + ae_vector_destroy(&p->fi); + ae_matrix_destroy(&p->j); + _rcommstate_destroy(&p->rstate); + ae_vector_destroy(&p->xbase); + ae_vector_destroy(&p->candstep); + ae_vector_destroy(&p->rightpart); + ae_vector_destroy(&p->cgbuf); +} + + +ae_bool _nleqreport_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + nleqreport *p = (nleqreport*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _nleqreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + nleqreport *dst = (nleqreport*)_dst; + nleqreport *src = (nleqreport*)_src; + dst->iterationscount = src->iterationscount; + dst->nfunc = src->nfunc; + dst->njac = src->njac; + dst->terminationtype = src->terminationtype; + return ae_true; +} + + +void _nleqreport_clear(void* _p) +{ + nleqreport *p = (nleqreport*)_p; + ae_touch_ptr((void*)p); +} + + +void _nleqreport_destroy(void* _p) +{ + nleqreport *p = (nleqreport*)_p; + ae_touch_ptr((void*)p); +} + + + +} + diff --git a/psdlag/src/solvers.h b/psdlag/src/solvers.h new file mode 100644 index 0000000..3c94873 --- /dev/null +++ b/psdlag/src/solvers.h @@ -0,0 +1,2016 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _solvers_pkg_h +#define _solvers_pkg_h +#include "ap.h" +#include "alglibinternal.h" +#include "linalg.h" +#include "alglibmisc.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +typedef struct +{ + double r1; + double rinf; +} densesolverreport; +typedef struct +{ + double r2; + ae_matrix cx; + ae_int_t n; + ae_int_t k; +} densesolverlsreport; +typedef struct +{ + normestimatorstate nes; + ae_vector rx; + ae_vector b; + ae_int_t n; + ae_int_t m; + ae_int_t prectype; + ae_vector ui; + ae_vector uip1; + ae_vector vi; + ae_vector vip1; + ae_vector omegai; + ae_vector omegaip1; + double alphai; + double alphaip1; + double betai; + double betaip1; + double phibari; + double phibarip1; + double phii; + double rhobari; + double rhobarip1; + double rhoi; + double ci; + double si; + double theta; + double lambdai; + ae_vector d; + double anorm; + double bnorm2; + double dnorm; + double r2; + ae_vector x; + ae_vector mv; + ae_vector mtv; + double epsa; + double epsb; + double epsc; + ae_int_t maxits; + ae_bool xrep; + ae_bool xupdated; + ae_bool needmv; + ae_bool needmtv; + ae_bool needmv2; + ae_bool needvmv; + ae_bool needprec; + ae_int_t repiterationscount; + ae_int_t repnmv; + ae_int_t repterminationtype; + ae_bool running; + ae_vector tmpd; + ae_vector tmpx; + rcommstate rstate; +} linlsqrstate; +typedef struct +{ + ae_int_t iterationscount; + ae_int_t nmv; + ae_int_t terminationtype; +} linlsqrreport; +typedef struct +{ + ae_vector rx; + ae_vector b; + ae_int_t n; + ae_int_t prectype; + ae_vector cx; + ae_vector cr; + ae_vector cz; + ae_vector p; + ae_vector r; + ae_vector z; + double alpha; + double beta; + double r2; + double meritfunction; + ae_vector x; + ae_vector mv; + ae_vector pv; + double vmv; + ae_vector startx; + double epsf; + ae_int_t maxits; + ae_int_t itsbeforerestart; + ae_int_t itsbeforerupdate; + ae_bool xrep; + ae_bool xupdated; + ae_bool needmv; + ae_bool needmtv; + ae_bool needmv2; + ae_bool needvmv; + ae_bool needprec; + ae_int_t repiterationscount; + ae_int_t repnmv; + ae_int_t repterminationtype; + ae_bool running; + ae_vector tmpd; + rcommstate rstate; +} lincgstate; +typedef struct +{ + ae_int_t iterationscount; + ae_int_t nmv; + ae_int_t terminationtype; + double r2; +} lincgreport; +typedef struct +{ + ae_int_t n; + ae_int_t m; + double epsf; + ae_int_t maxits; + ae_bool xrep; + double stpmax; + ae_vector x; + double f; + ae_vector fi; + ae_matrix j; + ae_bool needf; + ae_bool needfij; + ae_bool xupdated; + rcommstate rstate; + ae_int_t repiterationscount; + ae_int_t repnfunc; + ae_int_t repnjac; + ae_int_t repterminationtype; + ae_vector xbase; + double fbase; + double fprev; + ae_vector candstep; + ae_vector rightpart; + ae_vector cgbuf; +} nleqstate; +typedef struct +{ + ae_int_t iterationscount; + ae_int_t nfunc; + ae_int_t njac; + ae_int_t terminationtype; +} nleqreport; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + +/************************************************************************* + +*************************************************************************/ +class _densesolverreport_owner +{ +public: + _densesolverreport_owner(); + _densesolverreport_owner(const _densesolverreport_owner &rhs); + _densesolverreport_owner& operator=(const _densesolverreport_owner &rhs); + virtual ~_densesolverreport_owner(); + alglib_impl::densesolverreport* c_ptr(); + alglib_impl::densesolverreport* c_ptr() const; +protected: + alglib_impl::densesolverreport *p_struct; +}; +class densesolverreport : public _densesolverreport_owner +{ +public: + densesolverreport(); + densesolverreport(const densesolverreport &rhs); + densesolverreport& operator=(const densesolverreport &rhs); + virtual ~densesolverreport(); + double &r1; + double &rinf; + +}; + + +/************************************************************************* + +*************************************************************************/ +class _densesolverlsreport_owner +{ +public: + _densesolverlsreport_owner(); + _densesolverlsreport_owner(const _densesolverlsreport_owner &rhs); + _densesolverlsreport_owner& operator=(const _densesolverlsreport_owner &rhs); + virtual ~_densesolverlsreport_owner(); + alglib_impl::densesolverlsreport* c_ptr(); + alglib_impl::densesolverlsreport* c_ptr() const; +protected: + alglib_impl::densesolverlsreport *p_struct; +}; +class densesolverlsreport : public _densesolverlsreport_owner +{ +public: + densesolverlsreport(); + densesolverlsreport(const densesolverlsreport &rhs); + densesolverlsreport& operator=(const densesolverlsreport &rhs); + virtual ~densesolverlsreport(); + double &r2; + real_2d_array cx; + ae_int_t &n; + ae_int_t &k; + +}; + +/************************************************************************* +This object stores state of the LinLSQR method. + +You should use ALGLIB functions to work with this object. +*************************************************************************/ +class _linlsqrstate_owner +{ +public: + _linlsqrstate_owner(); + _linlsqrstate_owner(const _linlsqrstate_owner &rhs); + _linlsqrstate_owner& operator=(const _linlsqrstate_owner &rhs); + virtual ~_linlsqrstate_owner(); + alglib_impl::linlsqrstate* c_ptr(); + alglib_impl::linlsqrstate* c_ptr() const; +protected: + alglib_impl::linlsqrstate *p_struct; +}; +class linlsqrstate : public _linlsqrstate_owner +{ +public: + linlsqrstate(); + linlsqrstate(const linlsqrstate &rhs); + linlsqrstate& operator=(const linlsqrstate &rhs); + virtual ~linlsqrstate(); + +}; + + +/************************************************************************* + +*************************************************************************/ +class _linlsqrreport_owner +{ +public: + _linlsqrreport_owner(); + _linlsqrreport_owner(const _linlsqrreport_owner &rhs); + _linlsqrreport_owner& operator=(const _linlsqrreport_owner &rhs); + virtual ~_linlsqrreport_owner(); + alglib_impl::linlsqrreport* c_ptr(); + alglib_impl::linlsqrreport* c_ptr() const; +protected: + alglib_impl::linlsqrreport *p_struct; +}; +class linlsqrreport : public _linlsqrreport_owner +{ +public: + linlsqrreport(); + linlsqrreport(const linlsqrreport &rhs); + linlsqrreport& operator=(const linlsqrreport &rhs); + virtual ~linlsqrreport(); + ae_int_t &iterationscount; + ae_int_t &nmv; + ae_int_t &terminationtype; + +}; + +/************************************************************************* +This object stores state of the linear CG method. + +You should use ALGLIB functions to work with this object. +Never try to access its fields directly! +*************************************************************************/ +class _lincgstate_owner +{ +public: + _lincgstate_owner(); + _lincgstate_owner(const _lincgstate_owner &rhs); + _lincgstate_owner& operator=(const _lincgstate_owner &rhs); + virtual ~_lincgstate_owner(); + alglib_impl::lincgstate* c_ptr(); + alglib_impl::lincgstate* c_ptr() const; +protected: + alglib_impl::lincgstate *p_struct; +}; +class lincgstate : public _lincgstate_owner +{ +public: + lincgstate(); + lincgstate(const lincgstate &rhs); + lincgstate& operator=(const lincgstate &rhs); + virtual ~lincgstate(); + +}; + + +/************************************************************************* + +*************************************************************************/ +class _lincgreport_owner +{ +public: + _lincgreport_owner(); + _lincgreport_owner(const _lincgreport_owner &rhs); + _lincgreport_owner& operator=(const _lincgreport_owner &rhs); + virtual ~_lincgreport_owner(); + alglib_impl::lincgreport* c_ptr(); + alglib_impl::lincgreport* c_ptr() const; +protected: + alglib_impl::lincgreport *p_struct; +}; +class lincgreport : public _lincgreport_owner +{ +public: + lincgreport(); + lincgreport(const lincgreport &rhs); + lincgreport& operator=(const lincgreport &rhs); + virtual ~lincgreport(); + ae_int_t &iterationscount; + ae_int_t &nmv; + ae_int_t &terminationtype; + double &r2; + +}; + +/************************************************************************* + +*************************************************************************/ +class _nleqstate_owner +{ +public: + _nleqstate_owner(); + _nleqstate_owner(const _nleqstate_owner &rhs); + _nleqstate_owner& operator=(const _nleqstate_owner &rhs); + virtual ~_nleqstate_owner(); + alglib_impl::nleqstate* c_ptr(); + alglib_impl::nleqstate* c_ptr() const; +protected: + alglib_impl::nleqstate *p_struct; +}; +class nleqstate : public _nleqstate_owner +{ +public: + nleqstate(); + nleqstate(const nleqstate &rhs); + nleqstate& operator=(const nleqstate &rhs); + virtual ~nleqstate(); + ae_bool &needf; + ae_bool &needfij; + ae_bool &xupdated; + double &f; + real_1d_array fi; + real_2d_array j; + real_1d_array x; + +}; + + +/************************************************************************* + +*************************************************************************/ +class _nleqreport_owner +{ +public: + _nleqreport_owner(); + _nleqreport_owner(const _nleqreport_owner &rhs); + _nleqreport_owner& operator=(const _nleqreport_owner &rhs); + virtual ~_nleqreport_owner(); + alglib_impl::nleqreport* c_ptr(); + alglib_impl::nleqreport* c_ptr() const; +protected: + alglib_impl::nleqreport *p_struct; +}; +class nleqreport : public _nleqreport_owner +{ +public: + nleqreport(); + nleqreport(const nleqreport &rhs); + nleqreport& operator=(const nleqreport &rhs); + virtual ~nleqreport(); + ae_int_t &iterationscount; + ae_int_t &nfunc; + ae_int_t &njac; + ae_int_t &terminationtype; + +}; + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*x=b, where A is NxN non-denegerate +real matrix, x and b are vectors. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - return code: + * -3 A is singular, or VERY close to singular. + X is filled by zeros in such cases. + * -1 N<=0 was passed + * 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 + X - array[0..N-1], it contains: + * solution of A*x=b if A is non-singular (well-conditioned + or ill-conditioned, but not very close to singular) + * zeros, if A is singular or VERY close to singular + (in this case Info=-3). + +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. + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolve(const real_2d_array &a, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); + + +/************************************************************************* +Dense solver. + +Similar to RMatrixSolve() but solves task with multiple right parts (where +b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* optional iterative refinement +* O(N^3+M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + RFS - iterative refinement switch: + * True - refinement is used. + Less performance, more precision. + * False - refinement is not used. + More performance, less precision. + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolvem(const real_2d_array &a, const ae_int_t n, const real_2d_array &b, const ae_int_t m, const bool rfs, ae_int_t &info, densesolverreport &rep, real_2d_array &x); + + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*X=B, where A is NxN non-denegerate +real matrix given by its LU decomposition, X and B are NxM real matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixlusolve(const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); + + +/************************************************************************* +Dense solver. + +Similar to RMatrixLUSolve() but solves task with multiple right parts +(where b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixlusolvem(const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x); + + +/************************************************************************* +Dense solver. + +This subroutine solves a system A*x=b, where BOTH ORIGINAL A AND ITS +LU DECOMPOSITION ARE KNOWN. You can use it if for some reasons you have +both A and its LU decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixmixedsolve(const real_2d_array &a, const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); + + +/************************************************************************* +Dense solver. + +Similar to RMatrixMixedSolve() but solves task with multiple right parts +(where b and x are NxM matrices). + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void rmatrixmixedsolvem(const real_2d_array &a, const real_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3+M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + RFS - iterative refinement switch: + * True - refinement is used. + Less performance, more precision. + * False - refinement is not used. + More performance, less precision. + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixsolvem(const complex_2d_array &a, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, const bool rfs, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixsolve(const complex_2d_array &a, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, RMatrixLU result + P - array[0..N-1], pivots array, RMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixlusolvem(const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation + +No iterative refinement is provided because exact form of original matrix +is not known to subroutine. Use CMatrixSolve or CMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixlusolve(const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixMixedSolveM(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(M*N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixmixedsolvem(const complex_2d_array &a, const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixMixedSolve(), but for complex matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* iterative refinement +* O(N^2) complexity + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + LUA - array[0..N-1,0..N-1], LU decomposition, CMatrixLU result + P - array[0..N-1], pivots array, CMatrixLU result + N - size of A + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolveM + Rep - same as in RMatrixSolveM + X - same as in RMatrixSolveM + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void cmatrixmixedsolve(const complex_2d_array &a, const complex_2d_array &lua, const integer_1d_array &p, const ae_int_t n, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for symmetric positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3+M*N^2) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve. + Returns -3 for non-SPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixsolvem(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for SPD matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Returns -3 for non-SPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixsolve(const real_2d_array &a, const ae_int_t n, const bool isupper, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for SPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of CHA + IsUpper - what half of CHA is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskysolvem(const real_2d_array &cha, const ae_int_t n, const bool isupper, const real_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, real_2d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for SPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of A + IsUpper - what half of CHA is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void spdmatrixcholeskysolve(const real_2d_array &cha, const ae_int_t n, const bool isupper, const real_1d_array &b, ae_int_t &info, densesolverreport &rep, real_1d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixSolveM(), but for Hermitian positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3+M*N^2) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve. + Returns -3 for non-HPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixsolvem(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixSolve(), but for Hermitian positive definite +matrices. + +Algorithm features: +* automatic detection of degenerate cases +* condition number estimation +* O(N^3) complexity +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + A - array[0..N-1,0..N-1], system matrix + N - size of A + IsUpper - what half of A is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Returns -3 for non-HPD matrices. + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixsolve(const complex_2d_array &a, const ae_int_t n, const bool isupper, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolveM(), but for HPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(M*N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + HPDMatrixCholesky result + N - size of CHA + IsUpper - what half of CHA is provided + B - array[0..N-1,0..M-1], right part + M - right part size + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskysolvem(const complex_2d_array &cha, const ae_int_t n, const bool isupper, const complex_2d_array &b, const ae_int_t m, ae_int_t &info, densesolverreport &rep, complex_2d_array &x); + + +/************************************************************************* +Dense solver. Same as RMatrixLUSolve(), but for HPD matrices represented +by their Cholesky decomposition. + +Algorithm features: +* automatic detection of degenerate cases +* O(N^2) complexity +* condition number estimation +* matrix is represented by its upper or lower triangle + +No iterative refinement is provided because such partial representation of +matrix does not allow efficient calculation of extra-precise matrix-vector +products for large matrices. Use RMatrixSolve or RMatrixMixedSolve if you +need iterative refinement. + +INPUT PARAMETERS + CHA - array[0..N-1,0..N-1], Cholesky decomposition, + SPDMatrixCholesky result + N - size of A + IsUpper - what half of CHA is provided + B - array[0..N-1], right part + +OUTPUT PARAMETERS + Info - same as in RMatrixSolve + Rep - same as in RMatrixSolve + X - same as in RMatrixSolve + + -- ALGLIB -- + Copyright 27.01.2010 by Bochkanov Sergey +*************************************************************************/ +void hpdmatrixcholeskysolve(const complex_2d_array &cha, const ae_int_t n, const bool isupper, const complex_1d_array &b, ae_int_t &info, densesolverreport &rep, complex_1d_array &x); + + +/************************************************************************* +Dense solver. + +This subroutine finds solution of the linear system A*X=B with non-square, +possibly degenerate A. System is solved in the least squares sense, and +general least squares solution X = X0 + CX*y which minimizes |A*X-B| is +returned. If A is non-degenerate, solution in the usual sense is returned. + +Algorithm features: +* automatic detection (and correct handling!) of degenerate cases +* iterative refinement +* O(N^3) complexity + +INPUT PARAMETERS + A - array[0..NRows-1,0..NCols-1], system matrix + NRows - vertical size of A + NCols - horizontal size of A + B - array[0..NCols-1], right part + Threshold- a number in [0,1]. Singular values beyond Threshold are + considered zero. Set it to 0.0, if you don't understand + what it means, so the solver will choose good value on its + own. + +OUTPUT PARAMETERS + Info - return code: + * -4 SVD subroutine failed + * -1 if NRows<=0 or NCols<=0 or Threshold<0 was passed + * 1 if task is solved + Rep - solver report, see below for more info + X - array[0..N-1,0..M-1], it contains: + * solution of A*X=B (even for singular A) + * zeros, if SVD subroutine failed + +SOLVER REPORT + +Subroutine sets following fields of the Rep structure: +* R2 reciprocal of condition number: 1/cond(A), 2-norm. +* N = NCols +* K dim(Null(A)) +* CX array[0..N-1,0..K-1], kernel of A. + Columns of CX store such vectors that A*CX[i]=0. + + -- ALGLIB -- + Copyright 24.08.2009 by Bochkanov Sergey +*************************************************************************/ +void rmatrixsolvels(const real_2d_array &a, const ae_int_t nrows, const ae_int_t ncols, const real_1d_array &b, const double threshold, ae_int_t &info, densesolverlsreport &rep, real_1d_array &x); + +/************************************************************************* +This function initializes linear LSQR Solver. This solver is used to solve +non-symmetric (and, possibly, non-square) problems. Least squares solution +is returned for non-compatible systems. + +USAGE: +1. User initializes algorithm state with LinLSQRCreate() call +2. User tunes solver parameters with LinLSQRSetCond() and other functions +3. User calls LinLSQRSolveSparse() function which takes algorithm state + and SparseMatrix object. +4. User calls LinLSQRResults() to get solution +5. Optionally, user may call LinLSQRSolveSparse() again to solve another + problem with different matrix and/or right part without reinitializing + LinLSQRState structure. + +INPUT PARAMETERS: + M - number of rows in A + N - number of variables, N>0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrcreate(const ae_int_t m, const ae_int_t n, linlsqrstate &state); + + +/************************************************************************* +This function changes preconditioning settings of LinLSQQSolveSparse() +function. By default, SolveSparse() uses diagonal preconditioner, but if +you want to use solver without preconditioning, you can call this function +which forces solver to use unit matrix for preconditioning. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetprecunit(const linlsqrstate &state); + + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. LinCGSolveSparse() will use diagonal of the system matrix as +preconditioner. This preconditioning mode is active by default. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetprecdiag(const linlsqrstate &state); + + +/************************************************************************* +This function sets optional Tikhonov regularization coefficient. +It is zero by default. + +INPUT PARAMETERS: + LambdaI - regularization factor, LambdaI>=0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetlambdai(const linlsqrstate &state, const double lambdai); + + +/************************************************************************* +Procedure for solution of A*x=b with sparse A. + +INPUT PARAMETERS: + State - algorithm state + A - sparse M*N matrix in the CRS format (you MUST contvert it + to CRS format by calling SparseConvertToCRS() function + BEFORE you pass it to this function). + B - right part, array[M] + +RESULT: + This function returns no result. + You can get solution by calling LinCGResults() + +NOTE: this function uses lightweight preconditioning - multiplication by + inverse of diag(A). If you want, you can turn preconditioning off by + calling LinLSQRSetPrecUnit(). However, preconditioning cost is low + and preconditioner is very important for solution of badly scaled + problems. + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsolvesparse(const linlsqrstate &state, const sparsematrix &a, const real_1d_array &b); + + +/************************************************************************* +This function sets stopping criteria. + +INPUT PARAMETERS: + EpsA - algorithm will be stopped if ||A^T*Rk||/(||A||*||Rk||)<=EpsA. + EpsB - algorithm will be stopped if ||Rk||<=EpsB*||B|| + MaxIts - algorithm will be stopped if number of iterations + more than MaxIts. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTE: if EpsA,EpsB,EpsC and MaxIts are zero then these variables will +be setted as default values. + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetcond(const linlsqrstate &state, const double epsa, const double epsb, const ae_int_t maxits); + + +/************************************************************************* +LSQR solver: results. + +This function must be called after LinLSQRSolve + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[N], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * 1 ||Rk||<=EpsB*||B|| + * 4 ||A^T*Rk||/(||A||*||Rk||)<=EpsA + * 5 MaxIts steps was taken + * 7 rounding errors prevent further progress, + X contains best point found so far. + (sometimes returned on singular systems) + * Rep.IterationsCount contains iterations count + * NMV countains number of matrix-vector calculations + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrresults(const linlsqrstate &state, real_1d_array &x, linlsqrreport &rep); + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 30.11.2011 by Bochkanov Sergey +*************************************************************************/ +void linlsqrsetxrep(const linlsqrstate &state, const bool needxrep); + +/************************************************************************* +This function initializes linear CG Solver. This solver is used to solve +symmetric positive definite problems. If you want to solve nonsymmetric +(or non-positive definite) problem you may use LinLSQR solver provided by +ALGLIB. + +USAGE: +1. User initializes algorithm state with LinCGCreate() call +2. User tunes solver parameters with LinCGSetCond() and other functions +3. Optionally, user sets starting point with LinCGSetStartingPoint() +4. User calls LinCGSolveSparse() function which takes algorithm state and + SparseMatrix object. +5. User calls LinCGResults() to get solution +6. Optionally, user may call LinCGSolveSparse() again to solve another + problem with different matrix and/or right part without reinitializing + LinCGState structure. + +INPUT PARAMETERS: + N - problem dimension, N>0 + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgcreate(const ae_int_t n, lincgstate &state); + + +/************************************************************************* +This function sets starting point. +By default, zero starting point is used. + +INPUT PARAMETERS: + X - starting point, array[N] + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetstartingpoint(const lincgstate &state, const real_1d_array &x); + + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. By default, SolveSparse() uses diagonal preconditioner, but if +you want to use solver without preconditioning, you can call this function +which forces solver to use unit matrix for preconditioning. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void lincgsetprecunit(const lincgstate &state); + + +/************************************************************************* +This function changes preconditioning settings of LinCGSolveSparse() +function. LinCGSolveSparse() will use diagonal of the system matrix as +preconditioner. This preconditioning mode is active by default. + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 19.11.2012 by Bochkanov Sergey +*************************************************************************/ +void lincgsetprecdiag(const lincgstate &state); + + +/************************************************************************* +This function sets stopping criteria. + +INPUT PARAMETERS: + EpsF - algorithm will be stopped if norm of residual is less than + EpsF*||b||. + MaxIts - algorithm will be stopped if number of iterations is more + than MaxIts. + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + +NOTES: +If both EpsF and MaxIts are zero then small EpsF will be set to small +value. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetcond(const lincgstate &state, const double epsf, const ae_int_t maxits); + + +/************************************************************************* +Procedure for solution of A*x=b with sparse A. + +INPUT PARAMETERS: + State - algorithm state + A - sparse matrix in the CRS format (you MUST contvert it to + CRS format by calling SparseConvertToCRS() function). + IsUpper - whether upper or lower triangle of A is used: + * IsUpper=True => only upper triangle is used and lower + triangle is not referenced at all + * IsUpper=False => only lower triangle is used and upper + triangle is not referenced at all + B - right part, array[N] + +RESULT: + This function returns no result. + You can get solution by calling LinCGResults() + +NOTE: this function uses lightweight preconditioning - multiplication by + inverse of diag(A). If you want, you can turn preconditioning off by + calling LinCGSetPrecUnit(). However, preconditioning cost is low and + preconditioner is very important for solution of badly scaled + problems. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsolvesparse(const lincgstate &state, const sparsematrix &a, const bool isupper, const real_1d_array &b); + + +/************************************************************************* +CG-solver: results. + +This function must be called after LinCGSolve + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[N], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -5 input matrix is either not positive definite, + too large or too small + * -4 overflow/underflow during solution + (ill conditioned problem) + * 1 ||residual||<=EpsF*||b|| + * 5 MaxIts steps was taken + * 7 rounding errors prevent further progress, + best point found is returned + * Rep.IterationsCount contains iterations count + * NMV countains number of matrix-vector calculations + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgresults(const lincgstate &state, real_1d_array &x, lincgreport &rep); + + +/************************************************************************* +This function sets restart frequency. By default, algorithm is restarted +after N subsequent iterations. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetrestartfreq(const lincgstate &state, const ae_int_t srf); + + +/************************************************************************* +This function sets frequency of residual recalculations. + +Algorithm updates residual r_k using iterative formula, but recalculates +it from scratch after each 10 iterations. It is done to avoid accumulation +of numerical errors and to stop algorithm when r_k starts to grow. + +Such low update frequence (1/10) gives very little overhead, but makes +algorithm a bit more robust against numerical errors. However, you may +change it + +INPUT PARAMETERS: + Freq - desired update frequency, Freq>=0. + Zero value means that no updates will be done. + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetrupdatefreq(const lincgstate &state, const ae_int_t freq); + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to MinCGOptimize(). + + -- ALGLIB -- + Copyright 14.11.2011 by Bochkanov Sergey +*************************************************************************/ +void lincgsetxrep(const lincgstate &state, const bool needxrep); + +/************************************************************************* + LEVENBERG-MARQUARDT-LIKE NONLINEAR SOLVER + +DESCRIPTION: +This algorithm solves system of nonlinear equations + F[0](x[0], ..., x[n-1]) = 0 + F[1](x[0], ..., x[n-1]) = 0 + ... + F[M-1](x[0], ..., x[n-1]) = 0 +with M/N do not necessarily coincide. Algorithm converges quadratically +under following conditions: + * the solution set XS is nonempty + * for some xs in XS there exist such neighbourhood N(xs) that: + * vector function F(x) and its Jacobian J(x) are continuously + differentiable on N + * ||F(x)|| provides local error bound on N, i.e. there exists such + c1, that ||F(x)||>c1*distance(x,XS) +Note that these conditions are much more weaker than usual non-singularity +conditions. For example, algorithm will converge for any affine function +F (whether its Jacobian singular or not). + + +REQUIREMENTS: +Algorithm will request following information during its operation: +* function vector F[] and Jacobian matrix at given point X +* value of merit function f(x)=F[0]^2(x)+...+F[M-1]^2(x) at given point X + + +USAGE: +1. User initializes algorithm state with NLEQCreateLM() call +2. User tunes solver parameters with NLEQSetCond(), NLEQSetStpMax() and + other functions +3. User calls NLEQSolve() function which takes algorithm state and + pointers (delegates, etc.) to callback functions which calculate merit + function value and Jacobian. +4. User calls NLEQResults() to get solution +5. Optionally, user may call NLEQRestartFrom() to solve another problem + with same parameters (N/M) but another starting point and/or another + function vector. NLEQRestartFrom() allows to reuse already initialized + structure. + + +INPUT PARAMETERS: + N - space dimension, N>1: + * if provided, only leading N elements of X are used + * if not provided, determined automatically from size of X + M - system size + X - starting point + + +OUTPUT PARAMETERS: + State - structure which stores algorithm state + + +NOTES: +1. you may tune stopping conditions with NLEQSetCond() function +2. if target function contains exp() or other fast growing functions, and + optimization algorithm makes too large steps which leads to overflow, + use NLEQSetStpMax() function to bound algorithm's steps. +3. this algorithm is a slightly modified implementation of the method + described in 'Levenberg-Marquardt method for constrained nonlinear + equations with strong local convergence properties' by Christian Kanzow + Nobuo Yamashita and Masao Fukushima and further developed in 'On the + convergence of a New Levenberg-Marquardt Method' by Jin-yan Fan and + Ya-Xiang Yuan. + + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqcreatelm(const ae_int_t n, const ae_int_t m, const real_1d_array &x, nleqstate &state); +void nleqcreatelm(const ae_int_t m, const real_1d_array &x, nleqstate &state); + + +/************************************************************************* +This function sets stopping conditions for the nonlinear solver + +INPUT PARAMETERS: + State - structure which stores algorithm state + EpsF - >=0 + The subroutine finishes its work if on k+1-th iteration + the condition ||F||<=EpsF is satisfied + MaxIts - maximum number of iterations. If MaxIts=0, the number of + iterations is unlimited. + +Passing EpsF=0 and MaxIts=0 simultaneously will lead to automatic +stopping criterion selection (small EpsF). + +NOTES: + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetcond(const nleqstate &state, const double epsf, const ae_int_t maxits); + + +/************************************************************************* +This function turns on/off reporting. + +INPUT PARAMETERS: + State - structure which stores algorithm state + NeedXRep- whether iteration reports are needed or not + +If NeedXRep is True, algorithm will call rep() callback function if it is +provided to NLEQSolve(). + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetxrep(const nleqstate &state, const bool needxrep); + + +/************************************************************************* +This function sets maximum step length + +INPUT PARAMETERS: + State - structure which stores algorithm state + StpMax - maximum step length, >=0. Set StpMax to 0.0, if you don't + want to limit step length. + +Use this subroutine when target function contains exp() or other fast +growing functions, and algorithm makes too large steps which lead to +overflow. This function allows us to reject steps that are too large (and +therefore expose us to the possible overflow) without actually calculating +function value at the x+stp*d. + + -- ALGLIB -- + Copyright 20.08.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqsetstpmax(const nleqstate &state, const double stpmax); + + +/************************************************************************* +This function provides reverse communication interface +Reverse communication interface is not documented or recommended to use. +See below for functions which provide better documented API +*************************************************************************/ +bool nleqiteration(const nleqstate &state); + + +/************************************************************************* +This family of functions is used to launcn iterations of nonlinear solver + +These functions accept following parameters: + state - algorithm state + func - callback which calculates function (or merit function) + value func at given point x + jac - callback which calculates function vector fi[] + and Jacobian jac at given point x + rep - optional callback which is called after each iteration + can be NULL + ptr - optional pointer which is passed to func/grad/hess/jac/rep + can be NULL + + + -- ALGLIB -- + Copyright 20.03.2009 by Bochkanov Sergey + +*************************************************************************/ +void nleqsolve(nleqstate &state, + void (*func)(const real_1d_array &x, double &func, void *ptr), + void (*jac)(const real_1d_array &x, real_1d_array &fi, real_2d_array &jac, void *ptr), + void (*rep)(const real_1d_array &x, double func, void *ptr) = NULL, + void *ptr = NULL); + + +/************************************************************************* +NLEQ solver results + +INPUT PARAMETERS: + State - algorithm state. + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + Rep - optimization report: + * Rep.TerminationType completetion code: + * -4 ERROR: algorithm has converged to the + stationary point Xf which is local minimum of + f=F[0]^2+...+F[m-1]^2, but is not solution of + nonlinear system. + * 1 sqrt(f)<=EpsF. + * 5 MaxIts steps was taken + * 7 stopping conditions are too stringent, + further improvement is impossible + * Rep.IterationsCount contains iterations count + * NFEV countains number of function calculations + * ActiveConstraints contains number of active constraints + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqresults(const nleqstate &state, real_1d_array &x, nleqreport &rep); + + +/************************************************************************* +NLEQ solver results + +Buffered implementation of NLEQResults(), which uses pre-allocated buffer +to store X[]. If buffer size is too small, it resizes buffer. It is +intended to be used in the inner cycles of performance critical algorithms +where array reallocation penalty is too large to be ignored. + + -- ALGLIB -- + Copyright 20.08.2009 by Bochkanov Sergey +*************************************************************************/ +void nleqresultsbuf(const nleqstate &state, real_1d_array &x, nleqreport &rep); + + +/************************************************************************* +This subroutine restarts CG algorithm from new point. All optimization +parameters are left unchanged. + +This function allows to solve multiple optimization problems (which +must have same number of dimensions) without object reallocation penalty. + +INPUT PARAMETERS: + State - structure used for reverse communication previously + allocated with MinCGCreate call. + X - new starting point. + BndL - new lower bounds + BndU - new upper bounds + + -- ALGLIB -- + Copyright 30.07.2010 by Bochkanov Sergey +*************************************************************************/ +void nleqrestartfrom(const nleqstate &state, const real_1d_array &x); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void rmatrixsolve(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state); +void rmatrixsolvem(/* Real */ ae_matrix* a, + ae_int_t n, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_bool rfs, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state); +void rmatrixlusolve(/* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state); +void rmatrixlusolvem(/* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state); +void rmatrixmixedsolve(/* Real */ ae_matrix* a, + /* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state); +void rmatrixmixedsolvem(/* Real */ ae_matrix* a, + /* Real */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state); +void cmatrixsolvem(/* Complex */ ae_matrix* a, + ae_int_t n, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_bool rfs, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state); +void cmatrixsolve(/* Complex */ ae_matrix* a, + ae_int_t n, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state); +void cmatrixlusolvem(/* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state); +void cmatrixlusolve(/* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state); +void cmatrixmixedsolvem(/* Complex */ ae_matrix* a, + /* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state); +void cmatrixmixedsolve(/* Complex */ ae_matrix* a, + /* Complex */ ae_matrix* lua, + /* Integer */ ae_vector* p, + ae_int_t n, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state); +void spdmatrixsolvem(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state); +void spdmatrixsolve(/* Real */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state); +void spdmatrixcholeskysolvem(/* Real */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_matrix* x, + ae_state *_state); +void spdmatrixcholeskysolve(/* Real */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + /* Real */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Real */ ae_vector* x, + ae_state *_state); +void hpdmatrixsolvem(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state); +void hpdmatrixsolve(/* Complex */ ae_matrix* a, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state); +void hpdmatrixcholeskysolvem(/* Complex */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_matrix* b, + ae_int_t m, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_matrix* x, + ae_state *_state); +void hpdmatrixcholeskysolve(/* Complex */ ae_matrix* cha, + ae_int_t n, + ae_bool isupper, + /* Complex */ ae_vector* b, + ae_int_t* info, + densesolverreport* rep, + /* Complex */ ae_vector* x, + ae_state *_state); +void rmatrixsolvels(/* Real */ ae_matrix* a, + ae_int_t nrows, + ae_int_t ncols, + /* Real */ ae_vector* b, + double threshold, + ae_int_t* info, + densesolverlsreport* rep, + /* Real */ ae_vector* x, + ae_state *_state); +ae_bool _densesolverreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _densesolverreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _densesolverreport_clear(void* _p); +void _densesolverreport_destroy(void* _p); +ae_bool _densesolverlsreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _densesolverlsreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _densesolverlsreport_clear(void* _p); +void _densesolverlsreport_destroy(void* _p); +void linlsqrcreate(ae_int_t m, + ae_int_t n, + linlsqrstate* state, + ae_state *_state); +void linlsqrsetb(linlsqrstate* state, + /* Real */ ae_vector* b, + ae_state *_state); +void linlsqrsetprecunit(linlsqrstate* state, ae_state *_state); +void linlsqrsetprecdiag(linlsqrstate* state, ae_state *_state); +void linlsqrsetlambdai(linlsqrstate* state, + double lambdai, + ae_state *_state); +ae_bool linlsqriteration(linlsqrstate* state, ae_state *_state); +void linlsqrsolvesparse(linlsqrstate* state, + sparsematrix* a, + /* Real */ ae_vector* b, + ae_state *_state); +void linlsqrsetcond(linlsqrstate* state, + double epsa, + double epsb, + ae_int_t maxits, + ae_state *_state); +void linlsqrresults(linlsqrstate* state, + /* Real */ ae_vector* x, + linlsqrreport* rep, + ae_state *_state); +void linlsqrsetxrep(linlsqrstate* state, + ae_bool needxrep, + ae_state *_state); +void linlsqrrestart(linlsqrstate* state, ae_state *_state); +ae_bool _linlsqrstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _linlsqrstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _linlsqrstate_clear(void* _p); +void _linlsqrstate_destroy(void* _p); +ae_bool _linlsqrreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _linlsqrreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _linlsqrreport_clear(void* _p); +void _linlsqrreport_destroy(void* _p); +void lincgcreate(ae_int_t n, lincgstate* state, ae_state *_state); +void lincgsetstartingpoint(lincgstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +void lincgsetb(lincgstate* state, + /* Real */ ae_vector* b, + ae_state *_state); +void lincgsetprecunit(lincgstate* state, ae_state *_state); +void lincgsetprecdiag(lincgstate* state, ae_state *_state); +void lincgsetcond(lincgstate* state, + double epsf, + ae_int_t maxits, + ae_state *_state); +ae_bool lincgiteration(lincgstate* state, ae_state *_state); +void lincgsolvesparse(lincgstate* state, + sparsematrix* a, + ae_bool isupper, + /* Real */ ae_vector* b, + ae_state *_state); +void lincgresults(lincgstate* state, + /* Real */ ae_vector* x, + lincgreport* rep, + ae_state *_state); +void lincgsetrestartfreq(lincgstate* state, + ae_int_t srf, + ae_state *_state); +void lincgsetrupdatefreq(lincgstate* state, + ae_int_t freq, + ae_state *_state); +void lincgsetxrep(lincgstate* state, ae_bool needxrep, ae_state *_state); +void lincgrestart(lincgstate* state, ae_state *_state); +ae_bool _lincgstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _lincgstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _lincgstate_clear(void* _p); +void _lincgstate_destroy(void* _p); +ae_bool _lincgreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _lincgreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _lincgreport_clear(void* _p); +void _lincgreport_destroy(void* _p); +void nleqcreatelm(ae_int_t n, + ae_int_t m, + /* Real */ ae_vector* x, + nleqstate* state, + ae_state *_state); +void nleqsetcond(nleqstate* state, + double epsf, + ae_int_t maxits, + ae_state *_state); +void nleqsetxrep(nleqstate* state, ae_bool needxrep, ae_state *_state); +void nleqsetstpmax(nleqstate* state, double stpmax, ae_state *_state); +ae_bool nleqiteration(nleqstate* state, ae_state *_state); +void nleqresults(nleqstate* state, + /* Real */ ae_vector* x, + nleqreport* rep, + ae_state *_state); +void nleqresultsbuf(nleqstate* state, + /* Real */ ae_vector* x, + nleqreport* rep, + ae_state *_state); +void nleqrestartfrom(nleqstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +ae_bool _nleqstate_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _nleqstate_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _nleqstate_clear(void* _p); +void _nleqstate_destroy(void* _p); +ae_bool _nleqreport_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _nleqreport_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _nleqreport_clear(void* _p); +void _nleqreport_destroy(void* _p); + +} +#endif + diff --git a/psdlag/src/specialfunctions.cpp b/psdlag/src/specialfunctions.cpp new file mode 100644 index 0000000..bd786b6 --- /dev/null +++ b/psdlag/src/specialfunctions.cpp @@ -0,0 +1,9637 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "specialfunctions.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +Gamma function + +Input parameters: + X - argument + +Domain: + 0 < X < 171.6 + -170 < X < 0, X is not an integer. + +Relative error: + arithmetic domain # trials peak rms + IEEE -170,-33 20000 2.3e-15 3.3e-16 + IEEE -33, 33 20000 9.4e-16 2.2e-16 + IEEE 33, 171.6 20000 2.3e-15 3.2e-16 + +Cephes Math Library Release 2.8: June, 2000 +Original copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier +Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). +*************************************************************************/ +double gammafunction(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::gammafunction(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Natural logarithm of gamma function + +Input parameters: + X - argument + +Result: + logarithm of the absolute value of the Gamma(X). + +Output parameters: + SgnGam - sign(Gamma(X)) + +Domain: + 0 < X < 2.55e305 + -2.55e305 < X < 0, X is not an integer. + +ACCURACY: +arithmetic domain # trials peak rms + IEEE 0, 3 28000 5.4e-16 1.1e-16 + IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17 +The error criterion was relative when the function magnitude +was greater than one but absolute when it was less than one. + +The following test used the relative error criterion, though +at certain points the relative error could be much higher than +indicated. + IEEE -200, -4 10000 4.8e-16 1.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier +Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). +*************************************************************************/ +double lngamma(const double x, double &sgngam) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::lngamma(x, &sgngam, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Error function + +The integral is + + x + - + 2 | | 2 + erf(x) = -------- | exp( - t ) dt. + sqrt(pi) | | + - + 0 + +For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise +erf(x) = 1 - erfc(x). + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 3.7e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double errorfunction(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::errorfunction(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complementary error function + + 1 - erf(x) = + + inf. + - + 2 | | 2 + erfc(x) = -------- | exp( - t ) dt + sqrt(pi) | | + - + x + + +For small x, erfc(x) = 1 - erf(x); otherwise rational +approximations are computed. + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,26.6417 30000 5.7e-14 1.5e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double errorfunctionc(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::errorfunctionc(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Normal distribution function + +Returns the area under the Gaussian probability density +function, integrated from minus infinity to x: + + x + - + 1 | | 2 + ndtr(x) = --------- | exp( - t /2 ) dt + sqrt(2pi) | | + - + -inf. + + = ( 1 + erf(z) ) / 2 + = erfc(z) / 2 + +where z = x/sqrt(2). Computation is via the functions +erf and erfc. + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE -13,0 30000 3.4e-14 6.7e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double normaldistribution(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::normaldistribution(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Inverse of the error function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double inverf(const double e) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::inverf(e, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Inverse of Normal distribution function + +Returns the argument, x, for which the area under the +Gaussian probability density function (integrated from +minus infinity to x) is equal to y. + + +For small arguments 0 < y < exp(-2), the program computes +z = sqrt( -2.0 * log(y) ); then the approximation is +x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). +There are two rational functions P/Q, one for 0 < y < exp(-32) +and the other for y up to exp(-2). For larger arguments, +w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0.125, 1 20000 7.2e-16 1.3e-16 + IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double invnormaldistribution(const double y0) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::invnormaldistribution(y0, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Incomplete gamma integral + +The function is defined by + + x + - + 1 | | -t a-1 + igam(a,x) = ----- | e t dt. + - | | + | (a) - + 0 + + +In this implementation both arguments must be positive. +The integral is evaluated by either a power series or +continued fraction expansion, depending on the relative +values of a and x. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 200000 3.6e-14 2.9e-15 + IEEE 0,100 300000 9.9e-14 1.5e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletegamma(const double a, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::incompletegamma(a, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complemented incomplete gamma integral + +The function is defined by + + + igamc(a,x) = 1 - igam(a,x) + + inf. + - + 1 | | -t a-1 + = ----- | e t dt. + - | | + | (a) - + x + + +In this implementation both arguments must be positive. +The integral is evaluated by either a power series or +continued fraction expansion, depending on the relative +values of a and x. + +ACCURACY: + +Tested at random a, x. + a x Relative error: +arithmetic domain domain # trials peak rms + IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 + IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletegammac(const double a, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::incompletegammac(a, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Inverse of complemented imcomplete gamma integral + +Given p, the function finds x such that + + igamc( a, x ) = p. + +Starting with the approximate value + + 3 + x = a t + + where + + t = 1 - d - ndtri(p) sqrt(d) + +and + + d = 1/9a, + +the routine performs up to 10 Newton iterations to find the +root of igamc(a,x) - p = 0. + +ACCURACY: + +Tested at random a, p in the intervals indicated. + + a p Relative error: +arithmetic domain domain # trials peak rms + IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 + IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 + IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invincompletegammac(const double a, const double y0) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::invincompletegammac(a, y0, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Airy function + +Solution of the differential equation + +y"(x) = xy. + +The function returns the two independent solutions Ai, Bi +and their first derivatives Ai'(x), Bi'(x). + +Evaluation is by power series summation for small x, +by rational minimax approximations for large x. + + + +ACCURACY: +Error criterion is absolute when function <= 1, relative +when function > 1, except * denotes relative error criterion. +For large negative x, the absolute error increases as x^1.5. +For large positive x, the relative error increases as x^1.5. + +Arithmetic domain function # trials peak rms +IEEE -10, 0 Ai 10000 1.6e-15 2.7e-16 +IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15* +IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16 +IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15* +IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16 +IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +void airy(const double x, double &ai, double &aip, double &bi, double &bip) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::airy(x, &ai, &aip, &bi, &bip, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Bessel function of order zero + +Returns Bessel function of order zero of the argument. + +The domain is divided into the intervals [0, 5] and +(5, infinity). In the first interval the following rational +approximation is used: + + + 2 2 +(w - r ) (w - r ) P (w) / Q (w) + 1 2 3 8 + + 2 +where w = x and the two r's are zeros of the function. + +In the second interval, the Hankel asymptotic expansion +is employed with two rational functions of degree 6/6 +and 7/7. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 60000 4.2e-16 1.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselj0(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besselj0(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Bessel function of order one + +Returns Bessel function of order one of the argument. + +The domain is divided into the intervals [0, 8] and +(8, infinity). In the first interval a 24 term Chebyshev +expansion is used. In the second, the asymptotic +trigonometric representation is employed using two +rational functions of degree 5/5. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 2.6e-16 1.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselj1(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besselj1(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Bessel function of integer order + +Returns Bessel function of order n, where n is a +(possibly negative) integer. + +The ratio of jn(x) to j0(x) is computed by backward +recurrence. First the ratio jn/jn-1 is found by a +continued fraction expansion. Then the recurrence +relating successive orders is applied until j0 or j1 is +reached. + +If n = 0 or 1 the routine for j0 or j1 is called +directly. + +ACCURACY: + + Absolute error: +arithmetic range # trials peak rms + IEEE 0, 30 5000 4.4e-16 7.9e-17 + + +Not suitable for large n or x. Use jv() (fractional order) instead. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseljn(const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besseljn(n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Bessel function of the second kind, order zero + +Returns Bessel function of the second kind, of order +zero, of the argument. + +The domain is divided into the intervals [0, 5] and +(5, infinity). In the first interval a rational approximation +R(x) is employed to compute + y0(x) = R(x) + 2 * log(x) * j0(x) / PI. +Thus a call to j0() is required. + +In the second interval, the Hankel asymptotic expansion +is employed with two rational functions of degree 6/6 +and 7/7. + + + +ACCURACY: + + Absolute error, when y0(x) < 1; else relative error: + +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.3e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double bessely0(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::bessely0(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Bessel function of second kind of order one + +Returns Bessel function of the second kind of order one +of the argument. + +The domain is divided into the intervals [0, 8] and +(8, infinity). In the first interval a 25 term Chebyshev +expansion is used, and a call to j1() is required. +In the second, the asymptotic trigonometric representation +is employed using two rational functions of degree 5/5. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.0e-15 1.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double bessely1(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::bessely1(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Bessel function of second kind of integer order + +Returns Bessel function of order n, where n is a +(possibly negative) integer. + +The function is evaluated by forward recurrence on +n, starting with values computed by the routines +y0() and y1(). + +If n = 0 or 1 the routine for y0 or y1 is called +directly. + +ACCURACY: + Absolute error, except relative + when y > 1: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 3.4e-15 4.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselyn(const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besselyn(n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modified Bessel function of order zero + +Returns modified Bessel function of order zero of the +argument. + +The function is defined as i0(x) = j0( ix ). + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 30000 5.8e-16 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseli0(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besseli0(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modified Bessel function of order one + +Returns modified Bessel function of order one of the +argument. + +The function is defined as i1(x) = -i j1( ix ). + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.9e-15 2.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseli1(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besseli1(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modified Bessel function, second kind, order zero + +Returns modified Bessel function of the second kind +of order zero of the argument. + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + +Tested at 2000 random points between 0 and 8. Peak absolute +error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.2e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselk0(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besselk0(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modified Bessel function, second kind, order one + +Computes the modified Bessel function of the second kind +of order one of the argument. + +The range is partitioned into the two intervals [0,2] and +(2, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.2e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselk1(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besselk1(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Modified Bessel function, second kind, integer order + +Returns modified Bessel function of the second kind +of order n of the argument. + +The range is partitioned into the two intervals [0,9.55] and +(9.55, infinity). An ascending power series is used in the +low range, and an asymptotic expansion in the high range. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 90000 1.8e-8 3.0e-10 + +Error is high only near the crossover point x = 9.55 +between the two expansions used. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselkn(const ae_int_t nn, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::besselkn(nn, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Beta function + + + - - + | (a) | (b) +beta( a, b ) = -----------. + - + | (a+b) + +For large arguments the logarithm of the function is +evaluated using lgam(), then exponentiated. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 30000 8.1e-14 1.1e-14 + +Cephes Math Library Release 2.0: April, 1987 +Copyright 1984, 1987 by Stephen L. Moshier +*************************************************************************/ +double beta(const double a, const double b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::beta(a, b, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Incomplete beta integral + +Returns incomplete beta integral of the arguments, evaluated +from zero to x. The function is defined as + + x + - - + | (a+b) | | a-1 b-1 + ----------- | t (1-t) dt. + - - | | + | (a) | (b) - + 0 + +The domain of definition is 0 <= x <= 1. In this +implementation a and b are restricted to positive values. +The integral from x to 1 may be obtained by the symmetry +relation + + 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). + +The integral is evaluated by a continued fraction expansion +or, when b*x is small, by a power series. + +ACCURACY: + +Tested at uniformly distributed random points (a,b,x) with a and b +in "domain" and x between 0 and 1. + Relative error +arithmetic domain # trials peak rms + IEEE 0,5 10000 6.9e-15 4.5e-16 + IEEE 0,85 250000 2.2e-13 1.7e-14 + IEEE 0,1000 30000 5.3e-12 6.3e-13 + IEEE 0,10000 250000 9.3e-11 7.1e-12 + IEEE 0,100000 10000 8.7e-10 4.8e-11 +Outputs smaller than the IEEE gradual underflow threshold +were excluded from these statistics. + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletebeta(const double a, const double b, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::incompletebeta(a, b, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Inverse of imcomplete beta integral + +Given y, the function finds x such that + + incbet( a, b, x ) = y . + +The routine performs interval halving or Newton iterations to find the +root of incbet(a,b,x) - y = 0. + + +ACCURACY: + + Relative error: + x a,b +arithmetic domain domain # trials peak rms + IEEE 0,1 .5,10000 50000 5.8e-12 1.3e-13 + IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15 + IEEE 0,1 0,5 50000 1.1e-12 5.5e-15 +With a and b constrained to half-integer or integer values: + IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13 + IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16 +With a = .5, b constrained to half-integer or integer values: + IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1996, 2000 by Stephen L. Moshier +*************************************************************************/ +double invincompletebeta(const double a, const double b, const double y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::invincompletebeta(a, b, y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Binomial distribution + +Returns the sum of the terms 0 through k of the Binomial +probability density: + + k + -- ( n ) j n-j + > ( ) p (1-p) + -- ( j ) + j=0 + +The terms are not summed directly; instead the incomplete +beta integral is employed, according to the formula + +y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). + +The arguments must be positive, with p ranging from 0 to 1. + +ACCURACY: + +Tested at random points (a,b,p), with p between 0 and 1. + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 4.3e-15 2.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double binomialdistribution(const ae_int_t k, const ae_int_t n, const double p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::binomialdistribution(k, n, p, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complemented binomial distribution + +Returns the sum of the terms k+1 through n of the Binomial +probability density: + + n + -- ( n ) j n-j + > ( ) p (1-p) + -- ( j ) + j=k+1 + +The terms are not summed directly; instead the incomplete +beta integral is employed, according to the formula + +y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). + +The arguments must be positive, with p ranging from 0 to 1. + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 6.7e-15 8.2e-16 + For p between 0 and .001: + IEEE 0,100 100000 1.5e-13 2.7e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double binomialcdistribution(const ae_int_t k, const ae_int_t n, const double p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::binomialcdistribution(k, n, p, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Inverse binomial distribution + +Finds the event probability p such that the sum of the +terms 0 through k of the Binomial probability density +is equal to the given cumulative probability y. + +This is accomplished using the inverse beta integral +function and the relation + +1 - p = incbi( n-k, k+1, y ). + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 2.3e-14 6.4e-16 + IEEE 0,10000 100000 6.6e-12 1.2e-13 + For p between 10^-6 and 0.001: + IEEE 0,100 100000 2.0e-12 1.3e-14 + IEEE 0,10000 100000 1.5e-12 3.2e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invbinomialdistribution(const ae_int_t k, const ae_int_t n, const double y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::invbinomialdistribution(k, n, y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the value of the Chebyshev polynomials of the +first and second kinds. + +Parameters: + r - polynomial kind, either 1 or 2. + n - degree, n>=0 + x - argument, -1 <= x <= 1 + +Result: + the value of the Chebyshev polynomial at x +*************************************************************************/ +double chebyshevcalculate(const ae_int_t r, const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::chebyshevcalculate(r, n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Summation of Chebyshev polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*T0(x) + c[1]*T1(x) + ... + c[N]*TN(x) +or + c[0]*U0(x) + c[1]*U1(x) + ... + c[N]*UN(x) +depending on the R. + +Parameters: + r - polynomial kind, either 1 or 2. + n - degree, n>=0 + x - argument + +Result: + the value of the Chebyshev polynomial at x +*************************************************************************/ +double chebyshevsum(const real_1d_array &c, const ae_int_t r, const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::chebyshevsum(const_cast(c.c_ptr()), r, n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Representation of Tn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void chebyshevcoefficients(const ae_int_t n, real_1d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::chebyshevcoefficients(n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Conversion of a series of Chebyshev polynomials to a power series. + +Represents A[0]*T0(x) + A[1]*T1(x) + ... + A[N]*Tn(x) as +B[0] + B[1]*X + ... + B[N]*X^N. + +Input parameters: + A - Chebyshev series coefficients + N - degree, N>=0 + +Output parameters + B - power series coefficients +*************************************************************************/ +void fromchebyshev(const real_1d_array &a, const ae_int_t n, real_1d_array &b) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fromchebyshev(const_cast(a.c_ptr()), n, const_cast(b.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Chi-square distribution + +Returns the area under the left hand tail (from 0 to x) +of the Chi square probability density function with +v degrees of freedom. + + + x + - + 1 | | v/2-1 -t/2 + P( x | v ) = ----------- | t e dt + v/2 - | | + 2 | (v/2) - + 0 + +where x is the Chi-square variable. + +The incomplete gamma integral is used, according to the +formula + +y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double chisquaredistribution(const double v, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::chisquaredistribution(v, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complemented Chi-square distribution + +Returns the area under the right hand tail (from x to +infinity) of the Chi square probability density function +with v degrees of freedom: + + inf. + - + 1 | | v/2-1 -t/2 + P( x | v ) = ----------- | t e dt + v/2 - | | + 2 | (v/2) - + x + +where x is the Chi-square variable. + +The incomplete gamma integral is used, according to the +formula + +y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double chisquarecdistribution(const double v, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::chisquarecdistribution(v, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Inverse of complemented Chi-square distribution + +Finds the Chi-square argument x such that the integral +from x to infinity of the Chi-square density is equal +to the given cumulative probability y. + +This is accomplished using the inverse gamma integral +function and the relation + + x/2 = igami( df/2, y ); + +ACCURACY: + +See inverse incomplete gamma function + + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double invchisquaredistribution(const double v, const double y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::invchisquaredistribution(v, y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Dawson's Integral + +Approximates the integral + + x + - + 2 | | 2 + dawsn(x) = exp( -x ) | exp( t ) dt + | | + - + 0 + +Three different rational approximations are employed, for +the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,10 10000 6.9e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double dawsonintegral(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::dawsonintegral(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complete elliptic integral of the first kind + +Approximates the integral + + + + pi/2 + - + | | + | dt +K(m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +using the approximation + + P(x) - log x Q(x). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 2.5e-16 6.8e-17 + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double ellipticintegralk(const double m) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::ellipticintegralk(m, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complete elliptic integral of the first kind + +Approximates the integral + + + + pi/2 + - + | | + | dt +K(m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +where m = 1 - m1, using the approximation + + P(x) - log x Q(x). + +The argument m1 is used rather than m so that the logarithmic +singularity at m = 1 will be shifted to the origin; this +preserves maximum accuracy. + +K(0) = pi/2. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 2.5e-16 6.8e-17 + +Àëãîðèòì âçÿò èç áèáëèîòåêè Cephes +*************************************************************************/ +double ellipticintegralkhighprecision(const double m1) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::ellipticintegralkhighprecision(m1, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Incomplete elliptic integral of the first kind F(phi|m) + +Approximates the integral + + + + phi + - + | | + | dt +F(phi_\m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +of amplitude phi and modulus m, using the arithmetic - +geometric mean algorithm. + + + + +ACCURACY: + +Tested at random points with m in [0, 1] and phi as indicated. + + Relative error: +arithmetic domain # trials peak rms + IEEE -10,10 200000 7.4e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompleteellipticintegralk(const double phi, const double m) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::incompleteellipticintegralk(phi, m, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complete elliptic integral of the second kind + +Approximates the integral + + + pi/2 + - + | | 2 +E(m) = | sqrt( 1 - m sin t ) dt + | | + - + 0 + +using the approximation + + P(x) - x log x Q(x). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 1 10000 2.1e-16 7.3e-17 + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double ellipticintegrale(const double m) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::ellipticintegrale(m, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Incomplete elliptic integral of the second kind + +Approximates the integral + + + phi + - + | | + | 2 +E(phi_\m) = | sqrt( 1 - m sin t ) dt + | + | | + - + 0 + +of amplitude phi and modulus m, using the arithmetic - +geometric mean algorithm. + +ACCURACY: + +Tested at random arguments with phi in [-10, 10] and m in +[0, 1]. + Relative error: +arithmetic domain # trials peak rms + IEEE -10,10 150000 3.3e-15 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompleteellipticintegrale(const double phi, const double m) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::incompleteellipticintegrale(phi, m, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Exponential integral Ei(x) + + x + - t + | | e + Ei(x) = -|- --- dt . + | | t + - + -inf + +Not defined for x <= 0. +See also expn.c. + + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,100 50000 8.6e-16 1.3e-16 + +Cephes Math Library Release 2.8: May, 1999 +Copyright 1999 by Stephen L. Moshier +*************************************************************************/ +double exponentialintegralei(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::exponentialintegralei(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Exponential integral En(x) + +Evaluates the exponential integral + + inf. + - + | | -xt + | e + E (x) = | ---- dt. + n | n + | | t + - + 1 + + +Both n and x must be nonnegative. + +The routine employs either a power series, a continued +fraction, or an asymptotic formula depending on the +relative values of n and x. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 10000 1.7e-15 3.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 2000 by Stephen L. Moshier +*************************************************************************/ +double exponentialintegralen(const double x, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::exponentialintegralen(x, n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +F distribution + +Returns the area from zero to x under the F density +function (also known as Snedcor's density or the +variance ratio density). This is the density +of x = (u1/df1)/(u2/df2), where u1 and u2 are random +variables having Chi square distributions with df1 +and df2 degrees of freedom, respectively. +The incomplete beta integral is used, according to the +formula + +P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). + + +The arguments a and b are greater than zero, and x is +nonnegative. + +ACCURACY: + +Tested at random points (a,b,x). + + x a,b Relative error: +arithmetic domain domain # trials peak rms + IEEE 0,1 0,100 100000 9.8e-15 1.7e-15 + IEEE 1,5 0,100 100000 6.5e-15 3.5e-16 + IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12 + IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double fdistribution(const ae_int_t a, const ae_int_t b, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::fdistribution(a, b, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complemented F distribution + +Returns the area from x to infinity under the F density +function (also known as Snedcor's density or the +variance ratio density). + + + inf. + - + 1 | | a-1 b-1 +1-P(x) = ------ | t (1-t) dt + B(a,b) | | + - + x + + +The incomplete beta integral is used, according to the +formula + +P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). + + +ACCURACY: + +Tested at random points (a,b,x) in the indicated intervals. + x a,b Relative error: +arithmetic domain domain # trials peak rms + IEEE 0,1 1,100 100000 3.7e-14 5.9e-16 + IEEE 1,5 1,100 100000 8.0e-15 1.6e-15 + IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13 + IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double fcdistribution(const ae_int_t a, const ae_int_t b, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::fcdistribution(a, b, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Inverse of complemented F distribution + +Finds the F density argument x such that the integral +from x to infinity of the F density is equal to the +given probability p. + +This is accomplished using the inverse beta integral +function and the relations + + z = incbi( df2/2, df1/2, p ) + x = df2 (1-z) / (df1 z). + +Note: the following relations hold for the inverse of +the uncomplemented F distribution: + + z = incbi( df1/2, df2/2, p ) + x = df2 z / (df1 (1-z)). + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between .001 and 1: + IEEE 1,100 100000 8.3e-15 4.7e-16 + IEEE 1,10000 100000 2.1e-11 1.4e-13 + For p between 10^-6 and 10^-3: + IEEE 1,100 50000 1.3e-12 8.4e-15 + IEEE 1,10000 50000 3.0e-12 4.8e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invfdistribution(const ae_int_t a, const ae_int_t b, const double y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::invfdistribution(a, b, y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Fresnel integral + +Evaluates the Fresnel integrals + + x + - + | | +C(x) = | cos(pi/2 t**2) dt, + | | + - + 0 + + x + - + | | +S(x) = | sin(pi/2 t**2) dt. + | | + - + 0 + + +The integrals are evaluated by a power series for x < 1. +For x >= 1 auxiliary functions f(x) and g(x) are employed +such that + +C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) +S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) + + + +ACCURACY: + + Relative error. + +Arithmetic function domain # trials peak rms + IEEE S(x) 0, 10 10000 2.0e-15 3.2e-16 + IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +void fresnelintegral(const double x, double &c, double &s) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::fresnelintegral(x, &c, &s, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the value of the Hermite polynomial. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Hermite polynomial Hn at x +*************************************************************************/ +double hermitecalculate(const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hermitecalculate(n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Summation of Hermite polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*H0(x) + c[1]*H1(x) + ... + c[N]*HN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Hermite polynomial at x +*************************************************************************/ +double hermitesum(const real_1d_array &c, const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::hermitesum(const_cast(c.c_ptr()), n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Representation of Hn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void hermitecoefficients(const ae_int_t n, real_1d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hermitecoefficients(n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Jacobian Elliptic Functions + +Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), +and dn(u|m) of parameter m between 0 and 1, and real +argument u. + +These functions are periodic, with quarter-period on the +real axis equal to the complete elliptic integral +ellpk(1.0-m). + +Relation to incomplete elliptic integral: +If u = ellik(phi,m), then sn(u|m) = sin(phi), +and cn(u|m) = cos(phi). Phi is called the amplitude of u. + +Computation is by means of the arithmetic-geometric mean +algorithm, except when m is within 1e-9 of 0 or 1. In the +latter case with m close to 1, the approximation applies +only for phi < pi/2. + +ACCURACY: + +Tested at random points with u between 0 and 10, m between +0 and 1. + + Absolute error (* = relative error): +arithmetic function # trials peak rms + IEEE phi 10000 9.2e-16* 1.4e-16* + IEEE sn 50000 4.1e-15 4.6e-16 + IEEE cn 40000 3.6e-15 4.4e-16 + IEEE dn 10000 1.3e-12 1.8e-14 + + Peak error observed in consistency check using addition +theorem for sn(u+v) was 4e-16 (absolute). Also tested by +the above relation to the incomplete elliptic integral. +Accuracy deteriorates when u is large. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +void jacobianellipticfunctions(const double u, const double m, double &sn, double &cn, double &dn, double &ph) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::jacobianellipticfunctions(u, m, &sn, &cn, &dn, &ph, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the value of the Laguerre polynomial. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Laguerre polynomial Ln at x +*************************************************************************/ +double laguerrecalculate(const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::laguerrecalculate(n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Summation of Laguerre polynomials using Clenshaw’s recurrence formula. + +This routine calculates c[0]*L0(x) + c[1]*L1(x) + ... + c[N]*LN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Laguerre polynomial at x +*************************************************************************/ +double laguerresum(const real_1d_array &c, const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::laguerresum(const_cast(c.c_ptr()), n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Representation of Ln as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void laguerrecoefficients(const ae_int_t n, real_1d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::laguerrecoefficients(n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the value of the Legendre polynomial Pn. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Legendre polynomial Pn at x +*************************************************************************/ +double legendrecalculate(const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::legendrecalculate(n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Summation of Legendre polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*P0(x) + c[1]*P1(x) + ... + c[N]*PN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Legendre polynomial at x +*************************************************************************/ +double legendresum(const real_1d_array &c, const ae_int_t n, const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::legendresum(const_cast(c.c_ptr()), n, x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Representation of Pn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void legendrecoefficients(const ae_int_t n, real_1d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::legendrecoefficients(n, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Poisson distribution + +Returns the sum of the first k+1 terms of the Poisson +distribution: + + k j + -- -m m + > e -- + -- j! + j=0 + +The terms are not summed directly; instead the incomplete +gamma integral is employed, according to the relation + +y = pdtr( k, m ) = igamc( k+1, m ). + +The arguments must both be positive. +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double poissondistribution(const ae_int_t k, const double m) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::poissondistribution(k, m, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Complemented Poisson distribution + +Returns the sum of the terms k+1 to infinity of the Poisson +distribution: + + inf. j + -- -m m + > e -- + -- j! + j=k+1 + +The terms are not summed directly; instead the incomplete +gamma integral is employed, according to the formula + +y = pdtrc( k, m ) = igam( k+1, m ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double poissoncdistribution(const ae_int_t k, const double m) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::poissoncdistribution(k, m, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Inverse Poisson distribution + +Finds the Poisson variable x such that the integral +from 0 to x of the Poisson density is equal to the +given probability y. + +This is accomplished using the inverse gamma integral +function and the relation + + m = igami( k+1, y ). + +ACCURACY: + +See inverse incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invpoissondistribution(const ae_int_t k, const double y) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::invpoissondistribution(k, y, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Psi (digamma) function + + d - + psi(x) = -- ln | (x) + dx + +is the logarithmic derivative of the gamma function. +For integer x, + n-1 + - +psi(n) = -EUL + > 1/k. + - + k=1 + +This formula is used for 0 < n <= 10. If x is negative, it +is transformed to a positive argument by the reflection +formula psi(1-x) = psi(x) + pi cot(pi x). +For general positive x, the argument is made greater than 10 +using the recurrence psi(x+1) = psi(x) + 1/x. +Then the following asymptotic expansion is applied: + + inf. B + - 2k +psi(x) = log(x) - 1/2x - > ------- + - 2k + k=1 2k x + +where the B2k are Bernoulli numbers. + +ACCURACY: + Relative error (except absolute when |psi| < 1): +arithmetic domain # trials peak rms + IEEE 0,30 30000 1.3e-15 1.4e-16 + IEEE -30,0 40000 1.5e-15 2.2e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double psi(const double x) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::psi(x, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Student's t distribution + +Computes the integral from minus infinity to t of the Student +t distribution with integer k > 0 degrees of freedom: + + t + - + | | + - | 2 -(k+1)/2 + | ( (k+1)/2 ) | ( x ) + ---------------------- | ( 1 + --- ) dx + - | ( k ) + sqrt( k pi ) | ( k/2 ) | + | | + - + -inf. + +Relation to incomplete beta integral: + + 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) +where + z = k/(k + t**2). + +For t < -2, this is the method of computation. For higher t, +a direct method is derived from integration by parts. +Since the function is symmetric about t=0, the area under the +right tail of the density is found by calling the function +with -t instead of t. + +ACCURACY: + +Tested at random 1 <= k <= 25. The "domain" refers to t. + Relative error: +arithmetic domain # trials peak rms + IEEE -100,-2 50000 5.9e-15 1.4e-15 + IEEE -2,100 500000 2.7e-15 4.9e-17 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double studenttdistribution(const ae_int_t k, const double t) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::studenttdistribution(k, t, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Functional inverse of Student's t distribution + +Given probability p, finds the argument t such that stdtr(k,t) +is equal to p. + +ACCURACY: + +Tested at random 1 <= k <= 100. The "domain" refers to p: + Relative error: +arithmetic domain # trials peak rms + IEEE .001,.999 25000 5.7e-15 8.0e-16 + IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invstudenttdistribution(const ae_int_t k, const double p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::invstudenttdistribution(k, p, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Sine and cosine integrals + +Evaluates the integrals + + x + - + | cos t - 1 + Ci(x) = eul + ln x + | --------- dt, + | t + - + 0 + x + - + | sin t + Si(x) = | ----- dt + | t + - + 0 + +where eul = 0.57721566490153286061 is Euler's constant. +The integrals are approximated by rational functions. +For x > 8 auxiliary functions f(x) and g(x) are employed +such that + +Ci(x) = f(x) sin(x) - g(x) cos(x) +Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) + + +ACCURACY: + Test interval = [0,50]. +Absolute error, except relative when > 1: +arithmetic function # trials peak rms + IEEE Si 30000 4.4e-16 7.3e-17 + IEEE Ci 30000 6.9e-16 5.1e-17 + +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +*************************************************************************/ +void sinecosineintegrals(const double x, double &si, double &ci) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sinecosineintegrals(x, &si, &ci, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Hyperbolic sine and cosine integrals + +Approximates the integrals + + x + - + | | cosh t - 1 + Chi(x) = eul + ln x + | ----------- dt, + | | t + - + 0 + + x + - + | | sinh t + Shi(x) = | ------ dt + | | t + - + 0 + +where eul = 0.57721566490153286061 is Euler's constant. +The integrals are evaluated by power series for x < 8 +and by Chebyshev expansions for x between 8 and 88. +For large x, both functions approach exp(x)/2x. +Arguments greater than 88 in magnitude return MAXNUM. + + +ACCURACY: + +Test interval 0 to 88. + Relative error: +arithmetic function # trials peak rms + IEEE Shi 30000 6.9e-16 1.6e-16 + Absolute error, except relative when |Chi| > 1: + IEEE Chi 30000 8.4e-16 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +void hyperbolicsinecosineintegrals(const double x, double &shi, double &chi) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::hyperbolicsinecosineintegrals(x, &shi, &chi, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +static double gammafunc_gammastirf(double x, ae_state *_state); + + + + + + + + +static void bessel_besselmfirstcheb(double c, + double* b0, + double* b1, + double* b2, + ae_state *_state); +static void bessel_besselmnextcheb(double x, + double c, + double* b0, + double* b1, + double* b2, + ae_state *_state); +static void bessel_besselm1firstcheb(double c, + double* b0, + double* b1, + double* b2, + ae_state *_state); +static void bessel_besselm1nextcheb(double x, + double c, + double* b0, + double* b1, + double* b2, + ae_state *_state); +static void bessel_besselasympt0(double x, + double* pzero, + double* qzero, + ae_state *_state); +static void bessel_besselasympt1(double x, + double* pzero, + double* qzero, + ae_state *_state); + + + + +static double ibetaf_incompletebetafe(double a, + double b, + double x, + double big, + double biginv, + ae_state *_state); +static double ibetaf_incompletebetafe2(double a, + double b, + double x, + double big, + double biginv, + ae_state *_state); +static double ibetaf_incompletebetaps(double a, + double b, + double x, + double maxgam, + ae_state *_state); + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +static void trigintegrals_chebiterationshichi(double x, + double c, + double* b0, + double* b1, + double* b2, + ae_state *_state); + + + + + +/************************************************************************* +Gamma function + +Input parameters: + X - argument + +Domain: + 0 < X < 171.6 + -170 < X < 0, X is not an integer. + +Relative error: + arithmetic domain # trials peak rms + IEEE -170,-33 20000 2.3e-15 3.3e-16 + IEEE -33, 33 20000 9.4e-16 2.2e-16 + IEEE 33, 171.6 20000 2.3e-15 3.2e-16 + +Cephes Math Library Release 2.8: June, 2000 +Original copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier +Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). +*************************************************************************/ +double gammafunction(double x, ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_SPECFUNCS + double p; + double pp; + double q; + double qq; + double z; + ae_int_t i; + double sgngam; + double result; + + + sgngam = 1; + q = ae_fabs(x, _state); + if( ae_fp_greater(q,33.0) ) + { + if( ae_fp_less(x,0.0) ) + { + p = ae_ifloor(q, _state); + i = ae_round(p, _state); + if( i%2==0 ) + { + sgngam = -1; + } + z = q-p; + if( ae_fp_greater(z,0.5) ) + { + p = p+1; + z = q-p; + } + z = q*ae_sin(ae_pi*z, _state); + z = ae_fabs(z, _state); + z = ae_pi/(z*gammafunc_gammastirf(q, _state)); + } + else + { + z = gammafunc_gammastirf(x, _state); + } + result = sgngam*z; + return result; + } + z = 1; + while(ae_fp_greater_eq(x,3)) + { + x = x-1; + z = z*x; + } + while(ae_fp_less(x,0)) + { + if( ae_fp_greater(x,-0.000000001) ) + { + result = z/((1+0.5772156649015329*x)*x); + return result; + } + z = z/x; + x = x+1; + } + while(ae_fp_less(x,2)) + { + if( ae_fp_less(x,0.000000001) ) + { + result = z/((1+0.5772156649015329*x)*x); + return result; + } + z = z/x; + x = x+1.0; + } + if( ae_fp_eq(x,2) ) + { + result = z; + return result; + } + x = x-2.0; + pp = 1.60119522476751861407E-4; + pp = 1.19135147006586384913E-3+x*pp; + pp = 1.04213797561761569935E-2+x*pp; + pp = 4.76367800457137231464E-2+x*pp; + pp = 2.07448227648435975150E-1+x*pp; + pp = 4.94214826801497100753E-1+x*pp; + pp = 9.99999999999999996796E-1+x*pp; + qq = -2.31581873324120129819E-5; + qq = 5.39605580493303397842E-4+x*qq; + qq = -4.45641913851797240494E-3+x*qq; + qq = 1.18139785222060435552E-2+x*qq; + qq = 3.58236398605498653373E-2+x*qq; + qq = -2.34591795718243348568E-1+x*qq; + qq = 7.14304917030273074085E-2+x*qq; + qq = 1.00000000000000000320+x*qq; + result = z*pp/qq; + return result; +#else + return _ialglib_i_gammafunction(x); +#endif +} + + +/************************************************************************* +Natural logarithm of gamma function + +Input parameters: + X - argument + +Result: + logarithm of the absolute value of the Gamma(X). + +Output parameters: + SgnGam - sign(Gamma(X)) + +Domain: + 0 < X < 2.55e305 + -2.55e305 < X < 0, X is not an integer. + +ACCURACY: +arithmetic domain # trials peak rms + IEEE 0, 3 28000 5.4e-16 1.1e-16 + IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17 +The error criterion was relative when the function magnitude +was greater than one but absolute when it was less than one. + +The following test used the relative error criterion, though +at certain points the relative error could be much higher than +indicated. + IEEE -200, -4 10000 4.8e-16 1.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier +Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). +*************************************************************************/ +double lngamma(double x, double* sgngam, ae_state *_state) +{ +#ifndef ALGLIB_INTERCEPTS_SPECFUNCS + double a; + double b; + double c; + double p; + double q; + double u; + double w; + double z; + ae_int_t i; + double logpi; + double ls2pi; + double tmp; + double result; + + *sgngam = 0; + + *sgngam = 1; + logpi = 1.14472988584940017414; + ls2pi = 0.91893853320467274178; + if( ae_fp_less(x,-34.0) ) + { + q = -x; + w = lngamma(q, &tmp, _state); + p = ae_ifloor(q, _state); + i = ae_round(p, _state); + if( i%2==0 ) + { + *sgngam = -1; + } + else + { + *sgngam = 1; + } + z = q-p; + if( ae_fp_greater(z,0.5) ) + { + p = p+1; + z = p-q; + } + z = q*ae_sin(ae_pi*z, _state); + result = logpi-ae_log(z, _state)-w; + return result; + } + if( ae_fp_less(x,13) ) + { + z = 1; + p = 0; + u = x; + while(ae_fp_greater_eq(u,3)) + { + p = p-1; + u = x+p; + z = z*u; + } + while(ae_fp_less(u,2)) + { + z = z/u; + p = p+1; + u = x+p; + } + if( ae_fp_less(z,0) ) + { + *sgngam = -1; + z = -z; + } + else + { + *sgngam = 1; + } + if( ae_fp_eq(u,2) ) + { + result = ae_log(z, _state); + return result; + } + p = p-2; + x = x+p; + b = -1378.25152569120859100; + b = -38801.6315134637840924+x*b; + b = -331612.992738871184744+x*b; + b = -1162370.97492762307383+x*b; + b = -1721737.00820839662146+x*b; + b = -853555.664245765465627+x*b; + c = 1; + c = -351.815701436523470549+x*c; + c = -17064.2106651881159223+x*c; + c = -220528.590553854454839+x*c; + c = -1139334.44367982507207+x*c; + c = -2532523.07177582951285+x*c; + c = -2018891.41433532773231+x*c; + p = x*b/c; + result = ae_log(z, _state)+p; + return result; + } + q = (x-0.5)*ae_log(x, _state)-x+ls2pi; + if( ae_fp_greater(x,100000000) ) + { + result = q; + return result; + } + p = 1/(x*x); + if( ae_fp_greater_eq(x,1000.0) ) + { + q = q+((7.9365079365079365079365*0.0001*p-2.7777777777777777777778*0.001)*p+0.0833333333333333333333)/x; + } + else + { + a = 8.11614167470508450300*0.0001; + a = -5.95061904284301438324*0.0001+p*a; + a = 7.93650340457716943945*0.0001+p*a; + a = -2.77777777730099687205*0.001+p*a; + a = 8.33333333333331927722*0.01+p*a; + q = q+a/x; + } + result = q; + return result; +#else + return _ialglib_i_lngamma(x, sgngam); +#endif +} + + +static double gammafunc_gammastirf(double x, ae_state *_state) +{ + double y; + double w; + double v; + double stir; + double result; + + + w = 1/x; + stir = 7.87311395793093628397E-4; + stir = -2.29549961613378126380E-4+w*stir; + stir = -2.68132617805781232825E-3+w*stir; + stir = 3.47222221605458667310E-3+w*stir; + stir = 8.33333333333482257126E-2+w*stir; + w = 1+w*stir; + y = ae_exp(x, _state); + if( ae_fp_greater(x,143.01608) ) + { + v = ae_pow(x, 0.5*x-0.25, _state); + y = v*(v/y); + } + else + { + y = ae_pow(x, x-0.5, _state)/y; + } + result = 2.50662827463100050242*y*w; + return result; +} + + + + +/************************************************************************* +Error function + +The integral is + + x + - + 2 | | 2 + erf(x) = -------- | exp( - t ) dt. + sqrt(pi) | | + - + 0 + +For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise +erf(x) = 1 - erfc(x). + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 3.7e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double errorfunction(double x, ae_state *_state) +{ + double xsq; + double s; + double p; + double q; + double result; + + + s = ae_sign(x, _state); + x = ae_fabs(x, _state); + if( ae_fp_less(x,0.5) ) + { + xsq = x*x; + p = 0.007547728033418631287834; + p = -0.288805137207594084924010+xsq*p; + p = 14.3383842191748205576712+xsq*p; + p = 38.0140318123903008244444+xsq*p; + p = 3017.82788536507577809226+xsq*p; + p = 7404.07142710151470082064+xsq*p; + p = 80437.3630960840172832162+xsq*p; + q = 0.0; + q = 1.00000000000000000000000+xsq*q; + q = 38.0190713951939403753468+xsq*q; + q = 658.070155459240506326937+xsq*q; + q = 6379.60017324428279487120+xsq*q; + q = 34216.5257924628539769006+xsq*q; + q = 80437.3630960840172826266+xsq*q; + result = s*1.1283791670955125738961589031*x*p/q; + return result; + } + if( ae_fp_greater_eq(x,10) ) + { + result = s; + return result; + } + result = s*(1-errorfunctionc(x, _state)); + return result; +} + + +/************************************************************************* +Complementary error function + + 1 - erf(x) = + + inf. + - + 2 | | 2 + erfc(x) = -------- | exp( - t ) dt + sqrt(pi) | | + - + x + + +For small x, erfc(x) = 1 - erf(x); otherwise rational +approximations are computed. + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,26.6417 30000 5.7e-14 1.5e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double errorfunctionc(double x, ae_state *_state) +{ + double p; + double q; + double result; + + + if( ae_fp_less(x,0) ) + { + result = 2-errorfunctionc(-x, _state); + return result; + } + if( ae_fp_less(x,0.5) ) + { + result = 1.0-errorfunction(x, _state); + return result; + } + if( ae_fp_greater_eq(x,10) ) + { + result = 0; + return result; + } + p = 0.0; + p = 0.5641877825507397413087057563+x*p; + p = 9.675807882987265400604202961+x*p; + p = 77.08161730368428609781633646+x*p; + p = 368.5196154710010637133875746+x*p; + p = 1143.262070703886173606073338+x*p; + p = 2320.439590251635247384768711+x*p; + p = 2898.0293292167655611275846+x*p; + p = 1826.3348842295112592168999+x*p; + q = 1.0; + q = 17.14980943627607849376131193+x*q; + q = 137.1255960500622202878443578+x*q; + q = 661.7361207107653469211984771+x*q; + q = 2094.384367789539593790281779+x*q; + q = 4429.612803883682726711528526+x*q; + q = 6089.5424232724435504633068+x*q; + q = 4958.82756472114071495438422+x*q; + q = 1826.3348842295112595576438+x*q; + result = ae_exp(-ae_sqr(x, _state), _state)*p/q; + return result; +} + + +/************************************************************************* +Normal distribution function + +Returns the area under the Gaussian probability density +function, integrated from minus infinity to x: + + x + - + 1 | | 2 + ndtr(x) = --------- | exp( - t /2 ) dt + sqrt(2pi) | | + - + -inf. + + = ( 1 + erf(z) ) / 2 + = erfc(z) / 2 + +where z = x/sqrt(2). Computation is via the functions +erf and erfc. + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE -13,0 30000 3.4e-14 6.7e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double normaldistribution(double x, ae_state *_state) +{ + double result; + + + result = 0.5*(errorfunction(x/1.41421356237309504880, _state)+1); + return result; +} + + +/************************************************************************* +Inverse of the error function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double inverf(double e, ae_state *_state) +{ + double result; + + + result = invnormaldistribution(0.5*(e+1), _state)/ae_sqrt(2, _state); + return result; +} + + +/************************************************************************* +Inverse of Normal distribution function + +Returns the argument, x, for which the area under the +Gaussian probability density function (integrated from +minus infinity to x) is equal to y. + + +For small arguments 0 < y < exp(-2), the program computes +z = sqrt( -2.0 * log(y) ); then the approximation is +x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). +There are two rational functions P/Q, one for 0 < y < exp(-32) +and the other for y up to exp(-2). For larger arguments, +w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0.125, 1 20000 7.2e-16 1.3e-16 + IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double invnormaldistribution(double y0, ae_state *_state) +{ + double expm2; + double s2pi; + double x; + double y; + double z; + double y2; + double x0; + double x1; + ae_int_t code; + double p0; + double q0; + double p1; + double q1; + double p2; + double q2; + double result; + + + expm2 = 0.13533528323661269189; + s2pi = 2.50662827463100050242; + if( ae_fp_less_eq(y0,0) ) + { + result = -ae_maxrealnumber; + return result; + } + if( ae_fp_greater_eq(y0,1) ) + { + result = ae_maxrealnumber; + return result; + } + code = 1; + y = y0; + if( ae_fp_greater(y,1.0-expm2) ) + { + y = 1.0-y; + code = 0; + } + if( ae_fp_greater(y,expm2) ) + { + y = y-0.5; + y2 = y*y; + p0 = -59.9633501014107895267; + p0 = 98.0010754185999661536+y2*p0; + p0 = -56.6762857469070293439+y2*p0; + p0 = 13.9312609387279679503+y2*p0; + p0 = -1.23916583867381258016+y2*p0; + q0 = 1; + q0 = 1.95448858338141759834+y2*q0; + q0 = 4.67627912898881538453+y2*q0; + q0 = 86.3602421390890590575+y2*q0; + q0 = -225.462687854119370527+y2*q0; + q0 = 200.260212380060660359+y2*q0; + q0 = -82.0372256168333339912+y2*q0; + q0 = 15.9056225126211695515+y2*q0; + q0 = -1.18331621121330003142+y2*q0; + x = y+y*y2*p0/q0; + x = x*s2pi; + result = x; + return result; + } + x = ae_sqrt(-2.0*ae_log(y, _state), _state); + x0 = x-ae_log(x, _state)/x; + z = 1.0/x; + if( ae_fp_less(x,8.0) ) + { + p1 = 4.05544892305962419923; + p1 = 31.5251094599893866154+z*p1; + p1 = 57.1628192246421288162+z*p1; + p1 = 44.0805073893200834700+z*p1; + p1 = 14.6849561928858024014+z*p1; + p1 = 2.18663306850790267539+z*p1; + p1 = -1.40256079171354495875*0.1+z*p1; + p1 = -3.50424626827848203418*0.01+z*p1; + p1 = -8.57456785154685413611*0.0001+z*p1; + q1 = 1; + q1 = 15.7799883256466749731+z*q1; + q1 = 45.3907635128879210584+z*q1; + q1 = 41.3172038254672030440+z*q1; + q1 = 15.0425385692907503408+z*q1; + q1 = 2.50464946208309415979+z*q1; + q1 = -1.42182922854787788574*0.1+z*q1; + q1 = -3.80806407691578277194*0.01+z*q1; + q1 = -9.33259480895457427372*0.0001+z*q1; + x1 = z*p1/q1; + } + else + { + p2 = 3.23774891776946035970; + p2 = 6.91522889068984211695+z*p2; + p2 = 3.93881025292474443415+z*p2; + p2 = 1.33303460815807542389+z*p2; + p2 = 2.01485389549179081538*0.1+z*p2; + p2 = 1.23716634817820021358*0.01+z*p2; + p2 = 3.01581553508235416007*0.0001+z*p2; + p2 = 2.65806974686737550832*0.000001+z*p2; + p2 = 6.23974539184983293730*0.000000001+z*p2; + q2 = 1; + q2 = 6.02427039364742014255+z*q2; + q2 = 3.67983563856160859403+z*q2; + q2 = 1.37702099489081330271+z*q2; + q2 = 2.16236993594496635890*0.1+z*q2; + q2 = 1.34204006088543189037*0.01+z*q2; + q2 = 3.28014464682127739104*0.0001+z*q2; + q2 = 2.89247864745380683936*0.000001+z*q2; + q2 = 6.79019408009981274425*0.000000001+z*q2; + x1 = z*p2/q2; + } + x = x0-x1; + if( code!=0 ) + { + x = -x; + } + result = x; + return result; +} + + + + +/************************************************************************* +Incomplete gamma integral + +The function is defined by + + x + - + 1 | | -t a-1 + igam(a,x) = ----- | e t dt. + - | | + | (a) - + 0 + + +In this implementation both arguments must be positive. +The integral is evaluated by either a power series or +continued fraction expansion, depending on the relative +values of a and x. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 200000 3.6e-14 2.9e-15 + IEEE 0,100 300000 9.9e-14 1.5e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletegamma(double a, double x, ae_state *_state) +{ + double igammaepsilon; + double ans; + double ax; + double c; + double r; + double tmp; + double result; + + + igammaepsilon = 0.000000000000001; + if( ae_fp_less_eq(x,0)||ae_fp_less_eq(a,0) ) + { + result = 0; + return result; + } + if( ae_fp_greater(x,1)&&ae_fp_greater(x,a) ) + { + result = 1-incompletegammac(a, x, _state); + return result; + } + ax = a*ae_log(x, _state)-x-lngamma(a, &tmp, _state); + if( ae_fp_less(ax,-709.78271289338399) ) + { + result = 0; + return result; + } + ax = ae_exp(ax, _state); + r = a; + c = 1; + ans = 1; + do + { + r = r+1; + c = c*x/r; + ans = ans+c; + } + while(ae_fp_greater(c/ans,igammaepsilon)); + result = ans*ax/a; + return result; +} + + +/************************************************************************* +Complemented incomplete gamma integral + +The function is defined by + + + igamc(a,x) = 1 - igam(a,x) + + inf. + - + 1 | | -t a-1 + = ----- | e t dt. + - | | + | (a) - + x + + +In this implementation both arguments must be positive. +The integral is evaluated by either a power series or +continued fraction expansion, depending on the relative +values of a and x. + +ACCURACY: + +Tested at random a, x. + a x Relative error: +arithmetic domain domain # trials peak rms + IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 + IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletegammac(double a, double x, ae_state *_state) +{ + double igammaepsilon; + double igammabignumber; + double igammabignumberinv; + double ans; + double ax; + double c; + double yc; + double r; + double t; + double y; + double z; + double pk; + double pkm1; + double pkm2; + double qk; + double qkm1; + double qkm2; + double tmp; + double result; + + + igammaepsilon = 0.000000000000001; + igammabignumber = 4503599627370496.0; + igammabignumberinv = 2.22044604925031308085*0.0000000000000001; + if( ae_fp_less_eq(x,0)||ae_fp_less_eq(a,0) ) + { + result = 1; + return result; + } + if( ae_fp_less(x,1)||ae_fp_less(x,a) ) + { + result = 1-incompletegamma(a, x, _state); + return result; + } + ax = a*ae_log(x, _state)-x-lngamma(a, &tmp, _state); + if( ae_fp_less(ax,-709.78271289338399) ) + { + result = 0; + return result; + } + ax = ae_exp(ax, _state); + y = 1-a; + z = x+y+1; + c = 0; + pkm2 = 1; + qkm2 = x; + pkm1 = x+1; + qkm1 = z*x; + ans = pkm1/qkm1; + do + { + c = c+1; + y = y+1; + z = z+2; + yc = y*c; + pk = pkm1*z-pkm2*yc; + qk = qkm1*z-qkm2*yc; + if( ae_fp_neq(qk,0) ) + { + r = pk/qk; + t = ae_fabs((ans-r)/r, _state); + ans = r; + } + else + { + t = 1; + } + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + if( ae_fp_greater(ae_fabs(pk, _state),igammabignumber) ) + { + pkm2 = pkm2*igammabignumberinv; + pkm1 = pkm1*igammabignumberinv; + qkm2 = qkm2*igammabignumberinv; + qkm1 = qkm1*igammabignumberinv; + } + } + while(ae_fp_greater(t,igammaepsilon)); + result = ans*ax; + return result; +} + + +/************************************************************************* +Inverse of complemented imcomplete gamma integral + +Given p, the function finds x such that + + igamc( a, x ) = p. + +Starting with the approximate value + + 3 + x = a t + + where + + t = 1 - d - ndtri(p) sqrt(d) + +and + + d = 1/9a, + +the routine performs up to 10 Newton iterations to find the +root of igamc(a,x) - p = 0. + +ACCURACY: + +Tested at random a, p in the intervals indicated. + + a p Relative error: +arithmetic domain domain # trials peak rms + IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 + IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 + IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invincompletegammac(double a, double y0, ae_state *_state) +{ + double igammaepsilon; + double iinvgammabignumber; + double x0; + double x1; + double x; + double yl; + double yh; + double y; + double d; + double lgm; + double dithresh; + ae_int_t i; + ae_int_t dir; + double tmp; + double result; + + + igammaepsilon = 0.000000000000001; + iinvgammabignumber = 4503599627370496.0; + x0 = iinvgammabignumber; + yl = 0; + x1 = 0; + yh = 1; + dithresh = 5*igammaepsilon; + d = 1/(9*a); + y = 1-d-invnormaldistribution(y0, _state)*ae_sqrt(d, _state); + x = a*y*y*y; + lgm = lngamma(a, &tmp, _state); + i = 0; + while(i<10) + { + if( ae_fp_greater(x,x0)||ae_fp_less(x,x1) ) + { + d = 0.0625; + break; + } + y = incompletegammac(a, x, _state); + if( ae_fp_less(y,yl)||ae_fp_greater(y,yh) ) + { + d = 0.0625; + break; + } + if( ae_fp_less(y,y0) ) + { + x0 = x; + yl = y; + } + else + { + x1 = x; + yh = y; + } + d = (a-1)*ae_log(x, _state)-x-lgm; + if( ae_fp_less(d,-709.78271289338399) ) + { + d = 0.0625; + break; + } + d = -ae_exp(d, _state); + d = (y-y0)/d; + if( ae_fp_less(ae_fabs(d/x, _state),igammaepsilon) ) + { + result = x; + return result; + } + x = x-d; + i = i+1; + } + if( ae_fp_eq(x0,iinvgammabignumber) ) + { + if( ae_fp_less_eq(x,0) ) + { + x = 1; + } + while(ae_fp_eq(x0,iinvgammabignumber)) + { + x = (1+d)*x; + y = incompletegammac(a, x, _state); + if( ae_fp_less(y,y0) ) + { + x0 = x; + yl = y; + break; + } + d = d+d; + } + } + d = 0.5; + dir = 0; + i = 0; + while(i<400) + { + x = x1+d*(x0-x1); + y = incompletegammac(a, x, _state); + lgm = (x0-x1)/(x1+x0); + if( ae_fp_less(ae_fabs(lgm, _state),dithresh) ) + { + break; + } + lgm = (y-y0)/y0; + if( ae_fp_less(ae_fabs(lgm, _state),dithresh) ) + { + break; + } + if( ae_fp_less_eq(x,0.0) ) + { + break; + } + if( ae_fp_greater_eq(y,y0) ) + { + x1 = x; + yh = y; + if( dir<0 ) + { + dir = 0; + d = 0.5; + } + else + { + if( dir>1 ) + { + d = 0.5*d+0.5; + } + else + { + d = (y0-yl)/(yh-yl); + } + } + dir = dir+1; + } + else + { + x0 = x; + yl = y; + if( dir>0 ) + { + dir = 0; + d = 0.5; + } + else + { + if( dir<-1 ) + { + d = 0.5*d; + } + else + { + d = (y0-yl)/(yh-yl); + } + } + dir = dir-1; + } + i = i+1; + } + result = x; + return result; +} + + + + +/************************************************************************* +Airy function + +Solution of the differential equation + +y"(x) = xy. + +The function returns the two independent solutions Ai, Bi +and their first derivatives Ai'(x), Bi'(x). + +Evaluation is by power series summation for small x, +by rational minimax approximations for large x. + + + +ACCURACY: +Error criterion is absolute when function <= 1, relative +when function > 1, except * denotes relative error criterion. +For large negative x, the absolute error increases as x^1.5. +For large positive x, the relative error increases as x^1.5. + +Arithmetic domain function # trials peak rms +IEEE -10, 0 Ai 10000 1.6e-15 2.7e-16 +IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15* +IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16 +IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15* +IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16 +IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +void airy(double x, + double* ai, + double* aip, + double* bi, + double* bip, + ae_state *_state) +{ + double z; + double zz; + double t; + double f; + double g; + double uf; + double ug; + double k; + double zeta; + double theta; + ae_int_t domflg; + double c1; + double c2; + double sqrt3; + double sqpii; + double afn; + double afd; + double agn; + double agd; + double apfn; + double apfd; + double apgn; + double apgd; + double an; + double ad; + double apn; + double apd; + double bn16; + double bd16; + double bppn; + double bppd; + + *ai = 0; + *aip = 0; + *bi = 0; + *bip = 0; + + sqpii = 5.64189583547756286948E-1; + c1 = 0.35502805388781723926; + c2 = 0.258819403792806798405; + sqrt3 = 1.732050807568877293527; + domflg = 0; + if( ae_fp_greater(x,25.77) ) + { + *ai = 0; + *aip = 0; + *bi = ae_maxrealnumber; + *bip = ae_maxrealnumber; + return; + } + if( ae_fp_less(x,-2.09) ) + { + domflg = 15; + t = ae_sqrt(-x, _state); + zeta = -2.0*x*t/3.0; + t = ae_sqrt(t, _state); + k = sqpii/t; + z = 1.0/zeta; + zz = z*z; + afn = -1.31696323418331795333E-1; + afn = afn*zz-6.26456544431912369773E-1; + afn = afn*zz-6.93158036036933542233E-1; + afn = afn*zz-2.79779981545119124951E-1; + afn = afn*zz-4.91900132609500318020E-2; + afn = afn*zz-4.06265923594885404393E-3; + afn = afn*zz-1.59276496239262096340E-4; + afn = afn*zz-2.77649108155232920844E-6; + afn = afn*zz-1.67787698489114633780E-8; + afd = 1.00000000000000000000E0; + afd = afd*zz+1.33560420706553243746E1; + afd = afd*zz+3.26825032795224613948E1; + afd = afd*zz+2.67367040941499554804E1; + afd = afd*zz+9.18707402907259625840E0; + afd = afd*zz+1.47529146771666414581E0; + afd = afd*zz+1.15687173795188044134E-1; + afd = afd*zz+4.40291641615211203805E-3; + afd = afd*zz+7.54720348287414296618E-5; + afd = afd*zz+4.51850092970580378464E-7; + uf = 1.0+zz*afn/afd; + agn = 1.97339932091685679179E-2; + agn = agn*zz+3.91103029615688277255E-1; + agn = agn*zz+1.06579897599595591108E0; + agn = agn*zz+9.39169229816650230044E-1; + agn = agn*zz+3.51465656105547619242E-1; + agn = agn*zz+6.33888919628925490927E-2; + agn = agn*zz+5.85804113048388458567E-3; + agn = agn*zz+2.82851600836737019778E-4; + agn = agn*zz+6.98793669997260967291E-6; + agn = agn*zz+8.11789239554389293311E-8; + agn = agn*zz+3.41551784765923618484E-10; + agd = 1.00000000000000000000E0; + agd = agd*zz+9.30892908077441974853E0; + agd = agd*zz+1.98352928718312140417E1; + agd = agd*zz+1.55646628932864612953E1; + agd = agd*zz+5.47686069422975497931E0; + agd = agd*zz+9.54293611618961883998E-1; + agd = agd*zz+8.64580826352392193095E-2; + agd = agd*zz+4.12656523824222607191E-3; + agd = agd*zz+1.01259085116509135510E-4; + agd = agd*zz+1.17166733214413521882E-6; + agd = agd*zz+4.91834570062930015649E-9; + ug = z*agn/agd; + theta = zeta+0.25*ae_pi; + f = ae_sin(theta, _state); + g = ae_cos(theta, _state); + *ai = k*(f*uf-g*ug); + *bi = k*(g*uf+f*ug); + apfn = 1.85365624022535566142E-1; + apfn = apfn*zz+8.86712188052584095637E-1; + apfn = apfn*zz+9.87391981747398547272E-1; + apfn = apfn*zz+4.01241082318003734092E-1; + apfn = apfn*zz+7.10304926289631174579E-2; + apfn = apfn*zz+5.90618657995661810071E-3; + apfn = apfn*zz+2.33051409401776799569E-4; + apfn = apfn*zz+4.08718778289035454598E-6; + apfn = apfn*zz+2.48379932900442457853E-8; + apfd = 1.00000000000000000000E0; + apfd = apfd*zz+1.47345854687502542552E1; + apfd = apfd*zz+3.75423933435489594466E1; + apfd = apfd*zz+3.14657751203046424330E1; + apfd = apfd*zz+1.09969125207298778536E1; + apfd = apfd*zz+1.78885054766999417817E0; + apfd = apfd*zz+1.41733275753662636873E-1; + apfd = apfd*zz+5.44066067017226003627E-3; + apfd = apfd*zz+9.39421290654511171663E-5; + apfd = apfd*zz+5.65978713036027009243E-7; + uf = 1.0+zz*apfn/apfd; + apgn = -3.55615429033082288335E-2; + apgn = apgn*zz-6.37311518129435504426E-1; + apgn = apgn*zz-1.70856738884312371053E0; + apgn = apgn*zz-1.50221872117316635393E0; + apgn = apgn*zz-5.63606665822102676611E-1; + apgn = apgn*zz-1.02101031120216891789E-1; + apgn = apgn*zz-9.48396695961445269093E-3; + apgn = apgn*zz-4.60325307486780994357E-4; + apgn = apgn*zz-1.14300836484517375919E-5; + apgn = apgn*zz-1.33415518685547420648E-7; + apgn = apgn*zz-5.63803833958893494476E-10; + apgd = 1.00000000000000000000E0; + apgd = apgd*zz+9.85865801696130355144E0; + apgd = apgd*zz+2.16401867356585941885E1; + apgd = apgd*zz+1.73130776389749389525E1; + apgd = apgd*zz+6.17872175280828766327E0; + apgd = apgd*zz+1.08848694396321495475E0; + apgd = apgd*zz+9.95005543440888479402E-2; + apgd = apgd*zz+4.78468199683886610842E-3; + apgd = apgd*zz+1.18159633322838625562E-4; + apgd = apgd*zz+1.37480673554219441465E-6; + apgd = apgd*zz+5.79912514929147598821E-9; + ug = z*apgn/apgd; + k = sqpii*t; + *aip = -k*(g*uf+f*ug); + *bip = k*(f*uf-g*ug); + return; + } + if( ae_fp_greater_eq(x,2.09) ) + { + domflg = 5; + t = ae_sqrt(x, _state); + zeta = 2.0*x*t/3.0; + g = ae_exp(zeta, _state); + t = ae_sqrt(t, _state); + k = 2.0*t*g; + z = 1.0/zeta; + an = 3.46538101525629032477E-1; + an = an*z+1.20075952739645805542E1; + an = an*z+7.62796053615234516538E1; + an = an*z+1.68089224934630576269E2; + an = an*z+1.59756391350164413639E2; + an = an*z+7.05360906840444183113E1; + an = an*z+1.40264691163389668864E1; + an = an*z+9.99999999999999995305E-1; + ad = 5.67594532638770212846E-1; + ad = ad*z+1.47562562584847203173E1; + ad = ad*z+8.45138970141474626562E1; + ad = ad*z+1.77318088145400459522E2; + ad = ad*z+1.64234692871529701831E2; + ad = ad*z+7.14778400825575695274E1; + ad = ad*z+1.40959135607834029598E1; + ad = ad*z+1.00000000000000000470E0; + f = an/ad; + *ai = sqpii*f/k; + k = -0.5*sqpii*t/g; + apn = 6.13759184814035759225E-1; + apn = apn*z+1.47454670787755323881E1; + apn = apn*z+8.20584123476060982430E1; + apn = apn*z+1.71184781360976385540E2; + apn = apn*z+1.59317847137141783523E2; + apn = apn*z+6.99778599330103016170E1; + apn = apn*z+1.39470856980481566958E1; + apn = apn*z+1.00000000000000000550E0; + apd = 3.34203677749736953049E-1; + apd = apd*z+1.11810297306158156705E1; + apd = apd*z+7.11727352147859965283E1; + apd = apd*z+1.58778084372838313640E2; + apd = apd*z+1.53206427475809220834E2; + apd = apd*z+6.86752304592780337944E1; + apd = apd*z+1.38498634758259442477E1; + apd = apd*z+9.99999999999999994502E-1; + f = apn/apd; + *aip = f*k; + if( ae_fp_greater(x,8.3203353) ) + { + bn16 = -2.53240795869364152689E-1; + bn16 = bn16*z+5.75285167332467384228E-1; + bn16 = bn16*z-3.29907036873225371650E-1; + bn16 = bn16*z+6.44404068948199951727E-2; + bn16 = bn16*z-3.82519546641336734394E-3; + bd16 = 1.00000000000000000000E0; + bd16 = bd16*z-7.15685095054035237902E0; + bd16 = bd16*z+1.06039580715664694291E1; + bd16 = bd16*z-5.23246636471251500874E0; + bd16 = bd16*z+9.57395864378383833152E-1; + bd16 = bd16*z-5.50828147163549611107E-2; + f = z*bn16/bd16; + k = sqpii*g; + *bi = k*(1.0+f)/t; + bppn = 4.65461162774651610328E-1; + bppn = bppn*z-1.08992173800493920734E0; + bppn = bppn*z+6.38800117371827987759E-1; + bppn = bppn*z-1.26844349553102907034E-1; + bppn = bppn*z+7.62487844342109852105E-3; + bppd = 1.00000000000000000000E0; + bppd = bppd*z-8.70622787633159124240E0; + bppd = bppd*z+1.38993162704553213172E1; + bppd = bppd*z-7.14116144616431159572E0; + bppd = bppd*z+1.34008595960680518666E0; + bppd = bppd*z-7.84273211323341930448E-2; + f = z*bppn/bppd; + *bip = k*t*(1.0+f); + return; + } + } + f = 1.0; + g = x; + t = 1.0; + uf = 1.0; + ug = x; + k = 1.0; + z = x*x*x; + while(ae_fp_greater(t,ae_machineepsilon)) + { + uf = uf*z; + k = k+1.0; + uf = uf/k; + ug = ug*z; + k = k+1.0; + ug = ug/k; + uf = uf/k; + f = f+uf; + k = k+1.0; + ug = ug/k; + g = g+ug; + t = ae_fabs(uf/f, _state); + } + uf = c1*f; + ug = c2*g; + if( domflg%2==0 ) + { + *ai = uf-ug; + } + if( domflg/2%2==0 ) + { + *bi = sqrt3*(uf+ug); + } + k = 4.0; + uf = x*x/2.0; + ug = z/3.0; + f = uf; + g = 1.0+ug; + uf = uf/3.0; + t = 1.0; + while(ae_fp_greater(t,ae_machineepsilon)) + { + uf = uf*z; + ug = ug/k; + k = k+1.0; + ug = ug*z; + uf = uf/k; + f = f+uf; + k = k+1.0; + ug = ug/k; + uf = uf/k; + g = g+ug; + k = k+1.0; + t = ae_fabs(ug/g, _state); + } + uf = c1*f; + ug = c2*g; + if( domflg/4%2==0 ) + { + *aip = uf-ug; + } + if( domflg/8%2==0 ) + { + *bip = sqrt3*(uf+ug); + } +} + + + + +/************************************************************************* +Bessel function of order zero + +Returns Bessel function of order zero of the argument. + +The domain is divided into the intervals [0, 5] and +(5, infinity). In the first interval the following rational +approximation is used: + + + 2 2 +(w - r ) (w - r ) P (w) / Q (w) + 1 2 3 8 + + 2 +where w = x and the two r's are zeros of the function. + +In the second interval, the Hankel asymptotic expansion +is employed with two rational functions of degree 6/6 +and 7/7. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 60000 4.2e-16 1.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselj0(double x, ae_state *_state) +{ + double xsq; + double nn; + double pzero; + double qzero; + double p1; + double q1; + double result; + + + if( ae_fp_less(x,0) ) + { + x = -x; + } + if( ae_fp_greater(x,8.0) ) + { + bessel_besselasympt0(x, &pzero, &qzero, _state); + nn = x-ae_pi/4; + result = ae_sqrt(2/ae_pi/x, _state)*(pzero*ae_cos(nn, _state)-qzero*ae_sin(nn, _state)); + return result; + } + xsq = ae_sqr(x, _state); + p1 = 26857.86856980014981415848441; + p1 = -40504123.71833132706360663322+xsq*p1; + p1 = 25071582855.36881945555156435+xsq*p1; + p1 = -8085222034853.793871199468171+xsq*p1; + p1 = 1434354939140344.111664316553+xsq*p1; + p1 = -136762035308817138.6865416609+xsq*p1; + p1 = 6382059341072356562.289432465+xsq*p1; + p1 = -117915762910761053603.8440800+xsq*p1; + p1 = 493378725179413356181.6813446+xsq*p1; + q1 = 1.0; + q1 = 1363.063652328970604442810507+xsq*q1; + q1 = 1114636.098462985378182402543+xsq*q1; + q1 = 669998767.2982239671814028660+xsq*q1; + q1 = 312304311494.1213172572469442+xsq*q1; + q1 = 112775673967979.8507056031594+xsq*q1; + q1 = 30246356167094626.98627330784+xsq*q1; + q1 = 5428918384092285160.200195092+xsq*q1; + q1 = 493378725179413356211.3278438+xsq*q1; + result = p1/q1; + return result; +} + + +/************************************************************************* +Bessel function of order one + +Returns Bessel function of order one of the argument. + +The domain is divided into the intervals [0, 8] and +(8, infinity). In the first interval a 24 term Chebyshev +expansion is used. In the second, the asymptotic +trigonometric representation is employed using two +rational functions of degree 5/5. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 2.6e-16 1.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselj1(double x, ae_state *_state) +{ + double s; + double xsq; + double nn; + double pzero; + double qzero; + double p1; + double q1; + double result; + + + s = ae_sign(x, _state); + if( ae_fp_less(x,0) ) + { + x = -x; + } + if( ae_fp_greater(x,8.0) ) + { + bessel_besselasympt1(x, &pzero, &qzero, _state); + nn = x-3*ae_pi/4; + result = ae_sqrt(2/ae_pi/x, _state)*(pzero*ae_cos(nn, _state)-qzero*ae_sin(nn, _state)); + if( ae_fp_less(s,0) ) + { + result = -result; + } + return result; + } + xsq = ae_sqr(x, _state); + p1 = 2701.122710892323414856790990; + p1 = -4695753.530642995859767162166+xsq*p1; + p1 = 3413234182.301700539091292655+xsq*p1; + p1 = -1322983480332.126453125473247+xsq*p1; + p1 = 290879526383477.5409737601689+xsq*p1; + p1 = -35888175699101060.50743641413+xsq*p1; + p1 = 2316433580634002297.931815435+xsq*p1; + p1 = -66721065689249162980.20941484+xsq*p1; + p1 = 581199354001606143928.050809+xsq*p1; + q1 = 1.0; + q1 = 1606.931573481487801970916749+xsq*q1; + q1 = 1501793.594998585505921097578+xsq*q1; + q1 = 1013863514.358673989967045588+xsq*q1; + q1 = 524371026216.7649715406728642+xsq*q1; + q1 = 208166122130760.7351240184229+xsq*q1; + q1 = 60920613989175217.46105196863+xsq*q1; + q1 = 11857707121903209998.37113348+xsq*q1; + q1 = 1162398708003212287858.529400+xsq*q1; + result = s*x*p1/q1; + return result; +} + + +/************************************************************************* +Bessel function of integer order + +Returns Bessel function of order n, where n is a +(possibly negative) integer. + +The ratio of jn(x) to j0(x) is computed by backward +recurrence. First the ratio jn/jn-1 is found by a +continued fraction expansion. Then the recurrence +relating successive orders is applied until j0 or j1 is +reached. + +If n = 0 or 1 the routine for j0 or j1 is called +directly. + +ACCURACY: + + Absolute error: +arithmetic range # trials peak rms + IEEE 0, 30 5000 4.4e-16 7.9e-17 + + +Not suitable for large n or x. Use jv() (fractional order) instead. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseljn(ae_int_t n, double x, ae_state *_state) +{ + double pkm2; + double pkm1; + double pk; + double xk; + double r; + double ans; + ae_int_t k; + ae_int_t sg; + double result; + + + if( n<0 ) + { + n = -n; + if( n%2==0 ) + { + sg = 1; + } + else + { + sg = -1; + } + } + else + { + sg = 1; + } + if( ae_fp_less(x,0) ) + { + if( n%2!=0 ) + { + sg = -sg; + } + x = -x; + } + if( n==0 ) + { + result = sg*besselj0(x, _state); + return result; + } + if( n==1 ) + { + result = sg*besselj1(x, _state); + return result; + } + if( n==2 ) + { + if( ae_fp_eq(x,0) ) + { + result = 0; + } + else + { + result = sg*(2.0*besselj1(x, _state)/x-besselj0(x, _state)); + } + return result; + } + if( ae_fp_less(x,ae_machineepsilon) ) + { + result = 0; + return result; + } + k = 53; + pk = 2*(n+k); + ans = pk; + xk = x*x; + do + { + pk = pk-2.0; + ans = pk-xk/ans; + k = k-1; + } + while(k!=0); + ans = x/ans; + pk = 1.0; + pkm1 = 1.0/ans; + k = n-1; + r = 2*k; + do + { + pkm2 = (pkm1*r-pk*x)/x; + pk = pkm1; + pkm1 = pkm2; + r = r-2.0; + k = k-1; + } + while(k!=0); + if( ae_fp_greater(ae_fabs(pk, _state),ae_fabs(pkm1, _state)) ) + { + ans = besselj1(x, _state)/pk; + } + else + { + ans = besselj0(x, _state)/pkm1; + } + result = sg*ans; + return result; +} + + +/************************************************************************* +Bessel function of the second kind, order zero + +Returns Bessel function of the second kind, of order +zero, of the argument. + +The domain is divided into the intervals [0, 5] and +(5, infinity). In the first interval a rational approximation +R(x) is employed to compute + y0(x) = R(x) + 2 * log(x) * j0(x) / PI. +Thus a call to j0() is required. + +In the second interval, the Hankel asymptotic expansion +is employed with two rational functions of degree 6/6 +and 7/7. + + + +ACCURACY: + + Absolute error, when y0(x) < 1; else relative error: + +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.3e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double bessely0(double x, ae_state *_state) +{ + double nn; + double xsq; + double pzero; + double qzero; + double p4; + double q4; + double result; + + + if( ae_fp_greater(x,8.0) ) + { + bessel_besselasympt0(x, &pzero, &qzero, _state); + nn = x-ae_pi/4; + result = ae_sqrt(2/ae_pi/x, _state)*(pzero*ae_sin(nn, _state)+qzero*ae_cos(nn, _state)); + return result; + } + xsq = ae_sqr(x, _state); + p4 = -41370.35497933148554125235152; + p4 = 59152134.65686889654273830069+xsq*p4; + p4 = -34363712229.79040378171030138+xsq*p4; + p4 = 10255208596863.94284509167421+xsq*p4; + p4 = -1648605817185729.473122082537+xsq*p4; + p4 = 137562431639934407.8571335453+xsq*p4; + p4 = -5247065581112764941.297350814+xsq*p4; + p4 = 65874732757195549259.99402049+xsq*p4; + p4 = -27502866786291095837.01933175+xsq*p4; + q4 = 1.0; + q4 = 1282.452772478993804176329391+xsq*q4; + q4 = 1001702.641288906265666651753+xsq*q4; + q4 = 579512264.0700729537480087915+xsq*q4; + q4 = 261306575504.1081249568482092+xsq*q4; + q4 = 91620380340751.85262489147968+xsq*q4; + q4 = 23928830434997818.57439356652+xsq*q4; + q4 = 4192417043410839973.904769661+xsq*q4; + q4 = 372645883898616588198.9980+xsq*q4; + result = p4/q4+2/ae_pi*besselj0(x, _state)*ae_log(x, _state); + return result; +} + + +/************************************************************************* +Bessel function of second kind of order one + +Returns Bessel function of the second kind of order one +of the argument. + +The domain is divided into the intervals [0, 8] and +(8, infinity). In the first interval a 25 term Chebyshev +expansion is used, and a call to j1() is required. +In the second, the asymptotic trigonometric representation +is employed using two rational functions of degree 5/5. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.0e-15 1.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double bessely1(double x, ae_state *_state) +{ + double nn; + double xsq; + double pzero; + double qzero; + double p4; + double q4; + double result; + + + if( ae_fp_greater(x,8.0) ) + { + bessel_besselasympt1(x, &pzero, &qzero, _state); + nn = x-3*ae_pi/4; + result = ae_sqrt(2/ae_pi/x, _state)*(pzero*ae_sin(nn, _state)+qzero*ae_cos(nn, _state)); + return result; + } + xsq = ae_sqr(x, _state); + p4 = -2108847.540133123652824139923; + p4 = 3639488548.124002058278999428+xsq*p4; + p4 = -2580681702194.450950541426399+xsq*p4; + p4 = 956993023992168.3481121552788+xsq*p4; + p4 = -196588746272214065.8820322248+xsq*p4; + p4 = 21931073399177975921.11427556+xsq*p4; + p4 = -1212297555414509577913.561535+xsq*p4; + p4 = 26554738314348543268942.48968+xsq*p4; + p4 = -99637534243069222259967.44354+xsq*p4; + q4 = 1.0; + q4 = 1612.361029677000859332072312+xsq*q4; + q4 = 1563282.754899580604737366452+xsq*q4; + q4 = 1128686837.169442121732366891+xsq*q4; + q4 = 646534088126.5275571961681500+xsq*q4; + q4 = 297663212564727.6729292742282+xsq*q4; + q4 = 108225825940881955.2553850180+xsq*q4; + q4 = 29549879358971486742.90758119+xsq*q4; + q4 = 5435310377188854170800.653097+xsq*q4; + q4 = 508206736694124324531442.4152+xsq*q4; + result = x*p4/q4+2/ae_pi*(besselj1(x, _state)*ae_log(x, _state)-1/x); + return result; +} + + +/************************************************************************* +Bessel function of second kind of integer order + +Returns Bessel function of order n, where n is a +(possibly negative) integer. + +The function is evaluated by forward recurrence on +n, starting with values computed by the routines +y0() and y1(). + +If n = 0 or 1 the routine for y0 or y1 is called +directly. + +ACCURACY: + Absolute error, except relative + when y > 1: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 3.4e-15 4.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselyn(ae_int_t n, double x, ae_state *_state) +{ + ae_int_t i; + double a; + double b; + double tmp; + double s; + double result; + + + s = 1; + if( n<0 ) + { + n = -n; + if( n%2!=0 ) + { + s = -1; + } + } + if( n==0 ) + { + result = bessely0(x, _state); + return result; + } + if( n==1 ) + { + result = s*bessely1(x, _state); + return result; + } + a = bessely0(x, _state); + b = bessely1(x, _state); + for(i=1; i<=n-1; i++) + { + tmp = b; + b = 2*i/x*b-a; + a = tmp; + } + result = s*b; + return result; +} + + +/************************************************************************* +Modified Bessel function of order zero + +Returns modified Bessel function of order zero of the +argument. + +The function is defined as i0(x) = j0( ix ). + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 30000 5.8e-16 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseli0(double x, ae_state *_state) +{ + double y; + double v; + double z; + double b0; + double b1; + double b2; + double result; + + + if( ae_fp_less(x,0) ) + { + x = -x; + } + if( ae_fp_less_eq(x,8.0) ) + { + y = x/2.0-2.0; + bessel_besselmfirstcheb(-4.41534164647933937950E-18, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 3.33079451882223809783E-17, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -2.43127984654795469359E-16, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.71539128555513303061E-15, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -1.16853328779934516808E-14, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 7.67618549860493561688E-14, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -4.85644678311192946090E-13, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 2.95505266312963983461E-12, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -1.72682629144155570723E-11, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 9.67580903537323691224E-11, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -5.18979560163526290666E-10, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 2.65982372468238665035E-9, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -1.30002500998624804212E-8, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 6.04699502254191894932E-8, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -2.67079385394061173391E-7, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.11738753912010371815E-6, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -4.41673835845875056359E-6, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.64484480707288970893E-5, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -5.75419501008210370398E-5, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.88502885095841655729E-4, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -5.76375574538582365885E-4, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.63947561694133579842E-3, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -4.32430999505057594430E-3, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.05464603945949983183E-2, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -2.37374148058994688156E-2, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 4.93052842396707084878E-2, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -9.49010970480476444210E-2, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.71620901522208775349E-1, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -3.04682672343198398683E-1, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 6.76795274409476084995E-1, &b0, &b1, &b2, _state); + v = 0.5*(b0-b2); + result = ae_exp(x, _state)*v; + return result; + } + z = 32.0/x-2.0; + bessel_besselmfirstcheb(-7.23318048787475395456E-18, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -4.83050448594418207126E-18, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 4.46562142029675999901E-17, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 3.46122286769746109310E-17, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -2.82762398051658348494E-16, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -3.42548561967721913462E-16, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 1.77256013305652638360E-15, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 3.81168066935262242075E-15, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -9.55484669882830764870E-15, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -4.15056934728722208663E-14, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 1.54008621752140982691E-14, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 3.85277838274214270114E-13, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 7.18012445138366623367E-13, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -1.79417853150680611778E-12, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -1.32158118404477131188E-11, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -3.14991652796324136454E-11, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 1.18891471078464383424E-11, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 4.94060238822496958910E-10, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 3.39623202570838634515E-9, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 2.26666899049817806459E-8, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 2.04891858946906374183E-7, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 2.89137052083475648297E-6, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 6.88975834691682398426E-5, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 3.36911647825569408990E-3, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 8.04490411014108831608E-1, &b0, &b1, &b2, _state); + v = 0.5*(b0-b2); + result = ae_exp(x, _state)*v/ae_sqrt(x, _state); + return result; +} + + +/************************************************************************* +Modified Bessel function of order one + +Returns modified Bessel function of order one of the +argument. + +The function is defined as i1(x) = -i j1( ix ). + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.9e-15 2.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseli1(double x, ae_state *_state) +{ + double y; + double z; + double v; + double b0; + double b1; + double b2; + double result; + + + z = ae_fabs(x, _state); + if( ae_fp_less_eq(z,8.0) ) + { + y = z/2.0-2.0; + bessel_besselm1firstcheb(2.77791411276104639959E-18, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.11142121435816608115E-17, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.55363195773620046921E-16, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.10559694773538630805E-15, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 7.60068429473540693410E-15, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -5.04218550472791168711E-14, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 3.22379336594557470981E-13, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.98397439776494371520E-12, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.17361862988909016308E-11, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -6.66348972350202774223E-11, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 3.62559028155211703701E-10, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.88724975172282928790E-9, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 9.38153738649577178388E-9, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -4.44505912879632808065E-8, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.00329475355213526229E-7, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -8.56872026469545474066E-7, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 3.47025130813767847674E-6, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.32731636560394358279E-5, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 4.78156510755005422638E-5, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.61760815825896745588E-4, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 5.12285956168575772895E-4, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.51357245063125314899E-3, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 4.15642294431288815669E-3, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.05640848946261981558E-2, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.47264490306265168283E-2, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -5.29459812080949914269E-2, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.02643658689847095384E-1, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.76416518357834055153E-1, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.52587186443633654823E-1, &b0, &b1, &b2, _state); + v = 0.5*(b0-b2); + z = v*z*ae_exp(z, _state); + } + else + { + y = 32.0/z-2.0; + bessel_besselm1firstcheb(7.51729631084210481353E-18, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 4.41434832307170791151E-18, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -4.65030536848935832153E-17, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -3.20952592199342395980E-17, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.96262899764595013876E-16, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 3.30820231092092828324E-16, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.88035477551078244854E-15, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -3.81440307243700780478E-15, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.04202769841288027642E-14, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 4.27244001671195135429E-14, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.10154184277266431302E-14, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -4.08355111109219731823E-13, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -7.19855177624590851209E-13, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.03562854414708950722E-12, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.41258074366137813316E-11, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 3.25260358301548823856E-11, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.89749581235054123450E-11, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -5.58974346219658380687E-10, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -3.83538038596423702205E-9, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.63146884688951950684E-8, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.51223623787020892529E-7, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -3.88256480887769039346E-6, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.10588938762623716291E-4, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -9.76109749136146840777E-3, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 7.78576235018280120474E-1, &b0, &b1, &b2, _state); + v = 0.5*(b0-b2); + z = v*ae_exp(z, _state)/ae_sqrt(z, _state); + } + if( ae_fp_less(x,0) ) + { + z = -z; + } + result = z; + return result; +} + + +/************************************************************************* +Modified Bessel function, second kind, order zero + +Returns modified Bessel function of the second kind +of order zero of the argument. + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + +Tested at 2000 random points between 0 and 8. Peak absolute +error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.2e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselk0(double x, ae_state *_state) +{ + double y; + double z; + double v; + double b0; + double b1; + double b2; + double result; + + + ae_assert(ae_fp_greater(x,0), "Domain error in BesselK0: x<=0", _state); + if( ae_fp_less_eq(x,2) ) + { + y = x*x-2.0; + bessel_besselmfirstcheb(1.37446543561352307156E-16, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 4.25981614279661018399E-14, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.03496952576338420167E-11, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.90451637722020886025E-9, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 2.53479107902614945675E-7, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 2.28621210311945178607E-5, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 1.26461541144692592338E-3, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 3.59799365153615016266E-2, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, 3.44289899924628486886E-1, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(y, -5.35327393233902768720E-1, &b0, &b1, &b2, _state); + v = 0.5*(b0-b2); + v = v-ae_log(0.5*x, _state)*besseli0(x, _state); + } + else + { + z = 8.0/x-2.0; + bessel_besselmfirstcheb(5.30043377268626276149E-18, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -1.64758043015242134646E-17, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 5.21039150503902756861E-17, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -1.67823109680541210385E-16, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 5.51205597852431940784E-16, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -1.84859337734377901440E-15, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 6.34007647740507060557E-15, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -2.22751332699166985548E-14, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 8.03289077536357521100E-14, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -2.98009692317273043925E-13, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 1.14034058820847496303E-12, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -4.51459788337394416547E-12, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 1.85594911495471785253E-11, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -7.95748924447710747776E-11, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 3.57739728140030116597E-10, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -1.69753450938905987466E-9, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 8.57403401741422608519E-9, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -4.66048989768794782956E-8, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 2.76681363944501510342E-7, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -1.83175552271911948767E-6, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 1.39498137188764993662E-5, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -1.28495495816278026384E-4, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 1.56988388573005337491E-3, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, -3.14481013119645005427E-2, &b0, &b1, &b2, _state); + bessel_besselmnextcheb(z, 2.44030308206595545468E0, &b0, &b1, &b2, _state); + v = 0.5*(b0-b2); + v = v*ae_exp(-x, _state)/ae_sqrt(x, _state); + } + result = v; + return result; +} + + +/************************************************************************* +Modified Bessel function, second kind, order one + +Computes the modified Bessel function of the second kind +of order one of the argument. + +The range is partitioned into the two intervals [0,2] and +(2, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.2e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselk1(double x, ae_state *_state) +{ + double y; + double z; + double v; + double b0; + double b1; + double b2; + double result; + + + z = 0.5*x; + ae_assert(ae_fp_greater(z,0), "Domain error in K1", _state); + if( ae_fp_less_eq(x,2) ) + { + y = x*x-2.0; + bessel_besselm1firstcheb(-7.02386347938628759343E-18, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.42744985051936593393E-15, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -6.66690169419932900609E-13, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.41148839263352776110E-10, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.21338763073472585583E-8, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.43340614156596823496E-6, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.73028895751305206302E-4, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -6.97572385963986435018E-3, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.22611180822657148235E-1, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -3.53155960776544875667E-1, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.52530022733894777053E0, &b0, &b1, &b2, _state); + v = 0.5*(b0-b2); + result = ae_log(z, _state)*besseli1(x, _state)+v/x; + } + else + { + y = 8.0/x-2.0; + bessel_besselm1firstcheb(-5.75674448366501715755E-18, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.79405087314755922667E-17, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -5.68946255844285935196E-17, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.83809354436663880070E-16, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -6.05704724837331885336E-16, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.03870316562433424052E-15, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -7.01983709041831346144E-15, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.47715442448130437068E-14, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -8.97670518232499435011E-14, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 3.34841966607842919884E-13, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.28917396095102890680E-12, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 5.13963967348173025100E-12, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.12996783842756842877E-11, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 9.21831518760500529508E-11, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -4.19035475934189648750E-10, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.01504975519703286596E-9, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.03457624656780970260E-8, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 5.74108412545004946722E-8, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -3.50196060308781257119E-7, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.40648494783721712015E-6, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -1.93619797416608296024E-5, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.95215518471351631108E-4, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, -2.85781685962277938680E-3, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 1.03923736576817238437E-1, &b0, &b1, &b2, _state); + bessel_besselm1nextcheb(y, 2.72062619048444266945E0, &b0, &b1, &b2, _state); + v = 0.5*(b0-b2); + result = ae_exp(-x, _state)*v/ae_sqrt(x, _state); + } + return result; +} + + +/************************************************************************* +Modified Bessel function, second kind, integer order + +Returns modified Bessel function of the second kind +of order n of the argument. + +The range is partitioned into the two intervals [0,9.55] and +(9.55, infinity). An ascending power series is used in the +low range, and an asymptotic expansion in the high range. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 90000 1.8e-8 3.0e-10 + +Error is high only near the crossover point x = 9.55 +between the two expansions used. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselkn(ae_int_t nn, double x, ae_state *_state) +{ + double k; + double kf; + double nk1f; + double nkf; + double zn; + double t; + double s; + double z0; + double z; + double ans; + double fn; + double pn; + double pk; + double zmn; + double tlg; + double tox; + ae_int_t i; + ae_int_t n; + double eul; + double result; + + + eul = 5.772156649015328606065e-1; + if( nn<0 ) + { + n = -nn; + } + else + { + n = nn; + } + ae_assert(n<=31, "Overflow in BesselKN", _state); + ae_assert(ae_fp_greater(x,0), "Domain error in BesselKN", _state); + if( ae_fp_less_eq(x,9.55) ) + { + ans = 0.0; + z0 = 0.25*x*x; + fn = 1.0; + pn = 0.0; + zmn = 1.0; + tox = 2.0/x; + if( n>0 ) + { + pn = -eul; + k = 1.0; + for(i=1; i<=n-1; i++) + { + pn = pn+1.0/k; + k = k+1.0; + fn = fn*k; + } + zmn = tox; + if( n==1 ) + { + ans = 1.0/x; + } + else + { + nk1f = fn/n; + kf = 1.0; + s = nk1f; + z = -z0; + zn = 1.0; + for(i=1; i<=n-1; i++) + { + nk1f = nk1f/(n-i); + kf = kf*i; + zn = zn*z; + t = nk1f*zn/kf; + s = s+t; + ae_assert(ae_fp_greater(ae_maxrealnumber-ae_fabs(t, _state),ae_fabs(s, _state)), "Overflow in BesselKN", _state); + ae_assert(!(ae_fp_greater(tox,1.0)&&ae_fp_less(ae_maxrealnumber/tox,zmn)), "Overflow in BesselKN", _state); + zmn = zmn*tox; + } + s = s*0.5; + t = ae_fabs(s, _state); + ae_assert(!(ae_fp_greater(zmn,1.0)&&ae_fp_less(ae_maxrealnumber/zmn,t)), "Overflow in BesselKN", _state); + ae_assert(!(ae_fp_greater(t,1.0)&&ae_fp_less(ae_maxrealnumber/t,zmn)), "Overflow in BesselKN", _state); + ans = s*zmn; + } + } + tlg = 2.0*ae_log(0.5*x, _state); + pk = -eul; + if( n==0 ) + { + pn = pk; + t = 1.0; + } + else + { + pn = pn+1.0/n; + t = 1.0/fn; + } + s = (pk+pn-tlg)*t; + k = 1.0; + do + { + t = t*(z0/(k*(k+n))); + pk = pk+1.0/k; + pn = pn+1.0/(k+n); + s = s+(pk+pn-tlg)*t; + k = k+1.0; + } + while(ae_fp_greater(ae_fabs(t/s, _state),ae_machineepsilon)); + s = 0.5*s/zmn; + if( n%2!=0 ) + { + s = -s; + } + ans = ans+s; + result = ans; + return result; + } + if( ae_fp_greater(x,ae_log(ae_maxrealnumber, _state)) ) + { + result = 0; + return result; + } + k = n; + pn = 4.0*k*k; + pk = 1.0; + z0 = 8.0*x; + fn = 1.0; + t = 1.0; + s = t; + nkf = ae_maxrealnumber; + i = 0; + do + { + z = pn-pk*pk; + t = t*z/(fn*z0); + nk1f = ae_fabs(t, _state); + if( i>=n&&ae_fp_greater(nk1f,nkf) ) + { + break; + } + nkf = nk1f; + s = s+t; + fn = fn+1.0; + pk = pk+2.0; + i = i+1; + } + while(ae_fp_greater(ae_fabs(t/s, _state),ae_machineepsilon)); + result = ae_exp(-x, _state)*ae_sqrt(ae_pi/(2.0*x), _state)*s; + return result; +} + + +/************************************************************************* +Internal subroutine + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +static void bessel_besselmfirstcheb(double c, + double* b0, + double* b1, + double* b2, + ae_state *_state) +{ + + + *b0 = c; + *b1 = 0.0; + *b2 = 0.0; +} + + +/************************************************************************* +Internal subroutine + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +static void bessel_besselmnextcheb(double x, + double c, + double* b0, + double* b1, + double* b2, + ae_state *_state) +{ + + + *b2 = *b1; + *b1 = *b0; + *b0 = x*(*b1)-(*b2)+c; +} + + +/************************************************************************* +Internal subroutine + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +static void bessel_besselm1firstcheb(double c, + double* b0, + double* b1, + double* b2, + ae_state *_state) +{ + + + *b0 = c; + *b1 = 0.0; + *b2 = 0.0; +} + + +/************************************************************************* +Internal subroutine + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +static void bessel_besselm1nextcheb(double x, + double c, + double* b0, + double* b1, + double* b2, + ae_state *_state) +{ + + + *b2 = *b1; + *b1 = *b0; + *b0 = x*(*b1)-(*b2)+c; +} + + +static void bessel_besselasympt0(double x, + double* pzero, + double* qzero, + ae_state *_state) +{ + double xsq; + double p2; + double q2; + double p3; + double q3; + + *pzero = 0; + *qzero = 0; + + xsq = 64.0/(x*x); + p2 = 0.0; + p2 = 2485.271928957404011288128951+xsq*p2; + p2 = 153982.6532623911470917825993+xsq*p2; + p2 = 2016135.283049983642487182349+xsq*p2; + p2 = 8413041.456550439208464315611+xsq*p2; + p2 = 12332384.76817638145232406055+xsq*p2; + p2 = 5393485.083869438325262122897+xsq*p2; + q2 = 1.0; + q2 = 2615.700736920839685159081813+xsq*q2; + q2 = 156001.7276940030940592769933+xsq*q2; + q2 = 2025066.801570134013891035236+xsq*q2; + q2 = 8426449.050629797331554404810+xsq*q2; + q2 = 12338310.22786324960844856182+xsq*q2; + q2 = 5393485.083869438325560444960+xsq*q2; + p3 = -0.0; + p3 = -4.887199395841261531199129300+xsq*p3; + p3 = -226.2630641933704113967255053+xsq*p3; + p3 = -2365.956170779108192723612816+xsq*p3; + p3 = -8239.066313485606568803548860+xsq*p3; + p3 = -10381.41698748464093880530341+xsq*p3; + p3 = -3984.617357595222463506790588+xsq*p3; + q3 = 1.0; + q3 = 408.7714673983499223402830260+xsq*q3; + q3 = 15704.89191515395519392882766+xsq*q3; + q3 = 156021.3206679291652539287109+xsq*q3; + q3 = 533291.3634216897168722255057+xsq*q3; + q3 = 666745.4239319826986004038103+xsq*q3; + q3 = 255015.5108860942382983170882+xsq*q3; + *pzero = p2/q2; + *qzero = 8*p3/q3/x; +} + + +static void bessel_besselasympt1(double x, + double* pzero, + double* qzero, + ae_state *_state) +{ + double xsq; + double p2; + double q2; + double p3; + double q3; + + *pzero = 0; + *qzero = 0; + + xsq = 64.0/(x*x); + p2 = -1611.616644324610116477412898; + p2 = -109824.0554345934672737413139+xsq*p2; + p2 = -1523529.351181137383255105722+xsq*p2; + p2 = -6603373.248364939109255245434+xsq*p2; + p2 = -9942246.505077641195658377899+xsq*p2; + p2 = -4435757.816794127857114720794+xsq*p2; + q2 = 1.0; + q2 = -1455.009440190496182453565068+xsq*q2; + q2 = -107263.8599110382011903063867+xsq*q2; + q2 = -1511809.506634160881644546358+xsq*q2; + q2 = -6585339.479723087072826915069+xsq*q2; + q2 = -9934124.389934585658967556309+xsq*q2; + q2 = -4435757.816794127856828016962+xsq*q2; + p3 = 35.26513384663603218592175580; + p3 = 1706.375429020768002061283546+xsq*p3; + p3 = 18494.26287322386679652009819+xsq*p3; + p3 = 66178.83658127083517939992166+xsq*p3; + p3 = 85145.16067533570196555001171+xsq*p3; + p3 = 33220.91340985722351859704442+xsq*p3; + q3 = 1.0; + q3 = 863.8367769604990967475517183+xsq*q3; + q3 = 37890.22974577220264142952256+xsq*q3; + q3 = 400294.4358226697511708610813+xsq*q3; + q3 = 1419460.669603720892855755253+xsq*q3; + q3 = 1819458.042243997298924553839+xsq*q3; + q3 = 708712.8194102874357377502472+xsq*q3; + *pzero = p2/q2; + *qzero = 8*p3/q3/x; +} + + + + +/************************************************************************* +Beta function + + + - - + | (a) | (b) +beta( a, b ) = -----------. + - + | (a+b) + +For large arguments the logarithm of the function is +evaluated using lgam(), then exponentiated. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 30000 8.1e-14 1.1e-14 + +Cephes Math Library Release 2.0: April, 1987 +Copyright 1984, 1987 by Stephen L. Moshier +*************************************************************************/ +double beta(double a, double b, ae_state *_state) +{ + double y; + double sg; + double s; + double result; + + + sg = 1; + ae_assert(ae_fp_greater(a,0)||ae_fp_neq(a,ae_ifloor(a, _state)), "Overflow in Beta", _state); + ae_assert(ae_fp_greater(b,0)||ae_fp_neq(b,ae_ifloor(b, _state)), "Overflow in Beta", _state); + y = a+b; + if( ae_fp_greater(ae_fabs(y, _state),171.624376956302725) ) + { + y = lngamma(y, &s, _state); + sg = sg*s; + y = lngamma(b, &s, _state)-y; + sg = sg*s; + y = lngamma(a, &s, _state)+y; + sg = sg*s; + ae_assert(ae_fp_less_eq(y,ae_log(ae_maxrealnumber, _state)), "Overflow in Beta", _state); + result = sg*ae_exp(y, _state); + return result; + } + y = gammafunction(y, _state); + ae_assert(ae_fp_neq(y,0), "Overflow in Beta", _state); + if( ae_fp_greater(a,b) ) + { + y = gammafunction(a, _state)/y; + y = y*gammafunction(b, _state); + } + else + { + y = gammafunction(b, _state)/y; + y = y*gammafunction(a, _state); + } + result = y; + return result; +} + + + + +/************************************************************************* +Incomplete beta integral + +Returns incomplete beta integral of the arguments, evaluated +from zero to x. The function is defined as + + x + - - + | (a+b) | | a-1 b-1 + ----------- | t (1-t) dt. + - - | | + | (a) | (b) - + 0 + +The domain of definition is 0 <= x <= 1. In this +implementation a and b are restricted to positive values. +The integral from x to 1 may be obtained by the symmetry +relation + + 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). + +The integral is evaluated by a continued fraction expansion +or, when b*x is small, by a power series. + +ACCURACY: + +Tested at uniformly distributed random points (a,b,x) with a and b +in "domain" and x between 0 and 1. + Relative error +arithmetic domain # trials peak rms + IEEE 0,5 10000 6.9e-15 4.5e-16 + IEEE 0,85 250000 2.2e-13 1.7e-14 + IEEE 0,1000 30000 5.3e-12 6.3e-13 + IEEE 0,10000 250000 9.3e-11 7.1e-12 + IEEE 0,100000 10000 8.7e-10 4.8e-11 +Outputs smaller than the IEEE gradual underflow threshold +were excluded from these statistics. + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletebeta(double a, double b, double x, ae_state *_state) +{ + double t; + double xc; + double w; + double y; + ae_int_t flag; + double sg; + double big; + double biginv; + double maxgam; + double minlog; + double maxlog; + double result; + + + big = 4.503599627370496e15; + biginv = 2.22044604925031308085e-16; + maxgam = 171.624376956302725; + minlog = ae_log(ae_minrealnumber, _state); + maxlog = ae_log(ae_maxrealnumber, _state); + ae_assert(ae_fp_greater(a,0)&&ae_fp_greater(b,0), "Domain error in IncompleteBeta", _state); + ae_assert(ae_fp_greater_eq(x,0)&&ae_fp_less_eq(x,1), "Domain error in IncompleteBeta", _state); + if( ae_fp_eq(x,0) ) + { + result = 0; + return result; + } + if( ae_fp_eq(x,1) ) + { + result = 1; + return result; + } + flag = 0; + if( ae_fp_less_eq(b*x,1.0)&&ae_fp_less_eq(x,0.95) ) + { + result = ibetaf_incompletebetaps(a, b, x, maxgam, _state); + return result; + } + w = 1.0-x; + if( ae_fp_greater(x,a/(a+b)) ) + { + flag = 1; + t = a; + a = b; + b = t; + xc = x; + x = w; + } + else + { + xc = w; + } + if( (flag==1&&ae_fp_less_eq(b*x,1.0))&&ae_fp_less_eq(x,0.95) ) + { + t = ibetaf_incompletebetaps(a, b, x, maxgam, _state); + if( ae_fp_less_eq(t,ae_machineepsilon) ) + { + result = 1.0-ae_machineepsilon; + } + else + { + result = 1.0-t; + } + return result; + } + y = x*(a+b-2.0)-(a-1.0); + if( ae_fp_less(y,0.0) ) + { + w = ibetaf_incompletebetafe(a, b, x, big, biginv, _state); + } + else + { + w = ibetaf_incompletebetafe2(a, b, x, big, biginv, _state)/xc; + } + y = a*ae_log(x, _state); + t = b*ae_log(xc, _state); + if( (ae_fp_less(a+b,maxgam)&&ae_fp_less(ae_fabs(y, _state),maxlog))&&ae_fp_less(ae_fabs(t, _state),maxlog) ) + { + t = ae_pow(xc, b, _state); + t = t*ae_pow(x, a, _state); + t = t/a; + t = t*w; + t = t*(gammafunction(a+b, _state)/(gammafunction(a, _state)*gammafunction(b, _state))); + if( flag==1 ) + { + if( ae_fp_less_eq(t,ae_machineepsilon) ) + { + result = 1.0-ae_machineepsilon; + } + else + { + result = 1.0-t; + } + } + else + { + result = t; + } + return result; + } + y = y+t+lngamma(a+b, &sg, _state)-lngamma(a, &sg, _state)-lngamma(b, &sg, _state); + y = y+ae_log(w/a, _state); + if( ae_fp_less(y,minlog) ) + { + t = 0.0; + } + else + { + t = ae_exp(y, _state); + } + if( flag==1 ) + { + if( ae_fp_less_eq(t,ae_machineepsilon) ) + { + t = 1.0-ae_machineepsilon; + } + else + { + t = 1.0-t; + } + } + result = t; + return result; +} + + +/************************************************************************* +Inverse of imcomplete beta integral + +Given y, the function finds x such that + + incbet( a, b, x ) = y . + +The routine performs interval halving or Newton iterations to find the +root of incbet(a,b,x) - y = 0. + + +ACCURACY: + + Relative error: + x a,b +arithmetic domain domain # trials peak rms + IEEE 0,1 .5,10000 50000 5.8e-12 1.3e-13 + IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15 + IEEE 0,1 0,5 50000 1.1e-12 5.5e-15 +With a and b constrained to half-integer or integer values: + IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13 + IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16 +With a = .5, b constrained to half-integer or integer values: + IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1996, 2000 by Stephen L. Moshier +*************************************************************************/ +double invincompletebeta(double a, double b, double y, ae_state *_state) +{ + double aaa; + double bbb; + double y0; + double d; + double yyy; + double x; + double x0; + double x1; + double lgm; + double yp; + double di; + double dithresh; + double yl; + double yh; + double xt; + ae_int_t i; + ae_int_t rflg; + ae_int_t dir; + ae_int_t nflg; + double s; + ae_int_t mainlooppos; + ae_int_t ihalve; + ae_int_t ihalvecycle; + ae_int_t newt; + ae_int_t newtcycle; + ae_int_t breaknewtcycle; + ae_int_t breakihalvecycle; + double result; + + + i = 0; + ae_assert(ae_fp_greater_eq(y,0)&&ae_fp_less_eq(y,1), "Domain error in InvIncompleteBeta", _state); + + /* + * special cases + */ + if( ae_fp_eq(y,0) ) + { + result = 0; + return result; + } + if( ae_fp_eq(y,1.0) ) + { + result = 1; + return result; + } + + /* + * these initializations are not really necessary, + * but without them compiler complains about 'possibly uninitialized variables'. + */ + dithresh = 0; + rflg = 0; + aaa = 0; + bbb = 0; + y0 = 0; + x = 0; + yyy = 0; + lgm = 0; + dir = 0; + di = 0; + + /* + * normal initializations + */ + x0 = 0.0; + yl = 0.0; + x1 = 1.0; + yh = 1.0; + nflg = 0; + mainlooppos = 0; + ihalve = 1; + ihalvecycle = 2; + newt = 3; + newtcycle = 4; + breaknewtcycle = 5; + breakihalvecycle = 6; + + /* + * main loop + */ + for(;;) + { + + /* + * start + */ + if( mainlooppos==0 ) + { + if( ae_fp_less_eq(a,1.0)||ae_fp_less_eq(b,1.0) ) + { + dithresh = 1.0e-6; + rflg = 0; + aaa = a; + bbb = b; + y0 = y; + x = aaa/(aaa+bbb); + yyy = incompletebeta(aaa, bbb, x, _state); + mainlooppos = ihalve; + continue; + } + else + { + dithresh = 1.0e-4; + } + yp = -invnormaldistribution(y, _state); + if( ae_fp_greater(y,0.5) ) + { + rflg = 1; + aaa = b; + bbb = a; + y0 = 1.0-y; + yp = -yp; + } + else + { + rflg = 0; + aaa = a; + bbb = b; + y0 = y; + } + lgm = (yp*yp-3.0)/6.0; + x = 2.0/(1.0/(2.0*aaa-1.0)+1.0/(2.0*bbb-1.0)); + d = yp*ae_sqrt(x+lgm, _state)/x-(1.0/(2.0*bbb-1.0)-1.0/(2.0*aaa-1.0))*(lgm+5.0/6.0-2.0/(3.0*x)); + d = 2.0*d; + if( ae_fp_less(d,ae_log(ae_minrealnumber, _state)) ) + { + x = 0; + break; + } + x = aaa/(aaa+bbb*ae_exp(d, _state)); + yyy = incompletebeta(aaa, bbb, x, _state); + yp = (yyy-y0)/y0; + if( ae_fp_less(ae_fabs(yp, _state),0.2) ) + { + mainlooppos = newt; + continue; + } + mainlooppos = ihalve; + continue; + } + + /* + * ihalve + */ + if( mainlooppos==ihalve ) + { + dir = 0; + di = 0.5; + i = 0; + mainlooppos = ihalvecycle; + continue; + } + + /* + * ihalvecycle + */ + if( mainlooppos==ihalvecycle ) + { + if( i<=99 ) + { + if( i!=0 ) + { + x = x0+di*(x1-x0); + if( ae_fp_eq(x,1.0) ) + { + x = 1.0-ae_machineepsilon; + } + if( ae_fp_eq(x,0.0) ) + { + di = 0.5; + x = x0+di*(x1-x0); + if( ae_fp_eq(x,0.0) ) + { + break; + } + } + yyy = incompletebeta(aaa, bbb, x, _state); + yp = (x1-x0)/(x1+x0); + if( ae_fp_less(ae_fabs(yp, _state),dithresh) ) + { + mainlooppos = newt; + continue; + } + yp = (yyy-y0)/y0; + if( ae_fp_less(ae_fabs(yp, _state),dithresh) ) + { + mainlooppos = newt; + continue; + } + } + if( ae_fp_less(yyy,y0) ) + { + x0 = x; + yl = yyy; + if( dir<0 ) + { + dir = 0; + di = 0.5; + } + else + { + if( dir>3 ) + { + di = 1.0-(1.0-di)*(1.0-di); + } + else + { + if( dir>1 ) + { + di = 0.5*di+0.5; + } + else + { + di = (y0-yyy)/(yh-yl); + } + } + } + dir = dir+1; + if( ae_fp_greater(x0,0.75) ) + { + if( rflg==1 ) + { + rflg = 0; + aaa = a; + bbb = b; + y0 = y; + } + else + { + rflg = 1; + aaa = b; + bbb = a; + y0 = 1.0-y; + } + x = 1.0-x; + yyy = incompletebeta(aaa, bbb, x, _state); + x0 = 0.0; + yl = 0.0; + x1 = 1.0; + yh = 1.0; + mainlooppos = ihalve; + continue; + } + } + else + { + x1 = x; + if( rflg==1&&ae_fp_less(x1,ae_machineepsilon) ) + { + x = 0.0; + break; + } + yh = yyy; + if( dir>0 ) + { + dir = 0; + di = 0.5; + } + else + { + if( dir<-3 ) + { + di = di*di; + } + else + { + if( dir<-1 ) + { + di = 0.5*di; + } + else + { + di = (yyy-y0)/(yh-yl); + } + } + } + dir = dir-1; + } + i = i+1; + mainlooppos = ihalvecycle; + continue; + } + else + { + mainlooppos = breakihalvecycle; + continue; + } + } + + /* + * breakihalvecycle + */ + if( mainlooppos==breakihalvecycle ) + { + if( ae_fp_greater_eq(x0,1.0) ) + { + x = 1.0-ae_machineepsilon; + break; + } + if( ae_fp_less_eq(x,0.0) ) + { + x = 0.0; + break; + } + mainlooppos = newt; + continue; + } + + /* + * newt + */ + if( mainlooppos==newt ) + { + if( nflg!=0 ) + { + break; + } + nflg = 1; + lgm = lngamma(aaa+bbb, &s, _state)-lngamma(aaa, &s, _state)-lngamma(bbb, &s, _state); + i = 0; + mainlooppos = newtcycle; + continue; + } + + /* + * newtcycle + */ + if( mainlooppos==newtcycle ) + { + if( i<=7 ) + { + if( i!=0 ) + { + yyy = incompletebeta(aaa, bbb, x, _state); + } + if( ae_fp_less(yyy,yl) ) + { + x = x0; + yyy = yl; + } + else + { + if( ae_fp_greater(yyy,yh) ) + { + x = x1; + yyy = yh; + } + else + { + if( ae_fp_less(yyy,y0) ) + { + x0 = x; + yl = yyy; + } + else + { + x1 = x; + yh = yyy; + } + } + } + if( ae_fp_eq(x,1.0)||ae_fp_eq(x,0.0) ) + { + mainlooppos = breaknewtcycle; + continue; + } + d = (aaa-1.0)*ae_log(x, _state)+(bbb-1.0)*ae_log(1.0-x, _state)+lgm; + if( ae_fp_less(d,ae_log(ae_minrealnumber, _state)) ) + { + break; + } + if( ae_fp_greater(d,ae_log(ae_maxrealnumber, _state)) ) + { + mainlooppos = breaknewtcycle; + continue; + } + d = ae_exp(d, _state); + d = (yyy-y0)/d; + xt = x-d; + if( ae_fp_less_eq(xt,x0) ) + { + yyy = (x-x0)/(x1-x0); + xt = x0+0.5*yyy*(x-x0); + if( ae_fp_less_eq(xt,0.0) ) + { + mainlooppos = breaknewtcycle; + continue; + } + } + if( ae_fp_greater_eq(xt,x1) ) + { + yyy = (x1-x)/(x1-x0); + xt = x1-0.5*yyy*(x1-x); + if( ae_fp_greater_eq(xt,1.0) ) + { + mainlooppos = breaknewtcycle; + continue; + } + } + x = xt; + if( ae_fp_less(ae_fabs(d/x, _state),128.0*ae_machineepsilon) ) + { + break; + } + i = i+1; + mainlooppos = newtcycle; + continue; + } + else + { + mainlooppos = breaknewtcycle; + continue; + } + } + + /* + * breaknewtcycle + */ + if( mainlooppos==breaknewtcycle ) + { + dithresh = 256.0*ae_machineepsilon; + mainlooppos = ihalve; + continue; + } + } + + /* + * done + */ + if( rflg!=0 ) + { + if( ae_fp_less_eq(x,ae_machineepsilon) ) + { + x = 1.0-ae_machineepsilon; + } + else + { + x = 1.0-x; + } + } + result = x; + return result; +} + + +/************************************************************************* +Continued fraction expansion #1 for incomplete beta integral + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +static double ibetaf_incompletebetafe(double a, + double b, + double x, + double big, + double biginv, + ae_state *_state) +{ + double xk; + double pk; + double pkm1; + double pkm2; + double qk; + double qkm1; + double qkm2; + double k1; + double k2; + double k3; + double k4; + double k5; + double k6; + double k7; + double k8; + double r; + double t; + double ans; + double thresh; + ae_int_t n; + double result; + + + k1 = a; + k2 = a+b; + k3 = a; + k4 = a+1.0; + k5 = 1.0; + k6 = b-1.0; + k7 = k4; + k8 = a+2.0; + pkm2 = 0.0; + qkm2 = 1.0; + pkm1 = 1.0; + qkm1 = 1.0; + ans = 1.0; + r = 1.0; + n = 0; + thresh = 3.0*ae_machineepsilon; + do + { + xk = -x*k1*k2/(k3*k4); + pk = pkm1+pkm2*xk; + qk = qkm1+qkm2*xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + xk = x*k5*k6/(k7*k8); + pk = pkm1+pkm2*xk; + qk = qkm1+qkm2*xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + if( ae_fp_neq(qk,0) ) + { + r = pk/qk; + } + if( ae_fp_neq(r,0) ) + { + t = ae_fabs((ans-r)/r, _state); + ans = r; + } + else + { + t = 1.0; + } + if( ae_fp_less(t,thresh) ) + { + break; + } + k1 = k1+1.0; + k2 = k2+1.0; + k3 = k3+2.0; + k4 = k4+2.0; + k5 = k5+1.0; + k6 = k6-1.0; + k7 = k7+2.0; + k8 = k8+2.0; + if( ae_fp_greater(ae_fabs(qk, _state)+ae_fabs(pk, _state),big) ) + { + pkm2 = pkm2*biginv; + pkm1 = pkm1*biginv; + qkm2 = qkm2*biginv; + qkm1 = qkm1*biginv; + } + if( ae_fp_less(ae_fabs(qk, _state),biginv)||ae_fp_less(ae_fabs(pk, _state),biginv) ) + { + pkm2 = pkm2*big; + pkm1 = pkm1*big; + qkm2 = qkm2*big; + qkm1 = qkm1*big; + } + n = n+1; + } + while(n!=300); + result = ans; + return result; +} + + +/************************************************************************* +Continued fraction expansion #2 +for incomplete beta integral + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +static double ibetaf_incompletebetafe2(double a, + double b, + double x, + double big, + double biginv, + ae_state *_state) +{ + double xk; + double pk; + double pkm1; + double pkm2; + double qk; + double qkm1; + double qkm2; + double k1; + double k2; + double k3; + double k4; + double k5; + double k6; + double k7; + double k8; + double r; + double t; + double ans; + double z; + double thresh; + ae_int_t n; + double result; + + + k1 = a; + k2 = b-1.0; + k3 = a; + k4 = a+1.0; + k5 = 1.0; + k6 = a+b; + k7 = a+1.0; + k8 = a+2.0; + pkm2 = 0.0; + qkm2 = 1.0; + pkm1 = 1.0; + qkm1 = 1.0; + z = x/(1.0-x); + ans = 1.0; + r = 1.0; + n = 0; + thresh = 3.0*ae_machineepsilon; + do + { + xk = -z*k1*k2/(k3*k4); + pk = pkm1+pkm2*xk; + qk = qkm1+qkm2*xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + xk = z*k5*k6/(k7*k8); + pk = pkm1+pkm2*xk; + qk = qkm1+qkm2*xk; + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + if( ae_fp_neq(qk,0) ) + { + r = pk/qk; + } + if( ae_fp_neq(r,0) ) + { + t = ae_fabs((ans-r)/r, _state); + ans = r; + } + else + { + t = 1.0; + } + if( ae_fp_less(t,thresh) ) + { + break; + } + k1 = k1+1.0; + k2 = k2-1.0; + k3 = k3+2.0; + k4 = k4+2.0; + k5 = k5+1.0; + k6 = k6+1.0; + k7 = k7+2.0; + k8 = k8+2.0; + if( ae_fp_greater(ae_fabs(qk, _state)+ae_fabs(pk, _state),big) ) + { + pkm2 = pkm2*biginv; + pkm1 = pkm1*biginv; + qkm2 = qkm2*biginv; + qkm1 = qkm1*biginv; + } + if( ae_fp_less(ae_fabs(qk, _state),biginv)||ae_fp_less(ae_fabs(pk, _state),biginv) ) + { + pkm2 = pkm2*big; + pkm1 = pkm1*big; + qkm2 = qkm2*big; + qkm1 = qkm1*big; + } + n = n+1; + } + while(n!=300); + result = ans; + return result; +} + + +/************************************************************************* +Power series for incomplete beta integral. +Use when b*x is small and x not too close to 1. + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +static double ibetaf_incompletebetaps(double a, + double b, + double x, + double maxgam, + ae_state *_state) +{ + double s; + double t; + double u; + double v; + double n; + double t1; + double z; + double ai; + double sg; + double result; + + + ai = 1.0/a; + u = (1.0-b)*x; + v = u/(a+1.0); + t1 = v; + t = u; + n = 2.0; + s = 0.0; + z = ae_machineepsilon*ai; + while(ae_fp_greater(ae_fabs(v, _state),z)) + { + u = (n-b)*x/n; + t = t*u; + v = t/(a+n); + s = s+v; + n = n+1.0; + } + s = s+t1; + s = s+ai; + u = a*ae_log(x, _state); + if( ae_fp_less(a+b,maxgam)&&ae_fp_less(ae_fabs(u, _state),ae_log(ae_maxrealnumber, _state)) ) + { + t = gammafunction(a+b, _state)/(gammafunction(a, _state)*gammafunction(b, _state)); + s = s*t*ae_pow(x, a, _state); + } + else + { + t = lngamma(a+b, &sg, _state)-lngamma(a, &sg, _state)-lngamma(b, &sg, _state)+u+ae_log(s, _state); + if( ae_fp_less(t,ae_log(ae_minrealnumber, _state)) ) + { + s = 0.0; + } + else + { + s = ae_exp(t, _state); + } + } + result = s; + return result; +} + + + + +/************************************************************************* +Binomial distribution + +Returns the sum of the terms 0 through k of the Binomial +probability density: + + k + -- ( n ) j n-j + > ( ) p (1-p) + -- ( j ) + j=0 + +The terms are not summed directly; instead the incomplete +beta integral is employed, according to the formula + +y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). + +The arguments must be positive, with p ranging from 0 to 1. + +ACCURACY: + +Tested at random points (a,b,p), with p between 0 and 1. + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 4.3e-15 2.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double binomialdistribution(ae_int_t k, + ae_int_t n, + double p, + ae_state *_state) +{ + double dk; + double dn; + double result; + + + ae_assert(ae_fp_greater_eq(p,0)&&ae_fp_less_eq(p,1), "Domain error in BinomialDistribution", _state); + ae_assert(k>=-1&&k<=n, "Domain error in BinomialDistribution", _state); + if( k==-1 ) + { + result = 0; + return result; + } + if( k==n ) + { + result = 1; + return result; + } + dn = n-k; + if( k==0 ) + { + dk = ae_pow(1.0-p, dn, _state); + } + else + { + dk = k+1; + dk = incompletebeta(dn, dk, 1.0-p, _state); + } + result = dk; + return result; +} + + +/************************************************************************* +Complemented binomial distribution + +Returns the sum of the terms k+1 through n of the Binomial +probability density: + + n + -- ( n ) j n-j + > ( ) p (1-p) + -- ( j ) + j=k+1 + +The terms are not summed directly; instead the incomplete +beta integral is employed, according to the formula + +y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). + +The arguments must be positive, with p ranging from 0 to 1. + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 6.7e-15 8.2e-16 + For p between 0 and .001: + IEEE 0,100 100000 1.5e-13 2.7e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double binomialcdistribution(ae_int_t k, + ae_int_t n, + double p, + ae_state *_state) +{ + double dk; + double dn; + double result; + + + ae_assert(ae_fp_greater_eq(p,0)&&ae_fp_less_eq(p,1), "Domain error in BinomialDistributionC", _state); + ae_assert(k>=-1&&k<=n, "Domain error in BinomialDistributionC", _state); + if( k==-1 ) + { + result = 1; + return result; + } + if( k==n ) + { + result = 0; + return result; + } + dn = n-k; + if( k==0 ) + { + if( ae_fp_less(p,0.01) ) + { + dk = -nuexpm1(dn*nulog1p(-p, _state), _state); + } + else + { + dk = 1.0-ae_pow(1.0-p, dn, _state); + } + } + else + { + dk = k+1; + dk = incompletebeta(dk, dn, p, _state); + } + result = dk; + return result; +} + + +/************************************************************************* +Inverse binomial distribution + +Finds the event probability p such that the sum of the +terms 0 through k of the Binomial probability density +is equal to the given cumulative probability y. + +This is accomplished using the inverse beta integral +function and the relation + +1 - p = incbi( n-k, k+1, y ). + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 2.3e-14 6.4e-16 + IEEE 0,10000 100000 6.6e-12 1.2e-13 + For p between 10^-6 and 0.001: + IEEE 0,100 100000 2.0e-12 1.3e-14 + IEEE 0,10000 100000 1.5e-12 3.2e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invbinomialdistribution(ae_int_t k, + ae_int_t n, + double y, + ae_state *_state) +{ + double dk; + double dn; + double p; + double result; + + + ae_assert(k>=0&&k=0 + x - argument, -1 <= x <= 1 + +Result: + the value of the Chebyshev polynomial at x +*************************************************************************/ +double chebyshevcalculate(ae_int_t r, + ae_int_t n, + double x, + ae_state *_state) +{ + ae_int_t i; + double a; + double b; + double result; + + + result = 0; + + /* + * Prepare A and B + */ + if( r==1 ) + { + a = 1; + b = x; + } + else + { + a = 1; + b = 2*x; + } + + /* + * Special cases: N=0 or N=1 + */ + if( n==0 ) + { + result = a; + return result; + } + if( n==1 ) + { + result = b; + return result; + } + + /* + * General case: N>=2 + */ + for(i=2; i<=n; i++) + { + result = 2*x*b-a; + a = b; + b = result; + } + return result; +} + + +/************************************************************************* +Summation of Chebyshev polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*T0(x) + c[1]*T1(x) + ... + c[N]*TN(x) +or + c[0]*U0(x) + c[1]*U1(x) + ... + c[N]*UN(x) +depending on the R. + +Parameters: + r - polynomial kind, either 1 or 2. + n - degree, n>=0 + x - argument + +Result: + the value of the Chebyshev polynomial at x +*************************************************************************/ +double chebyshevsum(/* Real */ ae_vector* c, + ae_int_t r, + ae_int_t n, + double x, + ae_state *_state) +{ + double b1; + double b2; + ae_int_t i; + double result; + + + b1 = 0; + b2 = 0; + for(i=n; i>=1; i--) + { + result = 2*x*b1-b2+c->ptr.p_double[i]; + b2 = b1; + b1 = result; + } + if( r==1 ) + { + result = -b2+x*b1+c->ptr.p_double[0]; + } + else + { + result = -b2+2*x*b1+c->ptr.p_double[0]; + } + return result; +} + + +/************************************************************************* +Representation of Tn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void chebyshevcoefficients(ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state) +{ + ae_int_t i; + + ae_vector_clear(c); + + ae_vector_set_length(c, n+1, _state); + for(i=0; i<=n; i++) + { + c->ptr.p_double[i] = 0; + } + if( n==0||n==1 ) + { + c->ptr.p_double[n] = 1; + } + else + { + c->ptr.p_double[n] = ae_exp((n-1)*ae_log(2, _state), _state); + for(i=0; i<=n/2-1; i++) + { + c->ptr.p_double[n-2*(i+1)] = -c->ptr.p_double[n-2*i]*(n-2*i)*(n-2*i-1)/4/(i+1)/(n-i-1); + } + } +} + + +/************************************************************************* +Conversion of a series of Chebyshev polynomials to a power series. + +Represents A[0]*T0(x) + A[1]*T1(x) + ... + A[N]*Tn(x) as +B[0] + B[1]*X + ... + B[N]*X^N. + +Input parameters: + A - Chebyshev series coefficients + N - degree, N>=0 + +Output parameters + B - power series coefficients +*************************************************************************/ +void fromchebyshev(/* Real */ ae_vector* a, + ae_int_t n, + /* Real */ ae_vector* b, + ae_state *_state) +{ + ae_int_t i; + ae_int_t k; + double e; + double d; + + ae_vector_clear(b); + + ae_vector_set_length(b, n+1, _state); + for(i=0; i<=n; i++) + { + b->ptr.p_double[i] = 0; + } + d = 0; + i = 0; + do + { + k = i; + do + { + e = b->ptr.p_double[k]; + b->ptr.p_double[k] = 0; + if( i<=1&&k==i ) + { + b->ptr.p_double[k] = 1; + } + else + { + if( i!=0 ) + { + b->ptr.p_double[k] = 2*d; + } + if( k>i+1 ) + { + b->ptr.p_double[k] = b->ptr.p_double[k]-b->ptr.p_double[k-2]; + } + } + d = e; + k = k+1; + } + while(k<=n); + d = b->ptr.p_double[i]; + e = 0; + k = i; + while(k<=n) + { + e = e+b->ptr.p_double[k]*a->ptr.p_double[k]; + k = k+2; + } + b->ptr.p_double[i] = e; + i = i+1; + } + while(i<=n); +} + + + + +/************************************************************************* +Chi-square distribution + +Returns the area under the left hand tail (from 0 to x) +of the Chi square probability density function with +v degrees of freedom. + + + x + - + 1 | | v/2-1 -t/2 + P( x | v ) = ----------- | t e dt + v/2 - | | + 2 | (v/2) - + 0 + +where x is the Chi-square variable. + +The incomplete gamma integral is used, according to the +formula + +y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double chisquaredistribution(double v, double x, ae_state *_state) +{ + double result; + + + ae_assert(ae_fp_greater_eq(x,0)&&ae_fp_greater_eq(v,1), "Domain error in ChiSquareDistribution", _state); + result = incompletegamma(v/2.0, x/2.0, _state); + return result; +} + + +/************************************************************************* +Complemented Chi-square distribution + +Returns the area under the right hand tail (from x to +infinity) of the Chi square probability density function +with v degrees of freedom: + + inf. + - + 1 | | v/2-1 -t/2 + P( x | v ) = ----------- | t e dt + v/2 - | | + 2 | (v/2) - + x + +where x is the Chi-square variable. + +The incomplete gamma integral is used, according to the +formula + +y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double chisquarecdistribution(double v, double x, ae_state *_state) +{ + double result; + + + ae_assert(ae_fp_greater_eq(x,0)&&ae_fp_greater_eq(v,1), "Domain error in ChiSquareDistributionC", _state); + result = incompletegammac(v/2.0, x/2.0, _state); + return result; +} + + +/************************************************************************* +Inverse of complemented Chi-square distribution + +Finds the Chi-square argument x such that the integral +from x to infinity of the Chi-square density is equal +to the given cumulative probability y. + +This is accomplished using the inverse gamma integral +function and the relation + + x/2 = igami( df/2, y ); + +ACCURACY: + +See inverse incomplete gamma function + + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double invchisquaredistribution(double v, double y, ae_state *_state) +{ + double result; + + + ae_assert((ae_fp_greater_eq(y,0)&&ae_fp_less_eq(y,1))&&ae_fp_greater_eq(v,1), "Domain error in InvChiSquareDistribution", _state); + result = 2*invincompletegammac(0.5*v, y, _state); + return result; +} + + + + +/************************************************************************* +Dawson's Integral + +Approximates the integral + + x + - + 2 | | 2 + dawsn(x) = exp( -x ) | exp( t ) dt + | | + - + 0 + +Three different rational approximations are employed, for +the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,10 10000 6.9e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double dawsonintegral(double x, ae_state *_state) +{ + double x2; + double y; + ae_int_t sg; + double an; + double ad; + double bn; + double bd; + double cn; + double cd; + double result; + + + sg = 1; + if( ae_fp_less(x,0) ) + { + sg = -1; + x = -x; + } + if( ae_fp_less(x,3.25) ) + { + x2 = x*x; + an = 1.13681498971755972054E-11; + an = an*x2+8.49262267667473811108E-10; + an = an*x2+1.94434204175553054283E-8; + an = an*x2+9.53151741254484363489E-7; + an = an*x2+3.07828309874913200438E-6; + an = an*x2+3.52513368520288738649E-4; + an = an*x2+(-8.50149846724410912031E-4); + an = an*x2+4.22618223005546594270E-2; + an = an*x2+(-9.17480371773452345351E-2); + an = an*x2+9.99999999999999994612E-1; + ad = 2.40372073066762605484E-11; + ad = ad*x2+1.48864681368493396752E-9; + ad = ad*x2+5.21265281010541664570E-8; + ad = ad*x2+1.27258478273186970203E-6; + ad = ad*x2+2.32490249820789513991E-5; + ad = ad*x2+3.25524741826057911661E-4; + ad = ad*x2+3.48805814657162590916E-3; + ad = ad*x2+2.79448531198828973716E-2; + ad = ad*x2+1.58874241960120565368E-1; + ad = ad*x2+5.74918629489320327824E-1; + ad = ad*x2+1.00000000000000000539E0; + y = x*an/ad; + result = sg*y; + return result; + } + x2 = 1.0/(x*x); + if( ae_fp_less(x,6.25) ) + { + bn = 5.08955156417900903354E-1; + bn = bn*x2-2.44754418142697847934E-1; + bn = bn*x2+9.41512335303534411857E-2; + bn = bn*x2-2.18711255142039025206E-2; + bn = bn*x2+3.66207612329569181322E-3; + bn = bn*x2-4.23209114460388756528E-4; + bn = bn*x2+3.59641304793896631888E-5; + bn = bn*x2-2.14640351719968974225E-6; + bn = bn*x2+9.10010780076391431042E-8; + bn = bn*x2-2.40274520828250956942E-9; + bn = bn*x2+3.59233385440928410398E-11; + bd = 1.00000000000000000000E0; + bd = bd*x2-6.31839869873368190192E-1; + bd = bd*x2+2.36706788228248691528E-1; + bd = bd*x2-5.31806367003223277662E-2; + bd = bd*x2+8.48041718586295374409E-3; + bd = bd*x2-9.47996768486665330168E-4; + bd = bd*x2+7.81025592944552338085E-5; + bd = bd*x2-4.55875153252442634831E-6; + bd = bd*x2+1.89100358111421846170E-7; + bd = bd*x2-4.91324691331920606875E-9; + bd = bd*x2+7.18466403235734541950E-11; + y = 1.0/x+x2*bn/(bd*x); + result = sg*0.5*y; + return result; + } + if( ae_fp_greater(x,1.0E9) ) + { + result = sg*0.5/x; + return result; + } + cn = -5.90592860534773254987E-1; + cn = cn*x2+6.29235242724368800674E-1; + cn = cn*x2-1.72858975380388136411E-1; + cn = cn*x2+1.64837047825189632310E-2; + cn = cn*x2-4.86827613020462700845E-4; + cd = 1.00000000000000000000E0; + cd = cd*x2-2.69820057197544900361E0; + cd = cd*x2+1.73270799045947845857E0; + cd = cd*x2-3.93708582281939493482E-1; + cd = cd*x2+3.44278924041233391079E-2; + cd = cd*x2-9.73655226040941223894E-4; + y = 1.0/x+x2*cn/(cd*x); + result = sg*0.5*y; + return result; +} + + + + +/************************************************************************* +Complete elliptic integral of the first kind + +Approximates the integral + + + + pi/2 + - + | | + | dt +K(m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +using the approximation + + P(x) - log x Q(x). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 2.5e-16 6.8e-17 + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double ellipticintegralk(double m, ae_state *_state) +{ + double result; + + + result = ellipticintegralkhighprecision(1.0-m, _state); + return result; +} + + +/************************************************************************* +Complete elliptic integral of the first kind + +Approximates the integral + + + + pi/2 + - + | | + | dt +K(m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +where m = 1 - m1, using the approximation + + P(x) - log x Q(x). + +The argument m1 is used rather than m so that the logarithmic +singularity at m = 1 will be shifted to the origin; this +preserves maximum accuracy. + +K(0) = pi/2. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 2.5e-16 6.8e-17 + +Àëãîðèòì âçÿò èç áèáëèîòåêè Cephes +*************************************************************************/ +double ellipticintegralkhighprecision(double m1, ae_state *_state) +{ + double p; + double q; + double result; + + + if( ae_fp_less_eq(m1,ae_machineepsilon) ) + { + result = 1.3862943611198906188E0-0.5*ae_log(m1, _state); + } + else + { + p = 1.37982864606273237150E-4; + p = p*m1+2.28025724005875567385E-3; + p = p*m1+7.97404013220415179367E-3; + p = p*m1+9.85821379021226008714E-3; + p = p*m1+6.87489687449949877925E-3; + p = p*m1+6.18901033637687613229E-3; + p = p*m1+8.79078273952743772254E-3; + p = p*m1+1.49380448916805252718E-2; + p = p*m1+3.08851465246711995998E-2; + p = p*m1+9.65735902811690126535E-2; + p = p*m1+1.38629436111989062502E0; + q = 2.94078955048598507511E-5; + q = q*m1+9.14184723865917226571E-4; + q = q*m1+5.94058303753167793257E-3; + q = q*m1+1.54850516649762399335E-2; + q = q*m1+2.39089602715924892727E-2; + q = q*m1+3.01204715227604046988E-2; + q = q*m1+3.73774314173823228969E-2; + q = q*m1+4.88280347570998239232E-2; + q = q*m1+7.03124996963957469739E-2; + q = q*m1+1.24999999999870820058E-1; + q = q*m1+4.99999999999999999821E-1; + result = p-q*ae_log(m1, _state); + } + return result; +} + + +/************************************************************************* +Incomplete elliptic integral of the first kind F(phi|m) + +Approximates the integral + + + + phi + - + | | + | dt +F(phi_\m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +of amplitude phi and modulus m, using the arithmetic - +geometric mean algorithm. + + + + +ACCURACY: + +Tested at random points with m in [0, 1] and phi as indicated. + + Relative error: +arithmetic domain # trials peak rms + IEEE -10,10 200000 7.4e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompleteellipticintegralk(double phi, double m, ae_state *_state) +{ + double a; + double b; + double c; + double e; + double temp; + double pio2; + double t; + double k; + ae_int_t d; + ae_int_t md; + ae_int_t s; + ae_int_t npio2; + double result; + + + pio2 = 1.57079632679489661923; + if( ae_fp_eq(m,0) ) + { + result = phi; + return result; + } + a = 1-m; + if( ae_fp_eq(a,0) ) + { + result = ae_log(ae_tan(0.5*(pio2+phi), _state), _state); + return result; + } + npio2 = ae_ifloor(phi/pio2, _state); + if( npio2%2!=0 ) + { + npio2 = npio2+1; + } + if( npio2!=0 ) + { + k = ellipticintegralk(1-a, _state); + phi = phi-npio2*pio2; + } + else + { + k = 0; + } + if( ae_fp_less(phi,0) ) + { + phi = -phi; + s = -1; + } + else + { + s = 0; + } + b = ae_sqrt(a, _state); + t = ae_tan(phi, _state); + if( ae_fp_greater(ae_fabs(t, _state),10) ) + { + e = 1.0/(b*t); + if( ae_fp_less(ae_fabs(e, _state),10) ) + { + e = ae_atan(e, _state); + if( npio2==0 ) + { + k = ellipticintegralk(1-a, _state); + } + temp = k-incompleteellipticintegralk(e, m, _state); + if( s<0 ) + { + temp = -temp; + } + result = temp+npio2*k; + return result; + } + } + a = 1.0; + c = ae_sqrt(m, _state); + d = 1; + md = 0; + while(ae_fp_greater(ae_fabs(c/a, _state),ae_machineepsilon)) + { + temp = b/a; + phi = phi+ae_atan(t*temp, _state)+md*ae_pi; + md = ae_trunc((phi+pio2)/ae_pi, _state); + t = t*(1.0+temp)/(1.0-temp*t*t); + c = 0.5*(a-b); + temp = ae_sqrt(a*b, _state); + a = 0.5*(a+b); + b = temp; + d = d+d; + } + temp = (ae_atan(t, _state)+md*ae_pi)/(d*a); + if( s<0 ) + { + temp = -temp; + } + result = temp+npio2*k; + return result; +} + + +/************************************************************************* +Complete elliptic integral of the second kind + +Approximates the integral + + + pi/2 + - + | | 2 +E(m) = | sqrt( 1 - m sin t ) dt + | | + - + 0 + +using the approximation + + P(x) - x log x Q(x). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 1 10000 2.1e-16 7.3e-17 + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double ellipticintegrale(double m, ae_state *_state) +{ + double p; + double q; + double result; + + + ae_assert(ae_fp_greater_eq(m,0)&&ae_fp_less_eq(m,1), "Domain error in EllipticIntegralE: m<0 or m>1", _state); + m = 1-m; + if( ae_fp_eq(m,0) ) + { + result = 1; + return result; + } + p = 1.53552577301013293365E-4; + p = p*m+2.50888492163602060990E-3; + p = p*m+8.68786816565889628429E-3; + p = p*m+1.07350949056076193403E-2; + p = p*m+7.77395492516787092951E-3; + p = p*m+7.58395289413514708519E-3; + p = p*m+1.15688436810574127319E-2; + p = p*m+2.18317996015557253103E-2; + p = p*m+5.68051945617860553470E-2; + p = p*m+4.43147180560990850618E-1; + p = p*m+1.00000000000000000299E0; + q = 3.27954898576485872656E-5; + q = q*m+1.00962792679356715133E-3; + q = q*m+6.50609489976927491433E-3; + q = q*m+1.68862163993311317300E-2; + q = q*m+2.61769742454493659583E-2; + q = q*m+3.34833904888224918614E-2; + q = q*m+4.27180926518931511717E-2; + q = q*m+5.85936634471101055642E-2; + q = q*m+9.37499997197644278445E-2; + q = q*m+2.49999999999888314361E-1; + result = p-q*m*ae_log(m, _state); + return result; +} + + +/************************************************************************* +Incomplete elliptic integral of the second kind + +Approximates the integral + + + phi + - + | | + | 2 +E(phi_\m) = | sqrt( 1 - m sin t ) dt + | + | | + - + 0 + +of amplitude phi and modulus m, using the arithmetic - +geometric mean algorithm. + +ACCURACY: + +Tested at random arguments with phi in [-10, 10] and m in +[0, 1]. + Relative error: +arithmetic domain # trials peak rms + IEEE -10,10 150000 3.3e-15 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompleteellipticintegrale(double phi, double m, ae_state *_state) +{ + double pio2; + double a; + double b; + double c; + double e; + double temp; + double lphi; + double t; + double ebig; + ae_int_t d; + ae_int_t md; + ae_int_t npio2; + ae_int_t s; + double result; + + + pio2 = 1.57079632679489661923; + if( ae_fp_eq(m,0) ) + { + result = phi; + return result; + } + lphi = phi; + npio2 = ae_ifloor(lphi/pio2, _state); + if( npio2%2!=0 ) + { + npio2 = npio2+1; + } + lphi = lphi-npio2*pio2; + if( ae_fp_less(lphi,0) ) + { + lphi = -lphi; + s = -1; + } + else + { + s = 1; + } + a = 1.0-m; + ebig = ellipticintegrale(m, _state); + if( ae_fp_eq(a,0) ) + { + temp = ae_sin(lphi, _state); + if( s<0 ) + { + temp = -temp; + } + result = temp+npio2*ebig; + return result; + } + t = ae_tan(lphi, _state); + b = ae_sqrt(a, _state); + + /* + * Thanks to Brian Fitzgerald + * for pointing out an instability near odd multiples of pi/2 + */ + if( ae_fp_greater(ae_fabs(t, _state),10) ) + { + + /* + * Transform the amplitude + */ + e = 1.0/(b*t); + + /* + * ... but avoid multiple recursions. + */ + if( ae_fp_less(ae_fabs(e, _state),10) ) + { + e = ae_atan(e, _state); + temp = ebig+m*ae_sin(lphi, _state)*ae_sin(e, _state)-incompleteellipticintegrale(e, m, _state); + if( s<0 ) + { + temp = -temp; + } + result = temp+npio2*ebig; + return result; + } + } + c = ae_sqrt(m, _state); + a = 1.0; + d = 1; + e = 0.0; + md = 0; + while(ae_fp_greater(ae_fabs(c/a, _state),ae_machineepsilon)) + { + temp = b/a; + lphi = lphi+ae_atan(t*temp, _state)+md*ae_pi; + md = ae_trunc((lphi+pio2)/ae_pi, _state); + t = t*(1.0+temp)/(1.0-temp*t*t); + c = 0.5*(a-b); + temp = ae_sqrt(a*b, _state); + a = 0.5*(a+b); + b = temp; + d = d+d; + e = e+c*ae_sin(lphi, _state); + } + temp = ebig/ellipticintegralk(m, _state); + temp = temp*((ae_atan(t, _state)+md*ae_pi)/(d*a)); + temp = temp+e; + if( s<0 ) + { + temp = -temp; + } + result = temp+npio2*ebig; + return result; +} + + + + +/************************************************************************* +Exponential integral Ei(x) + + x + - t + | | e + Ei(x) = -|- --- dt . + | | t + - + -inf + +Not defined for x <= 0. +See also expn.c. + + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,100 50000 8.6e-16 1.3e-16 + +Cephes Math Library Release 2.8: May, 1999 +Copyright 1999 by Stephen L. Moshier +*************************************************************************/ +double exponentialintegralei(double x, ae_state *_state) +{ + double eul; + double f; + double f1; + double f2; + double w; + double result; + + + eul = 0.5772156649015328606065; + if( ae_fp_less_eq(x,0) ) + { + result = 0; + return result; + } + if( ae_fp_less(x,2) ) + { + f1 = -5.350447357812542947283; + f1 = f1*x+218.5049168816613393830; + f1 = f1*x-4176.572384826693777058; + f1 = f1*x+55411.76756393557601232; + f1 = f1*x-331338.1331178144034309; + f1 = f1*x+1592627.163384945414220; + f2 = 1.000000000000000000000; + f2 = f2*x-52.50547959112862969197; + f2 = f2*x+1259.616186786790571525; + f2 = f2*x-17565.49581973534652631; + f2 = f2*x+149306.2117002725991967; + f2 = f2*x-729494.9239640527645655; + f2 = f2*x+1592627.163384945429726; + f = f1/f2; + result = eul+ae_log(x, _state)+x*f; + return result; + } + if( ae_fp_less(x,4) ) + { + w = 1/x; + f1 = 1.981808503259689673238E-2; + f1 = f1*w-1.271645625984917501326; + f1 = f1*w-2.088160335681228318920; + f1 = f1*w+2.755544509187936721172; + f1 = f1*w-4.409507048701600257171E-1; + f1 = f1*w+4.665623805935891391017E-2; + f1 = f1*w-1.545042679673485262580E-3; + f1 = f1*w+7.059980605299617478514E-5; + f2 = 1.000000000000000000000; + f2 = f2*w+1.476498670914921440652; + f2 = f2*w+5.629177174822436244827E-1; + f2 = f2*w+1.699017897879307263248E-1; + f2 = f2*w+2.291647179034212017463E-2; + f2 = f2*w+4.450150439728752875043E-3; + f2 = f2*w+1.727439612206521482874E-4; + f2 = f2*w+3.953167195549672482304E-5; + f = f1/f2; + result = ae_exp(x, _state)*w*(1+w*f); + return result; + } + if( ae_fp_less(x,8) ) + { + w = 1/x; + f1 = -1.373215375871208729803; + f1 = f1*w-7.084559133740838761406E-1; + f1 = f1*w+1.580806855547941010501; + f1 = f1*w-2.601500427425622944234E-1; + f1 = f1*w+2.994674694113713763365E-2; + f1 = f1*w-1.038086040188744005513E-3; + f1 = f1*w+4.371064420753005429514E-5; + f1 = f1*w+2.141783679522602903795E-6; + f2 = 1.000000000000000000000; + f2 = f2*w+8.585231423622028380768E-1; + f2 = f2*w+4.483285822873995129957E-1; + f2 = f2*w+7.687932158124475434091E-2; + f2 = f2*w+2.449868241021887685904E-2; + f2 = f2*w+8.832165941927796567926E-4; + f2 = f2*w+4.590952299511353531215E-4; + f2 = f2*w+(-4.729848351866523044863E-6); + f2 = f2*w+2.665195537390710170105E-6; + f = f1/f2; + result = ae_exp(x, _state)*w*(1+w*f); + return result; + } + if( ae_fp_less(x,16) ) + { + w = 1/x; + f1 = -2.106934601691916512584; + f1 = f1*w+1.732733869664688041885; + f1 = f1*w-2.423619178935841904839E-1; + f1 = f1*w+2.322724180937565842585E-2; + f1 = f1*w+2.372880440493179832059E-4; + f1 = f1*w-8.343219561192552752335E-5; + f1 = f1*w+1.363408795605250394881E-5; + f1 = f1*w-3.655412321999253963714E-7; + f1 = f1*w+1.464941733975961318456E-8; + f1 = f1*w+6.176407863710360207074E-10; + f2 = 1.000000000000000000000; + f2 = f2*w-2.298062239901678075778E-1; + f2 = f2*w+1.105077041474037862347E-1; + f2 = f2*w-1.566542966630792353556E-2; + f2 = f2*w+2.761106850817352773874E-3; + f2 = f2*w-2.089148012284048449115E-4; + f2 = f2*w+1.708528938807675304186E-5; + f2 = f2*w-4.459311796356686423199E-7; + f2 = f2*w+1.394634930353847498145E-8; + f2 = f2*w+6.150865933977338354138E-10; + f = f1/f2; + result = ae_exp(x, _state)*w*(1+w*f); + return result; + } + if( ae_fp_less(x,32) ) + { + w = 1/x; + f1 = -2.458119367674020323359E-1; + f1 = f1*w-1.483382253322077687183E-1; + f1 = f1*w+7.248291795735551591813E-2; + f1 = f1*w-1.348315687380940523823E-2; + f1 = f1*w+1.342775069788636972294E-3; + f1 = f1*w-7.942465637159712264564E-5; + f1 = f1*w+2.644179518984235952241E-6; + f1 = f1*w-4.239473659313765177195E-8; + f2 = 1.000000000000000000000; + f2 = f2*w-1.044225908443871106315E-1; + f2 = f2*w-2.676453128101402655055E-1; + f2 = f2*w+9.695000254621984627876E-2; + f2 = f2*w-1.601745692712991078208E-2; + f2 = f2*w+1.496414899205908021882E-3; + f2 = f2*w-8.462452563778485013756E-5; + f2 = f2*w+2.728938403476726394024E-6; + f2 = f2*w-4.239462431819542051337E-8; + f = f1/f2; + result = ae_exp(x, _state)*w*(1+w*f); + return result; + } + if( ae_fp_less(x,64) ) + { + w = 1/x; + f1 = 1.212561118105456670844E-1; + f1 = f1*w-5.823133179043894485122E-1; + f1 = f1*w+2.348887314557016779211E-1; + f1 = f1*w-3.040034318113248237280E-2; + f1 = f1*w+1.510082146865190661777E-3; + f1 = f1*w-2.523137095499571377122E-5; + f2 = 1.000000000000000000000; + f2 = f2*w-1.002252150365854016662; + f2 = f2*w+2.928709694872224144953E-1; + f2 = f2*w-3.337004338674007801307E-2; + f2 = f2*w+1.560544881127388842819E-3; + f2 = f2*w-2.523137093603234562648E-5; + f = f1/f2; + result = ae_exp(x, _state)*w*(1+w*f); + return result; + } + w = 1/x; + f1 = -7.657847078286127362028E-1; + f1 = f1*w+6.886192415566705051750E-1; + f1 = f1*w-2.132598113545206124553E-1; + f1 = f1*w+3.346107552384193813594E-2; + f1 = f1*w-3.076541477344756050249E-3; + f1 = f1*w+1.747119316454907477380E-4; + f1 = f1*w-6.103711682274170530369E-6; + f1 = f1*w+1.218032765428652199087E-7; + f1 = f1*w-1.086076102793290233007E-9; + f2 = 1.000000000000000000000; + f2 = f2*w-1.888802868662308731041; + f2 = f2*w+1.066691687211408896850; + f2 = f2*w-2.751915982306380647738E-1; + f2 = f2*w+3.930852688233823569726E-2; + f2 = f2*w-3.414684558602365085394E-3; + f2 = f2*w+1.866844370703555398195E-4; + f2 = f2*w-6.345146083130515357861E-6; + f2 = f2*w+1.239754287483206878024E-7; + f2 = f2*w-1.086076102793126632978E-9; + f = f1/f2; + result = ae_exp(x, _state)*w*(1+w*f); + return result; +} + + +/************************************************************************* +Exponential integral En(x) + +Evaluates the exponential integral + + inf. + - + | | -xt + | e + E (x) = | ---- dt. + n | n + | | t + - + 1 + + +Both n and x must be nonnegative. + +The routine employs either a power series, a continued +fraction, or an asymptotic formula depending on the +relative values of n and x. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 10000 1.7e-15 3.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 2000 by Stephen L. Moshier +*************************************************************************/ +double exponentialintegralen(double x, ae_int_t n, ae_state *_state) +{ + double r; + double t; + double yk; + double xk; + double pk; + double pkm1; + double pkm2; + double qk; + double qkm1; + double qkm2; + double psi; + double z; + ae_int_t i; + ae_int_t k; + double big; + double eul; + double result; + + + eul = 0.57721566490153286060; + big = 1.44115188075855872*ae_pow(10, 17, _state); + if( ((n<0||ae_fp_less(x,0))||ae_fp_greater(x,170))||(ae_fp_eq(x,0)&&n<2) ) + { + result = -1; + return result; + } + if( ae_fp_eq(x,0) ) + { + result = (double)1/(double)(n-1); + return result; + } + if( n==0 ) + { + result = ae_exp(-x, _state)/x; + return result; + } + if( n>5000 ) + { + xk = x+n; + yk = 1/(xk*xk); + t = n; + result = yk*t*(6*x*x-8*t*x+t*t); + result = yk*(result+t*(t-2.0*x)); + result = yk*(result+t); + result = (result+1)*ae_exp(-x, _state)/xk; + return result; + } + if( ae_fp_less_eq(x,1) ) + { + psi = -eul-ae_log(x, _state); + for(i=1; i<=n-1; i++) + { + psi = psi+(double)1/(double)i; + } + z = -x; + xk = 0; + yk = 1; + pk = 1-n; + if( n==1 ) + { + result = 0.0; + } + else + { + result = 1.0/pk; + } + do + { + xk = xk+1; + yk = yk*z/xk; + pk = pk+1; + if( ae_fp_neq(pk,0) ) + { + result = result+yk/pk; + } + if( ae_fp_neq(result,0) ) + { + t = ae_fabs(yk/result, _state); + } + else + { + t = 1; + } + } + while(ae_fp_greater_eq(t,ae_machineepsilon)); + t = 1; + for(i=1; i<=n-1; i++) + { + t = t*z/i; + } + result = psi*t-result; + return result; + } + else + { + k = 1; + pkm2 = 1; + qkm2 = x; + pkm1 = 1.0; + qkm1 = x+n; + result = pkm1/qkm1; + do + { + k = k+1; + if( k%2==1 ) + { + yk = 1; + xk = n+(double)(k-1)/(double)2; + } + else + { + yk = x; + xk = (double)k/(double)2; + } + pk = pkm1*yk+pkm2*xk; + qk = qkm1*yk+qkm2*xk; + if( ae_fp_neq(qk,0) ) + { + r = pk/qk; + t = ae_fabs((result-r)/r, _state); + result = r; + } + else + { + t = 1; + } + pkm2 = pkm1; + pkm1 = pk; + qkm2 = qkm1; + qkm1 = qk; + if( ae_fp_greater(ae_fabs(pk, _state),big) ) + { + pkm2 = pkm2/big; + pkm1 = pkm1/big; + qkm2 = qkm2/big; + qkm1 = qkm1/big; + } + } + while(ae_fp_greater_eq(t,ae_machineepsilon)); + result = result*ae_exp(-x, _state); + } + return result; +} + + + + +/************************************************************************* +F distribution + +Returns the area from zero to x under the F density +function (also known as Snedcor's density or the +variance ratio density). This is the density +of x = (u1/df1)/(u2/df2), where u1 and u2 are random +variables having Chi square distributions with df1 +and df2 degrees of freedom, respectively. +The incomplete beta integral is used, according to the +formula + +P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). + + +The arguments a and b are greater than zero, and x is +nonnegative. + +ACCURACY: + +Tested at random points (a,b,x). + + x a,b Relative error: +arithmetic domain domain # trials peak rms + IEEE 0,1 0,100 100000 9.8e-15 1.7e-15 + IEEE 1,5 0,100 100000 6.5e-15 3.5e-16 + IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12 + IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double fdistribution(ae_int_t a, ae_int_t b, double x, ae_state *_state) +{ + double w; + double result; + + + ae_assert((a>=1&&b>=1)&&ae_fp_greater_eq(x,0), "Domain error in FDistribution", _state); + w = a*x; + w = w/(b+w); + result = incompletebeta(0.5*a, 0.5*b, w, _state); + return result; +} + + +/************************************************************************* +Complemented F distribution + +Returns the area from x to infinity under the F density +function (also known as Snedcor's density or the +variance ratio density). + + + inf. + - + 1 | | a-1 b-1 +1-P(x) = ------ | t (1-t) dt + B(a,b) | | + - + x + + +The incomplete beta integral is used, according to the +formula + +P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). + + +ACCURACY: + +Tested at random points (a,b,x) in the indicated intervals. + x a,b Relative error: +arithmetic domain domain # trials peak rms + IEEE 0,1 1,100 100000 3.7e-14 5.9e-16 + IEEE 1,5 1,100 100000 8.0e-15 1.6e-15 + IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13 + IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double fcdistribution(ae_int_t a, ae_int_t b, double x, ae_state *_state) +{ + double w; + double result; + + + ae_assert((a>=1&&b>=1)&&ae_fp_greater_eq(x,0), "Domain error in FCDistribution", _state); + w = b/(b+a*x); + result = incompletebeta(0.5*b, 0.5*a, w, _state); + return result; +} + + +/************************************************************************* +Inverse of complemented F distribution + +Finds the F density argument x such that the integral +from x to infinity of the F density is equal to the +given probability p. + +This is accomplished using the inverse beta integral +function and the relations + + z = incbi( df2/2, df1/2, p ) + x = df2 (1-z) / (df1 z). + +Note: the following relations hold for the inverse of +the uncomplemented F distribution: + + z = incbi( df1/2, df2/2, p ) + x = df2 z / (df1 (1-z)). + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between .001 and 1: + IEEE 1,100 100000 8.3e-15 4.7e-16 + IEEE 1,10000 100000 2.1e-11 1.4e-13 + For p between 10^-6 and 10^-3: + IEEE 1,100 50000 1.3e-12 8.4e-15 + IEEE 1,10000 50000 3.0e-12 4.8e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invfdistribution(ae_int_t a, + ae_int_t b, + double y, + ae_state *_state) +{ + double w; + double result; + + + ae_assert(((a>=1&&b>=1)&&ae_fp_greater(y,0))&&ae_fp_less_eq(y,1), "Domain error in InvFDistribution", _state); + + /* + * Compute probability for x = 0.5 + */ + w = incompletebeta(0.5*b, 0.5*a, 0.5, _state); + + /* + * If that is greater than y, then the solution w < .5 + * Otherwise, solve at 1-y to remove cancellation in (b - b*w) + */ + if( ae_fp_greater(w,y)||ae_fp_less(y,0.001) ) + { + w = invincompletebeta(0.5*b, 0.5*a, y, _state); + result = (b-b*w)/(a*w); + } + else + { + w = invincompletebeta(0.5*a, 0.5*b, 1.0-y, _state); + result = b*w/(a*(1.0-w)); + } + return result; +} + + + + +/************************************************************************* +Fresnel integral + +Evaluates the Fresnel integrals + + x + - + | | +C(x) = | cos(pi/2 t**2) dt, + | | + - + 0 + + x + - + | | +S(x) = | sin(pi/2 t**2) dt. + | | + - + 0 + + +The integrals are evaluated by a power series for x < 1. +For x >= 1 auxiliary functions f(x) and g(x) are employed +such that + +C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) +S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) + + + +ACCURACY: + + Relative error. + +Arithmetic function domain # trials peak rms + IEEE S(x) 0, 10 10000 2.0e-15 3.2e-16 + IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +void fresnelintegral(double x, double* c, double* s, ae_state *_state) +{ + double xxa; + double f; + double g; + double cc; + double ss; + double t; + double u; + double x2; + double sn; + double sd; + double cn; + double cd; + double fn; + double fd; + double gn; + double gd; + double mpi; + double mpio2; + + + mpi = 3.14159265358979323846; + mpio2 = 1.57079632679489661923; + xxa = x; + x = ae_fabs(xxa, _state); + x2 = x*x; + if( ae_fp_less(x2,2.5625) ) + { + t = x2*x2; + sn = -2.99181919401019853726E3; + sn = sn*t+7.08840045257738576863E5; + sn = sn*t-6.29741486205862506537E7; + sn = sn*t+2.54890880573376359104E9; + sn = sn*t-4.42979518059697779103E10; + sn = sn*t+3.18016297876567817986E11; + sd = 1.00000000000000000000E0; + sd = sd*t+2.81376268889994315696E2; + sd = sd*t+4.55847810806532581675E4; + sd = sd*t+5.17343888770096400730E6; + sd = sd*t+4.19320245898111231129E8; + sd = sd*t+2.24411795645340920940E10; + sd = sd*t+6.07366389490084639049E11; + cn = -4.98843114573573548651E-8; + cn = cn*t+9.50428062829859605134E-6; + cn = cn*t-6.45191435683965050962E-4; + cn = cn*t+1.88843319396703850064E-2; + cn = cn*t-2.05525900955013891793E-1; + cn = cn*t+9.99999999999999998822E-1; + cd = 3.99982968972495980367E-12; + cd = cd*t+9.15439215774657478799E-10; + cd = cd*t+1.25001862479598821474E-7; + cd = cd*t+1.22262789024179030997E-5; + cd = cd*t+8.68029542941784300606E-4; + cd = cd*t+4.12142090722199792936E-2; + cd = cd*t+1.00000000000000000118E0; + *s = ae_sign(xxa, _state)*x*x2*sn/sd; + *c = ae_sign(xxa, _state)*x*cn/cd; + return; + } + if( ae_fp_greater(x,36974.0) ) + { + *c = ae_sign(xxa, _state)*0.5; + *s = ae_sign(xxa, _state)*0.5; + return; + } + x2 = x*x; + t = mpi*x2; + u = 1/(t*t); + t = 1/t; + fn = 4.21543555043677546506E-1; + fn = fn*u+1.43407919780758885261E-1; + fn = fn*u+1.15220955073585758835E-2; + fn = fn*u+3.45017939782574027900E-4; + fn = fn*u+4.63613749287867322088E-6; + fn = fn*u+3.05568983790257605827E-8; + fn = fn*u+1.02304514164907233465E-10; + fn = fn*u+1.72010743268161828879E-13; + fn = fn*u+1.34283276233062758925E-16; + fn = fn*u+3.76329711269987889006E-20; + fd = 1.00000000000000000000E0; + fd = fd*u+7.51586398353378947175E-1; + fd = fd*u+1.16888925859191382142E-1; + fd = fd*u+6.44051526508858611005E-3; + fd = fd*u+1.55934409164153020873E-4; + fd = fd*u+1.84627567348930545870E-6; + fd = fd*u+1.12699224763999035261E-8; + fd = fd*u+3.60140029589371370404E-11; + fd = fd*u+5.88754533621578410010E-14; + fd = fd*u+4.52001434074129701496E-17; + fd = fd*u+1.25443237090011264384E-20; + gn = 5.04442073643383265887E-1; + gn = gn*u+1.97102833525523411709E-1; + gn = gn*u+1.87648584092575249293E-2; + gn = gn*u+6.84079380915393090172E-4; + gn = gn*u+1.15138826111884280931E-5; + gn = gn*u+9.82852443688422223854E-8; + gn = gn*u+4.45344415861750144738E-10; + gn = gn*u+1.08268041139020870318E-12; + gn = gn*u+1.37555460633261799868E-15; + gn = gn*u+8.36354435630677421531E-19; + gn = gn*u+1.86958710162783235106E-22; + gd = 1.00000000000000000000E0; + gd = gd*u+1.47495759925128324529E0; + gd = gd*u+3.37748989120019970451E-1; + gd = gd*u+2.53603741420338795122E-2; + gd = gd*u+8.14679107184306179049E-4; + gd = gd*u+1.27545075667729118702E-5; + gd = gd*u+1.04314589657571990585E-7; + gd = gd*u+4.60680728146520428211E-10; + gd = gd*u+1.10273215066240270757E-12; + gd = gd*u+1.38796531259578871258E-15; + gd = gd*u+8.39158816283118707363E-19; + gd = gd*u+1.86958710162783236342E-22; + f = 1-u*fn/fd; + g = t*gn/gd; + t = mpio2*x2; + cc = ae_cos(t, _state); + ss = ae_sin(t, _state); + t = mpi*x; + *c = 0.5+(f*ss-g*cc)/t; + *s = 0.5-(f*cc+g*ss)/t; + *c = *c*ae_sign(xxa, _state); + *s = *s*ae_sign(xxa, _state); +} + + + + +/************************************************************************* +Calculation of the value of the Hermite polynomial. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Hermite polynomial Hn at x +*************************************************************************/ +double hermitecalculate(ae_int_t n, double x, ae_state *_state) +{ + ae_int_t i; + double a; + double b; + double result; + + + result = 0; + + /* + * Prepare A and B + */ + a = 1; + b = 2*x; + + /* + * Special cases: N=0 or N=1 + */ + if( n==0 ) + { + result = a; + return result; + } + if( n==1 ) + { + result = b; + return result; + } + + /* + * General case: N>=2 + */ + for(i=2; i<=n; i++) + { + result = 2*x*b-2*(i-1)*a; + a = b; + b = result; + } + return result; +} + + +/************************************************************************* +Summation of Hermite polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*H0(x) + c[1]*H1(x) + ... + c[N]*HN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Hermite polynomial at x +*************************************************************************/ +double hermitesum(/* Real */ ae_vector* c, + ae_int_t n, + double x, + ae_state *_state) +{ + double b1; + double b2; + ae_int_t i; + double result; + + + b1 = 0; + b2 = 0; + result = 0; + for(i=n; i>=0; i--) + { + result = 2*(x*b1-(i+1)*b2)+c->ptr.p_double[i]; + b2 = b1; + b1 = result; + } + return result; +} + + +/************************************************************************* +Representation of Hn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void hermitecoefficients(ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state) +{ + ae_int_t i; + + ae_vector_clear(c); + + ae_vector_set_length(c, n+1, _state); + for(i=0; i<=n; i++) + { + c->ptr.p_double[i] = 0; + } + c->ptr.p_double[n] = ae_exp(n*ae_log(2, _state), _state); + for(i=0; i<=n/2-1; i++) + { + c->ptr.p_double[n-2*(i+1)] = -c->ptr.p_double[n-2*i]*(n-2*i)*(n-2*i-1)/4/(i+1); + } +} + + + + +/************************************************************************* +Jacobian Elliptic Functions + +Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), +and dn(u|m) of parameter m between 0 and 1, and real +argument u. + +These functions are periodic, with quarter-period on the +real axis equal to the complete elliptic integral +ellpk(1.0-m). + +Relation to incomplete elliptic integral: +If u = ellik(phi,m), then sn(u|m) = sin(phi), +and cn(u|m) = cos(phi). Phi is called the amplitude of u. + +Computation is by means of the arithmetic-geometric mean +algorithm, except when m is within 1e-9 of 0 or 1. In the +latter case with m close to 1, the approximation applies +only for phi < pi/2. + +ACCURACY: + +Tested at random points with u between 0 and 10, m between +0 and 1. + + Absolute error (* = relative error): +arithmetic function # trials peak rms + IEEE phi 10000 9.2e-16* 1.4e-16* + IEEE sn 50000 4.1e-15 4.6e-16 + IEEE cn 40000 3.6e-15 4.4e-16 + IEEE dn 10000 1.3e-12 1.8e-14 + + Peak error observed in consistency check using addition +theorem for sn(u+v) was 4e-16 (absolute). Also tested by +the above relation to the incomplete elliptic integral. +Accuracy deteriorates when u is large. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +void jacobianellipticfunctions(double u, + double m, + double* sn, + double* cn, + double* dn, + double* ph, + ae_state *_state) +{ + ae_frame _frame_block; + double ai; + double b; + double phi; + double t; + double twon; + ae_vector a; + ae_vector c; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + *sn = 0; + *cn = 0; + *dn = 0; + *ph = 0; + ae_vector_init(&a, 0, DT_REAL, _state, ae_true); + ae_vector_init(&c, 0, DT_REAL, _state, ae_true); + + ae_assert(ae_fp_greater_eq(m,0)&&ae_fp_less_eq(m,1), "Domain error in JacobianEllipticFunctions: m<0 or m>1", _state); + ae_vector_set_length(&a, 8+1, _state); + ae_vector_set_length(&c, 8+1, _state); + if( ae_fp_less(m,1.0e-9) ) + { + t = ae_sin(u, _state); + b = ae_cos(u, _state); + ai = 0.25*m*(u-t*b); + *sn = t-ai*b; + *cn = b+ai*t; + *ph = u-ai; + *dn = 1.0-0.5*m*t*t; + ae_frame_leave(_state); + return; + } + if( ae_fp_greater_eq(m,0.9999999999) ) + { + ai = 0.25*(1.0-m); + b = ae_cosh(u, _state); + t = ae_tanh(u, _state); + phi = 1.0/b; + twon = b*ae_sinh(u, _state); + *sn = t+ai*(twon-u)/(b*b); + *ph = 2.0*ae_atan(ae_exp(u, _state), _state)-1.57079632679489661923+ai*(twon-u)/b; + ai = ai*t*phi; + *cn = phi-ai*(twon-u); + *dn = phi+ai*(twon+u); + ae_frame_leave(_state); + return; + } + a.ptr.p_double[0] = 1.0; + b = ae_sqrt(1.0-m, _state); + c.ptr.p_double[0] = ae_sqrt(m, _state); + twon = 1.0; + i = 0; + while(ae_fp_greater(ae_fabs(c.ptr.p_double[i]/a.ptr.p_double[i], _state),ae_machineepsilon)) + { + if( i>7 ) + { + ae_assert(ae_false, "Overflow in JacobianEllipticFunctions", _state); + break; + } + ai = a.ptr.p_double[i]; + i = i+1; + c.ptr.p_double[i] = 0.5*(ai-b); + t = ae_sqrt(ai*b, _state); + a.ptr.p_double[i] = 0.5*(ai+b); + b = t; + twon = twon*2.0; + } + phi = twon*a.ptr.p_double[i]*u; + do + { + t = c.ptr.p_double[i]*ae_sin(phi, _state)/a.ptr.p_double[i]; + b = phi; + phi = (ae_asin(t, _state)+phi)/2.0; + i = i-1; + } + while(i!=0); + *sn = ae_sin(phi, _state); + t = ae_cos(phi, _state); + *cn = t; + *dn = t/ae_cos(phi-b, _state); + *ph = phi; + ae_frame_leave(_state); +} + + + + +/************************************************************************* +Calculation of the value of the Laguerre polynomial. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Laguerre polynomial Ln at x +*************************************************************************/ +double laguerrecalculate(ae_int_t n, double x, ae_state *_state) +{ + double a; + double b; + double i; + double result; + + + result = 1; + a = 1; + b = 1-x; + if( n==1 ) + { + result = b; + } + i = 2; + while(ae_fp_less_eq(i,n)) + { + result = ((2*i-1-x)*b-(i-1)*a)/i; + a = b; + b = result; + i = i+1; + } + return result; +} + + +/************************************************************************* +Summation of Laguerre polynomials using Clenshaw’s recurrence formula. + +This routine calculates c[0]*L0(x) + c[1]*L1(x) + ... + c[N]*LN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Laguerre polynomial at x +*************************************************************************/ +double laguerresum(/* Real */ ae_vector* c, + ae_int_t n, + double x, + ae_state *_state) +{ + double b1; + double b2; + ae_int_t i; + double result; + + + b1 = 0; + b2 = 0; + result = 0; + for(i=n; i>=0; i--) + { + result = (2*i+1-x)*b1/(i+1)-(i+1)*b2/(i+2)+c->ptr.p_double[i]; + b2 = b1; + b1 = result; + } + return result; +} + + +/************************************************************************* +Representation of Ln as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void laguerrecoefficients(ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state) +{ + ae_int_t i; + + ae_vector_clear(c); + + ae_vector_set_length(c, n+1, _state); + c->ptr.p_double[0] = 1; + for(i=0; i<=n-1; i++) + { + c->ptr.p_double[i+1] = -c->ptr.p_double[i]*(n-i)/(i+1)/(i+1); + } +} + + + + +/************************************************************************* +Calculation of the value of the Legendre polynomial Pn. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Legendre polynomial Pn at x +*************************************************************************/ +double legendrecalculate(ae_int_t n, double x, ae_state *_state) +{ + double a; + double b; + ae_int_t i; + double result; + + + result = 1; + a = 1; + b = x; + if( n==0 ) + { + result = a; + return result; + } + if( n==1 ) + { + result = b; + return result; + } + for(i=2; i<=n; i++) + { + result = ((2*i-1)*x*b-(i-1)*a)/i; + a = b; + b = result; + } + return result; +} + + +/************************************************************************* +Summation of Legendre polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*P0(x) + c[1]*P1(x) + ... + c[N]*PN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Legendre polynomial at x +*************************************************************************/ +double legendresum(/* Real */ ae_vector* c, + ae_int_t n, + double x, + ae_state *_state) +{ + double b1; + double b2; + ae_int_t i; + double result; + + + b1 = 0; + b2 = 0; + result = 0; + for(i=n; i>=0; i--) + { + result = (2*i+1)*x*b1/(i+1)-(i+1)*b2/(i+2)+c->ptr.p_double[i]; + b2 = b1; + b1 = result; + } + return result; +} + + +/************************************************************************* +Representation of Pn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void legendrecoefficients(ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state) +{ + ae_int_t i; + + ae_vector_clear(c); + + ae_vector_set_length(c, n+1, _state); + for(i=0; i<=n; i++) + { + c->ptr.p_double[i] = 0; + } + c->ptr.p_double[n] = 1; + for(i=1; i<=n; i++) + { + c->ptr.p_double[n] = c->ptr.p_double[n]*(n+i)/2/i; + } + for(i=0; i<=n/2-1; i++) + { + c->ptr.p_double[n-2*(i+1)] = -c->ptr.p_double[n-2*i]*(n-2*i)*(n-2*i-1)/2/(i+1)/(2*(n-i)-1); + } +} + + + + +/************************************************************************* +Poisson distribution + +Returns the sum of the first k+1 terms of the Poisson +distribution: + + k j + -- -m m + > e -- + -- j! + j=0 + +The terms are not summed directly; instead the incomplete +gamma integral is employed, according to the relation + +y = pdtr( k, m ) = igamc( k+1, m ). + +The arguments must both be positive. +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double poissondistribution(ae_int_t k, double m, ae_state *_state) +{ + double result; + + + ae_assert(k>=0&&ae_fp_greater(m,0), "Domain error in PoissonDistribution", _state); + result = incompletegammac(k+1, m, _state); + return result; +} + + +/************************************************************************* +Complemented Poisson distribution + +Returns the sum of the terms k+1 to infinity of the Poisson +distribution: + + inf. j + -- -m m + > e -- + -- j! + j=k+1 + +The terms are not summed directly; instead the incomplete +gamma integral is employed, according to the formula + +y = pdtrc( k, m ) = igam( k+1, m ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double poissoncdistribution(ae_int_t k, double m, ae_state *_state) +{ + double result; + + + ae_assert(k>=0&&ae_fp_greater(m,0), "Domain error in PoissonDistributionC", _state); + result = incompletegamma(k+1, m, _state); + return result; +} + + +/************************************************************************* +Inverse Poisson distribution + +Finds the Poisson variable x such that the integral +from 0 to x of the Poisson density is equal to the +given probability y. + +This is accomplished using the inverse gamma integral +function and the relation + + m = igami( k+1, y ). + +ACCURACY: + +See inverse incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invpoissondistribution(ae_int_t k, double y, ae_state *_state) +{ + double result; + + + ae_assert((k>=0&&ae_fp_greater_eq(y,0))&&ae_fp_less(y,1), "Domain error in InvPoissonDistribution", _state); + result = invincompletegammac(k+1, y, _state); + return result; +} + + + + +/************************************************************************* +Psi (digamma) function + + d - + psi(x) = -- ln | (x) + dx + +is the logarithmic derivative of the gamma function. +For integer x, + n-1 + - +psi(n) = -EUL + > 1/k. + - + k=1 + +This formula is used for 0 < n <= 10. If x is negative, it +is transformed to a positive argument by the reflection +formula psi(1-x) = psi(x) + pi cot(pi x). +For general positive x, the argument is made greater than 10 +using the recurrence psi(x+1) = psi(x) + 1/x. +Then the following asymptotic expansion is applied: + + inf. B + - 2k +psi(x) = log(x) - 1/2x - > ------- + - 2k + k=1 2k x + +where the B2k are Bernoulli numbers. + +ACCURACY: + Relative error (except absolute when |psi| < 1): +arithmetic domain # trials peak rms + IEEE 0,30 30000 1.3e-15 1.4e-16 + IEEE -30,0 40000 1.5e-15 2.2e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double psi(double x, ae_state *_state) +{ + double p; + double q; + double nz; + double s; + double w; + double y; + double z; + double polv; + ae_int_t i; + ae_int_t n; + ae_int_t negative; + double result; + + + negative = 0; + nz = 0.0; + if( ae_fp_less_eq(x,0) ) + { + negative = 1; + q = x; + p = ae_ifloor(q, _state); + if( ae_fp_eq(p,q) ) + { + ae_assert(ae_false, "Singularity in Psi(x)", _state); + result = ae_maxrealnumber; + return result; + } + nz = q-p; + if( ae_fp_neq(nz,0.5) ) + { + if( ae_fp_greater(nz,0.5) ) + { + p = p+1.0; + nz = q-p; + } + nz = ae_pi/ae_tan(ae_pi*nz, _state); + } + else + { + nz = 0.0; + } + x = 1.0-x; + } + if( ae_fp_less_eq(x,10.0)&&ae_fp_eq(x,ae_ifloor(x, _state)) ) + { + y = 0.0; + n = ae_ifloor(x, _state); + for(i=1; i<=n-1; i++) + { + w = i; + y = y+1.0/w; + } + y = y-0.57721566490153286061; + } + else + { + s = x; + w = 0.0; + while(ae_fp_less(s,10.0)) + { + w = w+1.0/s; + s = s+1.0; + } + if( ae_fp_less(s,1.0E17) ) + { + z = 1.0/(s*s); + polv = 8.33333333333333333333E-2; + polv = polv*z-2.10927960927960927961E-2; + polv = polv*z+7.57575757575757575758E-3; + polv = polv*z-4.16666666666666666667E-3; + polv = polv*z+3.96825396825396825397E-3; + polv = polv*z-8.33333333333333333333E-3; + polv = polv*z+8.33333333333333333333E-2; + y = z*polv; + } + else + { + y = 0.0; + } + y = ae_log(s, _state)-0.5/s-y-w; + } + if( negative!=0 ) + { + y = y-nz; + } + result = y; + return result; +} + + + + +/************************************************************************* +Student's t distribution + +Computes the integral from minus infinity to t of the Student +t distribution with integer k > 0 degrees of freedom: + + t + - + | | + - | 2 -(k+1)/2 + | ( (k+1)/2 ) | ( x ) + ---------------------- | ( 1 + --- ) dx + - | ( k ) + sqrt( k pi ) | ( k/2 ) | + | | + - + -inf. + +Relation to incomplete beta integral: + + 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) +where + z = k/(k + t**2). + +For t < -2, this is the method of computation. For higher t, +a direct method is derived from integration by parts. +Since the function is symmetric about t=0, the area under the +right tail of the density is found by calling the function +with -t instead of t. + +ACCURACY: + +Tested at random 1 <= k <= 25. The "domain" refers to t. + Relative error: +arithmetic domain # trials peak rms + IEEE -100,-2 50000 5.9e-15 1.4e-15 + IEEE -2,100 500000 2.7e-15 4.9e-17 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double studenttdistribution(ae_int_t k, double t, ae_state *_state) +{ + double x; + double rk; + double z; + double f; + double tz; + double p; + double xsqk; + ae_int_t j; + double result; + + + ae_assert(k>0, "Domain error in StudentTDistribution", _state); + if( ae_fp_eq(t,0) ) + { + result = 0.5; + return result; + } + if( ae_fp_less(t,-2.0) ) + { + rk = k; + z = rk/(rk+t*t); + result = 0.5*incompletebeta(0.5*rk, 0.5, z, _state); + return result; + } + if( ae_fp_less(t,0) ) + { + x = -t; + } + else + { + x = t; + } + rk = k; + z = 1.0+x*x/rk; + if( k%2!=0 ) + { + xsqk = x/ae_sqrt(rk, _state); + p = ae_atan(xsqk, _state); + if( k>1 ) + { + f = 1.0; + tz = 1.0; + j = 3; + while(j<=k-2&&ae_fp_greater(tz/f,ae_machineepsilon)) + { + tz = tz*((j-1)/(z*j)); + f = f+tz; + j = j+2; + } + p = p+f*xsqk/z; + } + p = p*2.0/ae_pi; + } + else + { + f = 1.0; + tz = 1.0; + j = 2; + while(j<=k-2&&ae_fp_greater(tz/f,ae_machineepsilon)) + { + tz = tz*((j-1)/(z*j)); + f = f+tz; + j = j+2; + } + p = f*x/ae_sqrt(z*rk, _state); + } + if( ae_fp_less(t,0) ) + { + p = -p; + } + result = 0.5+0.5*p; + return result; +} + + +/************************************************************************* +Functional inverse of Student's t distribution + +Given probability p, finds the argument t such that stdtr(k,t) +is equal to p. + +ACCURACY: + +Tested at random 1 <= k <= 100. The "domain" refers to p: + Relative error: +arithmetic domain # trials peak rms + IEEE .001,.999 25000 5.7e-15 8.0e-16 + IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invstudenttdistribution(ae_int_t k, double p, ae_state *_state) +{ + double t; + double rk; + double z; + ae_int_t rflg; + double result; + + + ae_assert((k>0&&ae_fp_greater(p,0))&&ae_fp_less(p,1), "Domain error in InvStudentTDistribution", _state); + rk = k; + if( ae_fp_greater(p,0.25)&&ae_fp_less(p,0.75) ) + { + if( ae_fp_eq(p,0.5) ) + { + result = 0; + return result; + } + z = 1.0-2.0*p; + z = invincompletebeta(0.5, 0.5*rk, ae_fabs(z, _state), _state); + t = ae_sqrt(rk*z/(1.0-z), _state); + if( ae_fp_less(p,0.5) ) + { + t = -t; + } + result = t; + return result; + } + rflg = -1; + if( ae_fp_greater_eq(p,0.5) ) + { + p = 1.0-p; + rflg = 1; + } + z = invincompletebeta(0.5*rk, 0.5, 2.0*p, _state); + if( ae_fp_less(ae_maxrealnumber*z,rk) ) + { + result = rflg*ae_maxrealnumber; + return result; + } + t = ae_sqrt(rk/z-rk, _state); + result = rflg*t; + return result; +} + + + + +/************************************************************************* +Sine and cosine integrals + +Evaluates the integrals + + x + - + | cos t - 1 + Ci(x) = eul + ln x + | --------- dt, + | t + - + 0 + x + - + | sin t + Si(x) = | ----- dt + | t + - + 0 + +where eul = 0.57721566490153286061 is Euler's constant. +The integrals are approximated by rational functions. +For x > 8 auxiliary functions f(x) and g(x) are employed +such that + +Ci(x) = f(x) sin(x) - g(x) cos(x) +Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) + + +ACCURACY: + Test interval = [0,50]. +Absolute error, except relative when > 1: +arithmetic function # trials peak rms + IEEE Si 30000 4.4e-16 7.3e-17 + IEEE Ci 30000 6.9e-16 5.1e-17 + +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +*************************************************************************/ +void sinecosineintegrals(double x, + double* si, + double* ci, + ae_state *_state) +{ + double z; + double c; + double s; + double f; + double g; + ae_int_t sg; + double sn; + double sd; + double cn; + double cd; + double fn; + double fd; + double gn; + double gd; + + *si = 0; + *ci = 0; + + if( ae_fp_less(x,0) ) + { + sg = -1; + x = -x; + } + else + { + sg = 0; + } + if( ae_fp_eq(x,0) ) + { + *si = 0; + *ci = -ae_maxrealnumber; + return; + } + if( ae_fp_greater(x,1.0E9) ) + { + *si = 1.570796326794896619-ae_cos(x, _state)/x; + *ci = ae_sin(x, _state)/x; + return; + } + if( ae_fp_less_eq(x,4) ) + { + z = x*x; + sn = -8.39167827910303881427E-11; + sn = sn*z+4.62591714427012837309E-8; + sn = sn*z-9.75759303843632795789E-6; + sn = sn*z+9.76945438170435310816E-4; + sn = sn*z-4.13470316229406538752E-2; + sn = sn*z+1.00000000000000000302E0; + sd = 2.03269266195951942049E-12; + sd = sd*z+1.27997891179943299903E-9; + sd = sd*z+4.41827842801218905784E-7; + sd = sd*z+9.96412122043875552487E-5; + sd = sd*z+1.42085239326149893930E-2; + sd = sd*z+9.99999999999999996984E-1; + s = x*sn/sd; + cn = 2.02524002389102268789E-11; + cn = cn*z-1.35249504915790756375E-8; + cn = cn*z+3.59325051419993077021E-6; + cn = cn*z-4.74007206873407909465E-4; + cn = cn*z+2.89159652607555242092E-2; + cn = cn*z-1.00000000000000000080E0; + cd = 4.07746040061880559506E-12; + cd = cd*z+3.06780997581887812692E-9; + cd = cd*z+1.23210355685883423679E-6; + cd = cd*z+3.17442024775032769882E-4; + cd = cd*z+5.10028056236446052392E-2; + cd = cd*z+4.00000000000000000080E0; + c = z*cn/cd; + if( sg!=0 ) + { + s = -s; + } + *si = s; + *ci = 0.57721566490153286061+ae_log(x, _state)+c; + return; + } + s = ae_sin(x, _state); + c = ae_cos(x, _state); + z = 1.0/(x*x); + if( ae_fp_less(x,8) ) + { + fn = 4.23612862892216586994E0; + fn = fn*z+5.45937717161812843388E0; + fn = fn*z+1.62083287701538329132E0; + fn = fn*z+1.67006611831323023771E-1; + fn = fn*z+6.81020132472518137426E-3; + fn = fn*z+1.08936580650328664411E-4; + fn = fn*z+5.48900223421373614008E-7; + fd = 1.00000000000000000000E0; + fd = fd*z+8.16496634205391016773E0; + fd = fd*z+7.30828822505564552187E0; + fd = fd*z+1.86792257950184183883E0; + fd = fd*z+1.78792052963149907262E-1; + fd = fd*z+7.01710668322789753610E-3; + fd = fd*z+1.10034357153915731354E-4; + fd = fd*z+5.48900252756255700982E-7; + f = fn/(x*fd); + gn = 8.71001698973114191777E-2; + gn = gn*z+6.11379109952219284151E-1; + gn = gn*z+3.97180296392337498885E-1; + gn = gn*z+7.48527737628469092119E-2; + gn = gn*z+5.38868681462177273157E-3; + gn = gn*z+1.61999794598934024525E-4; + gn = gn*z+1.97963874140963632189E-6; + gn = gn*z+7.82579040744090311069E-9; + gd = 1.00000000000000000000E0; + gd = gd*z+1.64402202413355338886E0; + gd = gd*z+6.66296701268987968381E-1; + gd = gd*z+9.88771761277688796203E-2; + gd = gd*z+6.22396345441768420760E-3; + gd = gd*z+1.73221081474177119497E-4; + gd = gd*z+2.02659182086343991969E-6; + gd = gd*z+7.82579218933534490868E-9; + g = z*gn/gd; + } + else + { + fn = 4.55880873470465315206E-1; + fn = fn*z+7.13715274100146711374E-1; + fn = fn*z+1.60300158222319456320E-1; + fn = fn*z+1.16064229408124407915E-2; + fn = fn*z+3.49556442447859055605E-4; + fn = fn*z+4.86215430826454749482E-6; + fn = fn*z+3.20092790091004902806E-8; + fn = fn*z+9.41779576128512936592E-11; + fn = fn*z+9.70507110881952024631E-14; + fd = 1.00000000000000000000E0; + fd = fd*z+9.17463611873684053703E-1; + fd = fd*z+1.78685545332074536321E-1; + fd = fd*z+1.22253594771971293032E-2; + fd = fd*z+3.58696481881851580297E-4; + fd = fd*z+4.92435064317881464393E-6; + fd = fd*z+3.21956939101046018377E-8; + fd = fd*z+9.43720590350276732376E-11; + fd = fd*z+9.70507110881952025725E-14; + f = fn/(x*fd); + gn = 6.97359953443276214934E-1; + gn = gn*z+3.30410979305632063225E-1; + gn = gn*z+3.84878767649974295920E-2; + gn = gn*z+1.71718239052347903558E-3; + gn = gn*z+3.48941165502279436777E-5; + gn = gn*z+3.47131167084116673800E-7; + gn = gn*z+1.70404452782044526189E-9; + gn = gn*z+3.85945925430276600453E-12; + gn = gn*z+3.14040098946363334640E-15; + gd = 1.00000000000000000000E0; + gd = gd*z+1.68548898811011640017E0; + gd = gd*z+4.87852258695304967486E-1; + gd = gd*z+4.67913194259625806320E-2; + gd = gd*z+1.90284426674399523638E-3; + gd = gd*z+3.68475504442561108162E-5; + gd = gd*z+3.57043223443740838771E-7; + gd = gd*z+1.72693748966316146736E-9; + gd = gd*z+3.87830166023954706752E-12; + gd = gd*z+3.14040098946363335242E-15; + g = z*gn/gd; + } + *si = 1.570796326794896619-f*c-g*s; + if( sg!=0 ) + { + *si = -*si; + } + *ci = f*s-g*c; +} + + +/************************************************************************* +Hyperbolic sine and cosine integrals + +Approximates the integrals + + x + - + | | cosh t - 1 + Chi(x) = eul + ln x + | ----------- dt, + | | t + - + 0 + + x + - + | | sinh t + Shi(x) = | ------ dt + | | t + - + 0 + +where eul = 0.57721566490153286061 is Euler's constant. +The integrals are evaluated by power series for x < 8 +and by Chebyshev expansions for x between 8 and 88. +For large x, both functions approach exp(x)/2x. +Arguments greater than 88 in magnitude return MAXNUM. + + +ACCURACY: + +Test interval 0 to 88. + Relative error: +arithmetic function # trials peak rms + IEEE Shi 30000 6.9e-16 1.6e-16 + Absolute error, except relative when |Chi| > 1: + IEEE Chi 30000 8.4e-16 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +void hyperbolicsinecosineintegrals(double x, + double* shi, + double* chi, + ae_state *_state) +{ + double k; + double z; + double c; + double s; + double a; + ae_int_t sg; + double b0; + double b1; + double b2; + + *shi = 0; + *chi = 0; + + if( ae_fp_less(x,0) ) + { + sg = -1; + x = -x; + } + else + { + sg = 0; + } + if( ae_fp_eq(x,0) ) + { + *shi = 0; + *chi = -ae_maxrealnumber; + return; + } + if( ae_fp_less(x,8.0) ) + { + z = x*x; + a = 1.0; + s = 1.0; + c = 0.0; + k = 2.0; + do + { + a = a*z/k; + c = c+a/k; + k = k+1.0; + a = a/k; + s = s+a/k; + k = k+1.0; + } + while(ae_fp_greater_eq(ae_fabs(a/s, _state),ae_machineepsilon)); + s = s*x; + } + else + { + if( ae_fp_less(x,18.0) ) + { + a = (576.0/x-52.0)/10.0; + k = ae_exp(x, _state)/x; + b0 = 1.83889230173399459482E-17; + b1 = 0.0; + trigintegrals_chebiterationshichi(a, -9.55485532279655569575E-17, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.04326105980879882648E-16, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.09896949074905343022E-15, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.31313534344092599234E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 5.93976226264314278932E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.47197010497749154755E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.40059764613117131000E-12, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 9.49044626224223543299E-12, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.61596181145435454033E-11, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.77899784436430310321E-10, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.35455469767246947469E-9, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.03257121792819495123E-9, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.56699611114982536845E-8, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.44818877384267342057E-7, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 7.82018215184051295296E-7, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -5.39919118403805073710E-6, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.12458202168959833422E-5, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 8.90136741950727517826E-5, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.02558474743846862168E-3, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.96064440855633256972E-2, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.11847751047257036625E0, &b0, &b1, &b2, _state); + s = k*0.5*(b0-b2); + b0 = -8.12435385225864036372E-18; + b1 = 0.0; + trigintegrals_chebiterationshichi(a, 2.17586413290339214377E-17, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 5.22624394924072204667E-17, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -9.48812110591690559363E-16, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 5.35546311647465209166E-15, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.21009970113732918701E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -6.00865178553447437951E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 7.16339649156028587775E-13, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -2.93496072607599856104E-12, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.40359438136491256904E-12, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 8.76302288609054966081E-11, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -4.40092476213282340617E-10, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.87992075640569295479E-10, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.31458150989474594064E-8, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -4.75513930924765465590E-8, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -2.21775018801848880741E-7, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.94635531373272490962E-6, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 4.33505889257316408893E-6, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -6.13387001076494349496E-5, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.13085477492997465138E-4, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 4.97164789823116062801E-4, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.64347496031374526641E-2, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.11446150876699213025E0, &b0, &b1, &b2, _state); + c = k*0.5*(b0-b2); + } + else + { + if( ae_fp_less_eq(x,88.0) ) + { + a = (6336.0/x-212.0)/70.0; + k = ae_exp(x, _state)/x; + b0 = -1.05311574154850938805E-17; + b1 = 0.0; + trigintegrals_chebiterationshichi(a, 2.62446095596355225821E-17, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 8.82090135625368160657E-17, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.38459811878103047136E-16, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -8.30608026366935789136E-16, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 3.93397875437050071776E-15, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.01765565969729044505E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -4.21128170307640802703E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.60818204519802480035E-13, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 3.34714954175994481761E-13, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.72600352129153073807E-12, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.66894954752839083608E-12, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.49278141024730899554E-11, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.58580661666482709598E-10, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.79289437183355633342E-10, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.76281629144264523277E-9, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.69050228879421288846E-8, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.25391771228487041649E-7, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.16229947068677338732E-6, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.61038260117376323993E-5, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 3.49810375601053973070E-4, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.28478065259647610779E-2, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.03665722588798326712E0, &b0, &b1, &b2, _state); + s = k*0.5*(b0-b2); + b0 = 8.06913408255155572081E-18; + b1 = 0.0; + trigintegrals_chebiterationshichi(a, -2.08074168180148170312E-17, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -5.98111329658272336816E-17, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.68533951085945765591E-16, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 4.52313941698904694774E-16, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.10734917335299464535E-15, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -4.42823207332531972288E-15, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 3.49639695410806959872E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 6.63406731718911586609E-14, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.71902448093119218395E-13, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.27135418132338309016E-12, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.74851141935315395333E-12, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.33781843985453438400E-11, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 2.71436006377612442764E-11, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -2.56600180000355990529E-10, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -1.61021375163803438552E-9, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -4.72543064876271773512E-9, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, -3.00095178028681682282E-9, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 7.79387474390914922337E-8, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.06942765566401507066E-6, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.59503164802313196374E-5, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 3.49592575153777996871E-4, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.28475387530065247392E-2, &b0, &b1, &b2, _state); + trigintegrals_chebiterationshichi(a, 1.03665693917934275131E0, &b0, &b1, &b2, _state); + c = k*0.5*(b0-b2); + } + else + { + if( sg!=0 ) + { + *shi = -ae_maxrealnumber; + } + else + { + *shi = ae_maxrealnumber; + } + *chi = ae_maxrealnumber; + return; + } + } + } + if( sg!=0 ) + { + s = -s; + } + *shi = s; + *chi = 0.57721566490153286061+ae_log(x, _state)+c; +} + + +static void trigintegrals_chebiterationshichi(double x, + double c, + double* b0, + double* b1, + double* b2, + ae_state *_state) +{ + + + *b2 = *b1; + *b1 = *b0; + *b0 = x*(*b1)-(*b2)+c; +} + + + +} + diff --git a/psdlag/src/specialfunctions.h b/psdlag/src/specialfunctions.h new file mode 100644 index 0000000..167aed3 --- /dev/null +++ b/psdlag/src/specialfunctions.h @@ -0,0 +1,1976 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _specialfunctions_pkg_h +#define _specialfunctions_pkg_h +#include "ap.h" +#include "alglibinternal.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +Gamma function + +Input parameters: + X - argument + +Domain: + 0 < X < 171.6 + -170 < X < 0, X is not an integer. + +Relative error: + arithmetic domain # trials peak rms + IEEE -170,-33 20000 2.3e-15 3.3e-16 + IEEE -33, 33 20000 9.4e-16 2.2e-16 + IEEE 33, 171.6 20000 2.3e-15 3.2e-16 + +Cephes Math Library Release 2.8: June, 2000 +Original copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier +Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). +*************************************************************************/ +double gammafunction(const double x); + + +/************************************************************************* +Natural logarithm of gamma function + +Input parameters: + X - argument + +Result: + logarithm of the absolute value of the Gamma(X). + +Output parameters: + SgnGam - sign(Gamma(X)) + +Domain: + 0 < X < 2.55e305 + -2.55e305 < X < 0, X is not an integer. + +ACCURACY: +arithmetic domain # trials peak rms + IEEE 0, 3 28000 5.4e-16 1.1e-16 + IEEE 2.718, 2.556e305 40000 3.5e-16 8.3e-17 +The error criterion was relative when the function magnitude +was greater than one but absolute when it was less than one. + +The following test used the relative error criterion, though +at certain points the relative error could be much higher than +indicated. + IEEE -200, -4 10000 4.8e-16 1.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 1992, 2000 by Stephen L. Moshier +Translated to AlgoPascal by Bochkanov Sergey (2005, 2006, 2007). +*************************************************************************/ +double lngamma(const double x, double &sgngam); + +/************************************************************************* +Error function + +The integral is + + x + - + 2 | | 2 + erf(x) = -------- | exp( - t ) dt. + sqrt(pi) | | + - + 0 + +For 0 <= |x| < 1, erf(x) = x * P4(x**2)/Q5(x**2); otherwise +erf(x) = 1 - erfc(x). + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 3.7e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double errorfunction(const double x); + + +/************************************************************************* +Complementary error function + + 1 - erf(x) = + + inf. + - + 2 | | 2 + erfc(x) = -------- | exp( - t ) dt + sqrt(pi) | | + - + x + + +For small x, erfc(x) = 1 - erf(x); otherwise rational +approximations are computed. + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,26.6417 30000 5.7e-14 1.5e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double errorfunctionc(const double x); + + +/************************************************************************* +Normal distribution function + +Returns the area under the Gaussian probability density +function, integrated from minus infinity to x: + + x + - + 1 | | 2 + ndtr(x) = --------- | exp( - t /2 ) dt + sqrt(2pi) | | + - + -inf. + + = ( 1 + erf(z) ) / 2 + = erfc(z) / 2 + +where z = x/sqrt(2). Computation is via the functions +erf and erfc. + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE -13,0 30000 3.4e-14 6.7e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double normaldistribution(const double x); + + +/************************************************************************* +Inverse of the error function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double inverf(const double e); + + +/************************************************************************* +Inverse of Normal distribution function + +Returns the argument, x, for which the area under the +Gaussian probability density function (integrated from +minus infinity to x) is equal to y. + + +For small arguments 0 < y < exp(-2), the program computes +z = sqrt( -2.0 * log(y) ); then the approximation is +x = z - log(z)/z - (1/z) P(1/z) / Q(1/z). +There are two rational functions P/Q, one for 0 < y < exp(-32) +and the other for y up to exp(-2). For larger arguments, +w = y - 0.5, and x/sqrt(2pi) = w + w**3 R(w**2)/S(w**2)). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0.125, 1 20000 7.2e-16 1.3e-16 + IEEE 3e-308, 0.135 50000 4.6e-16 9.8e-17 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double invnormaldistribution(const double y0); + +/************************************************************************* +Incomplete gamma integral + +The function is defined by + + x + - + 1 | | -t a-1 + igam(a,x) = ----- | e t dt. + - | | + | (a) - + 0 + + +In this implementation both arguments must be positive. +The integral is evaluated by either a power series or +continued fraction expansion, depending on the relative +values of a and x. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 200000 3.6e-14 2.9e-15 + IEEE 0,100 300000 9.9e-14 1.5e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletegamma(const double a, const double x); + + +/************************************************************************* +Complemented incomplete gamma integral + +The function is defined by + + + igamc(a,x) = 1 - igam(a,x) + + inf. + - + 1 | | -t a-1 + = ----- | e t dt. + - | | + | (a) - + x + + +In this implementation both arguments must be positive. +The integral is evaluated by either a power series or +continued fraction expansion, depending on the relative +values of a and x. + +ACCURACY: + +Tested at random a, x. + a x Relative error: +arithmetic domain domain # trials peak rms + IEEE 0.5,100 0,100 200000 1.9e-14 1.7e-15 + IEEE 0.01,0.5 0,100 200000 1.4e-13 1.6e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletegammac(const double a, const double x); + + +/************************************************************************* +Inverse of complemented imcomplete gamma integral + +Given p, the function finds x such that + + igamc( a, x ) = p. + +Starting with the approximate value + + 3 + x = a t + + where + + t = 1 - d - ndtri(p) sqrt(d) + +and + + d = 1/9a, + +the routine performs up to 10 Newton iterations to find the +root of igamc(a,x) - p = 0. + +ACCURACY: + +Tested at random a, p in the intervals indicated. + + a p Relative error: +arithmetic domain domain # trials peak rms + IEEE 0.5,100 0,0.5 100000 1.0e-14 1.7e-15 + IEEE 0.01,0.5 0,0.5 100000 9.0e-14 3.4e-15 + IEEE 0.5,10000 0,0.5 20000 2.3e-13 3.8e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invincompletegammac(const double a, const double y0); + +/************************************************************************* +Airy function + +Solution of the differential equation + +y"(x) = xy. + +The function returns the two independent solutions Ai, Bi +and their first derivatives Ai'(x), Bi'(x). + +Evaluation is by power series summation for small x, +by rational minimax approximations for large x. + + + +ACCURACY: +Error criterion is absolute when function <= 1, relative +when function > 1, except * denotes relative error criterion. +For large negative x, the absolute error increases as x^1.5. +For large positive x, the relative error increases as x^1.5. + +Arithmetic domain function # trials peak rms +IEEE -10, 0 Ai 10000 1.6e-15 2.7e-16 +IEEE 0, 10 Ai 10000 2.3e-14* 1.8e-15* +IEEE -10, 0 Ai' 10000 4.6e-15 7.6e-16 +IEEE 0, 10 Ai' 10000 1.8e-14* 1.5e-15* +IEEE -10, 10 Bi 30000 4.2e-15 5.3e-16 +IEEE -10, 10 Bi' 30000 4.9e-15 7.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +void airy(const double x, double &ai, double &aip, double &bi, double &bip); + +/************************************************************************* +Bessel function of order zero + +Returns Bessel function of order zero of the argument. + +The domain is divided into the intervals [0, 5] and +(5, infinity). In the first interval the following rational +approximation is used: + + + 2 2 +(w - r ) (w - r ) P (w) / Q (w) + 1 2 3 8 + + 2 +where w = x and the two r's are zeros of the function. + +In the second interval, the Hankel asymptotic expansion +is employed with two rational functions of degree 6/6 +and 7/7. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 60000 4.2e-16 1.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselj0(const double x); + + +/************************************************************************* +Bessel function of order one + +Returns Bessel function of order one of the argument. + +The domain is divided into the intervals [0, 8] and +(8, infinity). In the first interval a 24 term Chebyshev +expansion is used. In the second, the asymptotic +trigonometric representation is employed using two +rational functions of degree 5/5. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 2.6e-16 1.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselj1(const double x); + + +/************************************************************************* +Bessel function of integer order + +Returns Bessel function of order n, where n is a +(possibly negative) integer. + +The ratio of jn(x) to j0(x) is computed by backward +recurrence. First the ratio jn/jn-1 is found by a +continued fraction expansion. Then the recurrence +relating successive orders is applied until j0 or j1 is +reached. + +If n = 0 or 1 the routine for j0 or j1 is called +directly. + +ACCURACY: + + Absolute error: +arithmetic range # trials peak rms + IEEE 0, 30 5000 4.4e-16 7.9e-17 + + +Not suitable for large n or x. Use jv() (fractional order) instead. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseljn(const ae_int_t n, const double x); + + +/************************************************************************* +Bessel function of the second kind, order zero + +Returns Bessel function of the second kind, of order +zero, of the argument. + +The domain is divided into the intervals [0, 5] and +(5, infinity). In the first interval a rational approximation +R(x) is employed to compute + y0(x) = R(x) + 2 * log(x) * j0(x) / PI. +Thus a call to j0() is required. + +In the second interval, the Hankel asymptotic expansion +is employed with two rational functions of degree 6/6 +and 7/7. + + + +ACCURACY: + + Absolute error, when y0(x) < 1; else relative error: + +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.3e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double bessely0(const double x); + + +/************************************************************************* +Bessel function of second kind of order one + +Returns Bessel function of the second kind of order one +of the argument. + +The domain is divided into the intervals [0, 8] and +(8, infinity). In the first interval a 25 term Chebyshev +expansion is used, and a call to j1() is required. +In the second, the asymptotic trigonometric representation +is employed using two rational functions of degree 5/5. + +ACCURACY: + + Absolute error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.0e-15 1.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double bessely1(const double x); + + +/************************************************************************* +Bessel function of second kind of integer order + +Returns Bessel function of order n, where n is a +(possibly negative) integer. + +The function is evaluated by forward recurrence on +n, starting with values computed by the routines +y0() and y1(). + +If n = 0 or 1 the routine for y0 or y1 is called +directly. + +ACCURACY: + Absolute error, except relative + when y > 1: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 3.4e-15 4.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselyn(const ae_int_t n, const double x); + + +/************************************************************************* +Modified Bessel function of order zero + +Returns modified Bessel function of order zero of the +argument. + +The function is defined as i0(x) = j0( ix ). + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 30000 5.8e-16 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseli0(const double x); + + +/************************************************************************* +Modified Bessel function of order one + +Returns modified Bessel function of order one of the +argument. + +The function is defined as i1(x) = -i j1( ix ). + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.9e-15 2.1e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besseli1(const double x); + + +/************************************************************************* +Modified Bessel function, second kind, order zero + +Returns modified Bessel function of the second kind +of order zero of the argument. + +The range is partitioned into the two intervals [0,8] and +(8, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + +Tested at 2000 random points between 0 and 8. Peak absolute +error (relative when K0 > 1) was 1.46e-14; rms, 4.26e-15. + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.2e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselk0(const double x); + + +/************************************************************************* +Modified Bessel function, second kind, order one + +Computes the modified Bessel function of the second kind +of order one of the argument. + +The range is partitioned into the two intervals [0,2] and +(2, infinity). Chebyshev polynomial expansions are employed +in each interval. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 30000 1.2e-15 1.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselk1(const double x); + + +/************************************************************************* +Modified Bessel function, second kind, integer order + +Returns modified Bessel function of the second kind +of order n of the argument. + +The range is partitioned into the two intervals [0,9.55] and +(9.55, infinity). An ascending power series is used in the +low range, and an asymptotic expansion in the high range. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 90000 1.8e-8 3.0e-10 + +Error is high only near the crossover point x = 9.55 +between the two expansions used. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier +*************************************************************************/ +double besselkn(const ae_int_t nn, const double x); + +/************************************************************************* +Beta function + + + - - + | (a) | (b) +beta( a, b ) = -----------. + - + | (a+b) + +For large arguments the logarithm of the function is +evaluated using lgam(), then exponentiated. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,30 30000 8.1e-14 1.1e-14 + +Cephes Math Library Release 2.0: April, 1987 +Copyright 1984, 1987 by Stephen L. Moshier +*************************************************************************/ +double beta(const double a, const double b); + +/************************************************************************* +Incomplete beta integral + +Returns incomplete beta integral of the arguments, evaluated +from zero to x. The function is defined as + + x + - - + | (a+b) | | a-1 b-1 + ----------- | t (1-t) dt. + - - | | + | (a) | (b) - + 0 + +The domain of definition is 0 <= x <= 1. In this +implementation a and b are restricted to positive values. +The integral from x to 1 may be obtained by the symmetry +relation + + 1 - incbet( a, b, x ) = incbet( b, a, 1-x ). + +The integral is evaluated by a continued fraction expansion +or, when b*x is small, by a power series. + +ACCURACY: + +Tested at uniformly distributed random points (a,b,x) with a and b +in "domain" and x between 0 and 1. + Relative error +arithmetic domain # trials peak rms + IEEE 0,5 10000 6.9e-15 4.5e-16 + IEEE 0,85 250000 2.2e-13 1.7e-14 + IEEE 0,1000 30000 5.3e-12 6.3e-13 + IEEE 0,10000 250000 9.3e-11 7.1e-12 + IEEE 0,100000 10000 8.7e-10 4.8e-11 +Outputs smaller than the IEEE gradual underflow threshold +were excluded from these statistics. + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompletebeta(const double a, const double b, const double x); + + +/************************************************************************* +Inverse of imcomplete beta integral + +Given y, the function finds x such that + + incbet( a, b, x ) = y . + +The routine performs interval halving or Newton iterations to find the +root of incbet(a,b,x) - y = 0. + + +ACCURACY: + + Relative error: + x a,b +arithmetic domain domain # trials peak rms + IEEE 0,1 .5,10000 50000 5.8e-12 1.3e-13 + IEEE 0,1 .25,100 100000 1.8e-13 3.9e-15 + IEEE 0,1 0,5 50000 1.1e-12 5.5e-15 +With a and b constrained to half-integer or integer values: + IEEE 0,1 .5,10000 50000 5.8e-12 1.1e-13 + IEEE 0,1 .5,100 100000 1.7e-14 7.9e-16 +With a = .5, b constrained to half-integer or integer values: + IEEE 0,1 .5,10000 10000 8.3e-11 1.0e-11 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1996, 2000 by Stephen L. Moshier +*************************************************************************/ +double invincompletebeta(const double a, const double b, const double y); + +/************************************************************************* +Binomial distribution + +Returns the sum of the terms 0 through k of the Binomial +probability density: + + k + -- ( n ) j n-j + > ( ) p (1-p) + -- ( j ) + j=0 + +The terms are not summed directly; instead the incomplete +beta integral is employed, according to the formula + +y = bdtr( k, n, p ) = incbet( n-k, k+1, 1-p ). + +The arguments must be positive, with p ranging from 0 to 1. + +ACCURACY: + +Tested at random points (a,b,p), with p between 0 and 1. + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 4.3e-15 2.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double binomialdistribution(const ae_int_t k, const ae_int_t n, const double p); + + +/************************************************************************* +Complemented binomial distribution + +Returns the sum of the terms k+1 through n of the Binomial +probability density: + + n + -- ( n ) j n-j + > ( ) p (1-p) + -- ( j ) + j=k+1 + +The terms are not summed directly; instead the incomplete +beta integral is employed, according to the formula + +y = bdtrc( k, n, p ) = incbet( k+1, n-k, p ). + +The arguments must be positive, with p ranging from 0 to 1. + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 6.7e-15 8.2e-16 + For p between 0 and .001: + IEEE 0,100 100000 1.5e-13 2.7e-15 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double binomialcdistribution(const ae_int_t k, const ae_int_t n, const double p); + + +/************************************************************************* +Inverse binomial distribution + +Finds the event probability p such that the sum of the +terms 0 through k of the Binomial probability density +is equal to the given cumulative probability y. + +This is accomplished using the inverse beta integral +function and the relation + +1 - p = incbi( n-k, k+1, y ). + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between 0.001 and 1: + IEEE 0,100 100000 2.3e-14 6.4e-16 + IEEE 0,10000 100000 6.6e-12 1.2e-13 + For p between 10^-6 and 0.001: + IEEE 0,100 100000 2.0e-12 1.3e-14 + IEEE 0,10000 100000 1.5e-12 3.2e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invbinomialdistribution(const ae_int_t k, const ae_int_t n, const double y); + +/************************************************************************* +Calculation of the value of the Chebyshev polynomials of the +first and second kinds. + +Parameters: + r - polynomial kind, either 1 or 2. + n - degree, n>=0 + x - argument, -1 <= x <= 1 + +Result: + the value of the Chebyshev polynomial at x +*************************************************************************/ +double chebyshevcalculate(const ae_int_t r, const ae_int_t n, const double x); + + +/************************************************************************* +Summation of Chebyshev polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*T0(x) + c[1]*T1(x) + ... + c[N]*TN(x) +or + c[0]*U0(x) + c[1]*U1(x) + ... + c[N]*UN(x) +depending on the R. + +Parameters: + r - polynomial kind, either 1 or 2. + n - degree, n>=0 + x - argument + +Result: + the value of the Chebyshev polynomial at x +*************************************************************************/ +double chebyshevsum(const real_1d_array &c, const ae_int_t r, const ae_int_t n, const double x); + + +/************************************************************************* +Representation of Tn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void chebyshevcoefficients(const ae_int_t n, real_1d_array &c); + + +/************************************************************************* +Conversion of a series of Chebyshev polynomials to a power series. + +Represents A[0]*T0(x) + A[1]*T1(x) + ... + A[N]*Tn(x) as +B[0] + B[1]*X + ... + B[N]*X^N. + +Input parameters: + A - Chebyshev series coefficients + N - degree, N>=0 + +Output parameters + B - power series coefficients +*************************************************************************/ +void fromchebyshev(const real_1d_array &a, const ae_int_t n, real_1d_array &b); + +/************************************************************************* +Chi-square distribution + +Returns the area under the left hand tail (from 0 to x) +of the Chi square probability density function with +v degrees of freedom. + + + x + - + 1 | | v/2-1 -t/2 + P( x | v ) = ----------- | t e dt + v/2 - | | + 2 | (v/2) - + 0 + +where x is the Chi-square variable. + +The incomplete gamma integral is used, according to the +formula + +y = chdtr( v, x ) = igam( v/2.0, x/2.0 ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double chisquaredistribution(const double v, const double x); + + +/************************************************************************* +Complemented Chi-square distribution + +Returns the area under the right hand tail (from x to +infinity) of the Chi square probability density function +with v degrees of freedom: + + inf. + - + 1 | | v/2-1 -t/2 + P( x | v ) = ----------- | t e dt + v/2 - | | + 2 | (v/2) - + x + +where x is the Chi-square variable. + +The incomplete gamma integral is used, according to the +formula + +y = chdtr( v, x ) = igamc( v/2.0, x/2.0 ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double chisquarecdistribution(const double v, const double x); + + +/************************************************************************* +Inverse of complemented Chi-square distribution + +Finds the Chi-square argument x such that the integral +from x to infinity of the Chi-square density is equal +to the given cumulative probability y. + +This is accomplished using the inverse gamma integral +function and the relation + + x/2 = igami( df/2, y ); + +ACCURACY: + +See inverse incomplete gamma function + + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double invchisquaredistribution(const double v, const double y); + +/************************************************************************* +Dawson's Integral + +Approximates the integral + + x + - + 2 | | 2 + dawsn(x) = exp( -x ) | exp( t ) dt + | | + - + 0 + +Three different rational approximations are employed, for +the intervals 0 to 3.25; 3.25 to 6.25; and 6.25 up. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,10 10000 6.9e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double dawsonintegral(const double x); + +/************************************************************************* +Complete elliptic integral of the first kind + +Approximates the integral + + + + pi/2 + - + | | + | dt +K(m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +using the approximation + + P(x) - log x Q(x). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 2.5e-16 6.8e-17 + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double ellipticintegralk(const double m); + + +/************************************************************************* +Complete elliptic integral of the first kind + +Approximates the integral + + + + pi/2 + - + | | + | dt +K(m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +where m = 1 - m1, using the approximation + + P(x) - log x Q(x). + +The argument m1 is used rather than m so that the logarithmic +singularity at m = 1 will be shifted to the origin; this +preserves maximum accuracy. + +K(0) = pi/2. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,1 30000 2.5e-16 6.8e-17 + +Àëãîðèòì âçÿò èç áèáëèîòåêè Cephes +*************************************************************************/ +double ellipticintegralkhighprecision(const double m1); + + +/************************************************************************* +Incomplete elliptic integral of the first kind F(phi|m) + +Approximates the integral + + + + phi + - + | | + | dt +F(phi_\m) = | ------------------ + | 2 + | | sqrt( 1 - m sin t ) + - + 0 + +of amplitude phi and modulus m, using the arithmetic - +geometric mean algorithm. + + + + +ACCURACY: + +Tested at random points with m in [0, 1] and phi as indicated. + + Relative error: +arithmetic domain # trials peak rms + IEEE -10,10 200000 7.4e-16 1.0e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompleteellipticintegralk(const double phi, const double m); + + +/************************************************************************* +Complete elliptic integral of the second kind + +Approximates the integral + + + pi/2 + - + | | 2 +E(m) = | sqrt( 1 - m sin t ) dt + | | + - + 0 + +using the approximation + + P(x) - x log x Q(x). + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 1 10000 2.1e-16 7.3e-17 + +Cephes Math Library, Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +double ellipticintegrale(const double m); + + +/************************************************************************* +Incomplete elliptic integral of the second kind + +Approximates the integral + + + phi + - + | | + | 2 +E(phi_\m) = | sqrt( 1 - m sin t ) dt + | + | | + - + 0 + +of amplitude phi and modulus m, using the arithmetic - +geometric mean algorithm. + +ACCURACY: + +Tested at random arguments with phi in [-10, 10] and m in +[0, 1]. + Relative error: +arithmetic domain # trials peak rms + IEEE -10,10 150000 3.3e-15 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1993, 2000 by Stephen L. Moshier +*************************************************************************/ +double incompleteellipticintegrale(const double phi, const double m); + +/************************************************************************* +Exponential integral Ei(x) + + x + - t + | | e + Ei(x) = -|- --- dt . + | | t + - + -inf + +Not defined for x <= 0. +See also expn.c. + + + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0,100 50000 8.6e-16 1.3e-16 + +Cephes Math Library Release 2.8: May, 1999 +Copyright 1999 by Stephen L. Moshier +*************************************************************************/ +double exponentialintegralei(const double x); + + +/************************************************************************* +Exponential integral En(x) + +Evaluates the exponential integral + + inf. + - + | | -xt + | e + E (x) = | ---- dt. + n | n + | | t + - + 1 + + +Both n and x must be nonnegative. + +The routine employs either a power series, a continued +fraction, or an asymptotic formula depending on the +relative values of n and x. + +ACCURACY: + + Relative error: +arithmetic domain # trials peak rms + IEEE 0, 30 10000 1.7e-15 3.6e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 2000 by Stephen L. Moshier +*************************************************************************/ +double exponentialintegralen(const double x, const ae_int_t n); + +/************************************************************************* +F distribution + +Returns the area from zero to x under the F density +function (also known as Snedcor's density or the +variance ratio density). This is the density +of x = (u1/df1)/(u2/df2), where u1 and u2 are random +variables having Chi square distributions with df1 +and df2 degrees of freedom, respectively. +The incomplete beta integral is used, according to the +formula + +P(x) = incbet( df1/2, df2/2, (df1*x/(df2 + df1*x) ). + + +The arguments a and b are greater than zero, and x is +nonnegative. + +ACCURACY: + +Tested at random points (a,b,x). + + x a,b Relative error: +arithmetic domain domain # trials peak rms + IEEE 0,1 0,100 100000 9.8e-15 1.7e-15 + IEEE 1,5 0,100 100000 6.5e-15 3.5e-16 + IEEE 0,1 1,10000 100000 2.2e-11 3.3e-12 + IEEE 1,5 1,10000 100000 1.1e-11 1.7e-13 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double fdistribution(const ae_int_t a, const ae_int_t b, const double x); + + +/************************************************************************* +Complemented F distribution + +Returns the area from x to infinity under the F density +function (also known as Snedcor's density or the +variance ratio density). + + + inf. + - + 1 | | a-1 b-1 +1-P(x) = ------ | t (1-t) dt + B(a,b) | | + - + x + + +The incomplete beta integral is used, according to the +formula + +P(x) = incbet( df2/2, df1/2, (df2/(df2 + df1*x) ). + + +ACCURACY: + +Tested at random points (a,b,x) in the indicated intervals. + x a,b Relative error: +arithmetic domain domain # trials peak rms + IEEE 0,1 1,100 100000 3.7e-14 5.9e-16 + IEEE 1,5 1,100 100000 8.0e-15 1.6e-15 + IEEE 0,1 1,10000 100000 1.8e-11 3.5e-13 + IEEE 1,5 1,10000 100000 2.0e-11 3.0e-12 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double fcdistribution(const ae_int_t a, const ae_int_t b, const double x); + + +/************************************************************************* +Inverse of complemented F distribution + +Finds the F density argument x such that the integral +from x to infinity of the F density is equal to the +given probability p. + +This is accomplished using the inverse beta integral +function and the relations + + z = incbi( df2/2, df1/2, p ) + x = df2 (1-z) / (df1 z). + +Note: the following relations hold for the inverse of +the uncomplemented F distribution: + + z = incbi( df1/2, df2/2, p ) + x = df2 z / (df1 (1-z)). + +ACCURACY: + +Tested at random points (a,b,p). + + a,b Relative error: +arithmetic domain # trials peak rms + For p between .001 and 1: + IEEE 1,100 100000 8.3e-15 4.7e-16 + IEEE 1,10000 100000 2.1e-11 1.4e-13 + For p between 10^-6 and 10^-3: + IEEE 1,100 50000 1.3e-12 8.4e-15 + IEEE 1,10000 50000 3.0e-12 4.8e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invfdistribution(const ae_int_t a, const ae_int_t b, const double y); + +/************************************************************************* +Fresnel integral + +Evaluates the Fresnel integrals + + x + - + | | +C(x) = | cos(pi/2 t**2) dt, + | | + - + 0 + + x + - + | | +S(x) = | sin(pi/2 t**2) dt. + | | + - + 0 + + +The integrals are evaluated by a power series for x < 1. +For x >= 1 auxiliary functions f(x) and g(x) are employed +such that + +C(x) = 0.5 + f(x) sin( pi/2 x**2 ) - g(x) cos( pi/2 x**2 ) +S(x) = 0.5 - f(x) cos( pi/2 x**2 ) - g(x) sin( pi/2 x**2 ) + + + +ACCURACY: + + Relative error. + +Arithmetic function domain # trials peak rms + IEEE S(x) 0, 10 10000 2.0e-15 3.2e-16 + IEEE C(x) 0, 10 10000 1.8e-15 3.3e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1989, 2000 by Stephen L. Moshier +*************************************************************************/ +void fresnelintegral(const double x, double &c, double &s); + +/************************************************************************* +Calculation of the value of the Hermite polynomial. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Hermite polynomial Hn at x +*************************************************************************/ +double hermitecalculate(const ae_int_t n, const double x); + + +/************************************************************************* +Summation of Hermite polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*H0(x) + c[1]*H1(x) + ... + c[N]*HN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Hermite polynomial at x +*************************************************************************/ +double hermitesum(const real_1d_array &c, const ae_int_t n, const double x); + + +/************************************************************************* +Representation of Hn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void hermitecoefficients(const ae_int_t n, real_1d_array &c); + +/************************************************************************* +Jacobian Elliptic Functions + +Evaluates the Jacobian elliptic functions sn(u|m), cn(u|m), +and dn(u|m) of parameter m between 0 and 1, and real +argument u. + +These functions are periodic, with quarter-period on the +real axis equal to the complete elliptic integral +ellpk(1.0-m). + +Relation to incomplete elliptic integral: +If u = ellik(phi,m), then sn(u|m) = sin(phi), +and cn(u|m) = cos(phi). Phi is called the amplitude of u. + +Computation is by means of the arithmetic-geometric mean +algorithm, except when m is within 1e-9 of 0 or 1. In the +latter case with m close to 1, the approximation applies +only for phi < pi/2. + +ACCURACY: + +Tested at random points with u between 0 and 10, m between +0 and 1. + + Absolute error (* = relative error): +arithmetic function # trials peak rms + IEEE phi 10000 9.2e-16* 1.4e-16* + IEEE sn 50000 4.1e-15 4.6e-16 + IEEE cn 40000 3.6e-15 4.4e-16 + IEEE dn 10000 1.3e-12 1.8e-14 + + Peak error observed in consistency check using addition +theorem for sn(u+v) was 4e-16 (absolute). Also tested by +the above relation to the incomplete elliptic integral. +Accuracy deteriorates when u is large. + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +void jacobianellipticfunctions(const double u, const double m, double &sn, double &cn, double &dn, double &ph); + +/************************************************************************* +Calculation of the value of the Laguerre polynomial. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Laguerre polynomial Ln at x +*************************************************************************/ +double laguerrecalculate(const ae_int_t n, const double x); + + +/************************************************************************* +Summation of Laguerre polynomials using Clenshaw’s recurrence formula. + +This routine calculates c[0]*L0(x) + c[1]*L1(x) + ... + c[N]*LN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Laguerre polynomial at x +*************************************************************************/ +double laguerresum(const real_1d_array &c, const ae_int_t n, const double x); + + +/************************************************************************* +Representation of Ln as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void laguerrecoefficients(const ae_int_t n, real_1d_array &c); + +/************************************************************************* +Calculation of the value of the Legendre polynomial Pn. + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Legendre polynomial Pn at x +*************************************************************************/ +double legendrecalculate(const ae_int_t n, const double x); + + +/************************************************************************* +Summation of Legendre polynomials using Clenshaw’s recurrence formula. + +This routine calculates + c[0]*P0(x) + c[1]*P1(x) + ... + c[N]*PN(x) + +Parameters: + n - degree, n>=0 + x - argument + +Result: + the value of the Legendre polynomial at x +*************************************************************************/ +double legendresum(const real_1d_array &c, const ae_int_t n, const double x); + + +/************************************************************************* +Representation of Pn as C[0] + C[1]*X + ... + C[N]*X^N + +Input parameters: + N - polynomial degree, n>=0 + +Output parameters: + C - coefficients +*************************************************************************/ +void legendrecoefficients(const ae_int_t n, real_1d_array &c); + +/************************************************************************* +Poisson distribution + +Returns the sum of the first k+1 terms of the Poisson +distribution: + + k j + -- -m m + > e -- + -- j! + j=0 + +The terms are not summed directly; instead the incomplete +gamma integral is employed, according to the relation + +y = pdtr( k, m ) = igamc( k+1, m ). + +The arguments must both be positive. +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double poissondistribution(const ae_int_t k, const double m); + + +/************************************************************************* +Complemented Poisson distribution + +Returns the sum of the terms k+1 to infinity of the Poisson +distribution: + + inf. j + -- -m m + > e -- + -- j! + j=k+1 + +The terms are not summed directly; instead the incomplete +gamma integral is employed, according to the formula + +y = pdtrc( k, m ) = igam( k+1, m ). + +The arguments must both be positive. + +ACCURACY: + +See incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double poissoncdistribution(const ae_int_t k, const double m); + + +/************************************************************************* +Inverse Poisson distribution + +Finds the Poisson variable x such that the integral +from 0 to x of the Poisson density is equal to the +given probability y. + +This is accomplished using the inverse gamma integral +function and the relation + + m = igami( k+1, y ). + +ACCURACY: + +See inverse incomplete gamma function + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invpoissondistribution(const ae_int_t k, const double y); + +/************************************************************************* +Psi (digamma) function + + d - + psi(x) = -- ln | (x) + dx + +is the logarithmic derivative of the gamma function. +For integer x, + n-1 + - +psi(n) = -EUL + > 1/k. + - + k=1 + +This formula is used for 0 < n <= 10. If x is negative, it +is transformed to a positive argument by the reflection +formula psi(1-x) = psi(x) + pi cot(pi x). +For general positive x, the argument is made greater than 10 +using the recurrence psi(x+1) = psi(x) + 1/x. +Then the following asymptotic expansion is applied: + + inf. B + - 2k +psi(x) = log(x) - 1/2x - > ------- + - 2k + k=1 2k x + +where the B2k are Bernoulli numbers. + +ACCURACY: + Relative error (except absolute when |psi| < 1): +arithmetic domain # trials peak rms + IEEE 0,30 30000 1.3e-15 1.4e-16 + IEEE -30,0 40000 1.5e-15 2.2e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1992, 2000 by Stephen L. Moshier +*************************************************************************/ +double psi(const double x); + +/************************************************************************* +Student's t distribution + +Computes the integral from minus infinity to t of the Student +t distribution with integer k > 0 degrees of freedom: + + t + - + | | + - | 2 -(k+1)/2 + | ( (k+1)/2 ) | ( x ) + ---------------------- | ( 1 + --- ) dx + - | ( k ) + sqrt( k pi ) | ( k/2 ) | + | | + - + -inf. + +Relation to incomplete beta integral: + + 1 - stdtr(k,t) = 0.5 * incbet( k/2, 1/2, z ) +where + z = k/(k + t**2). + +For t < -2, this is the method of computation. For higher t, +a direct method is derived from integration by parts. +Since the function is symmetric about t=0, the area under the +right tail of the density is found by calling the function +with -t instead of t. + +ACCURACY: + +Tested at random 1 <= k <= 25. The "domain" refers to t. + Relative error: +arithmetic domain # trials peak rms + IEEE -100,-2 50000 5.9e-15 1.4e-15 + IEEE -2,100 500000 2.7e-15 4.9e-17 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double studenttdistribution(const ae_int_t k, const double t); + + +/************************************************************************* +Functional inverse of Student's t distribution + +Given probability p, finds the argument t such that stdtr(k,t) +is equal to p. + +ACCURACY: + +Tested at random 1 <= k <= 100. The "domain" refers to p: + Relative error: +arithmetic domain # trials peak rms + IEEE .001,.999 25000 5.7e-15 8.0e-16 + IEEE 10^-6,.001 25000 2.0e-12 2.9e-14 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1995, 2000 by Stephen L. Moshier +*************************************************************************/ +double invstudenttdistribution(const ae_int_t k, const double p); + +/************************************************************************* +Sine and cosine integrals + +Evaluates the integrals + + x + - + | cos t - 1 + Ci(x) = eul + ln x + | --------- dt, + | t + - + 0 + x + - + | sin t + Si(x) = | ----- dt + | t + - + 0 + +where eul = 0.57721566490153286061 is Euler's constant. +The integrals are approximated by rational functions. +For x > 8 auxiliary functions f(x) and g(x) are employed +such that + +Ci(x) = f(x) sin(x) - g(x) cos(x) +Si(x) = pi/2 - f(x) cos(x) - g(x) sin(x) + + +ACCURACY: + Test interval = [0,50]. +Absolute error, except relative when > 1: +arithmetic function # trials peak rms + IEEE Si 30000 4.4e-16 7.3e-17 + IEEE Ci 30000 6.9e-16 5.1e-17 + +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +*************************************************************************/ +void sinecosineintegrals(const double x, double &si, double &ci); + + +/************************************************************************* +Hyperbolic sine and cosine integrals + +Approximates the integrals + + x + - + | | cosh t - 1 + Chi(x) = eul + ln x + | ----------- dt, + | | t + - + 0 + + x + - + | | sinh t + Shi(x) = | ------ dt + | | t + - + 0 + +where eul = 0.57721566490153286061 is Euler's constant. +The integrals are evaluated by power series for x < 8 +and by Chebyshev expansions for x between 8 and 88. +For large x, both functions approach exp(x)/2x. +Arguments greater than 88 in magnitude return MAXNUM. + + +ACCURACY: + +Test interval 0 to 88. + Relative error: +arithmetic function # trials peak rms + IEEE Shi 30000 6.9e-16 1.6e-16 + Absolute error, except relative when |Chi| > 1: + IEEE Chi 30000 8.4e-16 1.4e-16 + +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*************************************************************************/ +void hyperbolicsinecosineintegrals(const double x, double &shi, double &chi); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +double gammafunction(double x, ae_state *_state); +double lngamma(double x, double* sgngam, ae_state *_state); +double errorfunction(double x, ae_state *_state); +double errorfunctionc(double x, ae_state *_state); +double normaldistribution(double x, ae_state *_state); +double inverf(double e, ae_state *_state); +double invnormaldistribution(double y0, ae_state *_state); +double incompletegamma(double a, double x, ae_state *_state); +double incompletegammac(double a, double x, ae_state *_state); +double invincompletegammac(double a, double y0, ae_state *_state); +void airy(double x, + double* ai, + double* aip, + double* bi, + double* bip, + ae_state *_state); +double besselj0(double x, ae_state *_state); +double besselj1(double x, ae_state *_state); +double besseljn(ae_int_t n, double x, ae_state *_state); +double bessely0(double x, ae_state *_state); +double bessely1(double x, ae_state *_state); +double besselyn(ae_int_t n, double x, ae_state *_state); +double besseli0(double x, ae_state *_state); +double besseli1(double x, ae_state *_state); +double besselk0(double x, ae_state *_state); +double besselk1(double x, ae_state *_state); +double besselkn(ae_int_t nn, double x, ae_state *_state); +double beta(double a, double b, ae_state *_state); +double incompletebeta(double a, double b, double x, ae_state *_state); +double invincompletebeta(double a, double b, double y, ae_state *_state); +double binomialdistribution(ae_int_t k, + ae_int_t n, + double p, + ae_state *_state); +double binomialcdistribution(ae_int_t k, + ae_int_t n, + double p, + ae_state *_state); +double invbinomialdistribution(ae_int_t k, + ae_int_t n, + double y, + ae_state *_state); +double chebyshevcalculate(ae_int_t r, + ae_int_t n, + double x, + ae_state *_state); +double chebyshevsum(/* Real */ ae_vector* c, + ae_int_t r, + ae_int_t n, + double x, + ae_state *_state); +void chebyshevcoefficients(ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state); +void fromchebyshev(/* Real */ ae_vector* a, + ae_int_t n, + /* Real */ ae_vector* b, + ae_state *_state); +double chisquaredistribution(double v, double x, ae_state *_state); +double chisquarecdistribution(double v, double x, ae_state *_state); +double invchisquaredistribution(double v, double y, ae_state *_state); +double dawsonintegral(double x, ae_state *_state); +double ellipticintegralk(double m, ae_state *_state); +double ellipticintegralkhighprecision(double m1, ae_state *_state); +double incompleteellipticintegralk(double phi, double m, ae_state *_state); +double ellipticintegrale(double m, ae_state *_state); +double incompleteellipticintegrale(double phi, double m, ae_state *_state); +double exponentialintegralei(double x, ae_state *_state); +double exponentialintegralen(double x, ae_int_t n, ae_state *_state); +double fdistribution(ae_int_t a, ae_int_t b, double x, ae_state *_state); +double fcdistribution(ae_int_t a, ae_int_t b, double x, ae_state *_state); +double invfdistribution(ae_int_t a, + ae_int_t b, + double y, + ae_state *_state); +void fresnelintegral(double x, double* c, double* s, ae_state *_state); +double hermitecalculate(ae_int_t n, double x, ae_state *_state); +double hermitesum(/* Real */ ae_vector* c, + ae_int_t n, + double x, + ae_state *_state); +void hermitecoefficients(ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state); +void jacobianellipticfunctions(double u, + double m, + double* sn, + double* cn, + double* dn, + double* ph, + ae_state *_state); +double laguerrecalculate(ae_int_t n, double x, ae_state *_state); +double laguerresum(/* Real */ ae_vector* c, + ae_int_t n, + double x, + ae_state *_state); +void laguerrecoefficients(ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state); +double legendrecalculate(ae_int_t n, double x, ae_state *_state); +double legendresum(/* Real */ ae_vector* c, + ae_int_t n, + double x, + ae_state *_state); +void legendrecoefficients(ae_int_t n, + /* Real */ ae_vector* c, + ae_state *_state); +double poissondistribution(ae_int_t k, double m, ae_state *_state); +double poissoncdistribution(ae_int_t k, double m, ae_state *_state); +double invpoissondistribution(ae_int_t k, double y, ae_state *_state); +double psi(double x, ae_state *_state); +double studenttdistribution(ae_int_t k, double t, ae_state *_state); +double invstudenttdistribution(ae_int_t k, double p, ae_state *_state); +void sinecosineintegrals(double x, + double* si, + double* ci, + ae_state *_state); +void hyperbolicsinecosineintegrals(double x, + double* shi, + double* chi, + ae_state *_state); + +} +#endif + diff --git a/psdlag/src/statistics.cpp b/psdlag/src/statistics.cpp new file mode 100644 index 0000000..4f0ef4e --- /dev/null +++ b/psdlag/src/statistics.cpp @@ -0,0 +1,19718 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#include "stdafx.h" +#include "statistics.h" + +// disable some irrelevant warnings +#if (AE_COMPILER==AE_MSVC) +#pragma warning(disable:4100) +#pragma warning(disable:4127) +#pragma warning(disable:4702) +#pragma warning(disable:4996) +#endif +using namespace std; + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +Calculation of the distribution moments: mean, variance, skewness, kurtosis. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +OUTPUT PARAMETERS + Mean - mean. + Variance- variance. + Skewness- skewness (if variance<>0; zero otherwise). + Kurtosis- kurtosis (if variance<>0; zero otherwise). + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void samplemoments(const real_1d_array &x, const ae_int_t n, double &mean, double &variance, double &skewness, double &kurtosis) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::samplemoments(const_cast(x.c_ptr()), n, &mean, &variance, &skewness, &kurtosis, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the distribution moments: mean, variance, skewness, kurtosis. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +OUTPUT PARAMETERS + Mean - mean. + Variance- variance. + Skewness- skewness (if variance<>0; zero otherwise). + Kurtosis- kurtosis (if variance<>0; zero otherwise). + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void samplemoments(const real_1d_array &x, double &mean, double &variance, double &skewness, double &kurtosis) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::samplemoments(const_cast(x.c_ptr()), n, &mean, &variance, &skewness, &kurtosis, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the mean. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Mean' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplemean(const real_1d_array &x, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::samplemean(const_cast(x.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the mean. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Mean' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplemean(const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::samplemean(const_cast(x.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the variance. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Variance' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplevariance(const real_1d_array &x, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::samplevariance(const_cast(x.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the variance. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Variance' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplevariance(const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::samplevariance(const_cast(x.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the skewness. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Skewness' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double sampleskewness(const real_1d_array &x, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::sampleskewness(const_cast(x.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the skewness. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Skewness' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double sampleskewness(const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::sampleskewness(const_cast(x.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the kurtosis. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Kurtosis' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplekurtosis(const real_1d_array &x, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::samplekurtosis(const_cast(x.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Calculation of the kurtosis. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Kurtosis' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplekurtosis(const real_1d_array &x) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::samplekurtosis(const_cast(x.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +ADev + +Input parameters: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +Output parameters: + ADev- ADev + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void sampleadev(const real_1d_array &x, const ae_int_t n, double &adev) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sampleadev(const_cast(x.c_ptr()), n, &adev, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +ADev + +Input parameters: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +Output parameters: + ADev- ADev + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void sampleadev(const real_1d_array &x, double &adev) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::sampleadev(const_cast(x.c_ptr()), n, &adev, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Median calculation. + +Input parameters: + X - sample (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +Output parameters: + Median + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void samplemedian(const real_1d_array &x, const ae_int_t n, double &median) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::samplemedian(const_cast(x.c_ptr()), n, &median, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Median calculation. + +Input parameters: + X - sample (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +Output parameters: + Median + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void samplemedian(const real_1d_array &x, double &median) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::samplemedian(const_cast(x.c_ptr()), n, &median, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Percentile calculation. + +Input parameters: + X - sample (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + P - percentile (0<=P<=1) + +Output parameters: + V - percentile + + -- ALGLIB -- + Copyright 01.03.2008 by Bochkanov Sergey +*************************************************************************/ +void samplepercentile(const real_1d_array &x, const ae_int_t n, const double p, double &v) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::samplepercentile(const_cast(x.c_ptr()), n, p, &v, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Percentile calculation. + +Input parameters: + X - sample (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + P - percentile (0<=P<=1) + +Output parameters: + V - percentile + + -- ALGLIB -- + Copyright 01.03.2008 by Bochkanov Sergey +*************************************************************************/ +void samplepercentile(const real_1d_array &x, const double p, double &v) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::samplepercentile(const_cast(x.c_ptr()), n, p, &v, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +2-sample covariance + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + covariance (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +double cov2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::cov2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +2-sample covariance + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + covariance (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +double cov2(const real_1d_array &x, const real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'cov2': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::cov2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Pearson product-moment correlation coefficient + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + Pearson product-moment correlation coefficient + (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +double pearsoncorr2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::pearsoncorr2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Pearson product-moment correlation coefficient + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + Pearson product-moment correlation coefficient + (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +double pearsoncorr2(const real_1d_array &x, const real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'pearsoncorr2': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::pearsoncorr2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Spearman's rank correlation coefficient + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + Spearman's rank correlation coefficient + (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double spearmancorr2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spearmancorr2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Spearman's rank correlation coefficient + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + Spearman's rank correlation coefficient + (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double spearmancorr2(const real_1d_array &x, const real_1d_array &y) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + if( (x.length()!=y.length())) + throw ap_error("Error while calling 'spearmancorr2': looks like one of arguments has wrong size"); + n = x.length(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spearmancorr2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Covariance matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with covariance matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], covariance matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void covm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::covm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_covm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_covm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Covariance matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with covariance matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], covariance matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void covm(const real_2d_array &x, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + + n = x.rows(); + m = x.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::covm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_covm(const real_2d_array &x, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + + n = x.rows(); + m = x.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_covm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Pearson product-moment correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pearsoncorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_pearsoncorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_pearsoncorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Pearson product-moment correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrm(const real_2d_array &x, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + + n = x.rows(); + m = x.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pearsoncorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_pearsoncorrm(const real_2d_array &x, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + + n = x.rows(); + m = x.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_pearsoncorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Spearman's rank correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spearmancorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spearmancorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_spearmancorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_spearmancorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Spearman's rank correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spearmancorrm(const real_2d_array &x, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + + n = x.rows(); + m = x.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spearmancorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_spearmancorrm(const real_2d_array &x, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m; + + n = x.rows(); + m = x.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_spearmancorrm(const_cast(x.c_ptr()), n, m, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Cross-covariance matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with covariance matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-covariance matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void covm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::covm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_covm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_covm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Cross-covariance matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with covariance matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-covariance matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m1; + ae_int_t m2; + if( (x.rows()!=y.rows())) + throw ap_error("Error while calling 'covm2': looks like one of arguments has wrong size"); + n = x.rows(); + m1 = x.cols(); + m2 = y.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::covm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m1; + ae_int_t m2; + if( (x.rows()!=y.rows())) + throw ap_error("Error while calling 'covm2': looks like one of arguments has wrong size"); + n = x.rows(); + m1 = x.cols(); + m2 = y.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_covm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Pearson product-moment cross-correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pearsoncorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_pearsoncorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Pearson product-moment cross-correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m1; + ae_int_t m2; + if( (x.rows()!=y.rows())) + throw ap_error("Error while calling 'pearsoncorrm2': looks like one of arguments has wrong size"); + n = x.rows(); + m1 = x.cols(); + m2 = y.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pearsoncorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m1; + ae_int_t m2; + if( (x.rows()!=y.rows())) + throw ap_error("Error while calling 'pearsoncorrm2': looks like one of arguments has wrong size"); + n = x.rows(); + m1 = x.cols(); + m2 = y.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_pearsoncorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Spearman's rank cross-correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spearmancorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spearmancorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_spearmancorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_spearmancorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Spearman's rank cross-correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m1; + ae_int_t m2; + if( (x.rows()!=y.rows())) + throw ap_error("Error while calling 'spearmancorrm2': looks like one of arguments has wrong size"); + n = x.rows(); + m1 = x.cols(); + m2 = y.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spearmancorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t n; + ae_int_t m1; + ae_int_t m2; + if( (x.rows()!=y.rows())) + throw ap_error("Error while calling 'spearmancorrm2': looks like one of arguments has wrong size"); + n = x.rows(); + m1 = x.cols(); + m2 = y.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_spearmancorrm2(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, m1, m2, const_cast(c.c_ptr()), &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void rankdata(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rankdata(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_rankdata(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_rankdata(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void rankdata(real_2d_array &xy) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t npoints; + ae_int_t nfeatures; + + npoints = xy.rows(); + nfeatures = xy.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rankdata(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_rankdata(real_2d_array &xy) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t npoints; + ae_int_t nfeatures; + + npoints = xy.rows(); + nfeatures = xy.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_rankdata(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void rankdatacentered(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rankdatacentered(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_rankdatacentered(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_rankdatacentered(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* + +*************************************************************************/ +void rankdatacentered(real_2d_array &xy) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t npoints; + ae_int_t nfeatures; + + npoints = xy.rows(); + nfeatures = xy.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::rankdatacentered(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + + +void smp_rankdatacentered(real_2d_array &xy) +{ + alglib_impl::ae_state _alglib_env_state; + ae_int_t npoints; + ae_int_t nfeatures; + + npoints = xy.rows(); + nfeatures = xy.cols(); + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::_pexec_rankdatacentered(const_cast(xy.c_ptr()), npoints, nfeatures, &_alglib_env_state); + + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete function, we recommend to use PearsonCorr2(). + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double pearsoncorrelation(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::pearsoncorrelation(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Obsolete function, we recommend to use SpearmanCorr2(). + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double spearmanrankcorrelation(const real_1d_array &x, const real_1d_array &y, const ae_int_t n) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + double result = alglib_impl::spearmanrankcorrelation(const_cast(x.c_ptr()), const_cast(y.c_ptr()), n, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return *(reinterpret_cast(&result)); + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Pearson's correlation coefficient significance test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions having zero correlation or whether their +correlation is non-zero. + +The following tests are performed: + * two-tailed test (null hypothesis - X and Y have zero correlation) + * left-tailed test (null hypothesis - the correlation coefficient is + greater than or equal to 0) + * right-tailed test (null hypothesis - the correlation coefficient is + less than or equal to 0). + +Requirements: + * the number of elements in each sample is not less than 5 + * normality of distributions of X and Y. + +Input parameters: + R - Pearson's correlation coefficient for X and Y + N - number of elements in samples, N>=5. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrelationsignificance(const double r, const ae_int_t n, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::pearsoncorrelationsignificance(r, n, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Spearman's rank correlation coefficient significance test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions having zero correlation or whether their +correlation is non-zero. + +The following tests are performed: + * two-tailed test (null hypothesis - X and Y have zero correlation) + * left-tailed test (null hypothesis - the correlation coefficient is + greater than or equal to 0) + * right-tailed test (null hypothesis - the correlation coefficient is + less than or equal to 0). + +Requirements: + * the number of elements in each sample is not less than 5. + +The test is non-parametric and doesn't require distributions X and Y to be +normal. + +Input parameters: + R - Spearman's rank correlation coefficient for X and Y + N - number of elements in samples, N>=5. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void spearmanrankcorrelationsignificance(const double r, const ae_int_t n, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::spearmanrankcorrelationsignificance(r, n, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Jarque-Bera test + +This test checks hypotheses about the fact that a given sample X is a +sample of normal random variable. + +Requirements: + * the number of elements in the sample is not less than 5. + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. N>=5 + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +Accuracy of the approximation used (5<=N<=1951): + +p-value relative error (5<=N<=1951) +[1, 0.1] < 1% +[0.1, 0.01] < 2% +[0.01, 0.001] < 6% +[0.001, 0] wasn't measured + +For N>1951 accuracy wasn't measured but it shouldn't be sharply different +from table values. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void jarqueberatest(const real_1d_array &x, const ae_int_t n, double &p) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::jarqueberatest(const_cast(x.c_ptr()), n, &p, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Mann-Whitney U-test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions of the same shape and same median or whether +their medians are different. + +The following tests are performed: + * two-tailed test (null hypothesis - the medians are equal) + * left-tailed test (null hypothesis - the median of the first sample + is greater than or equal to the median of the second sample) + * right-tailed test (null hypothesis - the median of the first sample + is less than or equal to the median of the second sample). + +Requirements: + * the samples are independent + * X and Y are continuous distributions (or discrete distributions well- + approximating continuous distributions) + * distributions of X and Y have the same shape. The only possible + difference is their position (i.e. the value of the median) + * the number of elements in each sample is not less than 5 + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + +The test is non-parametric and doesn't require distributions to be normal. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. N>=5 + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of the sample. M>=5 + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +To calculate p-values, special approximation is used. This method lets us +calculate p-values with satisfactory accuracy in interval [0.0001, 1]. +There is no approximation outside the [0.0001, 1] interval. Therefore, if +the significance level outlies this interval, the test returns 0.0001. + +Relative precision of approximation of p-value: + +N M Max.err. Rms.err. +5..10 N..10 1.4e-02 6.0e-04 +5..10 N..100 2.2e-02 5.3e-06 +10..15 N..15 1.0e-02 3.2e-04 +10..15 N..100 1.0e-02 2.2e-05 +15..100 N..100 6.1e-03 2.7e-06 + +For N,M>100 accuracy checks weren't put into practice, but taking into +account characteristics of asymptotic approximation used, precision should +not be sharply different from the values for interval [5, 100]. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void mannwhitneyutest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::mannwhitneyutest(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Sign test + +This test checks three hypotheses about the median of the given sample. +The following tests are performed: + * two-tailed test (null hypothesis - the median is equal to the given + value) + * left-tailed test (null hypothesis - the median is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the median is less than or + equal to the given value) + +Requirements: + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + +The test is non-parametric and doesn't require distribution X to be normal + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. + Median - assumed median value. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +While calculating p-values high-precision binomial distribution +approximation is used, so significance levels have about 15 exact digits. + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void onesamplesigntest(const real_1d_array &x, const ae_int_t n, const double median, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::onesamplesigntest(const_cast(x.c_ptr()), n, median, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +One-sample t-test + +This test checks three hypotheses about the mean of the given sample. The +following tests are performed: + * two-tailed test (null hypothesis - the mean is equal to the given + value) + * left-tailed test (null hypothesis - the mean is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the mean is less than or equal + to the given value). + +The test is based on the assumption that a given sample has a normal +distribution and an unknown dispersion. If the distribution sharply +differs from normal, the test will work incorrectly. + +INPUT PARAMETERS: + X - sample. Array whose index goes from 0 to N-1. + N - size of sample, N>=0 + Mean - assumed value of the mean. + +OUTPUT PARAMETERS: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0, all p-values are set to 1.0 + * when variance of X[] is exactly zero, p-values are set + to 1.0 or 0.0, depending on difference between sample mean and + value of mean being tested. + + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void studentttest1(const real_1d_array &x, const ae_int_t n, const double mean, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::studentttest1(const_cast(x.c_ptr()), n, mean, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Two-sample pooled test + +This test checks three hypotheses about the mean of the given samples. The +following tests are performed: + * two-tailed test (null hypothesis - the means are equal) + * left-tailed test (null hypothesis - the mean of the first sample is + greater than or equal to the mean of the second sample) + * right-tailed test (null hypothesis - the mean of the first sample is + less than or equal to the mean of the second sample). + +Test is based on the following assumptions: + * given samples have normal distributions + * dispersions are equal + * samples are independent. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of sample. + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of sample. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0 or M=0, all p-values are set to 1.0 + * when both samples has exactly zero variance, p-values are set + to 1.0 or 0.0, depending on difference between means. + + -- ALGLIB -- + Copyright 18.09.2006 by Bochkanov Sergey +*************************************************************************/ +void studentttest2(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::studentttest2(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Two-sample unpooled test + +This test checks three hypotheses about the mean of the given samples. The +following tests are performed: + * two-tailed test (null hypothesis - the means are equal) + * left-tailed test (null hypothesis - the mean of the first sample is + greater than or equal to the mean of the second sample) + * right-tailed test (null hypothesis - the mean of the first sample is + less than or equal to the mean of the second sample). + +Test is based on the following assumptions: + * given samples have normal distributions + * samples are independent. +Equality of variances is NOT required. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of the sample. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0 or M=0, all p-values are set to 1.0 + * when both samples has zero variance, p-values are set + to 1.0 or 0.0, depending on difference between means. + * when only one sample has zero variance, test reduces to 1-sample + version. + + -- ALGLIB -- + Copyright 18.09.2006 by Bochkanov Sergey +*************************************************************************/ +void unequalvariancettest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::unequalvariancettest(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Two-sample F-test + +This test checks three hypotheses about dispersions of the given samples. +The following tests are performed: + * two-tailed test (null hypothesis - the dispersions are equal) + * left-tailed test (null hypothesis - the dispersion of the first + sample is greater than or equal to the dispersion of the second + sample). + * right-tailed test (null hypothesis - the dispersion of the first + sample is less than or equal to the dispersion of the second sample) + +The test is based on the following assumptions: + * the given samples have normal distributions + * the samples are independent. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - sample size. + Y - sample 2. Array whose index goes from 0 to M-1. + M - sample size. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 19.09.2006 by Bochkanov Sergey +*************************************************************************/ +void ftest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::ftest(const_cast(x.c_ptr()), n, const_cast(y.c_ptr()), m, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +One-sample chi-square test + +This test checks three hypotheses about the dispersion of the given sample +The following tests are performed: + * two-tailed test (null hypothesis - the dispersion equals the given + number) + * left-tailed test (null hypothesis - the dispersion is greater than + or equal to the given number) + * right-tailed test (null hypothesis - dispersion is less than or + equal to the given number). + +Test is based on the following assumptions: + * the given sample has a normal distribution. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. + Variance - dispersion value to compare with. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 19.09.2006 by Bochkanov Sergey +*************************************************************************/ +void onesamplevariancetest(const real_1d_array &x, const ae_int_t n, const double variance, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::onesamplevariancetest(const_cast(x.c_ptr()), n, variance, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} + +/************************************************************************* +Wilcoxon signed-rank test + +This test checks three hypotheses about the median of the given sample. +The following tests are performed: + * two-tailed test (null hypothesis - the median is equal to the given + value) + * left-tailed test (null hypothesis - the median is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the median is less than or + equal to the given value) + +Requirements: + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + * the distribution should be continuous and symmetric relative to its + median. + * number of distinct values in the X array should be greater than 4 + +The test is non-parametric and doesn't require distribution X to be normal + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. + Median - assumed median value. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +To calculate p-values, special approximation is used. This method lets us +calculate p-values with two decimal places in interval [0.0001, 1]. + +"Two decimal places" does not sound very impressive, but in practice the +relative error of less than 1% is enough to make a decision. + +There is no approximation outside the [0.0001, 1] interval. Therefore, if +the significance level outlies this interval, the test returns 0.0001. + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void wilcoxonsignedranktest(const real_1d_array &x, const ae_int_t n, const double e, double &bothtails, double &lefttail, double &righttail) +{ + alglib_impl::ae_state _alglib_env_state; + alglib_impl::ae_state_init(&_alglib_env_state); + try + { + alglib_impl::wilcoxonsignedranktest(const_cast(x.c_ptr()), n, e, &bothtails, &lefttail, &righttail, &_alglib_env_state); + alglib_impl::ae_state_clear(&_alglib_env_state); + return; + } + catch(alglib_impl::ae_error_type) + { + throw ap_error(_alglib_env_state.error_msg); + } +} +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS IMPLEMENTATION OF COMPUTATIONAL CORE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +static void basestat_rankdatarec(/* Real */ ae_matrix* xy, + ae_int_t i0, + ae_int_t i1, + ae_int_t nfeatures, + ae_bool iscentered, + ae_shared_pool* pool, + ae_int_t basecasecost, + ae_state *_state); +static void basestat_rankdatabasecase(/* Real */ ae_matrix* xy, + ae_int_t i0, + ae_int_t i1, + ae_int_t nfeatures, + ae_bool iscentered, + apbuffers* buf0, + apbuffers* buf1, + ae_state *_state); + + +static double correlationtests_spearmantail5(double s, ae_state *_state); +static double correlationtests_spearmantail6(double s, ae_state *_state); +static double correlationtests_spearmantail7(double s, ae_state *_state); +static double correlationtests_spearmantail8(double s, ae_state *_state); +static double correlationtests_spearmantail9(double s, ae_state *_state); +static double correlationtests_spearmantail(double t, + ae_int_t n, + ae_state *_state); + + +static void jarquebera_jarqueberastatistic(/* Real */ ae_vector* x, + ae_int_t n, + double* s, + ae_state *_state); +static double jarquebera_jarqueberaapprox(ae_int_t n, + double s, + ae_state *_state); +static double jarquebera_jbtbl5(double s, ae_state *_state); +static double jarquebera_jbtbl6(double s, ae_state *_state); +static double jarquebera_jbtbl7(double s, ae_state *_state); +static double jarquebera_jbtbl8(double s, ae_state *_state); +static double jarquebera_jbtbl9(double s, ae_state *_state); +static double jarquebera_jbtbl10(double s, ae_state *_state); +static double jarquebera_jbtbl11(double s, ae_state *_state); +static double jarquebera_jbtbl12(double s, ae_state *_state); +static double jarquebera_jbtbl13(double s, ae_state *_state); +static double jarquebera_jbtbl14(double s, ae_state *_state); +static double jarquebera_jbtbl15(double s, ae_state *_state); +static double jarquebera_jbtbl16(double s, ae_state *_state); +static double jarquebera_jbtbl17(double s, ae_state *_state); +static double jarquebera_jbtbl18(double s, ae_state *_state); +static double jarquebera_jbtbl19(double s, ae_state *_state); +static double jarquebera_jbtbl20(double s, ae_state *_state); +static double jarquebera_jbtbl30(double s, ae_state *_state); +static double jarquebera_jbtbl50(double s, ae_state *_state); +static double jarquebera_jbtbl65(double s, ae_state *_state); +static double jarquebera_jbtbl100(double s, ae_state *_state); +static double jarquebera_jbtbl130(double s, ae_state *_state); +static double jarquebera_jbtbl200(double s, ae_state *_state); +static double jarquebera_jbtbl301(double s, ae_state *_state); +static double jarquebera_jbtbl501(double s, ae_state *_state); +static double jarquebera_jbtbl701(double s, ae_state *_state); +static double jarquebera_jbtbl1401(double s, ae_state *_state); +static void jarquebera_jbcheb(double x, + double c, + double* tj, + double* tj1, + double* r, + ae_state *_state); + + +static void mannwhitneyu_ucheb(double x, + double c, + double* tj, + double* tj1, + double* r, + ae_state *_state); +static double mannwhitneyu_uninterpolate(double p1, + double p2, + double p3, + ae_int_t n, + ae_state *_state); +static double mannwhitneyu_usigma000(ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static double mannwhitneyu_usigma075(ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static double mannwhitneyu_usigma150(ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static double mannwhitneyu_usigma225(ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static double mannwhitneyu_usigma300(ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static double mannwhitneyu_usigma333(ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static double mannwhitneyu_usigma367(ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static double mannwhitneyu_usigma400(ae_int_t n1, + ae_int_t n2, + ae_state *_state); +static double mannwhitneyu_utbln5n5(double s, ae_state *_state); +static double mannwhitneyu_utbln5n6(double s, ae_state *_state); +static double mannwhitneyu_utbln5n7(double s, ae_state *_state); +static double mannwhitneyu_utbln5n8(double s, ae_state *_state); +static double mannwhitneyu_utbln5n9(double s, ae_state *_state); +static double mannwhitneyu_utbln5n10(double s, ae_state *_state); +static double mannwhitneyu_utbln5n11(double s, ae_state *_state); +static double mannwhitneyu_utbln5n12(double s, ae_state *_state); +static double mannwhitneyu_utbln5n13(double s, ae_state *_state); +static double mannwhitneyu_utbln5n14(double s, ae_state *_state); +static double mannwhitneyu_utbln5n15(double s, ae_state *_state); +static double mannwhitneyu_utbln5n16(double s, ae_state *_state); +static double mannwhitneyu_utbln5n17(double s, ae_state *_state); +static double mannwhitneyu_utbln5n18(double s, ae_state *_state); +static double mannwhitneyu_utbln5n19(double s, ae_state *_state); +static double mannwhitneyu_utbln5n20(double s, ae_state *_state); +static double mannwhitneyu_utbln5n21(double s, ae_state *_state); +static double mannwhitneyu_utbln5n22(double s, ae_state *_state); +static double mannwhitneyu_utbln5n23(double s, ae_state *_state); +static double mannwhitneyu_utbln5n24(double s, ae_state *_state); +static double mannwhitneyu_utbln5n25(double s, ae_state *_state); +static double mannwhitneyu_utbln5n26(double s, ae_state *_state); +static double mannwhitneyu_utbln5n27(double s, ae_state *_state); +static double mannwhitneyu_utbln5n28(double s, ae_state *_state); +static double mannwhitneyu_utbln5n29(double s, ae_state *_state); +static double mannwhitneyu_utbln5n30(double s, ae_state *_state); +static double mannwhitneyu_utbln5n100(double s, ae_state *_state); +static double mannwhitneyu_utbln6n6(double s, ae_state *_state); +static double mannwhitneyu_utbln6n7(double s, ae_state *_state); +static double mannwhitneyu_utbln6n8(double s, ae_state *_state); +static double mannwhitneyu_utbln6n9(double s, ae_state *_state); +static double mannwhitneyu_utbln6n10(double s, ae_state *_state); +static double mannwhitneyu_utbln6n11(double s, ae_state *_state); +static double mannwhitneyu_utbln6n12(double s, ae_state *_state); +static double mannwhitneyu_utbln6n13(double s, ae_state *_state); +static double mannwhitneyu_utbln6n14(double s, ae_state *_state); +static double mannwhitneyu_utbln6n15(double s, ae_state *_state); +static double mannwhitneyu_utbln6n30(double s, ae_state *_state); +static double mannwhitneyu_utbln6n100(double s, ae_state *_state); +static double mannwhitneyu_utbln7n7(double s, ae_state *_state); +static double mannwhitneyu_utbln7n8(double s, ae_state *_state); +static double mannwhitneyu_utbln7n9(double s, ae_state *_state); +static double mannwhitneyu_utbln7n10(double s, ae_state *_state); +static double mannwhitneyu_utbln7n11(double s, ae_state *_state); +static double mannwhitneyu_utbln7n12(double s, ae_state *_state); +static double mannwhitneyu_utbln7n13(double s, ae_state *_state); +static double mannwhitneyu_utbln7n14(double s, ae_state *_state); +static double mannwhitneyu_utbln7n15(double s, ae_state *_state); +static double mannwhitneyu_utbln7n30(double s, ae_state *_state); +static double mannwhitneyu_utbln7n100(double s, ae_state *_state); +static double mannwhitneyu_utbln8n8(double s, ae_state *_state); +static double mannwhitneyu_utbln8n9(double s, ae_state *_state); +static double mannwhitneyu_utbln8n10(double s, ae_state *_state); +static double mannwhitneyu_utbln8n11(double s, ae_state *_state); +static double mannwhitneyu_utbln8n12(double s, ae_state *_state); +static double mannwhitneyu_utbln8n13(double s, ae_state *_state); +static double mannwhitneyu_utbln8n14(double s, ae_state *_state); +static double mannwhitneyu_utbln8n15(double s, ae_state *_state); +static double mannwhitneyu_utbln8n30(double s, ae_state *_state); +static double mannwhitneyu_utbln8n100(double s, ae_state *_state); +static double mannwhitneyu_utbln9n9(double s, ae_state *_state); +static double mannwhitneyu_utbln9n10(double s, ae_state *_state); +static double mannwhitneyu_utbln9n11(double s, ae_state *_state); +static double mannwhitneyu_utbln9n12(double s, ae_state *_state); +static double mannwhitneyu_utbln9n13(double s, ae_state *_state); +static double mannwhitneyu_utbln9n14(double s, ae_state *_state); +static double mannwhitneyu_utbln9n15(double s, ae_state *_state); +static double mannwhitneyu_utbln9n30(double s, ae_state *_state); +static double mannwhitneyu_utbln9n100(double s, ae_state *_state); +static double mannwhitneyu_utbln10n10(double s, ae_state *_state); +static double mannwhitneyu_utbln10n11(double s, ae_state *_state); +static double mannwhitneyu_utbln10n12(double s, ae_state *_state); +static double mannwhitneyu_utbln10n13(double s, ae_state *_state); +static double mannwhitneyu_utbln10n14(double s, ae_state *_state); +static double mannwhitneyu_utbln10n15(double s, ae_state *_state); +static double mannwhitneyu_utbln10n30(double s, ae_state *_state); +static double mannwhitneyu_utbln10n100(double s, ae_state *_state); +static double mannwhitneyu_utbln11n11(double s, ae_state *_state); +static double mannwhitneyu_utbln11n12(double s, ae_state *_state); +static double mannwhitneyu_utbln11n13(double s, ae_state *_state); +static double mannwhitneyu_utbln11n14(double s, ae_state *_state); +static double mannwhitneyu_utbln11n15(double s, ae_state *_state); +static double mannwhitneyu_utbln11n30(double s, ae_state *_state); +static double mannwhitneyu_utbln11n100(double s, ae_state *_state); +static double mannwhitneyu_utbln12n12(double s, ae_state *_state); +static double mannwhitneyu_utbln12n13(double s, ae_state *_state); +static double mannwhitneyu_utbln12n14(double s, ae_state *_state); +static double mannwhitneyu_utbln12n15(double s, ae_state *_state); +static double mannwhitneyu_utbln12n30(double s, ae_state *_state); +static double mannwhitneyu_utbln12n100(double s, ae_state *_state); +static double mannwhitneyu_utbln13n13(double s, ae_state *_state); +static double mannwhitneyu_utbln13n14(double s, ae_state *_state); +static double mannwhitneyu_utbln13n15(double s, ae_state *_state); +static double mannwhitneyu_utbln13n30(double s, ae_state *_state); +static double mannwhitneyu_utbln13n100(double s, ae_state *_state); +static double mannwhitneyu_utbln14n14(double s, ae_state *_state); +static double mannwhitneyu_utbln14n15(double s, ae_state *_state); +static double mannwhitneyu_utbln14n30(double s, ae_state *_state); +static double mannwhitneyu_utbln14n100(double s, ae_state *_state); +static double mannwhitneyu_usigma(double s, + ae_int_t n1, + ae_int_t n2, + ae_state *_state); + + + + + + + + +static void wsr_wcheb(double x, + double c, + double* tj, + double* tj1, + double* r, + ae_state *_state); +static double wsr_w5(double s, ae_state *_state); +static double wsr_w6(double s, ae_state *_state); +static double wsr_w7(double s, ae_state *_state); +static double wsr_w8(double s, ae_state *_state); +static double wsr_w9(double s, ae_state *_state); +static double wsr_w10(double s, ae_state *_state); +static double wsr_w11(double s, ae_state *_state); +static double wsr_w12(double s, ae_state *_state); +static double wsr_w13(double s, ae_state *_state); +static double wsr_w14(double s, ae_state *_state); +static double wsr_w15(double s, ae_state *_state); +static double wsr_w16(double s, ae_state *_state); +static double wsr_w17(double s, ae_state *_state); +static double wsr_w18(double s, ae_state *_state); +static double wsr_w19(double s, ae_state *_state); +static double wsr_w20(double s, ae_state *_state); +static double wsr_w21(double s, ae_state *_state); +static double wsr_w22(double s, ae_state *_state); +static double wsr_w23(double s, ae_state *_state); +static double wsr_w24(double s, ae_state *_state); +static double wsr_w25(double s, ae_state *_state); +static double wsr_w26(double s, ae_state *_state); +static double wsr_w27(double s, ae_state *_state); +static double wsr_w28(double s, ae_state *_state); +static double wsr_w29(double s, ae_state *_state); +static double wsr_w30(double s, ae_state *_state); +static double wsr_w40(double s, ae_state *_state); +static double wsr_w60(double s, ae_state *_state); +static double wsr_w120(double s, ae_state *_state); +static double wsr_w200(double s, ae_state *_state); +static double wsr_wsigma(double s, ae_int_t n, ae_state *_state); + + + + + +/************************************************************************* +Calculation of the distribution moments: mean, variance, skewness, kurtosis. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +OUTPUT PARAMETERS + Mean - mean. + Variance- variance. + Skewness- skewness (if variance<>0; zero otherwise). + Kurtosis- kurtosis (if variance<>0; zero otherwise). + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void samplemoments(/* Real */ ae_vector* x, + ae_int_t n, + double* mean, + double* variance, + double* skewness, + double* kurtosis, + ae_state *_state) +{ + ae_int_t i; + double v; + double v1; + double v2; + double stddev; + + *mean = 0; + *variance = 0; + *skewness = 0; + *kurtosis = 0; + + ae_assert(n>=0, "SampleMoments: N<0", _state); + ae_assert(x->cnt>=n, "SampleMoments: Length(X)ptr.p_double[i]; + } + *mean = *mean/n; + + /* + * Variance (using corrected two-pass algorithm) + */ + if( n!=1 ) + { + v1 = 0; + for(i=0; i<=n-1; i++) + { + v1 = v1+ae_sqr(x->ptr.p_double[i]-(*mean), _state); + } + v2 = 0; + for(i=0; i<=n-1; i++) + { + v2 = v2+(x->ptr.p_double[i]-(*mean)); + } + v2 = ae_sqr(v2, _state)/n; + *variance = (v1-v2)/(n-1); + if( ae_fp_less(*variance,0) ) + { + *variance = 0; + } + stddev = ae_sqrt(*variance, _state); + } + + /* + * Skewness and kurtosis + */ + if( ae_fp_neq(stddev,0) ) + { + for(i=0; i<=n-1; i++) + { + v = (x->ptr.p_double[i]-(*mean))/stddev; + v2 = ae_sqr(v, _state); + *skewness = *skewness+v2*v; + *kurtosis = *kurtosis+ae_sqr(v2, _state); + } + *skewness = *skewness/n; + *kurtosis = *kurtosis/n-3; + } +} + + +/************************************************************************* +Calculation of the mean. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Mean' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplemean(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + double mean; + double tmp0; + double tmp1; + double tmp2; + double result; + + + samplemoments(x, n, &mean, &tmp0, &tmp1, &tmp2, _state); + result = mean; + return result; +} + + +/************************************************************************* +Calculation of the variance. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Variance' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplevariance(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + double variance; + double tmp0; + double tmp1; + double tmp2; + double result; + + + samplemoments(x, n, &tmp0, &variance, &tmp1, &tmp2, _state); + result = variance; + return result; +} + + +/************************************************************************* +Calculation of the skewness. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Skewness' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double sampleskewness(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + double skewness; + double tmp0; + double tmp1; + double tmp2; + double result; + + + samplemoments(x, n, &tmp0, &tmp1, &skewness, &tmp2, _state); + result = skewness; + return result; +} + + +/************************************************************************* +Calculation of the kurtosis. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Kurtosis' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplekurtosis(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state) +{ + double kurtosis; + double tmp0; + double tmp1; + double tmp2; + double result; + + + samplemoments(x, n, &tmp0, &tmp1, &tmp2, &kurtosis, _state); + result = kurtosis; + return result; +} + + +/************************************************************************* +ADev + +Input parameters: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +Output parameters: + ADev- ADev + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void sampleadev(/* Real */ ae_vector* x, + ae_int_t n, + double* adev, + ae_state *_state) +{ + ae_int_t i; + double mean; + + *adev = 0; + + ae_assert(n>=0, "SampleADev: N<0", _state); + ae_assert(x->cnt>=n, "SampleADev: Length(X)ptr.p_double[i]; + } + mean = mean/n; + + /* + * ADev + */ + for(i=0; i<=n-1; i++) + { + *adev = *adev+ae_fabs(x->ptr.p_double[i]-mean, _state); + } + *adev = *adev/n; +} + + +/************************************************************************* +Median calculation. + +Input parameters: + X - sample (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +Output parameters: + Median + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void samplemedian(/* Real */ ae_vector* x, + ae_int_t n, + double* median, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_int_t i; + ae_int_t ir; + ae_int_t j; + ae_int_t l; + ae_int_t midp; + ae_int_t k; + double a; + double tval; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + *median = 0; + + ae_assert(n>=0, "SampleMedian: N<0", _state); + ae_assert(x->cnt>=n, "SampleMedian: Length(X)ptr.p_double[0]; + ae_frame_leave(_state); + return; + } + if( n==2 ) + { + *median = 0.5*(x->ptr.p_double[0]+x->ptr.p_double[1]); + ae_frame_leave(_state); + return; + } + + /* + * Common case, N>=3. + * Choose X[(N-1)/2] + */ + l = 0; + ir = n-1; + k = (n-1)/2; + for(;;) + { + if( ir<=l+1 ) + { + + /* + * 1 or 2 elements in partition + */ + if( ir==l+1&&ae_fp_less(x->ptr.p_double[ir],x->ptr.p_double[l]) ) + { + tval = x->ptr.p_double[l]; + x->ptr.p_double[l] = x->ptr.p_double[ir]; + x->ptr.p_double[ir] = tval; + } + break; + } + else + { + midp = (l+ir)/2; + tval = x->ptr.p_double[midp]; + x->ptr.p_double[midp] = x->ptr.p_double[l+1]; + x->ptr.p_double[l+1] = tval; + if( ae_fp_greater(x->ptr.p_double[l],x->ptr.p_double[ir]) ) + { + tval = x->ptr.p_double[l]; + x->ptr.p_double[l] = x->ptr.p_double[ir]; + x->ptr.p_double[ir] = tval; + } + if( ae_fp_greater(x->ptr.p_double[l+1],x->ptr.p_double[ir]) ) + { + tval = x->ptr.p_double[l+1]; + x->ptr.p_double[l+1] = x->ptr.p_double[ir]; + x->ptr.p_double[ir] = tval; + } + if( ae_fp_greater(x->ptr.p_double[l],x->ptr.p_double[l+1]) ) + { + tval = x->ptr.p_double[l]; + x->ptr.p_double[l] = x->ptr.p_double[l+1]; + x->ptr.p_double[l+1] = tval; + } + i = l+1; + j = ir; + a = x->ptr.p_double[l+1]; + for(;;) + { + do + { + i = i+1; + } + while(ae_fp_less(x->ptr.p_double[i],a)); + do + { + j = j-1; + } + while(ae_fp_greater(x->ptr.p_double[j],a)); + if( jptr.p_double[i]; + x->ptr.p_double[i] = x->ptr.p_double[j]; + x->ptr.p_double[j] = tval; + } + x->ptr.p_double[l+1] = x->ptr.p_double[j]; + x->ptr.p_double[j] = a; + if( j>=k ) + { + ir = j-1; + } + if( j<=k ) + { + l = i; + } + } + } + + /* + * If N is odd, return result + */ + if( n%2==1 ) + { + *median = x->ptr.p_double[k]; + ae_frame_leave(_state); + return; + } + a = x->ptr.p_double[n-1]; + for(i=k+1; i<=n-1; i++) + { + if( ae_fp_less(x->ptr.p_double[i],a) ) + { + a = x->ptr.p_double[i]; + } + } + *median = 0.5*(x->ptr.p_double[k]+a); + ae_frame_leave(_state); +} + + +/************************************************************************* +Percentile calculation. + +Input parameters: + X - sample (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + P - percentile (0<=P<=1) + +Output parameters: + V - percentile + + -- ALGLIB -- + Copyright 01.03.2008 by Bochkanov Sergey +*************************************************************************/ +void samplepercentile(/* Real */ ae_vector* x, + ae_int_t n, + double p, + double* v, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_int_t i1; + double t; + ae_vector rbuf; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + *v = 0; + ae_vector_init(&rbuf, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=0, "SamplePercentile: N<0", _state); + ae_assert(x->cnt>=n, "SamplePercentile: Length(X)ptr.p_double[0]; + ae_frame_leave(_state); + return; + } + if( ae_fp_eq(p,1) ) + { + *v = x->ptr.p_double[n-1]; + ae_frame_leave(_state); + return; + } + t = p*(n-1); + i1 = ae_ifloor(t, _state); + t = t-ae_ifloor(t, _state); + *v = x->ptr.p_double[i1]*(1-t)+x->ptr.p_double[i1+1]*t; + ae_frame_leave(_state); +} + + +/************************************************************************* +2-sample covariance + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + covariance (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +double cov2(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + double xmean; + double ymean; + double v; + double x0; + double y0; + double s; + ae_bool samex; + ae_bool samey; + double result; + + + ae_assert(n>=0, "Cov2: N<0", _state); + ae_assert(x->cnt>=n, "Cov2: Length(X)cnt>=n, "Cov2: Length(Y)ptr.p_double[0]; + y0 = y->ptr.p_double[0]; + v = (double)1/(double)n; + for(i=0; i<=n-1; i++) + { + s = x->ptr.p_double[i]; + samex = samex&&ae_fp_eq(s,x0); + xmean = xmean+s*v; + s = y->ptr.p_double[i]; + samey = samey&&ae_fp_eq(s,y0); + ymean = ymean+s*v; + } + if( samex||samey ) + { + result = 0; + return result; + } + + /* + * covariance + */ + v = (double)1/(double)(n-1); + result = 0; + for(i=0; i<=n-1; i++) + { + result = result+v*(x->ptr.p_double[i]-xmean)*(y->ptr.p_double[i]-ymean); + } + return result; +} + + +/************************************************************************* +Pearson product-moment correlation coefficient + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + Pearson product-moment correlation coefficient + (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +double pearsoncorr2(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state) +{ + ae_int_t i; + double xmean; + double ymean; + double v; + double x0; + double y0; + double s; + ae_bool samex; + ae_bool samey; + double xv; + double yv; + double t1; + double t2; + double result; + + + ae_assert(n>=0, "PearsonCorr2: N<0", _state); + ae_assert(x->cnt>=n, "PearsonCorr2: Length(X)cnt>=n, "PearsonCorr2: Length(Y)ptr.p_double[0]; + y0 = y->ptr.p_double[0]; + v = (double)1/(double)n; + for(i=0; i<=n-1; i++) + { + s = x->ptr.p_double[i]; + samex = samex&&ae_fp_eq(s,x0); + xmean = xmean+s*v; + s = y->ptr.p_double[i]; + samey = samey&&ae_fp_eq(s,y0); + ymean = ymean+s*v; + } + if( samex||samey ) + { + result = 0; + return result; + } + + /* + * numerator and denominator + */ + s = 0; + xv = 0; + yv = 0; + for(i=0; i<=n-1; i++) + { + t1 = x->ptr.p_double[i]-xmean; + t2 = y->ptr.p_double[i]-ymean; + xv = xv+ae_sqr(t1, _state); + yv = yv+ae_sqr(t2, _state); + s = s+t1*t2; + } + if( ae_fp_eq(xv,0)||ae_fp_eq(yv,0) ) + { + result = 0; + } + else + { + result = s/(ae_sqrt(xv, _state)*ae_sqrt(yv, _state)); + } + return result; +} + + +/************************************************************************* +Spearman's rank correlation coefficient + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + Spearman's rank correlation coefficient + (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double spearmancorr2(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_vector _y; + apbuffers buf; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_vector_init_copy(&_y, y, _state, ae_true); + y = &_y; + _apbuffers_init(&buf, _state, ae_true); + + ae_assert(n>=0, "SpearmanCorr2: N<0", _state); + ae_assert(x->cnt>=n, "SpearmanCorr2: Length(X)cnt>=n, "SpearmanCorr2: Length(Y)=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], covariance matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void covm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _x; + ae_int_t i; + ae_int_t j; + double v; + ae_vector t; + ae_vector x0; + ae_vector same; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_matrix_clear(c); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&same, 0, DT_BOOL, _state, ae_true); + + ae_assert(n>=0, "CovM: N<0", _state); + ae_assert(m>=1, "CovM: M<1", _state); + ae_assert(x->rows>=n, "CovM: Rows(X)cols>=m||n==0, "CovM: Cols(X)ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return; + } + + /* + * Calculate means, + * check for constant columns + */ + ae_vector_set_length(&t, m, _state); + ae_vector_set_length(&x0, m, _state); + ae_vector_set_length(&same, m, _state); + ae_matrix_set_length(c, m, m, _state); + for(i=0; i<=m-1; i++) + { + t.ptr.p_double[i] = 0; + same.ptr.p_bool[i] = ae_true; + } + ae_v_move(&x0.ptr.p_double[0], 1, &x->ptr.pp_double[0][0], 1, ae_v_len(0,m-1)); + v = (double)1/(double)n; + for(i=0; i<=n-1; i++) + { + ae_v_addd(&t.ptr.p_double[0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m-1), v); + for(j=0; j<=m-1; j++) + { + same.ptr.p_bool[j] = same.ptr.p_bool[j]&&ae_fp_eq(x->ptr.pp_double[i][j],x0.ptr.p_double[j]); + } + } + + /* + * * center variables; + * * if we have constant columns, these columns are + * artificially zeroed (they must be zero in exact arithmetics, + * but unfortunately floating point ops are not exact). + * * calculate upper half of symmetric covariance matrix + */ + for(i=0; i<=n-1; i++) + { + ae_v_sub(&x->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m-1)); + for(j=0; j<=m-1; j++) + { + if( same.ptr.p_bool[j] ) + { + x->ptr.pp_double[i][j] = 0; + } + } + } + rmatrixsyrk(m, n, (double)1/(double)(n-1), x, 0, 0, 1, 0.0, c, 0, 0, ae_true, _state); + rmatrixenforcesymmetricity(c, m, ae_true, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_covm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, ae_state *_state) +{ + covm(x,n,m,c, _state); +} + + +/************************************************************************* +Pearson product-moment correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector t; + ae_int_t i; + ae_int_t j; + double v; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(c); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=0, "PearsonCorrM: N<0", _state); + ae_assert(m>=1, "PearsonCorrM: M<1", _state); + ae_assert(x->rows>=n, "PearsonCorrM: Rows(X)cols>=m||n==0, "PearsonCorrM: Cols(X)ptr.pp_double[i][i],0) ) + { + t.ptr.p_double[i] = 1/ae_sqrt(c->ptr.pp_double[i][i], _state); + } + else + { + t.ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=m-1; i++) + { + v = t.ptr.p_double[i]; + for(j=0; j<=m-1; j++) + { + c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]*v*t.ptr.p_double[j]; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_pearsoncorrm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, ae_state *_state) +{ + pearsoncorrm(x,n,m,c, _state); +} + + +/************************************************************************* +Spearman's rank correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spearmancorrm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + apbuffers buf; + ae_matrix xc; + ae_vector t; + double v; + double vv; + double x0; + ae_bool b; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(c); + _apbuffers_init(&buf, _state, ae_true); + ae_matrix_init(&xc, 0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + + ae_assert(n>=0, "SpearmanCorrM: N<0", _state); + ae_assert(m>=1, "SpearmanCorrM: M<1", _state); + ae_assert(x->rows>=n, "SpearmanCorrM: Rows(X)cols>=m||n==0, "SpearmanCorrM: Cols(X)ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return; + } + + /* + * Allocate + */ + ae_vector_set_length(&t, ae_maxint(n, m, _state), _state); + ae_matrix_set_length(c, m, m, _state); + + /* + * Replace data with ranks + */ + ae_matrix_set_length(&xc, m, n, _state); + rmatrixtranspose(n, m, x, 0, 0, &xc, 0, 0, _state); + rankdata(&xc, m, n, _state); + + /* + * 1. Calculate means, check for constant columns + * 2. Center variables, constant columns are + * artificialy zeroed (they must be zero in exact arithmetics, + * but unfortunately floating point is not exact). + */ + for(i=0; i<=m-1; i++) + { + + /* + * Calculate: + * * V - mean value of I-th variable + * * B - True in case all variable values are same + */ + v = 0; + b = ae_true; + x0 = xc.ptr.pp_double[i][0]; + for(j=0; j<=n-1; j++) + { + vv = xc.ptr.pp_double[i][j]; + v = v+vv; + b = b&&ae_fp_eq(vv,x0); + } + v = v/n; + + /* + * Center/zero I-th variable + */ + if( b ) + { + + /* + * Zero + */ + for(j=0; j<=n-1; j++) + { + xc.ptr.pp_double[i][j] = 0.0; + } + } + else + { + + /* + * Center + */ + for(j=0; j<=n-1; j++) + { + xc.ptr.pp_double[i][j] = xc.ptr.pp_double[i][j]-v; + } + } + } + + /* + * Calculate upper half of symmetric covariance matrix + */ + rmatrixsyrk(m, n, (double)1/(double)(n-1), &xc, 0, 0, 0, 0.0, c, 0, 0, ae_true, _state); + + /* + * Calculate Pearson coefficients (upper triangle) + */ + for(i=0; i<=m-1; i++) + { + if( ae_fp_greater(c->ptr.pp_double[i][i],0) ) + { + t.ptr.p_double[i] = 1/ae_sqrt(c->ptr.pp_double[i][i], _state); + } + else + { + t.ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=m-1; i++) + { + v = t.ptr.p_double[i]; + for(j=i; j<=m-1; j++) + { + c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]*v*t.ptr.p_double[j]; + } + } + + /* + * force symmetricity + */ + rmatrixenforcesymmetricity(c, m, ae_true, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_spearmancorrm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, ae_state *_state) +{ + spearmancorrm(x,n,m,c, _state); +} + + +/************************************************************************* +Cross-covariance matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with covariance matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-covariance matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void covm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _x; + ae_matrix _y; + ae_int_t i; + ae_int_t j; + double v; + ae_vector t; + ae_vector x0; + ae_vector y0; + ae_vector samex; + ae_vector samey; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_matrix_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_matrix_clear(c); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&samex, 0, DT_BOOL, _state, ae_true); + ae_vector_init(&samey, 0, DT_BOOL, _state, ae_true); + + ae_assert(n>=0, "CovM2: N<0", _state); + ae_assert(m1>=1, "CovM2: M1<1", _state); + ae_assert(m2>=1, "CovM2: M2<1", _state); + ae_assert(x->rows>=n, "CovM2: Rows(X)cols>=m1||n==0, "CovM2: Cols(X)rows>=n, "CovM2: Rows(Y)cols>=m2||n==0, "CovM2: Cols(Y)ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return; + } + + /* + * Allocate + */ + ae_vector_set_length(&t, ae_maxint(m1, m2, _state), _state); + ae_vector_set_length(&x0, m1, _state); + ae_vector_set_length(&y0, m2, _state); + ae_vector_set_length(&samex, m1, _state); + ae_vector_set_length(&samey, m2, _state); + ae_matrix_set_length(c, m1, m2, _state); + + /* + * * calculate means of X + * * center X + * * if we have constant columns, these columns are + * artificially zeroed (they must be zero in exact arithmetics, + * but unfortunately floating point ops are not exact). + */ + for(i=0; i<=m1-1; i++) + { + t.ptr.p_double[i] = 0; + samex.ptr.p_bool[i] = ae_true; + } + ae_v_move(&x0.ptr.p_double[0], 1, &x->ptr.pp_double[0][0], 1, ae_v_len(0,m1-1)); + v = (double)1/(double)n; + for(i=0; i<=n-1; i++) + { + ae_v_addd(&t.ptr.p_double[0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m1-1), v); + for(j=0; j<=m1-1; j++) + { + samex.ptr.p_bool[j] = samex.ptr.p_bool[j]&&ae_fp_eq(x->ptr.pp_double[i][j],x0.ptr.p_double[j]); + } + } + for(i=0; i<=n-1; i++) + { + ae_v_sub(&x->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m1-1)); + for(j=0; j<=m1-1; j++) + { + if( samex.ptr.p_bool[j] ) + { + x->ptr.pp_double[i][j] = 0; + } + } + } + + /* + * Repeat same steps for Y + */ + for(i=0; i<=m2-1; i++) + { + t.ptr.p_double[i] = 0; + samey.ptr.p_bool[i] = ae_true; + } + ae_v_move(&y0.ptr.p_double[0], 1, &y->ptr.pp_double[0][0], 1, ae_v_len(0,m2-1)); + v = (double)1/(double)n; + for(i=0; i<=n-1; i++) + { + ae_v_addd(&t.ptr.p_double[0], 1, &y->ptr.pp_double[i][0], 1, ae_v_len(0,m2-1), v); + for(j=0; j<=m2-1; j++) + { + samey.ptr.p_bool[j] = samey.ptr.p_bool[j]&&ae_fp_eq(y->ptr.pp_double[i][j],y0.ptr.p_double[j]); + } + } + for(i=0; i<=n-1; i++) + { + ae_v_sub(&y->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m2-1)); + for(j=0; j<=m2-1; j++) + { + if( samey.ptr.p_bool[j] ) + { + y->ptr.pp_double[i][j] = 0; + } + } + } + + /* + * calculate cross-covariance matrix + */ + rmatrixgemm(m1, m2, n, (double)1/(double)(n-1), x, 0, 0, 1, y, 0, 0, 0, 0.0, c, 0, 0, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_covm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, ae_state *_state) +{ + covm2(x,y,n,m1,m2,c, _state); +} + + +/************************************************************************* +Pearson product-moment cross-correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_matrix _x; + ae_matrix _y; + ae_int_t i; + ae_int_t j; + double v; + ae_vector t; + ae_vector x0; + ae_vector y0; + ae_vector sx; + ae_vector sy; + ae_vector samex; + ae_vector samey; + + ae_frame_make(_state, &_frame_block); + ae_matrix_init_copy(&_x, x, _state, ae_true); + x = &_x; + ae_matrix_init_copy(&_y, y, _state, ae_true); + y = &_y; + ae_matrix_clear(c); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&x0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&y0, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sy, 0, DT_REAL, _state, ae_true); + ae_vector_init(&samex, 0, DT_BOOL, _state, ae_true); + ae_vector_init(&samey, 0, DT_BOOL, _state, ae_true); + + ae_assert(n>=0, "PearsonCorrM2: N<0", _state); + ae_assert(m1>=1, "PearsonCorrM2: M1<1", _state); + ae_assert(m2>=1, "PearsonCorrM2: M2<1", _state); + ae_assert(x->rows>=n, "PearsonCorrM2: Rows(X)cols>=m1||n==0, "PearsonCorrM2: Cols(X)rows>=n, "PearsonCorrM2: Rows(Y)cols>=m2||n==0, "PearsonCorrM2: Cols(Y)ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return; + } + + /* + * Allocate + */ + ae_vector_set_length(&t, ae_maxint(m1, m2, _state), _state); + ae_vector_set_length(&x0, m1, _state); + ae_vector_set_length(&y0, m2, _state); + ae_vector_set_length(&sx, m1, _state); + ae_vector_set_length(&sy, m2, _state); + ae_vector_set_length(&samex, m1, _state); + ae_vector_set_length(&samey, m2, _state); + ae_matrix_set_length(c, m1, m2, _state); + + /* + * * calculate means of X + * * center X + * * if we have constant columns, these columns are + * artificially zeroed (they must be zero in exact arithmetics, + * but unfortunately floating point ops are not exact). + * * calculate column variances + */ + for(i=0; i<=m1-1; i++) + { + t.ptr.p_double[i] = 0; + samex.ptr.p_bool[i] = ae_true; + sx.ptr.p_double[i] = 0; + } + ae_v_move(&x0.ptr.p_double[0], 1, &x->ptr.pp_double[0][0], 1, ae_v_len(0,m1-1)); + v = (double)1/(double)n; + for(i=0; i<=n-1; i++) + { + ae_v_addd(&t.ptr.p_double[0], 1, &x->ptr.pp_double[i][0], 1, ae_v_len(0,m1-1), v); + for(j=0; j<=m1-1; j++) + { + samex.ptr.p_bool[j] = samex.ptr.p_bool[j]&&ae_fp_eq(x->ptr.pp_double[i][j],x0.ptr.p_double[j]); + } + } + for(i=0; i<=n-1; i++) + { + ae_v_sub(&x->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m1-1)); + for(j=0; j<=m1-1; j++) + { + if( samex.ptr.p_bool[j] ) + { + x->ptr.pp_double[i][j] = 0; + } + sx.ptr.p_double[j] = sx.ptr.p_double[j]+x->ptr.pp_double[i][j]*x->ptr.pp_double[i][j]; + } + } + for(j=0; j<=m1-1; j++) + { + sx.ptr.p_double[j] = ae_sqrt(sx.ptr.p_double[j]/(n-1), _state); + } + + /* + * Repeat same steps for Y + */ + for(i=0; i<=m2-1; i++) + { + t.ptr.p_double[i] = 0; + samey.ptr.p_bool[i] = ae_true; + sy.ptr.p_double[i] = 0; + } + ae_v_move(&y0.ptr.p_double[0], 1, &y->ptr.pp_double[0][0], 1, ae_v_len(0,m2-1)); + v = (double)1/(double)n; + for(i=0; i<=n-1; i++) + { + ae_v_addd(&t.ptr.p_double[0], 1, &y->ptr.pp_double[i][0], 1, ae_v_len(0,m2-1), v); + for(j=0; j<=m2-1; j++) + { + samey.ptr.p_bool[j] = samey.ptr.p_bool[j]&&ae_fp_eq(y->ptr.pp_double[i][j],y0.ptr.p_double[j]); + } + } + for(i=0; i<=n-1; i++) + { + ae_v_sub(&y->ptr.pp_double[i][0], 1, &t.ptr.p_double[0], 1, ae_v_len(0,m2-1)); + for(j=0; j<=m2-1; j++) + { + if( samey.ptr.p_bool[j] ) + { + y->ptr.pp_double[i][j] = 0; + } + sy.ptr.p_double[j] = sy.ptr.p_double[j]+y->ptr.pp_double[i][j]*y->ptr.pp_double[i][j]; + } + } + for(j=0; j<=m2-1; j++) + { + sy.ptr.p_double[j] = ae_sqrt(sy.ptr.p_double[j]/(n-1), _state); + } + + /* + * calculate cross-covariance matrix + */ + rmatrixgemm(m1, m2, n, (double)1/(double)(n-1), x, 0, 0, 1, y, 0, 0, 0, 0.0, c, 0, 0, _state); + + /* + * Divide by standard deviations + */ + for(i=0; i<=m1-1; i++) + { + if( ae_fp_neq(sx.ptr.p_double[i],0) ) + { + sx.ptr.p_double[i] = 1/sx.ptr.p_double[i]; + } + else + { + sx.ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=m2-1; i++) + { + if( ae_fp_neq(sy.ptr.p_double[i],0) ) + { + sy.ptr.p_double[i] = 1/sy.ptr.p_double[i]; + } + else + { + sy.ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=m1-1; i++) + { + v = sx.ptr.p_double[i]; + for(j=0; j<=m2-1; j++) + { + c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]*v*sy.ptr.p_double[j]; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_pearsoncorrm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, ae_state *_state) +{ + pearsoncorrm2(x,y,n,m1,m2,c, _state); +} + + +/************************************************************************* +Spearman's rank cross-correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spearmancorrm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + double v; + double v2; + double vv; + ae_bool b; + ae_vector t; + double x0; + double y0; + ae_vector sx; + ae_vector sy; + ae_matrix xc; + ae_matrix yc; + apbuffers buf; + + ae_frame_make(_state, &_frame_block); + ae_matrix_clear(c); + ae_vector_init(&t, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&sy, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&xc, 0, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&yc, 0, 0, DT_REAL, _state, ae_true); + _apbuffers_init(&buf, _state, ae_true); + + ae_assert(n>=0, "SpearmanCorrM2: N<0", _state); + ae_assert(m1>=1, "SpearmanCorrM2: M1<1", _state); + ae_assert(m2>=1, "SpearmanCorrM2: M2<1", _state); + ae_assert(x->rows>=n, "SpearmanCorrM2: Rows(X)cols>=m1||n==0, "SpearmanCorrM2: Cols(X)rows>=n, "SpearmanCorrM2: Rows(Y)cols>=m2||n==0, "SpearmanCorrM2: Cols(Y)ptr.pp_double[i][j] = 0; + } + } + ae_frame_leave(_state); + return; + } + + /* + * Allocate + */ + ae_vector_set_length(&t, ae_maxint(ae_maxint(m1, m2, _state), n, _state), _state); + ae_vector_set_length(&sx, m1, _state); + ae_vector_set_length(&sy, m2, _state); + ae_matrix_set_length(c, m1, m2, _state); + + /* + * Replace data with ranks + */ + ae_matrix_set_length(&xc, m1, n, _state); + ae_matrix_set_length(&yc, m2, n, _state); + rmatrixtranspose(n, m1, x, 0, 0, &xc, 0, 0, _state); + rmatrixtranspose(n, m2, y, 0, 0, &yc, 0, 0, _state); + rankdata(&xc, m1, n, _state); + rankdata(&yc, m2, n, _state); + + /* + * 1. Calculate means, variances, check for constant columns + * 2. Center variables, constant columns are + * artificialy zeroed (they must be zero in exact arithmetics, + * but unfortunately floating point is not exact). + * + * Description of variables: + * * V - mean value of I-th variable + * * V2- variance + * * VV-temporary + * * B - True in case all variable values are same + */ + for(i=0; i<=m1-1; i++) + { + v = 0; + v2 = 0.0; + b = ae_true; + x0 = xc.ptr.pp_double[i][0]; + for(j=0; j<=n-1; j++) + { + vv = xc.ptr.pp_double[i][j]; + v = v+vv; + b = b&&ae_fp_eq(vv,x0); + } + v = v/n; + if( b ) + { + for(j=0; j<=n-1; j++) + { + xc.ptr.pp_double[i][j] = 0.0; + } + } + else + { + for(j=0; j<=n-1; j++) + { + vv = xc.ptr.pp_double[i][j]; + xc.ptr.pp_double[i][j] = vv-v; + v2 = v2+(vv-v)*(vv-v); + } + } + sx.ptr.p_double[i] = ae_sqrt(v2/(n-1), _state); + } + for(i=0; i<=m2-1; i++) + { + v = 0; + v2 = 0.0; + b = ae_true; + y0 = yc.ptr.pp_double[i][0]; + for(j=0; j<=n-1; j++) + { + vv = yc.ptr.pp_double[i][j]; + v = v+vv; + b = b&&ae_fp_eq(vv,y0); + } + v = v/n; + if( b ) + { + for(j=0; j<=n-1; j++) + { + yc.ptr.pp_double[i][j] = 0.0; + } + } + else + { + for(j=0; j<=n-1; j++) + { + vv = yc.ptr.pp_double[i][j]; + yc.ptr.pp_double[i][j] = vv-v; + v2 = v2+(vv-v)*(vv-v); + } + } + sy.ptr.p_double[i] = ae_sqrt(v2/(n-1), _state); + } + + /* + * calculate cross-covariance matrix + */ + rmatrixgemm(m1, m2, n, (double)1/(double)(n-1), &xc, 0, 0, 0, &yc, 0, 0, 1, 0.0, c, 0, 0, _state); + + /* + * Divide by standard deviations + */ + for(i=0; i<=m1-1; i++) + { + if( ae_fp_neq(sx.ptr.p_double[i],0) ) + { + sx.ptr.p_double[i] = 1/sx.ptr.p_double[i]; + } + else + { + sx.ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=m2-1; i++) + { + if( ae_fp_neq(sy.ptr.p_double[i],0) ) + { + sy.ptr.p_double[i] = 1/sy.ptr.p_double[i]; + } + else + { + sy.ptr.p_double[i] = 0.0; + } + } + for(i=0; i<=m1-1; i++) + { + v = sx.ptr.p_double[i]; + for(j=0; j<=m2-1; j++) + { + c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]*v*sy.ptr.p_double[j]; + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Single-threaded stub. HPC ALGLIB replaces it by multithreaded code. +*************************************************************************/ +void _pexec_spearmancorrm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, ae_state *_state) +{ + spearmancorrm2(x,y,n,m1,m2,c, _state); +} + + +void rankdata(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_state *_state) +{ + ae_frame _frame_block; + apbuffers buf0; + apbuffers buf1; + ae_int_t basecasecost; + ae_shared_pool pool; + + ae_frame_make(_state, &_frame_block); + _apbuffers_init(&buf0, _state, ae_true); + _apbuffers_init(&buf1, _state, ae_true); + ae_shared_pool_init(&pool, _state, ae_true); + + ae_assert(npoints>=0, "RankData: NPoints<0", _state); + ae_assert(nfeatures>=1, "RankData: NFeatures<1", _state); + ae_assert(xy->rows>=npoints, "RankData: Rows(XY)cols>=nfeatures||npoints==0, "RankData: Cols(XY)=0, "RankData: NPoints<0", _state); + ae_assert(nfeatures>=1, "RankData: NFeatures<1", _state); + ae_assert(xy->rows>=npoints, "RankData: Rows(XY)cols>=nfeatures||npoints==0, "RankData: Cols(XY)=i0, "RankDataRec: internal error", _state); + + /* + * Recursively split problem, if it is too large + */ + problemcost = inttoreal(i1-i0, _state)*inttoreal(nfeatures, _state)*log2(nfeatures, _state); + if( i1-i0>=2&&ae_fp_greater(problemcost,basecasecost) ) + { + im = (i1+i0)/2; + basestat_rankdatarec(xy, i0, im, nfeatures, iscentered, pool, basecasecost, _state); + basestat_rankdatarec(xy, im, i1, nfeatures, iscentered, pool, basecasecost, _state); + ae_frame_leave(_state); + return; + } + + /* + * Retrieve buffers from pool, call serial code, return buffers to pool + */ + ae_shared_pool_retrieve(pool, &_buf0, _state); + ae_shared_pool_retrieve(pool, &_buf1, _state); + basestat_rankdatabasecase(xy, i0, i1, nfeatures, iscentered, buf0, buf1, _state); + ae_shared_pool_recycle(pool, &_buf0, _state); + ae_shared_pool_recycle(pool, &_buf1, _state); + ae_frame_leave(_state); +} + + +static void basestat_rankdatabasecase(/* Real */ ae_matrix* xy, + ae_int_t i0, + ae_int_t i1, + ae_int_t nfeatures, + ae_bool iscentered, + apbuffers* buf0, + apbuffers* buf1, + ae_state *_state) +{ + ae_int_t i; + + + ae_assert(i1>=i0, "RankDataBasecase: internal error", _state); + if( buf1->ra0.cntra0, nfeatures, _state); + } + for(i=i0; i<=i1-1; i++) + { + ae_v_move(&buf1->ra0.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1)); + rankx(&buf1->ra0, nfeatures, iscentered, buf0, _state); + ae_v_move(&xy->ptr.pp_double[i][0], 1, &buf1->ra0.ptr.p_double[0], 1, ae_v_len(0,nfeatures-1)); + } +} + + + + +/************************************************************************* +Pearson's correlation coefficient significance test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions having zero correlation or whether their +correlation is non-zero. + +The following tests are performed: + * two-tailed test (null hypothesis - X and Y have zero correlation) + * left-tailed test (null hypothesis - the correlation coefficient is + greater than or equal to 0) + * right-tailed test (null hypothesis - the correlation coefficient is + less than or equal to 0). + +Requirements: + * the number of elements in each sample is not less than 5 + * normality of distributions of X and Y. + +Input parameters: + R - Pearson's correlation coefficient for X and Y + N - number of elements in samples, N>=5. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrelationsignificance(double r, + ae_int_t n, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + double t; + double p; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + + /* + * Some special cases + */ + if( ae_fp_greater_eq(r,1) ) + { + *bothtails = 0.0; + *lefttail = 1.0; + *righttail = 0.0; + return; + } + if( ae_fp_less_eq(r,-1) ) + { + *bothtails = 0.0; + *lefttail = 0.0; + *righttail = 1.0; + return; + } + if( n<5 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * General case + */ + t = r*ae_sqrt((n-2)/(1-ae_sqr(r, _state)), _state); + p = studenttdistribution(n-2, t, _state); + *bothtails = 2*ae_minreal(p, 1-p, _state); + *lefttail = p; + *righttail = 1-p; +} + + +/************************************************************************* +Spearman's rank correlation coefficient significance test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions having zero correlation or whether their +correlation is non-zero. + +The following tests are performed: + * two-tailed test (null hypothesis - X and Y have zero correlation) + * left-tailed test (null hypothesis - the correlation coefficient is + greater than or equal to 0) + * right-tailed test (null hypothesis - the correlation coefficient is + less than or equal to 0). + +Requirements: + * the number of elements in each sample is not less than 5. + +The test is non-parametric and doesn't require distributions X and Y to be +normal. + +Input parameters: + R - Spearman's rank correlation coefficient for X and Y + N - number of elements in samples, N>=5. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void spearmanrankcorrelationsignificance(double r, + ae_int_t n, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + double t; + double p; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + + /* + * Special case + */ + if( n<5 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * General case + */ + if( ae_fp_greater_eq(r,1) ) + { + t = 1.0E10; + } + else + { + if( ae_fp_less_eq(r,-1) ) + { + t = -1.0E10; + } + else + { + t = r*ae_sqrt((n-2)/(1-ae_sqr(r, _state)), _state); + } + } + if( ae_fp_less(t,0) ) + { + p = correlationtests_spearmantail(t, n, _state); + *bothtails = 2*p; + *lefttail = p; + *righttail = 1-p; + } + else + { + p = correlationtests_spearmantail(-t, n, _state); + *bothtails = 2*p; + *lefttail = 1-p; + *righttail = p; + } +} + + +/************************************************************************* +Tail(S, 5) +*************************************************************************/ +static double correlationtests_spearmantail5(double s, ae_state *_state) +{ + double result; + + + if( ae_fp_less(s,0.000e+00) ) + { + result = studenttdistribution(3, -s, _state); + return result; + } + if( ae_fp_greater_eq(s,3.580e+00) ) + { + result = 8.304e-03; + return result; + } + if( ae_fp_greater_eq(s,2.322e+00) ) + { + result = 4.163e-02; + return result; + } + if( ae_fp_greater_eq(s,1.704e+00) ) + { + result = 6.641e-02; + return result; + } + if( ae_fp_greater_eq(s,1.303e+00) ) + { + result = 1.164e-01; + return result; + } + if( ae_fp_greater_eq(s,1.003e+00) ) + { + result = 1.748e-01; + return result; + } + if( ae_fp_greater_eq(s,7.584e-01) ) + { + result = 2.249e-01; + return result; + } + if( ae_fp_greater_eq(s,5.468e-01) ) + { + result = 2.581e-01; + return result; + } + if( ae_fp_greater_eq(s,3.555e-01) ) + { + result = 3.413e-01; + return result; + } + if( ae_fp_greater_eq(s,1.759e-01) ) + { + result = 3.911e-01; + return result; + } + if( ae_fp_greater_eq(s,1.741e-03) ) + { + result = 4.747e-01; + return result; + } + if( ae_fp_greater_eq(s,0.000e+00) ) + { + result = 5.248e-01; + return result; + } + result = 0; + return result; +} + + +/************************************************************************* +Tail(S, 6) +*************************************************************************/ +static double correlationtests_spearmantail6(double s, ae_state *_state) +{ + double result; + + + if( ae_fp_less(s,1.001e+00) ) + { + result = studenttdistribution(4, -s, _state); + return result; + } + if( ae_fp_greater_eq(s,5.663e+00) ) + { + result = 1.366e-03; + return result; + } + if( ae_fp_greater_eq(s,3.834e+00) ) + { + result = 8.350e-03; + return result; + } + if( ae_fp_greater_eq(s,2.968e+00) ) + { + result = 1.668e-02; + return result; + } + if( ae_fp_greater_eq(s,2.430e+00) ) + { + result = 2.921e-02; + return result; + } + if( ae_fp_greater_eq(s,2.045e+00) ) + { + result = 5.144e-02; + return result; + } + if( ae_fp_greater_eq(s,1.747e+00) ) + { + result = 6.797e-02; + return result; + } + if( ae_fp_greater_eq(s,1.502e+00) ) + { + result = 8.752e-02; + return result; + } + if( ae_fp_greater_eq(s,1.295e+00) ) + { + result = 1.210e-01; + return result; + } + if( ae_fp_greater_eq(s,1.113e+00) ) + { + result = 1.487e-01; + return result; + } + if( ae_fp_greater_eq(s,1.001e+00) ) + { + result = 1.780e-01; + return result; + } + result = 0; + return result; +} + + +/************************************************************************* +Tail(S, 7) +*************************************************************************/ +static double correlationtests_spearmantail7(double s, ae_state *_state) +{ + double result; + + + if( ae_fp_less(s,1.001e+00) ) + { + result = studenttdistribution(5, -s, _state); + return result; + } + if( ae_fp_greater_eq(s,8.159e+00) ) + { + result = 2.081e-04; + return result; + } + if( ae_fp_greater_eq(s,5.620e+00) ) + { + result = 1.393e-03; + return result; + } + if( ae_fp_greater_eq(s,4.445e+00) ) + { + result = 3.398e-03; + return result; + } + if( ae_fp_greater_eq(s,3.728e+00) ) + { + result = 6.187e-03; + return result; + } + if( ae_fp_greater_eq(s,3.226e+00) ) + { + result = 1.200e-02; + return result; + } + if( ae_fp_greater_eq(s,2.844e+00) ) + { + result = 1.712e-02; + return result; + } + if( ae_fp_greater_eq(s,2.539e+00) ) + { + result = 2.408e-02; + return result; + } + if( ae_fp_greater_eq(s,2.285e+00) ) + { + result = 3.320e-02; + return result; + } + if( ae_fp_greater_eq(s,2.068e+00) ) + { + result = 4.406e-02; + return result; + } + if( ae_fp_greater_eq(s,1.879e+00) ) + { + result = 5.478e-02; + return result; + } + if( ae_fp_greater_eq(s,1.710e+00) ) + { + result = 6.946e-02; + return result; + } + if( ae_fp_greater_eq(s,1.559e+00) ) + { + result = 8.331e-02; + return result; + } + if( ae_fp_greater_eq(s,1.420e+00) ) + { + result = 1.001e-01; + return result; + } + if( ae_fp_greater_eq(s,1.292e+00) ) + { + result = 1.180e-01; + return result; + } + if( ae_fp_greater_eq(s,1.173e+00) ) + { + result = 1.335e-01; + return result; + } + if( ae_fp_greater_eq(s,1.062e+00) ) + { + result = 1.513e-01; + return result; + } + if( ae_fp_greater_eq(s,1.001e+00) ) + { + result = 1.770e-01; + return result; + } + result = 0; + return result; +} + + +/************************************************************************* +Tail(S, 8) +*************************************************************************/ +static double correlationtests_spearmantail8(double s, ae_state *_state) +{ + double result; + + + if( ae_fp_less(s,2.001e+00) ) + { + result = studenttdistribution(6, -s, _state); + return result; + } + if( ae_fp_greater_eq(s,1.103e+01) ) + { + result = 2.194e-05; + return result; + } + if( ae_fp_greater_eq(s,7.685e+00) ) + { + result = 2.008e-04; + return result; + } + if( ae_fp_greater_eq(s,6.143e+00) ) + { + result = 5.686e-04; + return result; + } + if( ae_fp_greater_eq(s,5.213e+00) ) + { + result = 1.138e-03; + return result; + } + if( ae_fp_greater_eq(s,4.567e+00) ) + { + result = 2.310e-03; + return result; + } + if( ae_fp_greater_eq(s,4.081e+00) ) + { + result = 3.634e-03; + return result; + } + if( ae_fp_greater_eq(s,3.697e+00) ) + { + result = 5.369e-03; + return result; + } + if( ae_fp_greater_eq(s,3.381e+00) ) + { + result = 7.708e-03; + return result; + } + if( ae_fp_greater_eq(s,3.114e+00) ) + { + result = 1.087e-02; + return result; + } + if( ae_fp_greater_eq(s,2.884e+00) ) + { + result = 1.397e-02; + return result; + } + if( ae_fp_greater_eq(s,2.682e+00) ) + { + result = 1.838e-02; + return result; + } + if( ae_fp_greater_eq(s,2.502e+00) ) + { + result = 2.288e-02; + return result; + } + if( ae_fp_greater_eq(s,2.340e+00) ) + { + result = 2.883e-02; + return result; + } + if( ae_fp_greater_eq(s,2.192e+00) ) + { + result = 3.469e-02; + return result; + } + if( ae_fp_greater_eq(s,2.057e+00) ) + { + result = 4.144e-02; + return result; + } + if( ae_fp_greater_eq(s,2.001e+00) ) + { + result = 4.804e-02; + return result; + } + result = 0; + return result; +} + + +/************************************************************************* +Tail(S, 9) +*************************************************************************/ +static double correlationtests_spearmantail9(double s, ae_state *_state) +{ + double result; + + + if( ae_fp_less(s,2.001e+00) ) + { + result = studenttdistribution(7, -s, _state); + return result; + } + if( ae_fp_greater_eq(s,9.989e+00) ) + { + result = 2.306e-05; + return result; + } + if( ae_fp_greater_eq(s,8.069e+00) ) + { + result = 8.167e-05; + return result; + } + if( ae_fp_greater_eq(s,6.890e+00) ) + { + result = 1.744e-04; + return result; + } + if( ae_fp_greater_eq(s,6.077e+00) ) + { + result = 3.625e-04; + return result; + } + if( ae_fp_greater_eq(s,5.469e+00) ) + { + result = 6.450e-04; + return result; + } + if( ae_fp_greater_eq(s,4.991e+00) ) + { + result = 1.001e-03; + return result; + } + if( ae_fp_greater_eq(s,4.600e+00) ) + { + result = 1.514e-03; + return result; + } + if( ae_fp_greater_eq(s,4.272e+00) ) + { + result = 2.213e-03; + return result; + } + if( ae_fp_greater_eq(s,3.991e+00) ) + { + result = 2.990e-03; + return result; + } + if( ae_fp_greater_eq(s,3.746e+00) ) + { + result = 4.101e-03; + return result; + } + if( ae_fp_greater_eq(s,3.530e+00) ) + { + result = 5.355e-03; + return result; + } + if( ae_fp_greater_eq(s,3.336e+00) ) + { + result = 6.887e-03; + return result; + } + if( ae_fp_greater_eq(s,3.161e+00) ) + { + result = 8.598e-03; + return result; + } + if( ae_fp_greater_eq(s,3.002e+00) ) + { + result = 1.065e-02; + return result; + } + if( ae_fp_greater_eq(s,2.855e+00) ) + { + result = 1.268e-02; + return result; + } + if( ae_fp_greater_eq(s,2.720e+00) ) + { + result = 1.552e-02; + return result; + } + if( ae_fp_greater_eq(s,2.595e+00) ) + { + result = 1.836e-02; + return result; + } + if( ae_fp_greater_eq(s,2.477e+00) ) + { + result = 2.158e-02; + return result; + } + if( ae_fp_greater_eq(s,2.368e+00) ) + { + result = 2.512e-02; + return result; + } + if( ae_fp_greater_eq(s,2.264e+00) ) + { + result = 2.942e-02; + return result; + } + if( ae_fp_greater_eq(s,2.166e+00) ) + { + result = 3.325e-02; + return result; + } + if( ae_fp_greater_eq(s,2.073e+00) ) + { + result = 3.800e-02; + return result; + } + if( ae_fp_greater_eq(s,2.001e+00) ) + { + result = 4.285e-02; + return result; + } + result = 0; + return result; +} + + +/************************************************************************* +Tail(T,N), accepts T<0 +*************************************************************************/ +static double correlationtests_spearmantail(double t, + ae_int_t n, + ae_state *_state) +{ + double result; + + + if( n==5 ) + { + result = correlationtests_spearmantail5(-t, _state); + return result; + } + if( n==6 ) + { + result = correlationtests_spearmantail6(-t, _state); + return result; + } + if( n==7 ) + { + result = correlationtests_spearmantail7(-t, _state); + return result; + } + if( n==8 ) + { + result = correlationtests_spearmantail8(-t, _state); + return result; + } + if( n==9 ) + { + result = correlationtests_spearmantail9(-t, _state); + return result; + } + result = studenttdistribution(n-2, t, _state); + return result; +} + + + + +/************************************************************************* +Jarque-Bera test + +This test checks hypotheses about the fact that a given sample X is a +sample of normal random variable. + +Requirements: + * the number of elements in the sample is not less than 5. + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. N>=5 + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +Accuracy of the approximation used (5<=N<=1951): + +p-value relative error (5<=N<=1951) +[1, 0.1] < 1% +[0.1, 0.01] < 2% +[0.01, 0.001] < 6% +[0.001, 0] wasn't measured + +For N>1951 accuracy wasn't measured but it shouldn't be sharply different +from table values. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void jarqueberatest(/* Real */ ae_vector* x, + ae_int_t n, + double* p, + ae_state *_state) +{ + double s; + + *p = 0; + + + /* + * N is too small + */ + if( n<5 ) + { + *p = 1.0; + return; + } + + /* + * N is large enough + */ + jarquebera_jarqueberastatistic(x, n, &s, _state); + *p = jarquebera_jarqueberaapprox(n, s, _state); +} + + +static void jarquebera_jarqueberastatistic(/* Real */ ae_vector* x, + ae_int_t n, + double* s, + ae_state *_state) +{ + ae_int_t i; + double v; + double v1; + double v2; + double stddev; + double mean; + double variance; + double skewness; + double kurtosis; + + *s = 0; + + mean = 0; + variance = 0; + skewness = 0; + kurtosis = 0; + stddev = 0; + ae_assert(n>1, "Assertion failed", _state); + + /* + * Mean + */ + for(i=0; i<=n-1; i++) + { + mean = mean+x->ptr.p_double[i]; + } + mean = mean/n; + + /* + * Variance (using corrected two-pass algorithm) + */ + if( n!=1 ) + { + v1 = 0; + for(i=0; i<=n-1; i++) + { + v1 = v1+ae_sqr(x->ptr.p_double[i]-mean, _state); + } + v2 = 0; + for(i=0; i<=n-1; i++) + { + v2 = v2+(x->ptr.p_double[i]-mean); + } + v2 = ae_sqr(v2, _state)/n; + variance = (v1-v2)/(n-1); + if( ae_fp_less(variance,0) ) + { + variance = 0; + } + stddev = ae_sqrt(variance, _state); + } + + /* + * Skewness and kurtosis + */ + if( ae_fp_neq(stddev,0) ) + { + for(i=0; i<=n-1; i++) + { + v = (x->ptr.p_double[i]-mean)/stddev; + v2 = ae_sqr(v, _state); + skewness = skewness+v2*v; + kurtosis = kurtosis+ae_sqr(v2, _state); + } + skewness = skewness/n; + kurtosis = kurtosis/n-3; + } + + /* + * Statistic + */ + *s = (double)n/(double)6*(ae_sqr(skewness, _state)+ae_sqr(kurtosis, _state)/4); +} + + +static double jarquebera_jarqueberaapprox(ae_int_t n, + double s, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector vx; + ae_vector vy; + ae_matrix ctbl; + double t1; + double t2; + double t3; + double t; + double f1; + double f2; + double f3; + double f12; + double f23; + double x; + double result; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&vx, 0, DT_REAL, _state, ae_true); + ae_vector_init(&vy, 0, DT_REAL, _state, ae_true); + ae_matrix_init(&ctbl, 0, 0, DT_REAL, _state, ae_true); + + result = 1; + x = s; + if( n<5 ) + { + ae_frame_leave(_state); + return result; + } + + /* + * N = 5..20 are tabulated + */ + if( n>=5&&n<=20 ) + { + if( n==5 ) + { + result = ae_exp(jarquebera_jbtbl5(x, _state), _state); + } + if( n==6 ) + { + result = ae_exp(jarquebera_jbtbl6(x, _state), _state); + } + if( n==7 ) + { + result = ae_exp(jarquebera_jbtbl7(x, _state), _state); + } + if( n==8 ) + { + result = ae_exp(jarquebera_jbtbl8(x, _state), _state); + } + if( n==9 ) + { + result = ae_exp(jarquebera_jbtbl9(x, _state), _state); + } + if( n==10 ) + { + result = ae_exp(jarquebera_jbtbl10(x, _state), _state); + } + if( n==11 ) + { + result = ae_exp(jarquebera_jbtbl11(x, _state), _state); + } + if( n==12 ) + { + result = ae_exp(jarquebera_jbtbl12(x, _state), _state); + } + if( n==13 ) + { + result = ae_exp(jarquebera_jbtbl13(x, _state), _state); + } + if( n==14 ) + { + result = ae_exp(jarquebera_jbtbl14(x, _state), _state); + } + if( n==15 ) + { + result = ae_exp(jarquebera_jbtbl15(x, _state), _state); + } + if( n==16 ) + { + result = ae_exp(jarquebera_jbtbl16(x, _state), _state); + } + if( n==17 ) + { + result = ae_exp(jarquebera_jbtbl17(x, _state), _state); + } + if( n==18 ) + { + result = ae_exp(jarquebera_jbtbl18(x, _state), _state); + } + if( n==19 ) + { + result = ae_exp(jarquebera_jbtbl19(x, _state), _state); + } + if( n==20 ) + { + result = ae_exp(jarquebera_jbtbl20(x, _state), _state); + } + ae_frame_leave(_state); + return result; + } + + /* + * N = 20, 30, 50 are tabulated. + * In-between values are interpolated + * using interpolating polynomial of the second degree. + */ + if( n>20&&n<=50 ) + { + t1 = -1.0/20.0; + t2 = -1.0/30.0; + t3 = -1.0/50.0; + t = -1.0/n; + f1 = jarquebera_jbtbl20(x, _state); + f2 = jarquebera_jbtbl30(x, _state); + f3 = jarquebera_jbtbl50(x, _state); + f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); + f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); + result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + result = ae_exp(result, _state); + ae_frame_leave(_state); + return result; + } + + /* + * N = 50, 65, 100 are tabulated. + * In-between values are interpolated + * using interpolating polynomial of the second degree. + */ + if( n>50&&n<=100 ) + { + t1 = -1.0/50.0; + t2 = -1.0/65.0; + t3 = -1.0/100.0; + t = -1.0/n; + f1 = jarquebera_jbtbl50(x, _state); + f2 = jarquebera_jbtbl65(x, _state); + f3 = jarquebera_jbtbl100(x, _state); + f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); + f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); + result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + result = ae_exp(result, _state); + ae_frame_leave(_state); + return result; + } + + /* + * N = 100, 130, 200 are tabulated. + * In-between values are interpolated + * using interpolating polynomial of the second degree. + */ + if( n>100&&n<=200 ) + { + t1 = -1.0/100.0; + t2 = -1.0/130.0; + t3 = -1.0/200.0; + t = -1.0/n; + f1 = jarquebera_jbtbl100(x, _state); + f2 = jarquebera_jbtbl130(x, _state); + f3 = jarquebera_jbtbl200(x, _state); + f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); + f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); + result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + result = ae_exp(result, _state); + ae_frame_leave(_state); + return result; + } + + /* + * N = 200, 301, 501 are tabulated. + * In-between values are interpolated + * using interpolating polynomial of the second degree. + */ + if( n>200&&n<=501 ) + { + t1 = -1.0/200.0; + t2 = -1.0/301.0; + t3 = -1.0/501.0; + t = -1.0/n; + f1 = jarquebera_jbtbl200(x, _state); + f2 = jarquebera_jbtbl301(x, _state); + f3 = jarquebera_jbtbl501(x, _state); + f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); + f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); + result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + result = ae_exp(result, _state); + ae_frame_leave(_state); + return result; + } + + /* + * N = 501, 701, 1401 are tabulated. + * In-between values are interpolated + * using interpolating polynomial of the second degree. + */ + if( n>501&&n<=1401 ) + { + t1 = -1.0/501.0; + t2 = -1.0/701.0; + t3 = -1.0/1401.0; + t = -1.0/n; + f1 = jarquebera_jbtbl501(x, _state); + f2 = jarquebera_jbtbl701(x, _state); + f3 = jarquebera_jbtbl1401(x, _state); + f12 = ((t-t2)*f1+(t1-t)*f2)/(t1-t2); + f23 = ((t-t3)*f2+(t2-t)*f3)/(t2-t3); + result = ((t-t3)*f12+(t1-t)*f23)/(t1-t3); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + result = ae_exp(result, _state); + ae_frame_leave(_state); + return result; + } + + /* + * Asymptotic expansion + */ + if( n>1401 ) + { + result = -0.5*x+(jarquebera_jbtbl1401(x, _state)+0.5*x)*ae_sqrt((double)1401/(double)n, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + result = ae_exp(result, _state); + ae_frame_leave(_state); + return result; + } + ae_frame_leave(_state); + return result; +} + + +static double jarquebera_jbtbl5(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,0.4000) ) + { + x = 2*(s-0.000000)/0.400000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.097885e-20, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.854501e-20, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.756616e-20, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,1.1000) ) + { + x = 2*(s-0.400000)/0.700000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.324545e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.075941e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.772272e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.175686e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.576162e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.126861e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.434425e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.790359e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.809178e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.479704e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.717040e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.294170e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.880632e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.023344e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.601531e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.920403e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -5.188419e+02*(s-1.100000e+00)-4.767297e+00; + return result; +} + + +static double jarquebera_jbtbl6(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,0.2500) ) + { + x = 2*(s-0.000000)/0.250000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.274707e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.700471e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.425764e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,1.3000) ) + { + x = 2*(s-0.250000)/1.050000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.339000e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.011104e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.168177e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.085666e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.738606e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.022876e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.462402e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.908270e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.230772e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.006996e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.410222e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.893768e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.114564e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,1.8500) ) + { + x = 2*(s-1.300000)/0.550000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.794311e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.578700e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.394664e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.928290e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.813273e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.076063e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.835380e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.013013e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.058903e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.856915e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.710887e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.770029e+02*(s-1.850000e+00)-1.371015e+01; + return result; +} + + +static double jarquebera_jbtbl7(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,1.4000) ) + { + x = 2*(s-0.000000)/1.400000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.093681e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.695911e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.473192e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.203236e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.590379e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.291876e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.132007e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.411147e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.180067e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.487610e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.436561e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,3.0000) ) + { + x = 2*(s-1.400000)/1.600000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.947854e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.772675e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.707912e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.691171e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.132795e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.481310e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.867536e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.772327e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.033387e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.378277e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.497964e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.636814e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.581640e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,3.2000) ) + { + x = 2*(s-3.000000)/0.200000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -7.511008e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.140472e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.682053e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.568561e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.933930e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.140472e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.895025e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.140472e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.933930e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.568561e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.682053e+00, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.824116e+03*(s-3.200000e+00)-1.440330e+01; + return result; +} + + +static double jarquebera_jbtbl8(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,1.3000) ) + { + x = 2*(s-0.000000)/1.300000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -7.199015e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.095921e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.736828e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.047438e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.484320e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.937923e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.810470e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.139780e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.708443e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,2.0000) ) + { + x = 2*(s-1.300000)/0.700000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -3.378966e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.802461e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.547593e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.241042e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.203274e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.201990e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.125597e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.584426e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.546069e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,5.0000) ) + { + x = 2*(s-2.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.828366e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.137533e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.016671e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.745637e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.189801e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.621610e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.741122e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.516368e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.552085e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.787029e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.359774e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -5.087028e+00*(s-5.000000e+00)-1.071300e+01; + return result; +} + + +static double jarquebera_jbtbl9(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,1.3000) ) + { + x = 2*(s-0.000000)/1.300000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.279320e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.277151e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.669339e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.086149e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.333816e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.871249e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.007048e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.482245e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.355615e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,2.0000) ) + { + x = 2*(s-1.300000)/0.700000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.981430e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.972248e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.747737e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.808530e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.888305e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.001302e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.378767e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.108510e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.915372e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,7.0000) ) + { + x = 2*(s-2.000000)/5.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.387463e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.845231e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.809956e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.543461e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.880397e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.160074e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.356527e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.394428e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.619892e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.758763e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.790977e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -2.020952e+00*(s-7.000000e+00)-9.516623e+00; + return result; +} + + +static double jarquebera_jbtbl10(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,1.2000) ) + { + x = 2*(s-0.000000)/1.200000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.590993e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.562730e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.353934e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.069933e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.849151e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.931406e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.636295e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.178340e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.917749e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,2.0000) ) + { + x = 2*(s-1.200000)/0.800000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.537658e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.962401e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.838715e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.055792e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.580316e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.781701e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.770362e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.838983e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.999052e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,7.0000) ) + { + x = 2*(s-2.000000)/5.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.337524e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.877029e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.734650e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.249254e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.320250e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.432266e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -8.711035e-01*(s-7.000000e+00)-7.212811e+00; + return result; +} + + +static double jarquebera_jbtbl11(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,1.2000) ) + { + x = 2*(s-0.000000)/1.200000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.339517e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.051558e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.000992e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.022547e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.808401e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.592870e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.575081e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.086173e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.089011e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,2.2500) ) + { + x = 2*(s-1.200000)/1.050000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.523221e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.068388e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.179661e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.555524e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.238964e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.364320e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.895771e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.762774e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.201340e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,8.0000) ) + { + x = 2*(s-2.250000)/5.750000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.212179e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.684579e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.299519e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.606261e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.310869e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.320115e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -5.715445e-01*(s-8.000000e+00)-6.845834e+00; + return result; +} + + +static double jarquebera_jbtbl12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,1.0000) ) + { + x = 2*(s-0.000000)/1.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.736742e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.657836e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.047209e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.319599e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.545631e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.280445e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.815679e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.213519e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.256838e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,3.0000) ) + { + x = 2*(s-1.000000)/2.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.573947e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.515287e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.611880e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.271311e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.495815e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.141186e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.180886e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.388211e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.890761e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.233175e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.946156e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,12.0000) ) + { + x = 2*(s-3.000000)/9.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.947819e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.034157e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.878986e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.078603e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.990977e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.866215e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.897866e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.512252e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.073743e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.022621e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.501343e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -2.877243e-01*(s-1.200000e+01)-7.936839e+00; + return result; +} + + +static double jarquebera_jbtbl13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,1.0000) ) + { + x = 2*(s-0.000000)/1.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.713276e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.557541e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.459092e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.044145e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.546132e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.002374e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.349456e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.025669e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.590242e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,3.0000) ) + { + x = 2*(s-1.000000)/2.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.454383e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.467539e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.270774e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.075763e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.611647e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.990785e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.109212e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.135031e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.915919e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.522390e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.144701e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,13.0000) ) + { + x = 2*(s-3.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.736127e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.920809e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.175858e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.002049e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.158966e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.157781e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.762172e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.780347e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.193310e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.442421e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.547756e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -2.799944e-01*(s-1.300000e+01)-7.566269e+00; + return result; +} + + +static double jarquebera_jbtbl14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,1.0000) ) + { + x = 2*(s-0.000000)/1.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.698527e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.479081e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.640733e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.466899e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.469485e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.150009e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.965975e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.710210e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.327808e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,3.0000) ) + { + x = 2*(s-1.000000)/2.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -2.350359e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.421365e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.960468e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.149167e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.361109e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.976022e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.082700e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.563328e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.453123e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.917559e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.151067e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-3.000000)/12.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.746892e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.010441e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.566146e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.129690e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.929724e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.524227e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.192933e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.254730e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.620685e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.289618e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.112350e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -2.590621e-01*(s-1.500000e+01)-7.632238e+00; + return result; +} + + +static double jarquebera_jbtbl15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,2.0000) ) + { + x = 2*(s-0.000000)/2.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.043660e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.361653e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.009497e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.951784e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.377903e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.003253e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.271309e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,5.0000) ) + { + x = 2*(s-2.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -3.582778e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.349578e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.476514e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.717385e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.222591e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.635124e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.815993e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,17.0000) ) + { + x = 2*(s-5.000000)/12.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.115476e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.655936e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.404310e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.663794e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.868618e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.381447e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.444801e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.581503e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.468696e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.728509e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.206470e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.927937e-01*(s-1.700000e+01)-7.700983e+00; + return result; +} + + +static double jarquebera_jbtbl16(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,2.0000) ) + { + x = 2*(s-0.000000)/2.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.002570e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.298141e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.832803e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.877026e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.539436e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.439658e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.756911e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,5.0000) ) + { + x = 2*(s-2.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -3.486198e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.242944e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.020002e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.130531e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.512373e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.054876e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.556839e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,20.0000) ) + { + x = 2*(s-5.000000)/15.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.241608e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.832655e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.340545e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.361143e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.283219e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.484549e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.805968e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.057243e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.454439e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.177513e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.819209e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -2.391580e-01*(s-2.000000e+01)-7.963205e+00; + return result; +} + + +static double jarquebera_jbtbl17(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,3.0000) ) + { + x = 2*(s-0.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.566973e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.810330e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.840039e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.337294e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.383549e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.556515e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.656965e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.404569e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.447867e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,6.0000) ) + { + x = 2*(s-3.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -3.905684e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.222920e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.146667e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.809176e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.057028e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.211838e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.099683e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.161105e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.225465e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,24.0000) ) + { + x = 2*(s-6.000000)/18.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.594282e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.917838e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.455980e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.999589e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.604263e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.484445e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.819937e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.930390e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.771761e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.232581e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.029083e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -2.127771e-01*(s-2.400000e+01)-8.400197e+00; + return result; +} + + +static double jarquebera_jbtbl18(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,3.0000) ) + { + x = 2*(s-0.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.526802e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.762373e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.598890e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.189437e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.971721e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.823067e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.064501e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.014932e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.953513e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,6.0000) ) + { + x = 2*(s-3.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -3.818669e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.070918e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.277196e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.879817e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.887357e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.638451e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.502800e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.165796e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.034960e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,20.0000) ) + { + x = 2*(s-6.000000)/14.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.010656e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.496296e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.002227e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.338250e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.137036e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.586202e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.736384e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.332251e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.877982e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.160963e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.547247e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.684623e-01*(s-2.000000e+01)-7.428883e+00; + return result; +} + + +static double jarquebera_jbtbl19(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,3.0000) ) + { + x = 2*(s-0.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.490213e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.719633e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.459123e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.034878e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.113868e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.030922e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.054022e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.525623e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.277360e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,6.0000) ) + { + x = 2*(s-3.000000)/3.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -3.744750e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.977749e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.223716e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.363889e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.711774e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.557257e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.254794e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.034207e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.498107e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,20.0000) ) + { + x = 2*(s-6.000000)/14.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.872768e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.430689e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.136575e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.726627e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.421110e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.581510e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.559520e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.838208e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.428839e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.170682e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.006647e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.539373e-01*(s-2.000000e+01)-7.206941e+00; + return result; +} + + +static double jarquebera_jbtbl20(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.854794e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.948947e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.632184e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.139397e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.006237e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.810031e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.573620e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.951242e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.274092e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.464196e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.882139e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.575144e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.822804e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.061348e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.908404e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.978353e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.030989e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.327151e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.346404e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.840051e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.578551e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.813886e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.905973e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.358489e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.450795e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.941157e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.432418e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.070537e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.375654e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.367378e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.890859e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.679782e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -7.015854e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.487737e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.244254e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.318007e-01*(s-2.500000e+01)-7.742185e+00; + return result; +} + + +static double jarquebera_jbtbl30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.630822e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.724298e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.872756e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.658268e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.573597e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.994157e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.994825e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.394303e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.785029e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.990264e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.037838e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.755546e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.774473e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.821395e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.392603e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.353313e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.539322e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.197018e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.396848e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.804293e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.867928e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.768758e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.211792e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.925799e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.046235e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.536469e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.489642e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.263462e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.177316e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.590637e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.028212e-01*(s-2.500000e+01)-6.855288e+00; + return result; +} + + +static double jarquebera_jbtbl50(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.436279e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.519711e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.148699e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.001204e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.207620e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.034778e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.220322e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.033260e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.588280e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.851653e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.287733e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.234645e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.189127e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.429738e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.058822e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 9.086776e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.445783e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.311671e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.261298e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.496987e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.605249e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.162282e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.921095e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.888603e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.080113e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -9.313116e-02*(s-2.500000e+01)-6.479154e+00; + return result; +} + + +static double jarquebera_jbtbl65(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.360024e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.434631e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.514580e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 7.332038e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.158197e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.121233e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.051056e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.148601e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.214233e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.487977e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.424720e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.116715e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.043152e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.718149e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.313701e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.097305e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.181031e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.256975e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.858951e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.895179e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.933237e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -9.443768e-02*(s-2.500000e+01)-6.419137e+00; + return result; +} + + +static double jarquebera_jbtbl100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.257021e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.313418e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.628931e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.264287e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.518487e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.499826e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.836044e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.056508e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.279690e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.665746e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.290012e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.487632e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.704465e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.211669e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.866099e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.399767e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.498208e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.080097e-01*(s-2.500000e+01)-6.481094e+00; + return result; +} + + +static double jarquebera_jbtbl130(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.207999e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.253864e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.618032e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.112729e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.210546e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.732602e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.410527e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.026324e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.331990e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.779129e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.674749e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.669077e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.679136e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 8.833221e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -5.893951e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.475304e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.116734e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.045722e-01*(s-2.500000e+01)-6.510314e+00; + return result; +} + + +static double jarquebera_jbtbl200(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.146155e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.177398e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.297970e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.869745e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.717288e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.982108e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.427636e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.034235e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.455006e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.942996e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.973795e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.418812e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.156778e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.896705e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.086071e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.152176e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.725393e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.132404e-01*(s-2.500000e+01)-6.764034e+00; + return result; +} + + +static double jarquebera_jbtbl301(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.104290e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.125800e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.595847e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.219666e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.502210e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.414543e-05, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.754115e-05, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.065955e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.582060e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.004472e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -4.709092e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.105779e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.197391e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.386780e-04, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.311384e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.918763e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.626584e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.293626e-01*(s-2.500000e+01)-7.066995e+00; + return result; +} + + +static double jarquebera_jbtbl501(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.067426e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.079765e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -5.463005e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 6.875659e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.127574e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.740694e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.044502e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.746714e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 3.810594e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.197111e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.628194e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -8.846221e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.386405e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.418332e-01*(s-2.500000e+01)-7.468952e+00; + return result; +} + + +static double jarquebera_jbtbl701(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.050999e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.059769e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -3.922680e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 4.847054e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.192182e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.860007e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.963942e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.838711e-02, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.893112e-04, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.159788e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -6.917851e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -9.817020e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.383727e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -1.532706e-01*(s-2.500000e+01)-7.845715e+00; + return result; +} + + +static double jarquebera_jbtbl1401(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + if( ae_fp_less_eq(s,4.0000) ) + { + x = 2*(s-0.000000)/4.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -1.026266e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.030061e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.259222e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 2.536254e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,15.0000) ) + { + x = 2*(s-4.000000)/11.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -4.329849e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -2.095443e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 1.759363e-01, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -7.751359e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -6.124368e-03, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.793114e-03, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + if( ae_fp_less_eq(s,25.0000) ) + { + x = 2*(s-15.000000)/10.000000-1; + tj = 1; + tj1 = x; + jarquebera_jbcheb(x, -7.544330e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, -1.225382e+00, &tj, &tj1, &result, _state); + jarquebera_jbcheb(x, 5.392349e-02, &tj, &tj1, &result, _state); + if( ae_fp_greater(result,0) ) + { + result = 0; + } + return result; + } + result = -2.019375e-01*(s-2.500000e+01)-8.715788e+00; + return result; +} + + +static void jarquebera_jbcheb(double x, + double c, + double* tj, + double* tj1, + double* r, + ae_state *_state) +{ + double t; + + + *r = *r+c*(*tj); + t = 2*x*(*tj1)-(*tj); + *tj = *tj1; + *tj1 = t; +} + + + + +/************************************************************************* +Mann-Whitney U-test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions of the same shape and same median or whether +their medians are different. + +The following tests are performed: + * two-tailed test (null hypothesis - the medians are equal) + * left-tailed test (null hypothesis - the median of the first sample + is greater than or equal to the median of the second sample) + * right-tailed test (null hypothesis - the median of the first sample + is less than or equal to the median of the second sample). + +Requirements: + * the samples are independent + * X and Y are continuous distributions (or discrete distributions well- + approximating continuous distributions) + * distributions of X and Y have the same shape. The only possible + difference is their position (i.e. the value of the median) + * the number of elements in each sample is not less than 5 + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + +The test is non-parametric and doesn't require distributions to be normal. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. N>=5 + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of the sample. M>=5 + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +To calculate p-values, special approximation is used. This method lets us +calculate p-values with satisfactory accuracy in interval [0.0001, 1]. +There is no approximation outside the [0.0001, 1] interval. Therefore, if +the significance level outlies this interval, the test returns 0.0001. + +Relative precision of approximation of p-value: + +N M Max.err. Rms.err. +5..10 N..10 1.4e-02 6.0e-04 +5..10 N..100 2.2e-02 5.3e-06 +10..15 N..15 1.0e-02 3.2e-04 +10..15 N..100 1.0e-02 2.2e-05 +15..100 N..100 6.1e-03 2.7e-06 + +For N,M>100 accuracy checks weren't put into practice, but taking into +account characteristics of asymptotic approximation used, precision should +not be sharply different from the values for interval [5, 100]. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void mannwhitneyutest(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t t; + double tmp; + ae_int_t tmpi; + ae_int_t ns; + ae_vector r; + ae_vector c; + double u; + double p; + double mp; + double s; + double sigma; + double mu; + ae_int_t tiecount; + ae_vector tiesize; + + ae_frame_make(_state, &_frame_block); + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + ae_vector_init(&r, 0, DT_REAL, _state, ae_true); + ae_vector_init(&c, 0, DT_INT, _state, ae_true); + ae_vector_init(&tiesize, 0, DT_INT, _state, ae_true); + + + /* + * Prepare + */ + if( n<=4||m<=4 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + ae_frame_leave(_state); + return; + } + ns = n+m; + ae_vector_set_length(&r, ns-1+1, _state); + ae_vector_set_length(&c, ns-1+1, _state); + for(i=0; i<=n-1; i++) + { + r.ptr.p_double[i] = x->ptr.p_double[i]; + c.ptr.p_int[i] = 0; + } + for(i=0; i<=m-1; i++) + { + r.ptr.p_double[n+i] = y->ptr.p_double[i]; + c.ptr.p_int[n+i] = 1; + } + + /* + * sort {R, C} + */ + if( ns!=1 ) + { + i = 2; + do + { + t = i; + while(t!=1) + { + k = t/2; + if( ae_fp_greater_eq(r.ptr.p_double[k-1],r.ptr.p_double[t-1]) ) + { + t = 1; + } + else + { + tmp = r.ptr.p_double[k-1]; + r.ptr.p_double[k-1] = r.ptr.p_double[t-1]; + r.ptr.p_double[t-1] = tmp; + tmpi = c.ptr.p_int[k-1]; + c.ptr.p_int[k-1] = c.ptr.p_int[t-1]; + c.ptr.p_int[t-1] = tmpi; + t = k; + } + } + i = i+1; + } + while(i<=ns); + i = ns-1; + do + { + tmp = r.ptr.p_double[i]; + r.ptr.p_double[i] = r.ptr.p_double[0]; + r.ptr.p_double[0] = tmp; + tmpi = c.ptr.p_int[i]; + c.ptr.p_int[i] = c.ptr.p_int[0]; + c.ptr.p_int[0] = tmpi; + t = 1; + while(t!=0) + { + k = 2*t; + if( k>i ) + { + t = 0; + } + else + { + if( k=1); + } + + /* + * compute tied ranks + */ + i = 0; + tiecount = 0; + ae_vector_set_length(&tiesize, ns-1+1, _state); + while(i<=ns-1) + { + j = i+1; + while(j<=ns-1) + { + if( ae_fp_neq(r.ptr.p_double[j],r.ptr.p_double[i]) ) + { + break; + } + j = j+1; + } + for(k=i; k<=j-1; k++) + { + r.ptr.p_double[k] = 1+(double)(i+j-1)/(double)2; + } + tiesize.ptr.p_int[tiecount] = j-i; + tiecount = tiecount+1; + i = j; + } + + /* + * Compute U + */ + u = 0; + for(i=0; i<=ns-1; i++) + { + if( c.ptr.p_int[i]==0 ) + { + u = u+r.ptr.p_double[i]; + } + } + u = n*m+n*(n+1)/2-u; + + /* + * Result + */ + mu = (double)(n*m)/(double)2; + tmp = ns*(ae_sqr(ns, _state)-1)/12; + for(i=0; i<=tiecount-1; i++) + { + tmp = tmp-tiesize.ptr.p_int[i]*(ae_sqr(tiesize.ptr.p_int[i], _state)-1)/12; + } + sigma = ae_sqrt((double)(m*n)/(double)ns/(ns-1)*tmp, _state); + s = (u-mu)/sigma; + if( ae_fp_less_eq(s,0) ) + { + p = ae_exp(mannwhitneyu_usigma(-(u-mu)/sigma, n, m, _state), _state); + mp = 1-ae_exp(mannwhitneyu_usigma(-(u-1-mu)/sigma, n, m, _state), _state); + } + else + { + mp = ae_exp(mannwhitneyu_usigma((u-mu)/sigma, n, m, _state), _state); + p = 1-ae_exp(mannwhitneyu_usigma((u+1-mu)/sigma, n, m, _state), _state); + } + *bothtails = ae_maxreal(2*ae_minreal(p, mp, _state), 1.0E-4, _state); + *lefttail = ae_maxreal(mp, 1.0E-4, _state); + *righttail = ae_maxreal(p, 1.0E-4, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Sequential Chebyshev interpolation. +*************************************************************************/ +static void mannwhitneyu_ucheb(double x, + double c, + double* tj, + double* tj1, + double* r, + ae_state *_state) +{ + double t; + + + *r = *r+c*(*tj); + t = 2*x*(*tj1)-(*tj); + *tj = *tj1; + *tj1 = t; +} + + +/************************************************************************* +Three-point polynomial interpolation. +*************************************************************************/ +static double mannwhitneyu_uninterpolate(double p1, + double p2, + double p3, + ae_int_t n, + ae_state *_state) +{ + double t1; + double t2; + double t3; + double t; + double p12; + double p23; + double result; + + + t1 = 1.0/15.0; + t2 = 1.0/30.0; + t3 = 1.0/100.0; + t = 1.0/n; + p12 = ((t-t2)*p1+(t1-t)*p2)/(t1-t2); + p23 = ((t-t3)*p2+(t2-t)*p3)/(t2-t3); + result = ((t-t3)*p12+(t1-t)*p23)/(t1-t3); + return result; +} + + +/************************************************************************* +Tail(0, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma000(ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double p1; + double p2; + double p3; + double result; + + + p1 = mannwhitneyu_uninterpolate(-6.76984e-01, -6.83700e-01, -6.89873e-01, n2, _state); + p2 = mannwhitneyu_uninterpolate(-6.83700e-01, -6.87311e-01, -6.90957e-01, n2, _state); + p3 = mannwhitneyu_uninterpolate(-6.89873e-01, -6.90957e-01, -6.92175e-01, n2, _state); + result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); + return result; +} + + +/************************************************************************* +Tail(0.75, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma075(ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double p1; + double p2; + double p3; + double result; + + + p1 = mannwhitneyu_uninterpolate(-1.44500e+00, -1.45906e+00, -1.47063e+00, n2, _state); + p2 = mannwhitneyu_uninterpolate(-1.45906e+00, -1.46856e+00, -1.47644e+00, n2, _state); + p3 = mannwhitneyu_uninterpolate(-1.47063e+00, -1.47644e+00, -1.48100e+00, n2, _state); + result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); + return result; +} + + +/************************************************************************* +Tail(1.5, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma150(ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double p1; + double p2; + double p3; + double result; + + + p1 = mannwhitneyu_uninterpolate(-2.65380e+00, -2.67352e+00, -2.69011e+00, n2, _state); + p2 = mannwhitneyu_uninterpolate(-2.67352e+00, -2.68591e+00, -2.69659e+00, n2, _state); + p3 = mannwhitneyu_uninterpolate(-2.69011e+00, -2.69659e+00, -2.70192e+00, n2, _state); + result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); + return result; +} + + +/************************************************************************* +Tail(2.25, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma225(ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double p1; + double p2; + double p3; + double result; + + + p1 = mannwhitneyu_uninterpolate(-4.41465e+00, -4.42260e+00, -4.43702e+00, n2, _state); + p2 = mannwhitneyu_uninterpolate(-4.42260e+00, -4.41639e+00, -4.41928e+00, n2, _state); + p3 = mannwhitneyu_uninterpolate(-4.43702e+00, -4.41928e+00, -4.41030e+00, n2, _state); + result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); + return result; +} + + +/************************************************************************* +Tail(3.0, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma300(ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double p1; + double p2; + double p3; + double result; + + + p1 = mannwhitneyu_uninterpolate(-6.89839e+00, -6.83477e+00, -6.82340e+00, n2, _state); + p2 = mannwhitneyu_uninterpolate(-6.83477e+00, -6.74559e+00, -6.71117e+00, n2, _state); + p3 = mannwhitneyu_uninterpolate(-6.82340e+00, -6.71117e+00, -6.64929e+00, n2, _state); + result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); + return result; +} + + +/************************************************************************* +Tail(3.33, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma333(ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double p1; + double p2; + double p3; + double result; + + + p1 = mannwhitneyu_uninterpolate(-8.31272e+00, -8.17096e+00, -8.13125e+00, n2, _state); + p2 = mannwhitneyu_uninterpolate(-8.17096e+00, -8.00156e+00, -7.93245e+00, n2, _state); + p3 = mannwhitneyu_uninterpolate(-8.13125e+00, -7.93245e+00, -7.82502e+00, n2, _state); + result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); + return result; +} + + +/************************************************************************* +Tail(3.66, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma367(ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double p1; + double p2; + double p3; + double result; + + + p1 = mannwhitneyu_uninterpolate(-9.98837e+00, -9.70844e+00, -9.62087e+00, n2, _state); + p2 = mannwhitneyu_uninterpolate(-9.70844e+00, -9.41156e+00, -9.28998e+00, n2, _state); + p3 = mannwhitneyu_uninterpolate(-9.62087e+00, -9.28998e+00, -9.11686e+00, n2, _state); + result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); + return result; +} + + +/************************************************************************* +Tail(4.0, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma400(ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double p1; + double p2; + double p3; + double result; + + + p1 = mannwhitneyu_uninterpolate(-1.20250e+01, -1.14911e+01, -1.13231e+01, n2, _state); + p2 = mannwhitneyu_uninterpolate(-1.14911e+01, -1.09927e+01, -1.07937e+01, n2, _state); + p3 = mannwhitneyu_uninterpolate(-1.13231e+01, -1.07937e+01, -1.05285e+01, n2, _state); + result = mannwhitneyu_uninterpolate(p1, p2, p3, n1, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 5) +*************************************************************************/ +static double mannwhitneyu_utbln5n5(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/2.611165e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -2.596264e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.412086e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.858542e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.614282e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.372686e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.524731e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.435331e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.284665e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.184141e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.298360e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 7.447272e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.938769e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.276205e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.138481e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.684625e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.558104e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 6) +*************************************************************************/ +static double mannwhitneyu_utbln5n6(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/2.738613e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -2.810459e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.684429e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.712858e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.009324e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.644391e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.034173e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.953498e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.279293e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.563485e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.971952e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.506309e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.541406e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.283205e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.016347e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.221626e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.286752e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 7) +*************************************************************************/ +static double mannwhitneyu_utbln5n7(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/2.841993e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -2.994677e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.923264e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.506190e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.054280e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.794587e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.726290e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.534180e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.517845e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.904428e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.882443e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.482988e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.114875e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.515082e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.996056e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.293581e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.349444e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 8) +*************************************************************************/ +static double mannwhitneyu_utbln5n8(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/2.927700e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.155727e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.135078e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.247203e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.309697e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.993725e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.567219e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.383704e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.002188e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.487322e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.443899e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.688270e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.600339e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.874948e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.811593e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.072353e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.659457e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 9) +*************************************************************************/ +static double mannwhitneyu_utbln5n9(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.298162e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.325016e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.939852e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.563029e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.222652e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.195200e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.445665e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.204792e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.775217e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.527781e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.221948e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.242968e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.607959e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.771285e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.694026e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.481190e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 10) +*************************************************************************/ +static double mannwhitneyu_utbln5n10(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.061862e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.425360e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.496710e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.587658e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.812005e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.427637e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.515702e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.406867e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.796295e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.237591e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.654249e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.181165e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.011665e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.417927e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.534880e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.791255e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.871512e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 11) +*************************************************************************/ +static double mannwhitneyu_utbln5n11(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.115427e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.539959e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.652998e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.196503e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.054363e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.618848e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.109411e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.786668e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.215648e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.484220e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.935991e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.396191e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.894177e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.206979e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.519055e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.210326e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.189679e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 12) +*************************************************************************/ +static double mannwhitneyu_utbln5n12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.162278e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.644007e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.796173e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.771177e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.290043e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.794686e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.702110e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.185959e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.416259e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.592056e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.201530e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.754365e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.978945e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.012032e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.304579e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.100378e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.728269e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 13) +*************************************************************************/ +static double mannwhitneyu_utbln5n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.203616e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.739120e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.928117e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.031605e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.519403e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.962648e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.292183e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.809293e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.465156e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.456278e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.446055e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.109490e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.218256e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.941479e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.058603e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.824402e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.830947e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 14) +*************************************************************************/ +static double mannwhitneyu_utbln5n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.240370e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.826559e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.050370e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.083408e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.743164e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.012030e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.884686e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.059656e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.327521e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.134026e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.584201e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.440618e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.524133e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.990007e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.887334e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.534977e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.705395e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 15) +*************************************************************************/ +static double mannwhitneyu_utbln5n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.851572e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.082033e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.095983e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.814595e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.073148e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.420213e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.517175e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.344180e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.371393e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.711443e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.228569e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.683483e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.267112e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.156044e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.131316e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.301023e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 16) +*************************************************************************/ +static double mannwhitneyu_utbln5n16(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.852210e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.077482e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.091186e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.797282e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.084994e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.667054e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.843909e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.456732e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.039830e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.723508e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.940608e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.478285e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.649144e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.237703e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.707410e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.874293e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 17) +*************************************************************************/ +static double mannwhitneyu_utbln5n17(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.851752e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.071259e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.084700e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.758898e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.073846e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.684838e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.964936e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.782442e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.956362e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.984727e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.196936e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.558262e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.690746e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.364855e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.401006e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.546748e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 18) +*************************************************************************/ +static double mannwhitneyu_utbln5n18(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.850840e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.064799e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.077651e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.712659e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.049217e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.571333e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.929809e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.752044e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.949464e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.896101e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.614460e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.384357e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.489113e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.445725e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.945636e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.424653e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 19) +*************************************************************************/ +static double mannwhitneyu_utbln5n19(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.850027e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.059159e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.071106e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.669960e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.022780e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.442555e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.851335e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.433865e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.514465e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.332989e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.606099e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.341945e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.402164e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.039761e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.512831e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.284427e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 20) +*************************************************************************/ +static double mannwhitneyu_utbln5n20(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.849651e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.054729e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.065747e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.636243e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.003234e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.372789e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.831551e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.763090e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.830626e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.122384e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.108328e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.557983e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.945666e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.965696e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.493236e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.162591e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 21) +*************************************************************************/ +static double mannwhitneyu_utbln5n21(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.849649e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.051155e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.061430e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.608869e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.902788e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.346562e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.874709e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.682887e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.026206e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.534551e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.990575e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.713334e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.737011e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.304571e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.133110e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.123457e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 22) +*************************************************************************/ +static double mannwhitneyu_utbln5n22(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.849598e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.047605e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.057264e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.579513e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.749602e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.275137e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.881768e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.177374e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.981056e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.696290e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.886803e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.085378e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.675242e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.426367e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.039613e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.662378e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 23) +*************************************************************************/ +static double mannwhitneyu_utbln5n23(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.849269e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.043761e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.052735e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.544683e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.517503e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.112082e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.782070e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.549483e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.747329e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.694263e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.147141e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.526209e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.039173e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.235615e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.656546e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.014423e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 24) +*************************************************************************/ +static double mannwhitneyu_utbln5n24(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.848925e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.040178e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.048355e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.510198e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.261134e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.915864e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.627423e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.307345e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.732992e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.869652e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.494176e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.047533e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.178439e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.424171e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.829195e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.840810e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 25) +*************************************************************************/ +static double mannwhitneyu_utbln5n25(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.848937e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.037512e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.044866e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.483269e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.063682e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.767778e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.508540e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.332756e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.881511e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.124041e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.368456e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.930499e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.779630e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.029528e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.658678e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.289695e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 26) +*************************************************************************/ +static double mannwhitneyu_utbln5n26(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.849416e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.035915e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.042493e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.466021e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.956432e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.698914e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.465689e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.035254e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.674614e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.492734e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.014021e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.944953e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.255750e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.075841e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.989330e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.134862e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 27) +*************************************************************************/ +static double mannwhitneyu_utbln5n27(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.850070e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.034815e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.040650e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.453117e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.886426e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.661702e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.452346e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.002476e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.720126e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.001400e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.729826e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.740640e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.206333e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.366093e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.193471e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.804091e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 28) +*************************************************************************/ +static double mannwhitneyu_utbln5n28(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.850668e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.033786e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.038853e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.440281e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.806020e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.612883e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.420436e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.787982e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.535230e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.263121e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.849609e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.863967e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.391610e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.720294e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.952273e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.901413e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 29) +*************************************************************************/ +static double mannwhitneyu_utbln5n29(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.851217e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.032834e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.037113e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.427762e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.719146e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.557172e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.375498e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.452033e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.187516e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.916936e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.065533e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.067301e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.615824e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.432244e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.417795e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.710038e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 30) +*************************************************************************/ +static double mannwhitneyu_utbln5n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.851845e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.032148e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.035679e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.417758e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.655330e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.522132e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.352106e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.326911e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.064969e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.813321e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.683881e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.813346e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.627085e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.832107e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.519336e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.888530e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 5, 100) +*************************************************************************/ +static double mannwhitneyu_utbln5n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.250000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.877940e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.039324e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.022243e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.305825e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.960119e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.112000e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.138868e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.418164e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.174520e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.489617e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.878301e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.302233e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.054113e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.458862e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.186591e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.623412e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 6) +*************************************************************************/ +static double mannwhitneyu_utbln6n6(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/2.882307e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.054075e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.998804e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.681518e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.067578e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.709435e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.952661e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.641700e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.304572e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.336275e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.770385e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.401891e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.246148e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.442663e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.502866e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.105855e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.739371e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 7) +*************************************************************************/ +static double mannwhitneyu_utbln6n7(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.265287e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.274613e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.582352e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.334293e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.915502e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.108091e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.546701e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.298827e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.891501e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.313717e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.989501e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.914594e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.062372e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.158841e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.596443e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.185662e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 8) +*************************************************************************/ +static double mannwhitneyu_utbln6n8(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.098387e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.450954e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.520462e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.420299e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.604853e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.165840e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.008756e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.723402e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.843521e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.883405e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.720980e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.301709e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.948034e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.776243e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.623736e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.742068e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.796927e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 9) +*************************************************************************/ +static double mannwhitneyu_utbln6n9(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.181981e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.616113e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.741650e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.204487e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.873068e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.446794e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.632286e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.266481e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.280067e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.780687e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.480242e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.592200e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.581019e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.264231e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.347174e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.167535e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.092185e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 10) +*************************************************************************/ +static double mannwhitneyu_utbln6n10(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.253957e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.764382e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.942366e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.939896e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.137812e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.720270e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.281070e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.901060e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.824937e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.802812e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.258132e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.233536e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.085530e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.212151e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.001329e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.226048e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.035298e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 11) +*************************************************************************/ +static double mannwhitneyu_utbln6n11(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.316625e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.898597e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.125710e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.063297e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.396852e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.990126e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.927977e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.726500e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.858745e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.654590e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.217736e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.989770e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.768493e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.924364e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.140215e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.647914e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.924802e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 12) +*************************************************************************/ +static double mannwhitneyu_utbln6n12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.371709e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.020941e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.294250e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.128842e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.650389e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.248611e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.578510e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.162852e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.746982e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.454209e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.128042e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.936650e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.530794e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.665192e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.994144e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.662249e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.368541e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 13) +*************************************************************************/ +static double mannwhitneyu_utbln6n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.420526e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.133167e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.450016e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.191088e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.898220e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.050249e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.226901e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.471113e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.007470e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.049420e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.059074e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.881249e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.452780e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.441805e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.787493e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.483957e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.481590e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 14) +*************************************************************************/ +static double mannwhitneyu_utbln6n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.450000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.201268e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.542568e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.226965e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.046029e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.136657e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.786757e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.843748e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.588022e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.253029e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.667188e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.788330e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.474545e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.540494e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.951188e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.863323e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.220904e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 15) +*************************************************************************/ +static double mannwhitneyu_utbln6n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.450000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.195689e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.526567e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.213617e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.975035e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.118480e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.859142e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.083312e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.298720e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.766708e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.026356e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.093113e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.135168e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.136376e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.190870e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.435972e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.413129e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 30) +*************************************************************************/ +static double mannwhitneyu_utbln6n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.450000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.166269e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.427399e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.118239e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.360847e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.745885e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.025041e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.187179e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.432089e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.408451e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.388774e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.795560e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.304136e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.258516e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.180236e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.388679e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.836027e-06, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 6, 100) +*************************************************************************/ +static double mannwhitneyu_utbln6n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.450000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.181350e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.417919e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.094201e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.195883e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.818937e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.514202e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.125047e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.022148e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.284181e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.157766e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.023752e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.127985e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.221690e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.516179e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.501398e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.380220e-06, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 7) +*************************************************************************/ +static double mannwhitneyu_utbln7n7(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.130495e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.501264e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.584790e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.577311e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.617002e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.145186e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.023462e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.408251e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.626515e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.072492e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.722926e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.095445e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.842602e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.751427e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.008927e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.892431e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.772386e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 8) +*************************************************************************/ +static double mannwhitneyu_utbln7n8(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.240370e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.709965e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.862154e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.504541e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.900195e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.439995e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.678028e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.485540e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.437047e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.440092e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.114227e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.516569e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.829457e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.787550e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.761866e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.991911e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.533481e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 9) +*************************************************************************/ +static double mannwhitneyu_utbln7n9(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.334314e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.896550e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.112671e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.037277e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.181695e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.765190e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.360116e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.695960e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.780578e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.963843e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.616148e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.852104e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.390744e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.014041e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.888101e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.467474e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.004611e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 10) +*************************************************************************/ +static double mannwhitneyu_utbln7n10(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.415650e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.064844e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.340749e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.118888e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.459730e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.097781e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.057688e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.097406e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.209262e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.065641e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.196677e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.313994e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.827157e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.822284e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.389090e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.340850e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.395172e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 11) +*************************************************************************/ +static double mannwhitneyu_utbln7n11(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.486817e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.217795e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.549783e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.195905e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.733093e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.428447e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.760093e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.431676e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.717152e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.032199e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.832423e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.905979e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.302799e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.464371e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.456211e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.736244e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.140712e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 12) +*************************************************************************/ +static double mannwhitneyu_utbln7n12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.235822e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.564100e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.190813e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.686546e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.395083e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.967359e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.747096e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.304144e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.903198e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.134906e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.175035e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.266224e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.892931e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.604706e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.070459e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.427010e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 13) +*************************************************************************/ +static double mannwhitneyu_utbln7n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.222204e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.532300e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.164642e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.523768e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.531984e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.467857e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.483804e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.524136e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.077740e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.745218e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.602085e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.828831e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.994070e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.873879e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.341937e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.706444e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 14) +*************************************************************************/ +static double mannwhitneyu_utbln7n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.211763e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.507542e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.143640e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.395755e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.808020e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.044259e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.182308e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.057325e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.724255e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.303900e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.113148e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.102514e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.559442e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.634986e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.776476e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.054489e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 15) +*************************************************************************/ +static double mannwhitneyu_utbln7n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.204898e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.489960e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.129172e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.316741e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.506107e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.983676e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.258013e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.262515e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.984156e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.912108e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.974023e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.056195e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.090842e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.232620e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.816339e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.020421e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 30) +*************************************************************************/ +static double mannwhitneyu_utbln7n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.176536e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.398705e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.045481e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.821982e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.962304e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.698132e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.062667e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.282353e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.014836e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.035683e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.004137e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.801453e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.920705e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.518735e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.821501e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.801008e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 7, 100) +*************************************************************************/ +static double mannwhitneyu_utbln7n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.500000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.188337e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.386949e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.022834e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.686517e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.323516e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.399392e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.644333e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.617044e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.031396e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.792066e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.675457e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.673416e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.258552e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.174214e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.073644e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.349958e-06, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 8) +*************************************************************************/ +static double mannwhitneyu_utbln8n8(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.360672e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -3.940217e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.168913e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.051485e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.195325e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.775196e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.385506e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.244902e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.525632e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.771275e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.332874e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.079599e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.882551e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.407944e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.769844e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.062433e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.872535e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 9) +*************************************************************************/ +static double mannwhitneyu_utbln8n9(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.464102e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.147004e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.446939e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.146155e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.488561e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.144561e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.116917e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.205667e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.515661e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.618616e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.599011e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.457324e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.482917e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.488267e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.469823e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.957591e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.058326e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 10) +*************************************************************************/ +static double mannwhitneyu_utbln8n10(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.554093e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.334282e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.700860e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.235253e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.778489e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.527324e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.862885e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.589781e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.507355e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.717526e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.215726e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.848696e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.918854e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.219614e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.753761e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.573688e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.602177e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 11) +*************************************************************************/ +static double mannwhitneyu_utbln8n11(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.421882e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.812457e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.266153e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.849344e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.971527e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.258944e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.944820e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.894685e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.031836e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.514330e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.351660e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.206748e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.492600e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.005338e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.780099e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.673599e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 12) +*************************************************************************/ +static double mannwhitneyu_utbln8n12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.398211e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.762214e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.226296e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.603837e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.643223e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.502438e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.544574e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.647734e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.442259e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.011484e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.384758e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.998259e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.659985e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.331046e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.638478e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.056785e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 13) +*************************************************************************/ +static double mannwhitneyu_utbln8n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.380670e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.724511e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.195851e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.420511e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.609928e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.893999e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.115919e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.291410e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.339664e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.801548e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.534710e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.793250e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.806718e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.384624e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.120582e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.936453e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 14) +*************************************************************************/ +static double mannwhitneyu_utbln8n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.368494e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.697171e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.174440e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.300621e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.087393e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.685826e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.085254e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.525658e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.966647e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.453388e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.826066e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.501958e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.336297e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.251972e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.118456e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.415959e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 15) +*************************************************************************/ +static double mannwhitneyu_utbln8n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.358397e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.674485e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.155941e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.195780e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.544830e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.426183e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.309902e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.650956e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.068874e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.538544e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.192525e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.073905e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.079673e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.423572e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.579647e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.765904e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 30) +*************************************************************************/ +static double mannwhitneyu_utbln8n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.318823e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.567159e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.064864e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.688413e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.153712e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.309389e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.226861e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.523815e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.780987e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.166866e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.922431e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.466397e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.690036e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.008185e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.271903e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.534751e-06, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 8, 100) +*************************************************************************/ +static double mannwhitneyu_utbln8n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.600000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.324531e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.547071e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.038129e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.541549e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.525605e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.044992e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.085713e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.017871e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.459226e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.092064e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.024349e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 7.366347e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.385637e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.321722e-08, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.439286e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.058079e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 9) +*************************************************************************/ +static double mannwhitneyu_utbln9n9(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.576237e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.372857e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.750859e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.248233e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.792868e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.559372e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.894941e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.643256e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.091370e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.285034e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.112997e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.806229e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.150741e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.509825e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.891051e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.485013e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.343653e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 10) +*************************************************************************/ +static double mannwhitneyu_utbln9n10(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.516726e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.939333e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.305046e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.935326e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.029141e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.420592e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.053140e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.065930e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.523581e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.544888e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.813741e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.510631e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.536057e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.833815e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.189692e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.615050e-03, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 11) +*************************************************************************/ +static double mannwhitneyu_utbln9n11(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.481308e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.867483e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.249072e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.591790e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.400128e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.341992e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.463680e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.487211e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.671196e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.343472e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.544146e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.802335e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.117084e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.217443e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.858766e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.193687e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 12) +*************************************************************************/ +static double mannwhitneyu_utbln9n12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.456776e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.817037e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.209788e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.362108e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.171356e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.661557e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.026141e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.361908e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.093885e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.298389e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.663603e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.768522e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.579015e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.868677e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.440652e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.523037e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 13) +*************************************************************************/ +static double mannwhitneyu_utbln9n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.438840e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.779308e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.180614e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.196489e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.346621e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.234857e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.796211e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.575715e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.525647e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.964651e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.275235e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.299124e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.397416e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.295781e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.237619e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 7.269692e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 14) +*************************************************************************/ +static double mannwhitneyu_utbln9n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.425981e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.751545e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.159543e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.086570e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.917446e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.120112e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.175519e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.515473e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.727772e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.070629e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.677569e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.876953e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.233502e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.508182e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.120389e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.847212e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 15) +*************************************************************************/ +static double mannwhitneyu_utbln9n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.414952e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.727612e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.140634e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.981231e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.382635e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.853575e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.571051e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.567625e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.214197e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.448700e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.712669e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.015050e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.438610e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.301363e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.309386e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.164772e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 30) +*************************************************************************/ +static double mannwhitneyu_utbln9n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.370720e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.615712e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.050023e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.504775e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.318265e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.646826e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.741492e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.735360e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.966911e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.100738e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.348991e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.527687e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.917286e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.397466e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.360175e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.892252e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 9, 100) +*************************************************************************/ +static double mannwhitneyu_utbln9n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.372506e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.590966e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.021758e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.359849e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.755519e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.533166e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.936659e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.634913e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.730053e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.791845e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.030682e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.228663e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.631175e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.636749e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.404599e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.789872e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 10, 10) +*************************************************************************/ +static double mannwhitneyu_utbln10n10(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.468831e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.844398e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.231728e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.486073e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.781321e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.971425e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.215371e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.828451e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.419872e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.430165e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.740363e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.049211e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.269371e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.211393e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.232314e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.016081e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 10, 11) +*************************************************************************/ +static double mannwhitneyu_utbln10n11(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.437998e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.782296e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.184732e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.219585e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.457012e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.296008e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.481501e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.527940e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.953426e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.563840e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.574403e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.535775e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.338037e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.002654e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.852676e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.318132e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 10, 12) +*************************************************************************/ +static double mannwhitneyu_utbln10n12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.416082e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.737458e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.150952e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.036884e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.609030e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.908684e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.439666e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.162647e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.451601e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.148757e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.803981e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.731621e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.346903e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.013151e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.956148e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.438381e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 10, 13) +*************************************************************************/ +static double mannwhitneyu_utbln10n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.399480e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.702863e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.124829e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.897428e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.979802e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.634368e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.180461e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.484926e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.864376e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.186576e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.886925e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.836828e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.074756e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.209547e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.883266e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.380143e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 10, 14) +*************************************************************************/ +static double mannwhitneyu_utbln10n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.386924e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.676124e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.104740e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.793826e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.558886e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.492462e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.052903e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.917782e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.878696e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.576046e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.764551e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.288778e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.757658e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.299101e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.265197e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.384503e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 10, 15) +*************************************************************************/ +static double mannwhitneyu_utbln10n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.376846e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.654247e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.088083e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.705945e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.169677e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.317213e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.264836e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.548024e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.633910e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.505621e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.658588e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.320254e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.175277e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.122317e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.675688e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.661363e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 10, 30) +*************************************************************************/ +static double mannwhitneyu_utbln10n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.333977e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.548099e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.004444e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.291014e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.523674e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.828211e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.716917e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.894256e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.433371e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.522675e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.764192e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.140235e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.629230e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.541895e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.944946e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.726360e-06, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 10, 100) +*************************************************************************/ +static double mannwhitneyu_utbln10n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.650000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.334008e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.522316e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.769627e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.158110e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.053650e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.242235e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.173571e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.033661e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.824732e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.084420e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.610036e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.728155e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.217130e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.340966e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.001235e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.694052e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 11, 11) +*************************************************************************/ +static double mannwhitneyu_utbln11n11(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.519760e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.880694e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.200698e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.174092e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.072304e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.054773e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.506613e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.813942e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.223644e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.417416e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.499166e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.194332e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 7.369096e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.968590e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.630532e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.061000e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 11, 12) +*************************************************************************/ +static double mannwhitneyu_utbln11n12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.495790e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.832622e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.165420e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.987306e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.265621e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.723537e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.347406e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.353464e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.613369e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.102522e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.237709e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.665652e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.626903e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.167518e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.564455e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.047320e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 11, 13) +*************************************************************************/ +static double mannwhitneyu_utbln11n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.477880e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.796242e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.138769e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.851739e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.722104e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.548304e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.176683e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.817895e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.842451e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.935870e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.421777e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.238831e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.867026e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.458255e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.306259e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.961487e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 11, 14) +*************************************************************************/ +static double mannwhitneyu_utbln11n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.463683e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.766969e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.117082e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.739574e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.238865e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.350306e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.425871e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.640172e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.660633e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.879883e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.349658e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.271795e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.304544e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.024201e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.816867e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.596787e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 11, 15) +*************************************************************************/ +static double mannwhitneyu_utbln11n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.452526e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.743570e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.099705e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.650612e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.858285e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.187036e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.689241e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.294360e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.072623e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.278008e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.322382e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.131558e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.305669e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.825627e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.332689e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.120973e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 11, 30) +*************************************************************************/ +static double mannwhitneyu_utbln11n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.402621e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.627440e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.011333e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.224126e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.232856e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.859347e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.377381e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.756709e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.033230e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.875472e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.608399e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.102943e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.740693e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.343139e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.196878e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.658062e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 11, 100) +*************************************************************************/ +static double mannwhitneyu_utbln11n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.398795e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.596486e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.814761e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.085187e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.766529e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.379425e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.986351e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.214705e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.360075e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.260869e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.033307e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.727087e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.393883e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.242989e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.111928e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.898823e-09, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 12, 12) +*************************************************************************/ +static double mannwhitneyu_utbln12n12(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.472616e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.786627e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.132099e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.817523e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.570179e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.479511e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.799492e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.565350e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.530139e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.380132e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.242761e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.576269e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.018771e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.933911e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.002799e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.022048e-06, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 12, 13) +*************************************************************************/ +static double mannwhitneyu_utbln12n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.454800e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.750794e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.105988e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.684754e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.011826e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.262579e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.044492e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.478741e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.322165e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.621104e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.068753e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.468396e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.056235e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.327375e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.914877e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.784191e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 12, 14) +*************************************************************************/ +static double mannwhitneyu_utbln12n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.440910e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.722404e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.085254e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.579439e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.563738e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.066730e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.129346e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.014531e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.129679e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.000909e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.996174e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.377924e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.936304e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.051098e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.025820e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 8.730585e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 12, 15) +*************************************************************************/ +static double mannwhitneyu_utbln12n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.430123e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.700008e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.068971e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.499725e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.250897e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.473145e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.680008e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.483350e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.766992e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.891081e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.015140e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.977756e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.707414e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.114786e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.238865e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.381445e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 12, 30) +*************************************************************************/ +static double mannwhitneyu_utbln12n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.380023e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.585782e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.838583e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.103394e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.834015e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.635212e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.948212e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.574169e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.747980e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.833672e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.722433e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.181038e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.206473e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.716003e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.476434e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.217700e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 12, 100) +*************************************************************************/ +static double mannwhitneyu_utbln12n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.700000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.374567e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.553481e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.541334e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.701907e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.414757e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.404103e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.234388e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.453762e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.311060e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.317501e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.713888e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.309583e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.019804e-08, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.224829e-09, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.349019e-08, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.893302e-08, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 13, 13) +*************************************************************************/ +static double mannwhitneyu_utbln13n13(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.541046e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.859047e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.130164e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.689719e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.950693e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.231455e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.976550e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.538455e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.245603e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.142647e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.831434e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.032483e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.488405e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.156927e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.949279e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.532700e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 13, 14) +*************************************************************************/ +static double mannwhitneyu_utbln13n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.525655e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.828341e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.108110e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.579552e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.488307e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.032328e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.988741e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.766394e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.388950e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.338179e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.133440e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.023518e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.110570e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.202332e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.056132e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.536323e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 13, 15) +*************************************************************************/ +static double mannwhitneyu_utbln13n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.513585e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.803952e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.090686e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.495310e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.160314e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.073124e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.480313e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.478239e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.140914e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.311541e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.677105e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.115464e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.578563e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.044604e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.888939e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 2.395644e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 13, 30) +*************************************************************************/ +static double mannwhitneyu_utbln13n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.455999e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.678434e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.995491e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.078100e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.705220e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.258739e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.671526e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.185458e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.507764e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.411446e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.044355e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.285765e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.345282e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.066940e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.962037e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.723644e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 13, 100) +*************************************************************************/ +static double mannwhitneyu_utbln13n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.446787e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.640804e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.671552e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.364990e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.274444e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.047440e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.161439e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.171729e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.562171e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.359762e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.275494e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.747635e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.700292e-08, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.565559e-09, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 5.005396e-09, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 3.335794e-09, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 14, 14) +*************************************************************************/ +static double mannwhitneyu_utbln14n14(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.510624e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.798584e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.087107e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.478532e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.098050e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.855986e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.409083e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.299536e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.176177e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.479417e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.812761e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -5.225872e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 4.516521e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 6.730551e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 9.237563e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.611820e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 14, 15) +*************************************************************************/ +static double mannwhitneyu_utbln14n15(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.498681e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.774668e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.070267e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.399348e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.807239e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.845763e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.071773e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.261698e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.011695e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.305946e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.879295e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.999439e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.904438e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.944986e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.373908e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.140794e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 14, 30) +*************************************************************************/ +static double mannwhitneyu_utbln14n30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.440378e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.649587e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.807829e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.989753e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.463646e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.586580e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -6.745917e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.635398e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.923172e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.446699e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.613892e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.214073e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.651683e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.272777e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.464988e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.109803e-07, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 14, 100) +*************************************************************************/ +static double mannwhitneyu_utbln14n100(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/3.750000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + mannwhitneyu_ucheb(x, -4.429701e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -4.610577e+00, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -9.482675e-01, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.605550e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.062151e-02, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.525154e-03, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.835983e-04, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -8.411440e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.744901e-05, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.318850e-06, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.692100e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -1.536270e-07, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -3.705888e-08, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -7.999599e-09, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, -2.908395e-09, &tj, &tj1, &result, _state); + mannwhitneyu_ucheb(x, 1.546923e-09, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, N1, N2) +*************************************************************************/ +static double mannwhitneyu_usigma(double s, + ae_int_t n1, + ae_int_t n2, + ae_state *_state) +{ + double f0; + double f1; + double f2; + double f3; + double f4; + double s0; + double s1; + double s2; + double s3; + double s4; + double result; + + + result = 0; + + /* + * N1=5, N2 = 5, 6, 7, ... + */ + if( ae_minint(n1, n2, _state)==5 ) + { + if( ae_maxint(n1, n2, _state)==5 ) + { + result = mannwhitneyu_utbln5n5(s, _state); + } + if( ae_maxint(n1, n2, _state)==6 ) + { + result = mannwhitneyu_utbln5n6(s, _state); + } + if( ae_maxint(n1, n2, _state)==7 ) + { + result = mannwhitneyu_utbln5n7(s, _state); + } + if( ae_maxint(n1, n2, _state)==8 ) + { + result = mannwhitneyu_utbln5n8(s, _state); + } + if( ae_maxint(n1, n2, _state)==9 ) + { + result = mannwhitneyu_utbln5n9(s, _state); + } + if( ae_maxint(n1, n2, _state)==10 ) + { + result = mannwhitneyu_utbln5n10(s, _state); + } + if( ae_maxint(n1, n2, _state)==11 ) + { + result = mannwhitneyu_utbln5n11(s, _state); + } + if( ae_maxint(n1, n2, _state)==12 ) + { + result = mannwhitneyu_utbln5n12(s, _state); + } + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln5n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln5n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln5n15(s, _state); + } + if( ae_maxint(n1, n2, _state)==16 ) + { + result = mannwhitneyu_utbln5n16(s, _state); + } + if( ae_maxint(n1, n2, _state)==17 ) + { + result = mannwhitneyu_utbln5n17(s, _state); + } + if( ae_maxint(n1, n2, _state)==18 ) + { + result = mannwhitneyu_utbln5n18(s, _state); + } + if( ae_maxint(n1, n2, _state)==19 ) + { + result = mannwhitneyu_utbln5n19(s, _state); + } + if( ae_maxint(n1, n2, _state)==20 ) + { + result = mannwhitneyu_utbln5n20(s, _state); + } + if( ae_maxint(n1, n2, _state)==21 ) + { + result = mannwhitneyu_utbln5n21(s, _state); + } + if( ae_maxint(n1, n2, _state)==22 ) + { + result = mannwhitneyu_utbln5n22(s, _state); + } + if( ae_maxint(n1, n2, _state)==23 ) + { + result = mannwhitneyu_utbln5n23(s, _state); + } + if( ae_maxint(n1, n2, _state)==24 ) + { + result = mannwhitneyu_utbln5n24(s, _state); + } + if( ae_maxint(n1, n2, _state)==25 ) + { + result = mannwhitneyu_utbln5n25(s, _state); + } + if( ae_maxint(n1, n2, _state)==26 ) + { + result = mannwhitneyu_utbln5n26(s, _state); + } + if( ae_maxint(n1, n2, _state)==27 ) + { + result = mannwhitneyu_utbln5n27(s, _state); + } + if( ae_maxint(n1, n2, _state)==28 ) + { + result = mannwhitneyu_utbln5n28(s, _state); + } + if( ae_maxint(n1, n2, _state)==29 ) + { + result = mannwhitneyu_utbln5n29(s, _state); + } + if( ae_maxint(n1, n2, _state)>29 ) + { + f0 = mannwhitneyu_utbln5n15(s, _state); + f1 = mannwhitneyu_utbln5n30(s, _state); + f2 = mannwhitneyu_utbln5n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=6, N2 = 6, 7, 8, ... + */ + if( ae_minint(n1, n2, _state)==6 ) + { + if( ae_maxint(n1, n2, _state)==6 ) + { + result = mannwhitneyu_utbln6n6(s, _state); + } + if( ae_maxint(n1, n2, _state)==7 ) + { + result = mannwhitneyu_utbln6n7(s, _state); + } + if( ae_maxint(n1, n2, _state)==8 ) + { + result = mannwhitneyu_utbln6n8(s, _state); + } + if( ae_maxint(n1, n2, _state)==9 ) + { + result = mannwhitneyu_utbln6n9(s, _state); + } + if( ae_maxint(n1, n2, _state)==10 ) + { + result = mannwhitneyu_utbln6n10(s, _state); + } + if( ae_maxint(n1, n2, _state)==11 ) + { + result = mannwhitneyu_utbln6n11(s, _state); + } + if( ae_maxint(n1, n2, _state)==12 ) + { + result = mannwhitneyu_utbln6n12(s, _state); + } + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln6n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln6n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln6n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln6n15(s, _state); + f1 = mannwhitneyu_utbln6n30(s, _state); + f2 = mannwhitneyu_utbln6n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=7, N2 = 7, 8, ... + */ + if( ae_minint(n1, n2, _state)==7 ) + { + if( ae_maxint(n1, n2, _state)==7 ) + { + result = mannwhitneyu_utbln7n7(s, _state); + } + if( ae_maxint(n1, n2, _state)==8 ) + { + result = mannwhitneyu_utbln7n8(s, _state); + } + if( ae_maxint(n1, n2, _state)==9 ) + { + result = mannwhitneyu_utbln7n9(s, _state); + } + if( ae_maxint(n1, n2, _state)==10 ) + { + result = mannwhitneyu_utbln7n10(s, _state); + } + if( ae_maxint(n1, n2, _state)==11 ) + { + result = mannwhitneyu_utbln7n11(s, _state); + } + if( ae_maxint(n1, n2, _state)==12 ) + { + result = mannwhitneyu_utbln7n12(s, _state); + } + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln7n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln7n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln7n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln7n15(s, _state); + f1 = mannwhitneyu_utbln7n30(s, _state); + f2 = mannwhitneyu_utbln7n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=8, N2 = 8, 9, 10, ... + */ + if( ae_minint(n1, n2, _state)==8 ) + { + if( ae_maxint(n1, n2, _state)==8 ) + { + result = mannwhitneyu_utbln8n8(s, _state); + } + if( ae_maxint(n1, n2, _state)==9 ) + { + result = mannwhitneyu_utbln8n9(s, _state); + } + if( ae_maxint(n1, n2, _state)==10 ) + { + result = mannwhitneyu_utbln8n10(s, _state); + } + if( ae_maxint(n1, n2, _state)==11 ) + { + result = mannwhitneyu_utbln8n11(s, _state); + } + if( ae_maxint(n1, n2, _state)==12 ) + { + result = mannwhitneyu_utbln8n12(s, _state); + } + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln8n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln8n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln8n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln8n15(s, _state); + f1 = mannwhitneyu_utbln8n30(s, _state); + f2 = mannwhitneyu_utbln8n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=9, N2 = 9, 10, ... + */ + if( ae_minint(n1, n2, _state)==9 ) + { + if( ae_maxint(n1, n2, _state)==9 ) + { + result = mannwhitneyu_utbln9n9(s, _state); + } + if( ae_maxint(n1, n2, _state)==10 ) + { + result = mannwhitneyu_utbln9n10(s, _state); + } + if( ae_maxint(n1, n2, _state)==11 ) + { + result = mannwhitneyu_utbln9n11(s, _state); + } + if( ae_maxint(n1, n2, _state)==12 ) + { + result = mannwhitneyu_utbln9n12(s, _state); + } + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln9n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln9n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln9n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln9n15(s, _state); + f1 = mannwhitneyu_utbln9n30(s, _state); + f2 = mannwhitneyu_utbln9n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=10, N2 = 10, 11, ... + */ + if( ae_minint(n1, n2, _state)==10 ) + { + if( ae_maxint(n1, n2, _state)==10 ) + { + result = mannwhitneyu_utbln10n10(s, _state); + } + if( ae_maxint(n1, n2, _state)==11 ) + { + result = mannwhitneyu_utbln10n11(s, _state); + } + if( ae_maxint(n1, n2, _state)==12 ) + { + result = mannwhitneyu_utbln10n12(s, _state); + } + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln10n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln10n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln10n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln10n15(s, _state); + f1 = mannwhitneyu_utbln10n30(s, _state); + f2 = mannwhitneyu_utbln10n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=11, N2 = 11, 12, ... + */ + if( ae_minint(n1, n2, _state)==11 ) + { + if( ae_maxint(n1, n2, _state)==11 ) + { + result = mannwhitneyu_utbln11n11(s, _state); + } + if( ae_maxint(n1, n2, _state)==12 ) + { + result = mannwhitneyu_utbln11n12(s, _state); + } + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln11n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln11n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln11n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln11n15(s, _state); + f1 = mannwhitneyu_utbln11n30(s, _state); + f2 = mannwhitneyu_utbln11n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=12, N2 = 12, 13, ... + */ + if( ae_minint(n1, n2, _state)==12 ) + { + if( ae_maxint(n1, n2, _state)==12 ) + { + result = mannwhitneyu_utbln12n12(s, _state); + } + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln12n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln12n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln12n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln12n15(s, _state); + f1 = mannwhitneyu_utbln12n30(s, _state); + f2 = mannwhitneyu_utbln12n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=13, N2 = 13, 14, ... + */ + if( ae_minint(n1, n2, _state)==13 ) + { + if( ae_maxint(n1, n2, _state)==13 ) + { + result = mannwhitneyu_utbln13n13(s, _state); + } + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln13n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln13n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln13n15(s, _state); + f1 = mannwhitneyu_utbln13n30(s, _state); + f2 = mannwhitneyu_utbln13n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1=14, N2 = 14, 15, ... + */ + if( ae_minint(n1, n2, _state)==14 ) + { + if( ae_maxint(n1, n2, _state)==14 ) + { + result = mannwhitneyu_utbln14n14(s, _state); + } + if( ae_maxint(n1, n2, _state)==15 ) + { + result = mannwhitneyu_utbln14n15(s, _state); + } + if( ae_maxint(n1, n2, _state)>15 ) + { + f0 = mannwhitneyu_utbln14n15(s, _state); + f1 = mannwhitneyu_utbln14n30(s, _state); + f2 = mannwhitneyu_utbln14n100(s, _state); + result = mannwhitneyu_uninterpolate(f0, f1, f2, ae_maxint(n1, n2, _state), _state); + } + return result; + } + + /* + * N1 >= 15, N2 >= 15 + */ + if( ae_fp_greater(s,4) ) + { + s = 4; + } + if( ae_fp_less(s,3) ) + { + s0 = 0.000000e+00; + f0 = mannwhitneyu_usigma000(n1, n2, _state); + s1 = 7.500000e-01; + f1 = mannwhitneyu_usigma075(n1, n2, _state); + s2 = 1.500000e+00; + f2 = mannwhitneyu_usigma150(n1, n2, _state); + s3 = 2.250000e+00; + f3 = mannwhitneyu_usigma225(n1, n2, _state); + s4 = 3.000000e+00; + f4 = mannwhitneyu_usigma300(n1, n2, _state); + f1 = ((s-s0)*f1-(s-s1)*f0)/(s1-s0); + f2 = ((s-s0)*f2-(s-s2)*f0)/(s2-s0); + f3 = ((s-s0)*f3-(s-s3)*f0)/(s3-s0); + f4 = ((s-s0)*f4-(s-s4)*f0)/(s4-s0); + f2 = ((s-s1)*f2-(s-s2)*f1)/(s2-s1); + f3 = ((s-s1)*f3-(s-s3)*f1)/(s3-s1); + f4 = ((s-s1)*f4-(s-s4)*f1)/(s4-s1); + f3 = ((s-s2)*f3-(s-s3)*f2)/(s3-s2); + f4 = ((s-s2)*f4-(s-s4)*f2)/(s4-s2); + f4 = ((s-s3)*f4-(s-s4)*f3)/(s4-s3); + result = f4; + } + else + { + s0 = 3.000000e+00; + f0 = mannwhitneyu_usigma300(n1, n2, _state); + s1 = 3.333333e+00; + f1 = mannwhitneyu_usigma333(n1, n2, _state); + s2 = 3.666667e+00; + f2 = mannwhitneyu_usigma367(n1, n2, _state); + s3 = 4.000000e+00; + f3 = mannwhitneyu_usigma400(n1, n2, _state); + f1 = ((s-s0)*f1-(s-s1)*f0)/(s1-s0); + f2 = ((s-s0)*f2-(s-s2)*f0)/(s2-s0); + f3 = ((s-s0)*f3-(s-s3)*f0)/(s3-s0); + f2 = ((s-s1)*f2-(s-s2)*f1)/(s2-s1); + f3 = ((s-s1)*f3-(s-s3)*f1)/(s3-s1); + f3 = ((s-s2)*f3-(s-s3)*f2)/(s3-s2); + result = f3; + } + return result; +} + + + + +/************************************************************************* +Sign test + +This test checks three hypotheses about the median of the given sample. +The following tests are performed: + * two-tailed test (null hypothesis - the median is equal to the given + value) + * left-tailed test (null hypothesis - the median is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the median is less than or + equal to the given value) + +Requirements: + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + +The test is non-parametric and doesn't require distribution X to be normal + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. + Median - assumed median value. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +While calculating p-values high-precision binomial distribution +approximation is used, so significance levels have about 15 exact digits. + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void onesamplesigntest(/* Real */ ae_vector* x, + ae_int_t n, + double median, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + ae_int_t i; + ae_int_t gtcnt; + ae_int_t necnt; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + if( n<=1 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * Calculate: + * GTCnt - count of x[i]>Median + * NECnt - count of x[i]<>Median + */ + gtcnt = 0; + necnt = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_greater(x->ptr.p_double[i],median) ) + { + gtcnt = gtcnt+1; + } + if( ae_fp_neq(x->ptr.p_double[i],median) ) + { + necnt = necnt+1; + } + } + if( necnt==0 ) + { + + /* + * all x[i] are equal to Median. + * So we can conclude that Median is a true median :) + */ + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + *bothtails = ae_minreal(2*binomialdistribution(ae_minint(gtcnt, necnt-gtcnt, _state), necnt, 0.5, _state), 1.0, _state); + *lefttail = binomialdistribution(gtcnt, necnt, 0.5, _state); + *righttail = binomialcdistribution(gtcnt-1, necnt, 0.5, _state); +} + + + + +/************************************************************************* +One-sample t-test + +This test checks three hypotheses about the mean of the given sample. The +following tests are performed: + * two-tailed test (null hypothesis - the mean is equal to the given + value) + * left-tailed test (null hypothesis - the mean is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the mean is less than or equal + to the given value). + +The test is based on the assumption that a given sample has a normal +distribution and an unknown dispersion. If the distribution sharply +differs from normal, the test will work incorrectly. + +INPUT PARAMETERS: + X - sample. Array whose index goes from 0 to N-1. + N - size of sample, N>=0 + Mean - assumed value of the mean. + +OUTPUT PARAMETERS: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0, all p-values are set to 1.0 + * when variance of X[] is exactly zero, p-values are set + to 1.0 or 0.0, depending on difference between sample mean and + value of mean being tested. + + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void studentttest1(/* Real */ ae_vector* x, + ae_int_t n, + double mean, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + ae_int_t i; + double xmean; + double x0; + double v; + ae_bool samex; + double xvariance; + double xstddev; + double v1; + double v2; + double stat; + double s; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + if( n<=0 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * Mean + */ + xmean = 0; + x0 = x->ptr.p_double[0]; + samex = ae_true; + for(i=0; i<=n-1; i++) + { + v = x->ptr.p_double[i]; + xmean = xmean+v; + samex = samex&&ae_fp_eq(v,x0); + } + if( samex ) + { + xmean = x0; + } + else + { + xmean = xmean/n; + } + + /* + * Variance (using corrected two-pass algorithm) + */ + xvariance = 0; + xstddev = 0; + if( n!=1&&!samex ) + { + v1 = 0; + for(i=0; i<=n-1; i++) + { + v1 = v1+ae_sqr(x->ptr.p_double[i]-xmean, _state); + } + v2 = 0; + for(i=0; i<=n-1; i++) + { + v2 = v2+(x->ptr.p_double[i]-xmean); + } + v2 = ae_sqr(v2, _state)/n; + xvariance = (v1-v2)/(n-1); + if( ae_fp_less(xvariance,0) ) + { + xvariance = 0; + } + xstddev = ae_sqrt(xvariance, _state); + } + if( ae_fp_eq(xstddev,0) ) + { + if( ae_fp_eq(xmean,mean) ) + { + *bothtails = 1.0; + } + else + { + *bothtails = 0.0; + } + if( ae_fp_greater_eq(xmean,mean) ) + { + *lefttail = 1.0; + } + else + { + *lefttail = 0.0; + } + if( ae_fp_less_eq(xmean,mean) ) + { + *righttail = 1.0; + } + else + { + *righttail = 0.0; + } + return; + } + + /* + * Statistic + */ + stat = (xmean-mean)/(xstddev/ae_sqrt(n, _state)); + s = studenttdistribution(n-1, stat, _state); + *bothtails = 2*ae_minreal(s, 1-s, _state); + *lefttail = s; + *righttail = 1-s; +} + + +/************************************************************************* +Two-sample pooled test + +This test checks three hypotheses about the mean of the given samples. The +following tests are performed: + * two-tailed test (null hypothesis - the means are equal) + * left-tailed test (null hypothesis - the mean of the first sample is + greater than or equal to the mean of the second sample) + * right-tailed test (null hypothesis - the mean of the first sample is + less than or equal to the mean of the second sample). + +Test is based on the following assumptions: + * given samples have normal distributions + * dispersions are equal + * samples are independent. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of sample. + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of sample. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0 or M=0, all p-values are set to 1.0 + * when both samples has exactly zero variance, p-values are set + to 1.0 or 0.0, depending on difference between means. + + -- ALGLIB -- + Copyright 18.09.2006 by Bochkanov Sergey +*************************************************************************/ +void studentttest2(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + ae_int_t i; + ae_bool samex; + ae_bool samey; + double x0; + double y0; + double xmean; + double ymean; + double v; + double stat; + double s; + double p; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + if( n<=0||m<=0 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * Mean + */ + xmean = 0; + x0 = x->ptr.p_double[0]; + samex = ae_true; + for(i=0; i<=n-1; i++) + { + v = x->ptr.p_double[i]; + xmean = xmean+v; + samex = samex&&ae_fp_eq(v,x0); + } + if( samex ) + { + xmean = x0; + } + else + { + xmean = xmean/n; + } + ymean = 0; + y0 = y->ptr.p_double[0]; + samey = ae_true; + for(i=0; i<=m-1; i++) + { + v = y->ptr.p_double[i]; + ymean = ymean+v; + samey = samey&&ae_fp_eq(v,y0); + } + if( samey ) + { + ymean = y0; + } + else + { + ymean = ymean/m; + } + + /* + * S + */ + s = 0; + if( n+m>2 ) + { + for(i=0; i<=n-1; i++) + { + s = s+ae_sqr(x->ptr.p_double[i]-xmean, _state); + } + for(i=0; i<=m-1; i++) + { + s = s+ae_sqr(y->ptr.p_double[i]-ymean, _state); + } + s = ae_sqrt(s*((double)1/(double)n+(double)1/(double)m)/(n+m-2), _state); + } + if( ae_fp_eq(s,0) ) + { + if( ae_fp_eq(xmean,ymean) ) + { + *bothtails = 1.0; + } + else + { + *bothtails = 0.0; + } + if( ae_fp_greater_eq(xmean,ymean) ) + { + *lefttail = 1.0; + } + else + { + *lefttail = 0.0; + } + if( ae_fp_less_eq(xmean,ymean) ) + { + *righttail = 1.0; + } + else + { + *righttail = 0.0; + } + return; + } + + /* + * Statistic + */ + stat = (xmean-ymean)/s; + p = studenttdistribution(n+m-2, stat, _state); + *bothtails = 2*ae_minreal(p, 1-p, _state); + *lefttail = p; + *righttail = 1-p; +} + + +/************************************************************************* +Two-sample unpooled test + +This test checks three hypotheses about the mean of the given samples. The +following tests are performed: + * two-tailed test (null hypothesis - the means are equal) + * left-tailed test (null hypothesis - the mean of the first sample is + greater than or equal to the mean of the second sample) + * right-tailed test (null hypothesis - the mean of the first sample is + less than or equal to the mean of the second sample). + +Test is based on the following assumptions: + * given samples have normal distributions + * samples are independent. +Equality of variances is NOT required. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of the sample. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0 or M=0, all p-values are set to 1.0 + * when both samples has zero variance, p-values are set + to 1.0 or 0.0, depending on difference between means. + * when only one sample has zero variance, test reduces to 1-sample + version. + + -- ALGLIB -- + Copyright 18.09.2006 by Bochkanov Sergey +*************************************************************************/ +void unequalvariancettest(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + ae_int_t i; + ae_bool samex; + ae_bool samey; + double x0; + double y0; + double xmean; + double ymean; + double xvar; + double yvar; + double v; + double df; + double p; + double stat; + double c; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + if( n<=0||m<=0 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * Mean + */ + xmean = 0; + x0 = x->ptr.p_double[0]; + samex = ae_true; + for(i=0; i<=n-1; i++) + { + v = x->ptr.p_double[i]; + xmean = xmean+v; + samex = samex&&ae_fp_eq(v,x0); + } + if( samex ) + { + xmean = x0; + } + else + { + xmean = xmean/n; + } + ymean = 0; + y0 = y->ptr.p_double[0]; + samey = ae_true; + for(i=0; i<=m-1; i++) + { + v = y->ptr.p_double[i]; + ymean = ymean+v; + samey = samey&&ae_fp_eq(v,y0); + } + if( samey ) + { + ymean = y0; + } + else + { + ymean = ymean/m; + } + + /* + * Variance (using corrected two-pass algorithm) + */ + xvar = 0; + if( n>=2&&!samex ) + { + for(i=0; i<=n-1; i++) + { + xvar = xvar+ae_sqr(x->ptr.p_double[i]-xmean, _state); + } + xvar = xvar/(n-1); + } + yvar = 0; + if( m>=2&&!samey ) + { + for(i=0; i<=m-1; i++) + { + yvar = yvar+ae_sqr(y->ptr.p_double[i]-ymean, _state); + } + yvar = yvar/(m-1); + } + + /* + * Handle different special cases + * (one or both variances are zero). + */ + if( ae_fp_eq(xvar,0)&&ae_fp_eq(yvar,0) ) + { + if( ae_fp_eq(xmean,ymean) ) + { + *bothtails = 1.0; + } + else + { + *bothtails = 0.0; + } + if( ae_fp_greater_eq(xmean,ymean) ) + { + *lefttail = 1.0; + } + else + { + *lefttail = 0.0; + } + if( ae_fp_less_eq(xmean,ymean) ) + { + *righttail = 1.0; + } + else + { + *righttail = 0.0; + } + return; + } + if( ae_fp_eq(xvar,0) ) + { + + /* + * X is constant, unpooled 2-sample test reduces to 1-sample test. + * + * NOTE: right-tail and left-tail must be passed to 1-sample + * t-test in reverse order because we reverse order of + * of samples. + */ + studentttest1(y, m, xmean, bothtails, righttail, lefttail, _state); + return; + } + if( ae_fp_eq(yvar,0) ) + { + + /* + * Y is constant, unpooled 2-sample test reduces to 1-sample test. + */ + studentttest1(x, n, ymean, bothtails, lefttail, righttail, _state); + return; + } + + /* + * Statistic + */ + stat = (xmean-ymean)/ae_sqrt(xvar/n+yvar/m, _state); + c = xvar/n/(xvar/n+yvar/m); + df = (n-1)*(m-1)/((m-1)*ae_sqr(c, _state)+(n-1)*ae_sqr(1-c, _state)); + if( ae_fp_greater(stat,0) ) + { + p = 1-0.5*incompletebeta(df/2, 0.5, df/(df+ae_sqr(stat, _state)), _state); + } + else + { + p = 0.5*incompletebeta(df/2, 0.5, df/(df+ae_sqr(stat, _state)), _state); + } + *bothtails = 2*ae_minreal(p, 1-p, _state); + *lefttail = p; + *righttail = 1-p; +} + + + + +/************************************************************************* +Two-sample F-test + +This test checks three hypotheses about dispersions of the given samples. +The following tests are performed: + * two-tailed test (null hypothesis - the dispersions are equal) + * left-tailed test (null hypothesis - the dispersion of the first + sample is greater than or equal to the dispersion of the second + sample). + * right-tailed test (null hypothesis - the dispersion of the first + sample is less than or equal to the dispersion of the second sample) + +The test is based on the following assumptions: + * the given samples have normal distributions + * the samples are independent. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - sample size. + Y - sample 2. Array whose index goes from 0 to M-1. + M - sample size. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 19.09.2006 by Bochkanov Sergey +*************************************************************************/ +void ftest(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + ae_int_t i; + double xmean; + double ymean; + double xvar; + double yvar; + ae_int_t df1; + ae_int_t df2; + double stat; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + if( n<=2||m<=2 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * Mean + */ + xmean = 0; + for(i=0; i<=n-1; i++) + { + xmean = xmean+x->ptr.p_double[i]; + } + xmean = xmean/n; + ymean = 0; + for(i=0; i<=m-1; i++) + { + ymean = ymean+y->ptr.p_double[i]; + } + ymean = ymean/m; + + /* + * Variance (using corrected two-pass algorithm) + */ + xvar = 0; + for(i=0; i<=n-1; i++) + { + xvar = xvar+ae_sqr(x->ptr.p_double[i]-xmean, _state); + } + xvar = xvar/(n-1); + yvar = 0; + for(i=0; i<=m-1; i++) + { + yvar = yvar+ae_sqr(y->ptr.p_double[i]-ymean, _state); + } + yvar = yvar/(m-1); + if( ae_fp_eq(xvar,0)||ae_fp_eq(yvar,0) ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * Statistic + */ + df1 = n-1; + df2 = m-1; + stat = ae_minreal(xvar/yvar, yvar/xvar, _state); + *bothtails = 1-(fdistribution(df1, df2, 1/stat, _state)-fdistribution(df1, df2, stat, _state)); + *lefttail = fdistribution(df1, df2, xvar/yvar, _state); + *righttail = 1-(*lefttail); +} + + +/************************************************************************* +One-sample chi-square test + +This test checks three hypotheses about the dispersion of the given sample +The following tests are performed: + * two-tailed test (null hypothesis - the dispersion equals the given + number) + * left-tailed test (null hypothesis - the dispersion is greater than + or equal to the given number) + * right-tailed test (null hypothesis - dispersion is less than or + equal to the given number). + +Test is based on the following assumptions: + * the given sample has a normal distribution. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. + Variance - dispersion value to compare with. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 19.09.2006 by Bochkanov Sergey +*************************************************************************/ +void onesamplevariancetest(/* Real */ ae_vector* x, + ae_int_t n, + double variance, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + ae_int_t i; + double xmean; + double xvar; + double s; + double stat; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + if( n<=1 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * Mean + */ + xmean = 0; + for(i=0; i<=n-1; i++) + { + xmean = xmean+x->ptr.p_double[i]; + } + xmean = xmean/n; + + /* + * Variance + */ + xvar = 0; + for(i=0; i<=n-1; i++) + { + xvar = xvar+ae_sqr(x->ptr.p_double[i]-xmean, _state); + } + xvar = xvar/(n-1); + if( ae_fp_eq(xvar,0) ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + return; + } + + /* + * Statistic + */ + stat = (n-1)*xvar/variance; + s = chisquaredistribution(n-1, stat, _state); + *bothtails = 2*ae_minreal(s, 1-s, _state); + *lefttail = s; + *righttail = 1-(*lefttail); +} + + + + +/************************************************************************* +Wilcoxon signed-rank test + +This test checks three hypotheses about the median of the given sample. +The following tests are performed: + * two-tailed test (null hypothesis - the median is equal to the given + value) + * left-tailed test (null hypothesis - the median is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the median is less than or + equal to the given value) + +Requirements: + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + * the distribution should be continuous and symmetric relative to its + median. + * number of distinct values in the X array should be greater than 4 + +The test is non-parametric and doesn't require distribution X to be normal + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. + Median - assumed median value. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +To calculate p-values, special approximation is used. This method lets us +calculate p-values with two decimal places in interval [0.0001, 1]. + +"Two decimal places" does not sound very impressive, but in practice the +relative error of less than 1% is enough to make a decision. + +There is no approximation outside the [0.0001, 1] interval. Therefore, if +the significance level outlies this interval, the test returns 0.0001. + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void wilcoxonsignedranktest(/* Real */ ae_vector* x, + ae_int_t n, + double e, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector _x; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t t; + double tmp; + ae_int_t tmpi; + ae_int_t ns; + ae_vector r; + ae_vector c; + double w; + double p; + double mp; + double s; + double sigma; + double mu; + + ae_frame_make(_state, &_frame_block); + ae_vector_init_copy(&_x, x, _state, ae_true); + x = &_x; + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + ae_vector_init(&r, 0, DT_REAL, _state, ae_true); + ae_vector_init(&c, 0, DT_INT, _state, ae_true); + + + /* + * Prepare + */ + if( n<5 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + ae_frame_leave(_state); + return; + } + ns = 0; + for(i=0; i<=n-1; i++) + { + if( ae_fp_eq(x->ptr.p_double[i],e) ) + { + continue; + } + x->ptr.p_double[ns] = x->ptr.p_double[i]; + ns = ns+1; + } + if( ns<5 ) + { + *bothtails = 1.0; + *lefttail = 1.0; + *righttail = 1.0; + ae_frame_leave(_state); + return; + } + ae_vector_set_length(&r, ns-1+1, _state); + ae_vector_set_length(&c, ns-1+1, _state); + for(i=0; i<=ns-1; i++) + { + r.ptr.p_double[i] = ae_fabs(x->ptr.p_double[i]-e, _state); + c.ptr.p_int[i] = i; + } + + /* + * sort {R, C} + */ + if( ns!=1 ) + { + i = 2; + do + { + t = i; + while(t!=1) + { + k = t/2; + if( ae_fp_greater_eq(r.ptr.p_double[k-1],r.ptr.p_double[t-1]) ) + { + t = 1; + } + else + { + tmp = r.ptr.p_double[k-1]; + r.ptr.p_double[k-1] = r.ptr.p_double[t-1]; + r.ptr.p_double[t-1] = tmp; + tmpi = c.ptr.p_int[k-1]; + c.ptr.p_int[k-1] = c.ptr.p_int[t-1]; + c.ptr.p_int[t-1] = tmpi; + t = k; + } + } + i = i+1; + } + while(i<=ns); + i = ns-1; + do + { + tmp = r.ptr.p_double[i]; + r.ptr.p_double[i] = r.ptr.p_double[0]; + r.ptr.p_double[0] = tmp; + tmpi = c.ptr.p_int[i]; + c.ptr.p_int[i] = c.ptr.p_int[0]; + c.ptr.p_int[0] = tmpi; + t = 1; + while(t!=0) + { + k = 2*t; + if( k>i ) + { + t = 0; + } + else + { + if( k=1); + } + + /* + * compute tied ranks + */ + i = 0; + while(i<=ns-1) + { + j = i+1; + while(j<=ns-1) + { + if( ae_fp_neq(r.ptr.p_double[j],r.ptr.p_double[i]) ) + { + break; + } + j = j+1; + } + for(k=i; k<=j-1; k++) + { + r.ptr.p_double[k] = 1+(double)(i+j-1)/(double)2; + } + i = j; + } + + /* + * Compute W+ + */ + w = 0; + for(i=0; i<=ns-1; i++) + { + if( ae_fp_greater(x->ptr.p_double[c.ptr.p_int[i]],e) ) + { + w = w+r.ptr.p_double[i]; + } + } + + /* + * Result + */ + mu = (double)(ns*(ns+1))/(double)4; + sigma = ae_sqrt((double)(ns*(ns+1)*(2*ns+1))/(double)24, _state); + s = (w-mu)/sigma; + if( ae_fp_less_eq(s,0) ) + { + p = ae_exp(wsr_wsigma(-(w-mu)/sigma, ns, _state), _state); + mp = 1-ae_exp(wsr_wsigma(-(w-1-mu)/sigma, ns, _state), _state); + } + else + { + mp = ae_exp(wsr_wsigma((w-mu)/sigma, ns, _state), _state); + p = 1-ae_exp(wsr_wsigma((w+1-mu)/sigma, ns, _state), _state); + } + *bothtails = ae_maxreal(2*ae_minreal(p, mp, _state), 1.0E-4, _state); + *lefttail = ae_maxreal(p, 1.0E-4, _state); + *righttail = ae_maxreal(mp, 1.0E-4, _state); + ae_frame_leave(_state); +} + + +/************************************************************************* +Sequential Chebyshev interpolation. +*************************************************************************/ +static void wsr_wcheb(double x, + double c, + double* tj, + double* tj1, + double* r, + ae_state *_state) +{ + double t; + + + *r = *r+c*(*tj); + t = 2*x*(*tj1)-(*tj); + *tj = *tj1; + *tj1 = t; +} + + +/************************************************************************* +Tail(S, 5) +*************************************************************************/ +static double wsr_w5(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-3.708099e+00*s+7.500000e+00, _state); + if( w>=7 ) + { + r = -6.931e-01; + } + if( w==6 ) + { + r = -9.008e-01; + } + if( w==5 ) + { + r = -1.163e+00; + } + if( w==4 ) + { + r = -1.520e+00; + } + if( w==3 ) + { + r = -1.856e+00; + } + if( w==2 ) + { + r = -2.367e+00; + } + if( w==1 ) + { + r = -2.773e+00; + } + if( w<=0 ) + { + r = -3.466e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 6) +*************************************************************************/ +static double wsr_w6(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-4.769696e+00*s+1.050000e+01, _state); + if( w>=10 ) + { + r = -6.931e-01; + } + if( w==9 ) + { + r = -8.630e-01; + } + if( w==8 ) + { + r = -1.068e+00; + } + if( w==7 ) + { + r = -1.269e+00; + } + if( w==6 ) + { + r = -1.520e+00; + } + if( w==5 ) + { + r = -1.856e+00; + } + if( w==4 ) + { + r = -2.213e+00; + } + if( w==3 ) + { + r = -2.549e+00; + } + if( w==2 ) + { + r = -3.060e+00; + } + if( w==1 ) + { + r = -3.466e+00; + } + if( w<=0 ) + { + r = -4.159e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 7) +*************************************************************************/ +static double wsr_w7(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-5.916080e+00*s+1.400000e+01, _state); + if( w>=14 ) + { + r = -6.325e-01; + } + if( w==13 ) + { + r = -7.577e-01; + } + if( w==12 ) + { + r = -9.008e-01; + } + if( w==11 ) + { + r = -1.068e+00; + } + if( w==10 ) + { + r = -1.241e+00; + } + if( w==9 ) + { + r = -1.451e+00; + } + if( w==8 ) + { + r = -1.674e+00; + } + if( w==7 ) + { + r = -1.908e+00; + } + if( w==6 ) + { + r = -2.213e+00; + } + if( w==5 ) + { + r = -2.549e+00; + } + if( w==4 ) + { + r = -2.906e+00; + } + if( w==3 ) + { + r = -3.243e+00; + } + if( w==2 ) + { + r = -3.753e+00; + } + if( w==1 ) + { + r = -4.159e+00; + } + if( w<=0 ) + { + r = -4.852e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 8) +*************************************************************************/ +static double wsr_w8(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-7.141428e+00*s+1.800000e+01, _state); + if( w>=18 ) + { + r = -6.399e-01; + } + if( w==17 ) + { + r = -7.494e-01; + } + if( w==16 ) + { + r = -8.630e-01; + } + if( w==15 ) + { + r = -9.913e-01; + } + if( w==14 ) + { + r = -1.138e+00; + } + if( w==13 ) + { + r = -1.297e+00; + } + if( w==12 ) + { + r = -1.468e+00; + } + if( w==11 ) + { + r = -1.653e+00; + } + if( w==10 ) + { + r = -1.856e+00; + } + if( w==9 ) + { + r = -2.079e+00; + } + if( w==8 ) + { + r = -2.326e+00; + } + if( w==7 ) + { + r = -2.601e+00; + } + if( w==6 ) + { + r = -2.906e+00; + } + if( w==5 ) + { + r = -3.243e+00; + } + if( w==4 ) + { + r = -3.599e+00; + } + if( w==3 ) + { + r = -3.936e+00; + } + if( w==2 ) + { + r = -4.447e+00; + } + if( w==1 ) + { + r = -4.852e+00; + } + if( w<=0 ) + { + r = -5.545e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 9) +*************************************************************************/ +static double wsr_w9(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-8.440972e+00*s+2.250000e+01, _state); + if( w>=22 ) + { + r = -6.931e-01; + } + if( w==21 ) + { + r = -7.873e-01; + } + if( w==20 ) + { + r = -8.912e-01; + } + if( w==19 ) + { + r = -1.002e+00; + } + if( w==18 ) + { + r = -1.120e+00; + } + if( w==17 ) + { + r = -1.255e+00; + } + if( w==16 ) + { + r = -1.394e+00; + } + if( w==15 ) + { + r = -1.547e+00; + } + if( w==14 ) + { + r = -1.717e+00; + } + if( w==13 ) + { + r = -1.895e+00; + } + if( w==12 ) + { + r = -2.079e+00; + } + if( w==11 ) + { + r = -2.287e+00; + } + if( w==10 ) + { + r = -2.501e+00; + } + if( w==9 ) + { + r = -2.742e+00; + } + if( w==8 ) + { + r = -3.019e+00; + } + if( w==7 ) + { + r = -3.294e+00; + } + if( w==6 ) + { + r = -3.599e+00; + } + if( w==5 ) + { + r = -3.936e+00; + } + if( w==4 ) + { + r = -4.292e+00; + } + if( w==3 ) + { + r = -4.629e+00; + } + if( w==2 ) + { + r = -5.140e+00; + } + if( w==1 ) + { + r = -5.545e+00; + } + if( w<=0 ) + { + r = -6.238e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 10) +*************************************************************************/ +static double wsr_w10(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-9.810708e+00*s+2.750000e+01, _state); + if( w>=27 ) + { + r = -6.931e-01; + } + if( w==26 ) + { + r = -7.745e-01; + } + if( w==25 ) + { + r = -8.607e-01; + } + if( w==24 ) + { + r = -9.551e-01; + } + if( w==23 ) + { + r = -1.057e+00; + } + if( w==22 ) + { + r = -1.163e+00; + } + if( w==21 ) + { + r = -1.279e+00; + } + if( w==20 ) + { + r = -1.402e+00; + } + if( w==19 ) + { + r = -1.533e+00; + } + if( w==18 ) + { + r = -1.674e+00; + } + if( w==17 ) + { + r = -1.826e+00; + } + if( w==16 ) + { + r = -1.983e+00; + } + if( w==15 ) + { + r = -2.152e+00; + } + if( w==14 ) + { + r = -2.336e+00; + } + if( w==13 ) + { + r = -2.525e+00; + } + if( w==12 ) + { + r = -2.727e+00; + } + if( w==11 ) + { + r = -2.942e+00; + } + if( w==10 ) + { + r = -3.170e+00; + } + if( w==9 ) + { + r = -3.435e+00; + } + if( w==8 ) + { + r = -3.713e+00; + } + if( w==7 ) + { + r = -3.987e+00; + } + if( w==6 ) + { + r = -4.292e+00; + } + if( w==5 ) + { + r = -4.629e+00; + } + if( w==4 ) + { + r = -4.986e+00; + } + if( w==3 ) + { + r = -5.322e+00; + } + if( w==2 ) + { + r = -5.833e+00; + } + if( w==1 ) + { + r = -6.238e+00; + } + if( w<=0 ) + { + r = -6.931e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 11) +*************************************************************************/ +static double wsr_w11(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-1.124722e+01*s+3.300000e+01, _state); + if( w>=33 ) + { + r = -6.595e-01; + } + if( w==32 ) + { + r = -7.279e-01; + } + if( w==31 ) + { + r = -8.002e-01; + } + if( w==30 ) + { + r = -8.782e-01; + } + if( w==29 ) + { + r = -9.615e-01; + } + if( w==28 ) + { + r = -1.050e+00; + } + if( w==27 ) + { + r = -1.143e+00; + } + if( w==26 ) + { + r = -1.243e+00; + } + if( w==25 ) + { + r = -1.348e+00; + } + if( w==24 ) + { + r = -1.459e+00; + } + if( w==23 ) + { + r = -1.577e+00; + } + if( w==22 ) + { + r = -1.700e+00; + } + if( w==21 ) + { + r = -1.832e+00; + } + if( w==20 ) + { + r = -1.972e+00; + } + if( w==19 ) + { + r = -2.119e+00; + } + if( w==18 ) + { + r = -2.273e+00; + } + if( w==17 ) + { + r = -2.437e+00; + } + if( w==16 ) + { + r = -2.607e+00; + } + if( w==15 ) + { + r = -2.788e+00; + } + if( w==14 ) + { + r = -2.980e+00; + } + if( w==13 ) + { + r = -3.182e+00; + } + if( w==12 ) + { + r = -3.391e+00; + } + if( w==11 ) + { + r = -3.617e+00; + } + if( w==10 ) + { + r = -3.863e+00; + } + if( w==9 ) + { + r = -4.128e+00; + } + if( w==8 ) + { + r = -4.406e+00; + } + if( w==7 ) + { + r = -4.680e+00; + } + if( w==6 ) + { + r = -4.986e+00; + } + if( w==5 ) + { + r = -5.322e+00; + } + if( w==4 ) + { + r = -5.679e+00; + } + if( w==3 ) + { + r = -6.015e+00; + } + if( w==2 ) + { + r = -6.526e+00; + } + if( w==1 ) + { + r = -6.931e+00; + } + if( w<=0 ) + { + r = -7.625e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 12) +*************************************************************************/ +static double wsr_w12(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-1.274755e+01*s+3.900000e+01, _state); + if( w>=39 ) + { + r = -6.633e-01; + } + if( w==38 ) + { + r = -7.239e-01; + } + if( w==37 ) + { + r = -7.878e-01; + } + if( w==36 ) + { + r = -8.556e-01; + } + if( w==35 ) + { + r = -9.276e-01; + } + if( w==34 ) + { + r = -1.003e+00; + } + if( w==33 ) + { + r = -1.083e+00; + } + if( w==32 ) + { + r = -1.168e+00; + } + if( w==31 ) + { + r = -1.256e+00; + } + if( w==30 ) + { + r = -1.350e+00; + } + if( w==29 ) + { + r = -1.449e+00; + } + if( w==28 ) + { + r = -1.552e+00; + } + if( w==27 ) + { + r = -1.660e+00; + } + if( w==26 ) + { + r = -1.774e+00; + } + if( w==25 ) + { + r = -1.893e+00; + } + if( w==24 ) + { + r = -2.017e+00; + } + if( w==23 ) + { + r = -2.148e+00; + } + if( w==22 ) + { + r = -2.285e+00; + } + if( w==21 ) + { + r = -2.429e+00; + } + if( w==20 ) + { + r = -2.581e+00; + } + if( w==19 ) + { + r = -2.738e+00; + } + if( w==18 ) + { + r = -2.902e+00; + } + if( w==17 ) + { + r = -3.076e+00; + } + if( w==16 ) + { + r = -3.255e+00; + } + if( w==15 ) + { + r = -3.443e+00; + } + if( w==14 ) + { + r = -3.645e+00; + } + if( w==13 ) + { + r = -3.852e+00; + } + if( w==12 ) + { + r = -4.069e+00; + } + if( w==11 ) + { + r = -4.310e+00; + } + if( w==10 ) + { + r = -4.557e+00; + } + if( w==9 ) + { + r = -4.821e+00; + } + if( w==8 ) + { + r = -5.099e+00; + } + if( w==7 ) + { + r = -5.373e+00; + } + if( w==6 ) + { + r = -5.679e+00; + } + if( w==5 ) + { + r = -6.015e+00; + } + if( w==4 ) + { + r = -6.372e+00; + } + if( w==3 ) + { + r = -6.708e+00; + } + if( w==2 ) + { + r = -7.219e+00; + } + if( w==1 ) + { + r = -7.625e+00; + } + if( w<=0 ) + { + r = -8.318e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 13) +*************************************************************************/ +static double wsr_w13(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-1.430909e+01*s+4.550000e+01, _state); + if( w>=45 ) + { + r = -6.931e-01; + } + if( w==44 ) + { + r = -7.486e-01; + } + if( w==43 ) + { + r = -8.068e-01; + } + if( w==42 ) + { + r = -8.683e-01; + } + if( w==41 ) + { + r = -9.328e-01; + } + if( w==40 ) + { + r = -1.001e+00; + } + if( w==39 ) + { + r = -1.072e+00; + } + if( w==38 ) + { + r = -1.146e+00; + } + if( w==37 ) + { + r = -1.224e+00; + } + if( w==36 ) + { + r = -1.306e+00; + } + if( w==35 ) + { + r = -1.392e+00; + } + if( w==34 ) + { + r = -1.481e+00; + } + if( w==33 ) + { + r = -1.574e+00; + } + if( w==32 ) + { + r = -1.672e+00; + } + if( w==31 ) + { + r = -1.773e+00; + } + if( w==30 ) + { + r = -1.879e+00; + } + if( w==29 ) + { + r = -1.990e+00; + } + if( w==28 ) + { + r = -2.104e+00; + } + if( w==27 ) + { + r = -2.224e+00; + } + if( w==26 ) + { + r = -2.349e+00; + } + if( w==25 ) + { + r = -2.479e+00; + } + if( w==24 ) + { + r = -2.614e+00; + } + if( w==23 ) + { + r = -2.755e+00; + } + if( w==22 ) + { + r = -2.902e+00; + } + if( w==21 ) + { + r = -3.055e+00; + } + if( w==20 ) + { + r = -3.215e+00; + } + if( w==19 ) + { + r = -3.380e+00; + } + if( w==18 ) + { + r = -3.551e+00; + } + if( w==17 ) + { + r = -3.733e+00; + } + if( w==16 ) + { + r = -3.917e+00; + } + if( w==15 ) + { + r = -4.113e+00; + } + if( w==14 ) + { + r = -4.320e+00; + } + if( w==13 ) + { + r = -4.534e+00; + } + if( w==12 ) + { + r = -4.762e+00; + } + if( w==11 ) + { + r = -5.004e+00; + } + if( w==10 ) + { + r = -5.250e+00; + } + if( w==9 ) + { + r = -5.514e+00; + } + if( w==8 ) + { + r = -5.792e+00; + } + if( w==7 ) + { + r = -6.066e+00; + } + if( w==6 ) + { + r = -6.372e+00; + } + if( w==5 ) + { + r = -6.708e+00; + } + if( w==4 ) + { + r = -7.065e+00; + } + if( w==3 ) + { + r = -7.401e+00; + } + if( w==2 ) + { + r = -7.912e+00; + } + if( w==1 ) + { + r = -8.318e+00; + } + if( w<=0 ) + { + r = -9.011e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 14) +*************************************************************************/ +static double wsr_w14(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-1.592953e+01*s+5.250000e+01, _state); + if( w>=52 ) + { + r = -6.931e-01; + } + if( w==51 ) + { + r = -7.428e-01; + } + if( w==50 ) + { + r = -7.950e-01; + } + if( w==49 ) + { + r = -8.495e-01; + } + if( w==48 ) + { + r = -9.067e-01; + } + if( w==47 ) + { + r = -9.664e-01; + } + if( w==46 ) + { + r = -1.029e+00; + } + if( w==45 ) + { + r = -1.094e+00; + } + if( w==44 ) + { + r = -1.162e+00; + } + if( w==43 ) + { + r = -1.233e+00; + } + if( w==42 ) + { + r = -1.306e+00; + } + if( w==41 ) + { + r = -1.383e+00; + } + if( w==40 ) + { + r = -1.463e+00; + } + if( w==39 ) + { + r = -1.546e+00; + } + if( w==38 ) + { + r = -1.632e+00; + } + if( w==37 ) + { + r = -1.722e+00; + } + if( w==36 ) + { + r = -1.815e+00; + } + if( w==35 ) + { + r = -1.911e+00; + } + if( w==34 ) + { + r = -2.011e+00; + } + if( w==33 ) + { + r = -2.115e+00; + } + if( w==32 ) + { + r = -2.223e+00; + } + if( w==31 ) + { + r = -2.334e+00; + } + if( w==30 ) + { + r = -2.450e+00; + } + if( w==29 ) + { + r = -2.570e+00; + } + if( w==28 ) + { + r = -2.694e+00; + } + if( w==27 ) + { + r = -2.823e+00; + } + if( w==26 ) + { + r = -2.956e+00; + } + if( w==25 ) + { + r = -3.095e+00; + } + if( w==24 ) + { + r = -3.238e+00; + } + if( w==23 ) + { + r = -3.387e+00; + } + if( w==22 ) + { + r = -3.541e+00; + } + if( w==21 ) + { + r = -3.700e+00; + } + if( w==20 ) + { + r = -3.866e+00; + } + if( w==19 ) + { + r = -4.038e+00; + } + if( w==18 ) + { + r = -4.215e+00; + } + if( w==17 ) + { + r = -4.401e+00; + } + if( w==16 ) + { + r = -4.592e+00; + } + if( w==15 ) + { + r = -4.791e+00; + } + if( w==14 ) + { + r = -5.004e+00; + } + if( w==13 ) + { + r = -5.227e+00; + } + if( w==12 ) + { + r = -5.456e+00; + } + if( w==11 ) + { + r = -5.697e+00; + } + if( w==10 ) + { + r = -5.943e+00; + } + if( w==9 ) + { + r = -6.208e+00; + } + if( w==8 ) + { + r = -6.485e+00; + } + if( w==7 ) + { + r = -6.760e+00; + } + if( w==6 ) + { + r = -7.065e+00; + } + if( w==5 ) + { + r = -7.401e+00; + } + if( w==4 ) + { + r = -7.758e+00; + } + if( w==3 ) + { + r = -8.095e+00; + } + if( w==2 ) + { + r = -8.605e+00; + } + if( w==1 ) + { + r = -9.011e+00; + } + if( w<=0 ) + { + r = -9.704e+00; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 15) +*************************************************************************/ +static double wsr_w15(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-1.760682e+01*s+6.000000e+01, _state); + if( w>=60 ) + { + r = -6.714e-01; + } + if( w==59 ) + { + r = -7.154e-01; + } + if( w==58 ) + { + r = -7.613e-01; + } + if( w==57 ) + { + r = -8.093e-01; + } + if( w==56 ) + { + r = -8.593e-01; + } + if( w==55 ) + { + r = -9.114e-01; + } + if( w==54 ) + { + r = -9.656e-01; + } + if( w==53 ) + { + r = -1.022e+00; + } + if( w==52 ) + { + r = -1.081e+00; + } + if( w==51 ) + { + r = -1.142e+00; + } + if( w==50 ) + { + r = -1.205e+00; + } + if( w==49 ) + { + r = -1.270e+00; + } + if( w==48 ) + { + r = -1.339e+00; + } + if( w==47 ) + { + r = -1.409e+00; + } + if( w==46 ) + { + r = -1.482e+00; + } + if( w==45 ) + { + r = -1.558e+00; + } + if( w==44 ) + { + r = -1.636e+00; + } + if( w==43 ) + { + r = -1.717e+00; + } + if( w==42 ) + { + r = -1.801e+00; + } + if( w==41 ) + { + r = -1.888e+00; + } + if( w==40 ) + { + r = -1.977e+00; + } + if( w==39 ) + { + r = -2.070e+00; + } + if( w==38 ) + { + r = -2.166e+00; + } + if( w==37 ) + { + r = -2.265e+00; + } + if( w==36 ) + { + r = -2.366e+00; + } + if( w==35 ) + { + r = -2.472e+00; + } + if( w==34 ) + { + r = -2.581e+00; + } + if( w==33 ) + { + r = -2.693e+00; + } + if( w==32 ) + { + r = -2.809e+00; + } + if( w==31 ) + { + r = -2.928e+00; + } + if( w==30 ) + { + r = -3.051e+00; + } + if( w==29 ) + { + r = -3.179e+00; + } + if( w==28 ) + { + r = -3.310e+00; + } + if( w==27 ) + { + r = -3.446e+00; + } + if( w==26 ) + { + r = -3.587e+00; + } + if( w==25 ) + { + r = -3.732e+00; + } + if( w==24 ) + { + r = -3.881e+00; + } + if( w==23 ) + { + r = -4.036e+00; + } + if( w==22 ) + { + r = -4.195e+00; + } + if( w==21 ) + { + r = -4.359e+00; + } + if( w==20 ) + { + r = -4.531e+00; + } + if( w==19 ) + { + r = -4.707e+00; + } + if( w==18 ) + { + r = -4.888e+00; + } + if( w==17 ) + { + r = -5.079e+00; + } + if( w==16 ) + { + r = -5.273e+00; + } + if( w==15 ) + { + r = -5.477e+00; + } + if( w==14 ) + { + r = -5.697e+00; + } + if( w==13 ) + { + r = -5.920e+00; + } + if( w==12 ) + { + r = -6.149e+00; + } + if( w==11 ) + { + r = -6.390e+00; + } + if( w==10 ) + { + r = -6.636e+00; + } + if( w==9 ) + { + r = -6.901e+00; + } + if( w==8 ) + { + r = -7.178e+00; + } + if( w==7 ) + { + r = -7.453e+00; + } + if( w==6 ) + { + r = -7.758e+00; + } + if( w==5 ) + { + r = -8.095e+00; + } + if( w==4 ) + { + r = -8.451e+00; + } + if( w==3 ) + { + r = -8.788e+00; + } + if( w==2 ) + { + r = -9.299e+00; + } + if( w==1 ) + { + r = -9.704e+00; + } + if( w<=0 ) + { + r = -1.040e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 16) +*************************************************************************/ +static double wsr_w16(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-1.933908e+01*s+6.800000e+01, _state); + if( w>=68 ) + { + r = -6.733e-01; + } + if( w==67 ) + { + r = -7.134e-01; + } + if( w==66 ) + { + r = -7.551e-01; + } + if( w==65 ) + { + r = -7.986e-01; + } + if( w==64 ) + { + r = -8.437e-01; + } + if( w==63 ) + { + r = -8.905e-01; + } + if( w==62 ) + { + r = -9.391e-01; + } + if( w==61 ) + { + r = -9.895e-01; + } + if( w==60 ) + { + r = -1.042e+00; + } + if( w==59 ) + { + r = -1.096e+00; + } + if( w==58 ) + { + r = -1.152e+00; + } + if( w==57 ) + { + r = -1.210e+00; + } + if( w==56 ) + { + r = -1.270e+00; + } + if( w==55 ) + { + r = -1.331e+00; + } + if( w==54 ) + { + r = -1.395e+00; + } + if( w==53 ) + { + r = -1.462e+00; + } + if( w==52 ) + { + r = -1.530e+00; + } + if( w==51 ) + { + r = -1.600e+00; + } + if( w==50 ) + { + r = -1.673e+00; + } + if( w==49 ) + { + r = -1.748e+00; + } + if( w==48 ) + { + r = -1.825e+00; + } + if( w==47 ) + { + r = -1.904e+00; + } + if( w==46 ) + { + r = -1.986e+00; + } + if( w==45 ) + { + r = -2.071e+00; + } + if( w==44 ) + { + r = -2.158e+00; + } + if( w==43 ) + { + r = -2.247e+00; + } + if( w==42 ) + { + r = -2.339e+00; + } + if( w==41 ) + { + r = -2.434e+00; + } + if( w==40 ) + { + r = -2.532e+00; + } + if( w==39 ) + { + r = -2.632e+00; + } + if( w==38 ) + { + r = -2.735e+00; + } + if( w==37 ) + { + r = -2.842e+00; + } + if( w==36 ) + { + r = -2.951e+00; + } + if( w==35 ) + { + r = -3.064e+00; + } + if( w==34 ) + { + r = -3.179e+00; + } + if( w==33 ) + { + r = -3.298e+00; + } + if( w==32 ) + { + r = -3.420e+00; + } + if( w==31 ) + { + r = -3.546e+00; + } + if( w==30 ) + { + r = -3.676e+00; + } + if( w==29 ) + { + r = -3.810e+00; + } + if( w==28 ) + { + r = -3.947e+00; + } + if( w==27 ) + { + r = -4.088e+00; + } + if( w==26 ) + { + r = -4.234e+00; + } + if( w==25 ) + { + r = -4.383e+00; + } + if( w==24 ) + { + r = -4.538e+00; + } + if( w==23 ) + { + r = -4.697e+00; + } + if( w==22 ) + { + r = -4.860e+00; + } + if( w==21 ) + { + r = -5.029e+00; + } + if( w==20 ) + { + r = -5.204e+00; + } + if( w==19 ) + { + r = -5.383e+00; + } + if( w==18 ) + { + r = -5.569e+00; + } + if( w==17 ) + { + r = -5.762e+00; + } + if( w==16 ) + { + r = -5.960e+00; + } + if( w==15 ) + { + r = -6.170e+00; + } + if( w==14 ) + { + r = -6.390e+00; + } + if( w==13 ) + { + r = -6.613e+00; + } + if( w==12 ) + { + r = -6.842e+00; + } + if( w==11 ) + { + r = -7.083e+00; + } + if( w==10 ) + { + r = -7.329e+00; + } + if( w==9 ) + { + r = -7.594e+00; + } + if( w==8 ) + { + r = -7.871e+00; + } + if( w==7 ) + { + r = -8.146e+00; + } + if( w==6 ) + { + r = -8.451e+00; + } + if( w==5 ) + { + r = -8.788e+00; + } + if( w==4 ) + { + r = -9.144e+00; + } + if( w==3 ) + { + r = -9.481e+00; + } + if( w==2 ) + { + r = -9.992e+00; + } + if( w==1 ) + { + r = -1.040e+01; + } + if( w<=0 ) + { + r = -1.109e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 17) +*************************************************************************/ +static double wsr_w17(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-2.112463e+01*s+7.650000e+01, _state); + if( w>=76 ) + { + r = -6.931e-01; + } + if( w==75 ) + { + r = -7.306e-01; + } + if( w==74 ) + { + r = -7.695e-01; + } + if( w==73 ) + { + r = -8.097e-01; + } + if( w==72 ) + { + r = -8.514e-01; + } + if( w==71 ) + { + r = -8.946e-01; + } + if( w==70 ) + { + r = -9.392e-01; + } + if( w==69 ) + { + r = -9.853e-01; + } + if( w==68 ) + { + r = -1.033e+00; + } + if( w==67 ) + { + r = -1.082e+00; + } + if( w==66 ) + { + r = -1.133e+00; + } + if( w==65 ) + { + r = -1.185e+00; + } + if( w==64 ) + { + r = -1.240e+00; + } + if( w==63 ) + { + r = -1.295e+00; + } + if( w==62 ) + { + r = -1.353e+00; + } + if( w==61 ) + { + r = -1.412e+00; + } + if( w==60 ) + { + r = -1.473e+00; + } + if( w==59 ) + { + r = -1.536e+00; + } + if( w==58 ) + { + r = -1.600e+00; + } + if( w==57 ) + { + r = -1.666e+00; + } + if( w==56 ) + { + r = -1.735e+00; + } + if( w==55 ) + { + r = -1.805e+00; + } + if( w==54 ) + { + r = -1.877e+00; + } + if( w==53 ) + { + r = -1.951e+00; + } + if( w==52 ) + { + r = -2.028e+00; + } + if( w==51 ) + { + r = -2.106e+00; + } + if( w==50 ) + { + r = -2.186e+00; + } + if( w==49 ) + { + r = -2.269e+00; + } + if( w==48 ) + { + r = -2.353e+00; + } + if( w==47 ) + { + r = -2.440e+00; + } + if( w==46 ) + { + r = -2.530e+00; + } + if( w==45 ) + { + r = -2.621e+00; + } + if( w==44 ) + { + r = -2.715e+00; + } + if( w==43 ) + { + r = -2.812e+00; + } + if( w==42 ) + { + r = -2.911e+00; + } + if( w==41 ) + { + r = -3.012e+00; + } + if( w==40 ) + { + r = -3.116e+00; + } + if( w==39 ) + { + r = -3.223e+00; + } + if( w==38 ) + { + r = -3.332e+00; + } + if( w==37 ) + { + r = -3.445e+00; + } + if( w==36 ) + { + r = -3.560e+00; + } + if( w==35 ) + { + r = -3.678e+00; + } + if( w==34 ) + { + r = -3.799e+00; + } + if( w==33 ) + { + r = -3.924e+00; + } + if( w==32 ) + { + r = -4.052e+00; + } + if( w==31 ) + { + r = -4.183e+00; + } + if( w==30 ) + { + r = -4.317e+00; + } + if( w==29 ) + { + r = -4.456e+00; + } + if( w==28 ) + { + r = -4.597e+00; + } + if( w==27 ) + { + r = -4.743e+00; + } + if( w==26 ) + { + r = -4.893e+00; + } + if( w==25 ) + { + r = -5.047e+00; + } + if( w==24 ) + { + r = -5.204e+00; + } + if( w==23 ) + { + r = -5.367e+00; + } + if( w==22 ) + { + r = -5.534e+00; + } + if( w==21 ) + { + r = -5.706e+00; + } + if( w==20 ) + { + r = -5.884e+00; + } + if( w==19 ) + { + r = -6.066e+00; + } + if( w==18 ) + { + r = -6.254e+00; + } + if( w==17 ) + { + r = -6.451e+00; + } + if( w==16 ) + { + r = -6.654e+00; + } + if( w==15 ) + { + r = -6.864e+00; + } + if( w==14 ) + { + r = -7.083e+00; + } + if( w==13 ) + { + r = -7.306e+00; + } + if( w==12 ) + { + r = -7.535e+00; + } + if( w==11 ) + { + r = -7.776e+00; + } + if( w==10 ) + { + r = -8.022e+00; + } + if( w==9 ) + { + r = -8.287e+00; + } + if( w==8 ) + { + r = -8.565e+00; + } + if( w==7 ) + { + r = -8.839e+00; + } + if( w==6 ) + { + r = -9.144e+00; + } + if( w==5 ) + { + r = -9.481e+00; + } + if( w==4 ) + { + r = -9.838e+00; + } + if( w==3 ) + { + r = -1.017e+01; + } + if( w==2 ) + { + r = -1.068e+01; + } + if( w==1 ) + { + r = -1.109e+01; + } + if( w<=0 ) + { + r = -1.178e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 18) +*************************************************************************/ +static double wsr_w18(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-2.296193e+01*s+8.550000e+01, _state); + if( w>=85 ) + { + r = -6.931e-01; + } + if( w==84 ) + { + r = -7.276e-01; + } + if( w==83 ) + { + r = -7.633e-01; + } + if( w==82 ) + { + r = -8.001e-01; + } + if( w==81 ) + { + r = -8.381e-01; + } + if( w==80 ) + { + r = -8.774e-01; + } + if( w==79 ) + { + r = -9.179e-01; + } + if( w==78 ) + { + r = -9.597e-01; + } + if( w==77 ) + { + r = -1.003e+00; + } + if( w==76 ) + { + r = -1.047e+00; + } + if( w==75 ) + { + r = -1.093e+00; + } + if( w==74 ) + { + r = -1.140e+00; + } + if( w==73 ) + { + r = -1.188e+00; + } + if( w==72 ) + { + r = -1.238e+00; + } + if( w==71 ) + { + r = -1.289e+00; + } + if( w==70 ) + { + r = -1.342e+00; + } + if( w==69 ) + { + r = -1.396e+00; + } + if( w==68 ) + { + r = -1.452e+00; + } + if( w==67 ) + { + r = -1.509e+00; + } + if( w==66 ) + { + r = -1.568e+00; + } + if( w==65 ) + { + r = -1.628e+00; + } + if( w==64 ) + { + r = -1.690e+00; + } + if( w==63 ) + { + r = -1.753e+00; + } + if( w==62 ) + { + r = -1.818e+00; + } + if( w==61 ) + { + r = -1.885e+00; + } + if( w==60 ) + { + r = -1.953e+00; + } + if( w==59 ) + { + r = -2.023e+00; + } + if( w==58 ) + { + r = -2.095e+00; + } + if( w==57 ) + { + r = -2.168e+00; + } + if( w==56 ) + { + r = -2.244e+00; + } + if( w==55 ) + { + r = -2.321e+00; + } + if( w==54 ) + { + r = -2.400e+00; + } + if( w==53 ) + { + r = -2.481e+00; + } + if( w==52 ) + { + r = -2.564e+00; + } + if( w==51 ) + { + r = -2.648e+00; + } + if( w==50 ) + { + r = -2.735e+00; + } + if( w==49 ) + { + r = -2.824e+00; + } + if( w==48 ) + { + r = -2.915e+00; + } + if( w==47 ) + { + r = -3.008e+00; + } + if( w==46 ) + { + r = -3.104e+00; + } + if( w==45 ) + { + r = -3.201e+00; + } + if( w==44 ) + { + r = -3.301e+00; + } + if( w==43 ) + { + r = -3.403e+00; + } + if( w==42 ) + { + r = -3.508e+00; + } + if( w==41 ) + { + r = -3.615e+00; + } + if( w==40 ) + { + r = -3.724e+00; + } + if( w==39 ) + { + r = -3.836e+00; + } + if( w==38 ) + { + r = -3.950e+00; + } + if( w==37 ) + { + r = -4.068e+00; + } + if( w==36 ) + { + r = -4.188e+00; + } + if( w==35 ) + { + r = -4.311e+00; + } + if( w==34 ) + { + r = -4.437e+00; + } + if( w==33 ) + { + r = -4.565e+00; + } + if( w==32 ) + { + r = -4.698e+00; + } + if( w==31 ) + { + r = -4.833e+00; + } + if( w==30 ) + { + r = -4.971e+00; + } + if( w==29 ) + { + r = -5.113e+00; + } + if( w==28 ) + { + r = -5.258e+00; + } + if( w==27 ) + { + r = -5.408e+00; + } + if( w==26 ) + { + r = -5.561e+00; + } + if( w==25 ) + { + r = -5.717e+00; + } + if( w==24 ) + { + r = -5.878e+00; + } + if( w==23 ) + { + r = -6.044e+00; + } + if( w==22 ) + { + r = -6.213e+00; + } + if( w==21 ) + { + r = -6.388e+00; + } + if( w==20 ) + { + r = -6.569e+00; + } + if( w==19 ) + { + r = -6.753e+00; + } + if( w==18 ) + { + r = -6.943e+00; + } + if( w==17 ) + { + r = -7.144e+00; + } + if( w==16 ) + { + r = -7.347e+00; + } + if( w==15 ) + { + r = -7.557e+00; + } + if( w==14 ) + { + r = -7.776e+00; + } + if( w==13 ) + { + r = -7.999e+00; + } + if( w==12 ) + { + r = -8.228e+00; + } + if( w==11 ) + { + r = -8.469e+00; + } + if( w==10 ) + { + r = -8.715e+00; + } + if( w==9 ) + { + r = -8.980e+00; + } + if( w==8 ) + { + r = -9.258e+00; + } + if( w==7 ) + { + r = -9.532e+00; + } + if( w==6 ) + { + r = -9.838e+00; + } + if( w==5 ) + { + r = -1.017e+01; + } + if( w==4 ) + { + r = -1.053e+01; + } + if( w==3 ) + { + r = -1.087e+01; + } + if( w==2 ) + { + r = -1.138e+01; + } + if( w==1 ) + { + r = -1.178e+01; + } + if( w<=0 ) + { + r = -1.248e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 19) +*************************************************************************/ +static double wsr_w19(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-2.484955e+01*s+9.500000e+01, _state); + if( w>=95 ) + { + r = -6.776e-01; + } + if( w==94 ) + { + r = -7.089e-01; + } + if( w==93 ) + { + r = -7.413e-01; + } + if( w==92 ) + { + r = -7.747e-01; + } + if( w==91 ) + { + r = -8.090e-01; + } + if( w==90 ) + { + r = -8.445e-01; + } + if( w==89 ) + { + r = -8.809e-01; + } + if( w==88 ) + { + r = -9.185e-01; + } + if( w==87 ) + { + r = -9.571e-01; + } + if( w==86 ) + { + r = -9.968e-01; + } + if( w==85 ) + { + r = -1.038e+00; + } + if( w==84 ) + { + r = -1.080e+00; + } + if( w==83 ) + { + r = -1.123e+00; + } + if( w==82 ) + { + r = -1.167e+00; + } + if( w==81 ) + { + r = -1.213e+00; + } + if( w==80 ) + { + r = -1.259e+00; + } + if( w==79 ) + { + r = -1.307e+00; + } + if( w==78 ) + { + r = -1.356e+00; + } + if( w==77 ) + { + r = -1.407e+00; + } + if( w==76 ) + { + r = -1.458e+00; + } + if( w==75 ) + { + r = -1.511e+00; + } + if( w==74 ) + { + r = -1.565e+00; + } + if( w==73 ) + { + r = -1.621e+00; + } + if( w==72 ) + { + r = -1.678e+00; + } + if( w==71 ) + { + r = -1.736e+00; + } + if( w==70 ) + { + r = -1.796e+00; + } + if( w==69 ) + { + r = -1.857e+00; + } + if( w==68 ) + { + r = -1.919e+00; + } + if( w==67 ) + { + r = -1.983e+00; + } + if( w==66 ) + { + r = -2.048e+00; + } + if( w==65 ) + { + r = -2.115e+00; + } + if( w==64 ) + { + r = -2.183e+00; + } + if( w==63 ) + { + r = -2.253e+00; + } + if( w==62 ) + { + r = -2.325e+00; + } + if( w==61 ) + { + r = -2.398e+00; + } + if( w==60 ) + { + r = -2.472e+00; + } + if( w==59 ) + { + r = -2.548e+00; + } + if( w==58 ) + { + r = -2.626e+00; + } + if( w==57 ) + { + r = -2.706e+00; + } + if( w==56 ) + { + r = -2.787e+00; + } + if( w==55 ) + { + r = -2.870e+00; + } + if( w==54 ) + { + r = -2.955e+00; + } + if( w==53 ) + { + r = -3.042e+00; + } + if( w==52 ) + { + r = -3.130e+00; + } + if( w==51 ) + { + r = -3.220e+00; + } + if( w==50 ) + { + r = -3.313e+00; + } + if( w==49 ) + { + r = -3.407e+00; + } + if( w==48 ) + { + r = -3.503e+00; + } + if( w==47 ) + { + r = -3.601e+00; + } + if( w==46 ) + { + r = -3.702e+00; + } + if( w==45 ) + { + r = -3.804e+00; + } + if( w==44 ) + { + r = -3.909e+00; + } + if( w==43 ) + { + r = -4.015e+00; + } + if( w==42 ) + { + r = -4.125e+00; + } + if( w==41 ) + { + r = -4.236e+00; + } + if( w==40 ) + { + r = -4.350e+00; + } + if( w==39 ) + { + r = -4.466e+00; + } + if( w==38 ) + { + r = -4.585e+00; + } + if( w==37 ) + { + r = -4.706e+00; + } + if( w==36 ) + { + r = -4.830e+00; + } + if( w==35 ) + { + r = -4.957e+00; + } + if( w==34 ) + { + r = -5.086e+00; + } + if( w==33 ) + { + r = -5.219e+00; + } + if( w==32 ) + { + r = -5.355e+00; + } + if( w==31 ) + { + r = -5.493e+00; + } + if( w==30 ) + { + r = -5.634e+00; + } + if( w==29 ) + { + r = -5.780e+00; + } + if( w==28 ) + { + r = -5.928e+00; + } + if( w==27 ) + { + r = -6.080e+00; + } + if( w==26 ) + { + r = -6.235e+00; + } + if( w==25 ) + { + r = -6.394e+00; + } + if( w==24 ) + { + r = -6.558e+00; + } + if( w==23 ) + { + r = -6.726e+00; + } + if( w==22 ) + { + r = -6.897e+00; + } + if( w==21 ) + { + r = -7.074e+00; + } + if( w==20 ) + { + r = -7.256e+00; + } + if( w==19 ) + { + r = -7.443e+00; + } + if( w==18 ) + { + r = -7.636e+00; + } + if( w==17 ) + { + r = -7.837e+00; + } + if( w==16 ) + { + r = -8.040e+00; + } + if( w==15 ) + { + r = -8.250e+00; + } + if( w==14 ) + { + r = -8.469e+00; + } + if( w==13 ) + { + r = -8.692e+00; + } + if( w==12 ) + { + r = -8.921e+00; + } + if( w==11 ) + { + r = -9.162e+00; + } + if( w==10 ) + { + r = -9.409e+00; + } + if( w==9 ) + { + r = -9.673e+00; + } + if( w==8 ) + { + r = -9.951e+00; + } + if( w==7 ) + { + r = -1.023e+01; + } + if( w==6 ) + { + r = -1.053e+01; + } + if( w==5 ) + { + r = -1.087e+01; + } + if( w==4 ) + { + r = -1.122e+01; + } + if( w==3 ) + { + r = -1.156e+01; + } + if( w==2 ) + { + r = -1.207e+01; + } + if( w==1 ) + { + r = -1.248e+01; + } + if( w<=0 ) + { + r = -1.317e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 20) +*************************************************************************/ +static double wsr_w20(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-2.678619e+01*s+1.050000e+02, _state); + if( w>=105 ) + { + r = -6.787e-01; + } + if( w==104 ) + { + r = -7.078e-01; + } + if( w==103 ) + { + r = -7.378e-01; + } + if( w==102 ) + { + r = -7.686e-01; + } + if( w==101 ) + { + r = -8.004e-01; + } + if( w==100 ) + { + r = -8.330e-01; + } + if( w==99 ) + { + r = -8.665e-01; + } + if( w==98 ) + { + r = -9.010e-01; + } + if( w==97 ) + { + r = -9.363e-01; + } + if( w==96 ) + { + r = -9.726e-01; + } + if( w==95 ) + { + r = -1.010e+00; + } + if( w==94 ) + { + r = -1.048e+00; + } + if( w==93 ) + { + r = -1.087e+00; + } + if( w==92 ) + { + r = -1.128e+00; + } + if( w==91 ) + { + r = -1.169e+00; + } + if( w==90 ) + { + r = -1.211e+00; + } + if( w==89 ) + { + r = -1.254e+00; + } + if( w==88 ) + { + r = -1.299e+00; + } + if( w==87 ) + { + r = -1.344e+00; + } + if( w==86 ) + { + r = -1.390e+00; + } + if( w==85 ) + { + r = -1.438e+00; + } + if( w==84 ) + { + r = -1.486e+00; + } + if( w==83 ) + { + r = -1.536e+00; + } + if( w==82 ) + { + r = -1.587e+00; + } + if( w==81 ) + { + r = -1.639e+00; + } + if( w==80 ) + { + r = -1.692e+00; + } + if( w==79 ) + { + r = -1.746e+00; + } + if( w==78 ) + { + r = -1.802e+00; + } + if( w==77 ) + { + r = -1.859e+00; + } + if( w==76 ) + { + r = -1.916e+00; + } + if( w==75 ) + { + r = -1.976e+00; + } + if( w==74 ) + { + r = -2.036e+00; + } + if( w==73 ) + { + r = -2.098e+00; + } + if( w==72 ) + { + r = -2.161e+00; + } + if( w==71 ) + { + r = -2.225e+00; + } + if( w==70 ) + { + r = -2.290e+00; + } + if( w==69 ) + { + r = -2.357e+00; + } + if( w==68 ) + { + r = -2.426e+00; + } + if( w==67 ) + { + r = -2.495e+00; + } + if( w==66 ) + { + r = -2.566e+00; + } + if( w==65 ) + { + r = -2.639e+00; + } + if( w==64 ) + { + r = -2.713e+00; + } + if( w==63 ) + { + r = -2.788e+00; + } + if( w==62 ) + { + r = -2.865e+00; + } + if( w==61 ) + { + r = -2.943e+00; + } + if( w==60 ) + { + r = -3.023e+00; + } + if( w==59 ) + { + r = -3.104e+00; + } + if( w==58 ) + { + r = -3.187e+00; + } + if( w==57 ) + { + r = -3.272e+00; + } + if( w==56 ) + { + r = -3.358e+00; + } + if( w==55 ) + { + r = -3.446e+00; + } + if( w==54 ) + { + r = -3.536e+00; + } + if( w==53 ) + { + r = -3.627e+00; + } + if( w==52 ) + { + r = -3.721e+00; + } + if( w==51 ) + { + r = -3.815e+00; + } + if( w==50 ) + { + r = -3.912e+00; + } + if( w==49 ) + { + r = -4.011e+00; + } + if( w==48 ) + { + r = -4.111e+00; + } + if( w==47 ) + { + r = -4.214e+00; + } + if( w==46 ) + { + r = -4.318e+00; + } + if( w==45 ) + { + r = -4.425e+00; + } + if( w==44 ) + { + r = -4.534e+00; + } + if( w==43 ) + { + r = -4.644e+00; + } + if( w==42 ) + { + r = -4.757e+00; + } + if( w==41 ) + { + r = -4.872e+00; + } + if( w==40 ) + { + r = -4.990e+00; + } + if( w==39 ) + { + r = -5.109e+00; + } + if( w==38 ) + { + r = -5.232e+00; + } + if( w==37 ) + { + r = -5.356e+00; + } + if( w==36 ) + { + r = -5.484e+00; + } + if( w==35 ) + { + r = -5.614e+00; + } + if( w==34 ) + { + r = -5.746e+00; + } + if( w==33 ) + { + r = -5.882e+00; + } + if( w==32 ) + { + r = -6.020e+00; + } + if( w==31 ) + { + r = -6.161e+00; + } + if( w==30 ) + { + r = -6.305e+00; + } + if( w==29 ) + { + r = -6.453e+00; + } + if( w==28 ) + { + r = -6.603e+00; + } + if( w==27 ) + { + r = -6.757e+00; + } + if( w==26 ) + { + r = -6.915e+00; + } + if( w==25 ) + { + r = -7.076e+00; + } + if( w==24 ) + { + r = -7.242e+00; + } + if( w==23 ) + { + r = -7.411e+00; + } + if( w==22 ) + { + r = -7.584e+00; + } + if( w==21 ) + { + r = -7.763e+00; + } + if( w==20 ) + { + r = -7.947e+00; + } + if( w==19 ) + { + r = -8.136e+00; + } + if( w==18 ) + { + r = -8.330e+00; + } + if( w==17 ) + { + r = -8.530e+00; + } + if( w==16 ) + { + r = -8.733e+00; + } + if( w==15 ) + { + r = -8.943e+00; + } + if( w==14 ) + { + r = -9.162e+00; + } + if( w==13 ) + { + r = -9.386e+00; + } + if( w==12 ) + { + r = -9.614e+00; + } + if( w==11 ) + { + r = -9.856e+00; + } + if( w==10 ) + { + r = -1.010e+01; + } + if( w==9 ) + { + r = -1.037e+01; + } + if( w==8 ) + { + r = -1.064e+01; + } + if( w==7 ) + { + r = -1.092e+01; + } + if( w==6 ) + { + r = -1.122e+01; + } + if( w==5 ) + { + r = -1.156e+01; + } + if( w==4 ) + { + r = -1.192e+01; + } + if( w==3 ) + { + r = -1.225e+01; + } + if( w==2 ) + { + r = -1.276e+01; + } + if( w==1 ) + { + r = -1.317e+01; + } + if( w<=0 ) + { + r = -1.386e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 21) +*************************************************************************/ +static double wsr_w21(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-2.877064e+01*s+1.155000e+02, _state); + if( w>=115 ) + { + r = -6.931e-01; + } + if( w==114 ) + { + r = -7.207e-01; + } + if( w==113 ) + { + r = -7.489e-01; + } + if( w==112 ) + { + r = -7.779e-01; + } + if( w==111 ) + { + r = -8.077e-01; + } + if( w==110 ) + { + r = -8.383e-01; + } + if( w==109 ) + { + r = -8.697e-01; + } + if( w==108 ) + { + r = -9.018e-01; + } + if( w==107 ) + { + r = -9.348e-01; + } + if( w==106 ) + { + r = -9.685e-01; + } + if( w==105 ) + { + r = -1.003e+00; + } + if( w==104 ) + { + r = -1.039e+00; + } + if( w==103 ) + { + r = -1.075e+00; + } + if( w==102 ) + { + r = -1.112e+00; + } + if( w==101 ) + { + r = -1.150e+00; + } + if( w==100 ) + { + r = -1.189e+00; + } + if( w==99 ) + { + r = -1.229e+00; + } + if( w==98 ) + { + r = -1.269e+00; + } + if( w==97 ) + { + r = -1.311e+00; + } + if( w==96 ) + { + r = -1.353e+00; + } + if( w==95 ) + { + r = -1.397e+00; + } + if( w==94 ) + { + r = -1.441e+00; + } + if( w==93 ) + { + r = -1.486e+00; + } + if( w==92 ) + { + r = -1.533e+00; + } + if( w==91 ) + { + r = -1.580e+00; + } + if( w==90 ) + { + r = -1.628e+00; + } + if( w==89 ) + { + r = -1.677e+00; + } + if( w==88 ) + { + r = -1.728e+00; + } + if( w==87 ) + { + r = -1.779e+00; + } + if( w==86 ) + { + r = -1.831e+00; + } + if( w==85 ) + { + r = -1.884e+00; + } + if( w==84 ) + { + r = -1.939e+00; + } + if( w==83 ) + { + r = -1.994e+00; + } + if( w==82 ) + { + r = -2.051e+00; + } + if( w==81 ) + { + r = -2.108e+00; + } + if( w==80 ) + { + r = -2.167e+00; + } + if( w==79 ) + { + r = -2.227e+00; + } + if( w==78 ) + { + r = -2.288e+00; + } + if( w==77 ) + { + r = -2.350e+00; + } + if( w==76 ) + { + r = -2.414e+00; + } + if( w==75 ) + { + r = -2.478e+00; + } + if( w==74 ) + { + r = -2.544e+00; + } + if( w==73 ) + { + r = -2.611e+00; + } + if( w==72 ) + { + r = -2.679e+00; + } + if( w==71 ) + { + r = -2.748e+00; + } + if( w==70 ) + { + r = -2.819e+00; + } + if( w==69 ) + { + r = -2.891e+00; + } + if( w==68 ) + { + r = -2.964e+00; + } + if( w==67 ) + { + r = -3.039e+00; + } + if( w==66 ) + { + r = -3.115e+00; + } + if( w==65 ) + { + r = -3.192e+00; + } + if( w==64 ) + { + r = -3.270e+00; + } + if( w==63 ) + { + r = -3.350e+00; + } + if( w==62 ) + { + r = -3.432e+00; + } + if( w==61 ) + { + r = -3.515e+00; + } + if( w==60 ) + { + r = -3.599e+00; + } + if( w==59 ) + { + r = -3.685e+00; + } + if( w==58 ) + { + r = -3.772e+00; + } + if( w==57 ) + { + r = -3.861e+00; + } + if( w==56 ) + { + r = -3.952e+00; + } + if( w==55 ) + { + r = -4.044e+00; + } + if( w==54 ) + { + r = -4.138e+00; + } + if( w==53 ) + { + r = -4.233e+00; + } + if( w==52 ) + { + r = -4.330e+00; + } + if( w==51 ) + { + r = -4.429e+00; + } + if( w==50 ) + { + r = -4.530e+00; + } + if( w==49 ) + { + r = -4.632e+00; + } + if( w==48 ) + { + r = -4.736e+00; + } + if( w==47 ) + { + r = -4.842e+00; + } + if( w==46 ) + { + r = -4.950e+00; + } + if( w==45 ) + { + r = -5.060e+00; + } + if( w==44 ) + { + r = -5.172e+00; + } + if( w==43 ) + { + r = -5.286e+00; + } + if( w==42 ) + { + r = -5.402e+00; + } + if( w==41 ) + { + r = -5.520e+00; + } + if( w==40 ) + { + r = -5.641e+00; + } + if( w==39 ) + { + r = -5.763e+00; + } + if( w==38 ) + { + r = -5.889e+00; + } + if( w==37 ) + { + r = -6.016e+00; + } + if( w==36 ) + { + r = -6.146e+00; + } + if( w==35 ) + { + r = -6.278e+00; + } + if( w==34 ) + { + r = -6.413e+00; + } + if( w==33 ) + { + r = -6.551e+00; + } + if( w==32 ) + { + r = -6.692e+00; + } + if( w==31 ) + { + r = -6.835e+00; + } + if( w==30 ) + { + r = -6.981e+00; + } + if( w==29 ) + { + r = -7.131e+00; + } + if( w==28 ) + { + r = -7.283e+00; + } + if( w==27 ) + { + r = -7.439e+00; + } + if( w==26 ) + { + r = -7.599e+00; + } + if( w==25 ) + { + r = -7.762e+00; + } + if( w==24 ) + { + r = -7.928e+00; + } + if( w==23 ) + { + r = -8.099e+00; + } + if( w==22 ) + { + r = -8.274e+00; + } + if( w==21 ) + { + r = -8.454e+00; + } + if( w==20 ) + { + r = -8.640e+00; + } + if( w==19 ) + { + r = -8.829e+00; + } + if( w==18 ) + { + r = -9.023e+00; + } + if( w==17 ) + { + r = -9.223e+00; + } + if( w==16 ) + { + r = -9.426e+00; + } + if( w==15 ) + { + r = -9.636e+00; + } + if( w==14 ) + { + r = -9.856e+00; + } + if( w==13 ) + { + r = -1.008e+01; + } + if( w==12 ) + { + r = -1.031e+01; + } + if( w==11 ) + { + r = -1.055e+01; + } + if( w==10 ) + { + r = -1.079e+01; + } + if( w==9 ) + { + r = -1.106e+01; + } + if( w==8 ) + { + r = -1.134e+01; + } + if( w==7 ) + { + r = -1.161e+01; + } + if( w==6 ) + { + r = -1.192e+01; + } + if( w==5 ) + { + r = -1.225e+01; + } + if( w==4 ) + { + r = -1.261e+01; + } + if( w==3 ) + { + r = -1.295e+01; + } + if( w==2 ) + { + r = -1.346e+01; + } + if( w==1 ) + { + r = -1.386e+01; + } + if( w<=0 ) + { + r = -1.456e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 22) +*************************************************************************/ +static double wsr_w22(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-3.080179e+01*s+1.265000e+02, _state); + if( w>=126 ) + { + r = -6.931e-01; + } + if( w==125 ) + { + r = -7.189e-01; + } + if( w==124 ) + { + r = -7.452e-01; + } + if( w==123 ) + { + r = -7.722e-01; + } + if( w==122 ) + { + r = -7.999e-01; + } + if( w==121 ) + { + r = -8.283e-01; + } + if( w==120 ) + { + r = -8.573e-01; + } + if( w==119 ) + { + r = -8.871e-01; + } + if( w==118 ) + { + r = -9.175e-01; + } + if( w==117 ) + { + r = -9.486e-01; + } + if( w==116 ) + { + r = -9.805e-01; + } + if( w==115 ) + { + r = -1.013e+00; + } + if( w==114 ) + { + r = -1.046e+00; + } + if( w==113 ) + { + r = -1.080e+00; + } + if( w==112 ) + { + r = -1.115e+00; + } + if( w==111 ) + { + r = -1.151e+00; + } + if( w==110 ) + { + r = -1.187e+00; + } + if( w==109 ) + { + r = -1.224e+00; + } + if( w==108 ) + { + r = -1.262e+00; + } + if( w==107 ) + { + r = -1.301e+00; + } + if( w==106 ) + { + r = -1.340e+00; + } + if( w==105 ) + { + r = -1.381e+00; + } + if( w==104 ) + { + r = -1.422e+00; + } + if( w==103 ) + { + r = -1.464e+00; + } + if( w==102 ) + { + r = -1.506e+00; + } + if( w==101 ) + { + r = -1.550e+00; + } + if( w==100 ) + { + r = -1.594e+00; + } + if( w==99 ) + { + r = -1.640e+00; + } + if( w==98 ) + { + r = -1.686e+00; + } + if( w==97 ) + { + r = -1.733e+00; + } + if( w==96 ) + { + r = -1.781e+00; + } + if( w==95 ) + { + r = -1.830e+00; + } + if( w==94 ) + { + r = -1.880e+00; + } + if( w==93 ) + { + r = -1.930e+00; + } + if( w==92 ) + { + r = -1.982e+00; + } + if( w==91 ) + { + r = -2.034e+00; + } + if( w==90 ) + { + r = -2.088e+00; + } + if( w==89 ) + { + r = -2.142e+00; + } + if( w==88 ) + { + r = -2.198e+00; + } + if( w==87 ) + { + r = -2.254e+00; + } + if( w==86 ) + { + r = -2.312e+00; + } + if( w==85 ) + { + r = -2.370e+00; + } + if( w==84 ) + { + r = -2.429e+00; + } + if( w==83 ) + { + r = -2.490e+00; + } + if( w==82 ) + { + r = -2.551e+00; + } + if( w==81 ) + { + r = -2.614e+00; + } + if( w==80 ) + { + r = -2.677e+00; + } + if( w==79 ) + { + r = -2.742e+00; + } + if( w==78 ) + { + r = -2.808e+00; + } + if( w==77 ) + { + r = -2.875e+00; + } + if( w==76 ) + { + r = -2.943e+00; + } + if( w==75 ) + { + r = -3.012e+00; + } + if( w==74 ) + { + r = -3.082e+00; + } + if( w==73 ) + { + r = -3.153e+00; + } + if( w==72 ) + { + r = -3.226e+00; + } + if( w==71 ) + { + r = -3.300e+00; + } + if( w==70 ) + { + r = -3.375e+00; + } + if( w==69 ) + { + r = -3.451e+00; + } + if( w==68 ) + { + r = -3.529e+00; + } + if( w==67 ) + { + r = -3.607e+00; + } + if( w==66 ) + { + r = -3.687e+00; + } + if( w==65 ) + { + r = -3.769e+00; + } + if( w==64 ) + { + r = -3.851e+00; + } + if( w==63 ) + { + r = -3.935e+00; + } + if( w==62 ) + { + r = -4.021e+00; + } + if( w==61 ) + { + r = -4.108e+00; + } + if( w==60 ) + { + r = -4.196e+00; + } + if( w==59 ) + { + r = -4.285e+00; + } + if( w==58 ) + { + r = -4.376e+00; + } + if( w==57 ) + { + r = -4.469e+00; + } + if( w==56 ) + { + r = -4.563e+00; + } + if( w==55 ) + { + r = -4.659e+00; + } + if( w==54 ) + { + r = -4.756e+00; + } + if( w==53 ) + { + r = -4.855e+00; + } + if( w==52 ) + { + r = -4.955e+00; + } + if( w==51 ) + { + r = -5.057e+00; + } + if( w==50 ) + { + r = -5.161e+00; + } + if( w==49 ) + { + r = -5.266e+00; + } + if( w==48 ) + { + r = -5.374e+00; + } + if( w==47 ) + { + r = -5.483e+00; + } + if( w==46 ) + { + r = -5.594e+00; + } + if( w==45 ) + { + r = -5.706e+00; + } + if( w==44 ) + { + r = -5.821e+00; + } + if( w==43 ) + { + r = -5.938e+00; + } + if( w==42 ) + { + r = -6.057e+00; + } + if( w==41 ) + { + r = -6.177e+00; + } + if( w==40 ) + { + r = -6.300e+00; + } + if( w==39 ) + { + r = -6.426e+00; + } + if( w==38 ) + { + r = -6.553e+00; + } + if( w==37 ) + { + r = -6.683e+00; + } + if( w==36 ) + { + r = -6.815e+00; + } + if( w==35 ) + { + r = -6.949e+00; + } + if( w==34 ) + { + r = -7.086e+00; + } + if( w==33 ) + { + r = -7.226e+00; + } + if( w==32 ) + { + r = -7.368e+00; + } + if( w==31 ) + { + r = -7.513e+00; + } + if( w==30 ) + { + r = -7.661e+00; + } + if( w==29 ) + { + r = -7.813e+00; + } + if( w==28 ) + { + r = -7.966e+00; + } + if( w==27 ) + { + r = -8.124e+00; + } + if( w==26 ) + { + r = -8.285e+00; + } + if( w==25 ) + { + r = -8.449e+00; + } + if( w==24 ) + { + r = -8.617e+00; + } + if( w==23 ) + { + r = -8.789e+00; + } + if( w==22 ) + { + r = -8.965e+00; + } + if( w==21 ) + { + r = -9.147e+00; + } + if( w==20 ) + { + r = -9.333e+00; + } + if( w==19 ) + { + r = -9.522e+00; + } + if( w==18 ) + { + r = -9.716e+00; + } + if( w==17 ) + { + r = -9.917e+00; + } + if( w==16 ) + { + r = -1.012e+01; + } + if( w==15 ) + { + r = -1.033e+01; + } + if( w==14 ) + { + r = -1.055e+01; + } + if( w==13 ) + { + r = -1.077e+01; + } + if( w==12 ) + { + r = -1.100e+01; + } + if( w==11 ) + { + r = -1.124e+01; + } + if( w==10 ) + { + r = -1.149e+01; + } + if( w==9 ) + { + r = -1.175e+01; + } + if( w==8 ) + { + r = -1.203e+01; + } + if( w==7 ) + { + r = -1.230e+01; + } + if( w==6 ) + { + r = -1.261e+01; + } + if( w==5 ) + { + r = -1.295e+01; + } + if( w==4 ) + { + r = -1.330e+01; + } + if( w==3 ) + { + r = -1.364e+01; + } + if( w==2 ) + { + r = -1.415e+01; + } + if( w==1 ) + { + r = -1.456e+01; + } + if( w<=0 ) + { + r = -1.525e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 23) +*************************************************************************/ +static double wsr_w23(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-3.287856e+01*s+1.380000e+02, _state); + if( w>=138 ) + { + r = -6.813e-01; + } + if( w==137 ) + { + r = -7.051e-01; + } + if( w==136 ) + { + r = -7.295e-01; + } + if( w==135 ) + { + r = -7.544e-01; + } + if( w==134 ) + { + r = -7.800e-01; + } + if( w==133 ) + { + r = -8.061e-01; + } + if( w==132 ) + { + r = -8.328e-01; + } + if( w==131 ) + { + r = -8.601e-01; + } + if( w==130 ) + { + r = -8.880e-01; + } + if( w==129 ) + { + r = -9.166e-01; + } + if( w==128 ) + { + r = -9.457e-01; + } + if( w==127 ) + { + r = -9.755e-01; + } + if( w==126 ) + { + r = -1.006e+00; + } + if( w==125 ) + { + r = -1.037e+00; + } + if( w==124 ) + { + r = -1.069e+00; + } + if( w==123 ) + { + r = -1.101e+00; + } + if( w==122 ) + { + r = -1.134e+00; + } + if( w==121 ) + { + r = -1.168e+00; + } + if( w==120 ) + { + r = -1.202e+00; + } + if( w==119 ) + { + r = -1.237e+00; + } + if( w==118 ) + { + r = -1.273e+00; + } + if( w==117 ) + { + r = -1.309e+00; + } + if( w==116 ) + { + r = -1.347e+00; + } + if( w==115 ) + { + r = -1.384e+00; + } + if( w==114 ) + { + r = -1.423e+00; + } + if( w==113 ) + { + r = -1.462e+00; + } + if( w==112 ) + { + r = -1.502e+00; + } + if( w==111 ) + { + r = -1.543e+00; + } + if( w==110 ) + { + r = -1.585e+00; + } + if( w==109 ) + { + r = -1.627e+00; + } + if( w==108 ) + { + r = -1.670e+00; + } + if( w==107 ) + { + r = -1.714e+00; + } + if( w==106 ) + { + r = -1.758e+00; + } + if( w==105 ) + { + r = -1.804e+00; + } + if( w==104 ) + { + r = -1.850e+00; + } + if( w==103 ) + { + r = -1.897e+00; + } + if( w==102 ) + { + r = -1.944e+00; + } + if( w==101 ) + { + r = -1.993e+00; + } + if( w==100 ) + { + r = -2.042e+00; + } + if( w==99 ) + { + r = -2.093e+00; + } + if( w==98 ) + { + r = -2.144e+00; + } + if( w==97 ) + { + r = -2.195e+00; + } + if( w==96 ) + { + r = -2.248e+00; + } + if( w==95 ) + { + r = -2.302e+00; + } + if( w==94 ) + { + r = -2.356e+00; + } + if( w==93 ) + { + r = -2.412e+00; + } + if( w==92 ) + { + r = -2.468e+00; + } + if( w==91 ) + { + r = -2.525e+00; + } + if( w==90 ) + { + r = -2.583e+00; + } + if( w==89 ) + { + r = -2.642e+00; + } + if( w==88 ) + { + r = -2.702e+00; + } + if( w==87 ) + { + r = -2.763e+00; + } + if( w==86 ) + { + r = -2.825e+00; + } + if( w==85 ) + { + r = -2.888e+00; + } + if( w==84 ) + { + r = -2.951e+00; + } + if( w==83 ) + { + r = -3.016e+00; + } + if( w==82 ) + { + r = -3.082e+00; + } + if( w==81 ) + { + r = -3.149e+00; + } + if( w==80 ) + { + r = -3.216e+00; + } + if( w==79 ) + { + r = -3.285e+00; + } + if( w==78 ) + { + r = -3.355e+00; + } + if( w==77 ) + { + r = -3.426e+00; + } + if( w==76 ) + { + r = -3.498e+00; + } + if( w==75 ) + { + r = -3.571e+00; + } + if( w==74 ) + { + r = -3.645e+00; + } + if( w==73 ) + { + r = -3.721e+00; + } + if( w==72 ) + { + r = -3.797e+00; + } + if( w==71 ) + { + r = -3.875e+00; + } + if( w==70 ) + { + r = -3.953e+00; + } + if( w==69 ) + { + r = -4.033e+00; + } + if( w==68 ) + { + r = -4.114e+00; + } + if( w==67 ) + { + r = -4.197e+00; + } + if( w==66 ) + { + r = -4.280e+00; + } + if( w==65 ) + { + r = -4.365e+00; + } + if( w==64 ) + { + r = -4.451e+00; + } + if( w==63 ) + { + r = -4.539e+00; + } + if( w==62 ) + { + r = -4.628e+00; + } + if( w==61 ) + { + r = -4.718e+00; + } + if( w==60 ) + { + r = -4.809e+00; + } + if( w==59 ) + { + r = -4.902e+00; + } + if( w==58 ) + { + r = -4.996e+00; + } + if( w==57 ) + { + r = -5.092e+00; + } + if( w==56 ) + { + r = -5.189e+00; + } + if( w==55 ) + { + r = -5.287e+00; + } + if( w==54 ) + { + r = -5.388e+00; + } + if( w==53 ) + { + r = -5.489e+00; + } + if( w==52 ) + { + r = -5.592e+00; + } + if( w==51 ) + { + r = -5.697e+00; + } + if( w==50 ) + { + r = -5.804e+00; + } + if( w==49 ) + { + r = -5.912e+00; + } + if( w==48 ) + { + r = -6.022e+00; + } + if( w==47 ) + { + r = -6.133e+00; + } + if( w==46 ) + { + r = -6.247e+00; + } + if( w==45 ) + { + r = -6.362e+00; + } + if( w==44 ) + { + r = -6.479e+00; + } + if( w==43 ) + { + r = -6.598e+00; + } + if( w==42 ) + { + r = -6.719e+00; + } + if( w==41 ) + { + r = -6.842e+00; + } + if( w==40 ) + { + r = -6.967e+00; + } + if( w==39 ) + { + r = -7.094e+00; + } + if( w==38 ) + { + r = -7.224e+00; + } + if( w==37 ) + { + r = -7.355e+00; + } + if( w==36 ) + { + r = -7.489e+00; + } + if( w==35 ) + { + r = -7.625e+00; + } + if( w==34 ) + { + r = -7.764e+00; + } + if( w==33 ) + { + r = -7.905e+00; + } + if( w==32 ) + { + r = -8.049e+00; + } + if( w==31 ) + { + r = -8.196e+00; + } + if( w==30 ) + { + r = -8.345e+00; + } + if( w==29 ) + { + r = -8.498e+00; + } + if( w==28 ) + { + r = -8.653e+00; + } + if( w==27 ) + { + r = -8.811e+00; + } + if( w==26 ) + { + r = -8.974e+00; + } + if( w==25 ) + { + r = -9.139e+00; + } + if( w==24 ) + { + r = -9.308e+00; + } + if( w==23 ) + { + r = -9.481e+00; + } + if( w==22 ) + { + r = -9.658e+00; + } + if( w==21 ) + { + r = -9.840e+00; + } + if( w==20 ) + { + r = -1.003e+01; + } + if( w==19 ) + { + r = -1.022e+01; + } + if( w==18 ) + { + r = -1.041e+01; + } + if( w==17 ) + { + r = -1.061e+01; + } + if( w==16 ) + { + r = -1.081e+01; + } + if( w==15 ) + { + r = -1.102e+01; + } + if( w==14 ) + { + r = -1.124e+01; + } + if( w==13 ) + { + r = -1.147e+01; + } + if( w==12 ) + { + r = -1.169e+01; + } + if( w==11 ) + { + r = -1.194e+01; + } + if( w==10 ) + { + r = -1.218e+01; + } + if( w==9 ) + { + r = -1.245e+01; + } + if( w==8 ) + { + r = -1.272e+01; + } + if( w==7 ) + { + r = -1.300e+01; + } + if( w==6 ) + { + r = -1.330e+01; + } + if( w==5 ) + { + r = -1.364e+01; + } + if( w==4 ) + { + r = -1.400e+01; + } + if( w==3 ) + { + r = -1.433e+01; + } + if( w==2 ) + { + r = -1.484e+01; + } + if( w==1 ) + { + r = -1.525e+01; + } + if( w<=0 ) + { + r = -1.594e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 24) +*************************************************************************/ +static double wsr_w24(double s, ae_state *_state) +{ + ae_int_t w; + double r; + double result; + + + r = 0; + w = ae_round(-3.500000e+01*s+1.500000e+02, _state); + if( w>=150 ) + { + r = -6.820e-01; + } + if( w==149 ) + { + r = -7.044e-01; + } + if( w==148 ) + { + r = -7.273e-01; + } + if( w==147 ) + { + r = -7.507e-01; + } + if( w==146 ) + { + r = -7.746e-01; + } + if( w==145 ) + { + r = -7.990e-01; + } + if( w==144 ) + { + r = -8.239e-01; + } + if( w==143 ) + { + r = -8.494e-01; + } + if( w==142 ) + { + r = -8.754e-01; + } + if( w==141 ) + { + r = -9.020e-01; + } + if( w==140 ) + { + r = -9.291e-01; + } + if( w==139 ) + { + r = -9.567e-01; + } + if( w==138 ) + { + r = -9.849e-01; + } + if( w==137 ) + { + r = -1.014e+00; + } + if( w==136 ) + { + r = -1.043e+00; + } + if( w==135 ) + { + r = -1.073e+00; + } + if( w==134 ) + { + r = -1.103e+00; + } + if( w==133 ) + { + r = -1.135e+00; + } + if( w==132 ) + { + r = -1.166e+00; + } + if( w==131 ) + { + r = -1.198e+00; + } + if( w==130 ) + { + r = -1.231e+00; + } + if( w==129 ) + { + r = -1.265e+00; + } + if( w==128 ) + { + r = -1.299e+00; + } + if( w==127 ) + { + r = -1.334e+00; + } + if( w==126 ) + { + r = -1.369e+00; + } + if( w==125 ) + { + r = -1.405e+00; + } + if( w==124 ) + { + r = -1.441e+00; + } + if( w==123 ) + { + r = -1.479e+00; + } + if( w==122 ) + { + r = -1.517e+00; + } + if( w==121 ) + { + r = -1.555e+00; + } + if( w==120 ) + { + r = -1.594e+00; + } + if( w==119 ) + { + r = -1.634e+00; + } + if( w==118 ) + { + r = -1.675e+00; + } + if( w==117 ) + { + r = -1.716e+00; + } + if( w==116 ) + { + r = -1.758e+00; + } + if( w==115 ) + { + r = -1.800e+00; + } + if( w==114 ) + { + r = -1.844e+00; + } + if( w==113 ) + { + r = -1.888e+00; + } + if( w==112 ) + { + r = -1.932e+00; + } + if( w==111 ) + { + r = -1.978e+00; + } + if( w==110 ) + { + r = -2.024e+00; + } + if( w==109 ) + { + r = -2.070e+00; + } + if( w==108 ) + { + r = -2.118e+00; + } + if( w==107 ) + { + r = -2.166e+00; + } + if( w==106 ) + { + r = -2.215e+00; + } + if( w==105 ) + { + r = -2.265e+00; + } + if( w==104 ) + { + r = -2.316e+00; + } + if( w==103 ) + { + r = -2.367e+00; + } + if( w==102 ) + { + r = -2.419e+00; + } + if( w==101 ) + { + r = -2.472e+00; + } + if( w==100 ) + { + r = -2.526e+00; + } + if( w==99 ) + { + r = -2.580e+00; + } + if( w==98 ) + { + r = -2.636e+00; + } + if( w==97 ) + { + r = -2.692e+00; + } + if( w==96 ) + { + r = -2.749e+00; + } + if( w==95 ) + { + r = -2.806e+00; + } + if( w==94 ) + { + r = -2.865e+00; + } + if( w==93 ) + { + r = -2.925e+00; + } + if( w==92 ) + { + r = -2.985e+00; + } + if( w==91 ) + { + r = -3.046e+00; + } + if( w==90 ) + { + r = -3.108e+00; + } + if( w==89 ) + { + r = -3.171e+00; + } + if( w==88 ) + { + r = -3.235e+00; + } + if( w==87 ) + { + r = -3.300e+00; + } + if( w==86 ) + { + r = -3.365e+00; + } + if( w==85 ) + { + r = -3.432e+00; + } + if( w==84 ) + { + r = -3.499e+00; + } + if( w==83 ) + { + r = -3.568e+00; + } + if( w==82 ) + { + r = -3.637e+00; + } + if( w==81 ) + { + r = -3.708e+00; + } + if( w==80 ) + { + r = -3.779e+00; + } + if( w==79 ) + { + r = -3.852e+00; + } + if( w==78 ) + { + r = -3.925e+00; + } + if( w==77 ) + { + r = -4.000e+00; + } + if( w==76 ) + { + r = -4.075e+00; + } + if( w==75 ) + { + r = -4.151e+00; + } + if( w==74 ) + { + r = -4.229e+00; + } + if( w==73 ) + { + r = -4.308e+00; + } + if( w==72 ) + { + r = -4.387e+00; + } + if( w==71 ) + { + r = -4.468e+00; + } + if( w==70 ) + { + r = -4.550e+00; + } + if( w==69 ) + { + r = -4.633e+00; + } + if( w==68 ) + { + r = -4.718e+00; + } + if( w==67 ) + { + r = -4.803e+00; + } + if( w==66 ) + { + r = -4.890e+00; + } + if( w==65 ) + { + r = -4.978e+00; + } + if( w==64 ) + { + r = -5.067e+00; + } + if( w==63 ) + { + r = -5.157e+00; + } + if( w==62 ) + { + r = -5.249e+00; + } + if( w==61 ) + { + r = -5.342e+00; + } + if( w==60 ) + { + r = -5.436e+00; + } + if( w==59 ) + { + r = -5.531e+00; + } + if( w==58 ) + { + r = -5.628e+00; + } + if( w==57 ) + { + r = -5.727e+00; + } + if( w==56 ) + { + r = -5.826e+00; + } + if( w==55 ) + { + r = -5.927e+00; + } + if( w==54 ) + { + r = -6.030e+00; + } + if( w==53 ) + { + r = -6.134e+00; + } + if( w==52 ) + { + r = -6.240e+00; + } + if( w==51 ) + { + r = -6.347e+00; + } + if( w==50 ) + { + r = -6.456e+00; + } + if( w==49 ) + { + r = -6.566e+00; + } + if( w==48 ) + { + r = -6.678e+00; + } + if( w==47 ) + { + r = -6.792e+00; + } + if( w==46 ) + { + r = -6.907e+00; + } + if( w==45 ) + { + r = -7.025e+00; + } + if( w==44 ) + { + r = -7.144e+00; + } + if( w==43 ) + { + r = -7.265e+00; + } + if( w==42 ) + { + r = -7.387e+00; + } + if( w==41 ) + { + r = -7.512e+00; + } + if( w==40 ) + { + r = -7.639e+00; + } + if( w==39 ) + { + r = -7.768e+00; + } + if( w==38 ) + { + r = -7.899e+00; + } + if( w==37 ) + { + r = -8.032e+00; + } + if( w==36 ) + { + r = -8.167e+00; + } + if( w==35 ) + { + r = -8.305e+00; + } + if( w==34 ) + { + r = -8.445e+00; + } + if( w==33 ) + { + r = -8.588e+00; + } + if( w==32 ) + { + r = -8.733e+00; + } + if( w==31 ) + { + r = -8.881e+00; + } + if( w==30 ) + { + r = -9.031e+00; + } + if( w==29 ) + { + r = -9.185e+00; + } + if( w==28 ) + { + r = -9.341e+00; + } + if( w==27 ) + { + r = -9.501e+00; + } + if( w==26 ) + { + r = -9.664e+00; + } + if( w==25 ) + { + r = -9.830e+00; + } + if( w==24 ) + { + r = -1.000e+01; + } + if( w==23 ) + { + r = -1.017e+01; + } + if( w==22 ) + { + r = -1.035e+01; + } + if( w==21 ) + { + r = -1.053e+01; + } + if( w==20 ) + { + r = -1.072e+01; + } + if( w==19 ) + { + r = -1.091e+01; + } + if( w==18 ) + { + r = -1.110e+01; + } + if( w==17 ) + { + r = -1.130e+01; + } + if( w==16 ) + { + r = -1.151e+01; + } + if( w==15 ) + { + r = -1.172e+01; + } + if( w==14 ) + { + r = -1.194e+01; + } + if( w==13 ) + { + r = -1.216e+01; + } + if( w==12 ) + { + r = -1.239e+01; + } + if( w==11 ) + { + r = -1.263e+01; + } + if( w==10 ) + { + r = -1.287e+01; + } + if( w==9 ) + { + r = -1.314e+01; + } + if( w==8 ) + { + r = -1.342e+01; + } + if( w==7 ) + { + r = -1.369e+01; + } + if( w==6 ) + { + r = -1.400e+01; + } + if( w==5 ) + { + r = -1.433e+01; + } + if( w==4 ) + { + r = -1.469e+01; + } + if( w==3 ) + { + r = -1.503e+01; + } + if( w==2 ) + { + r = -1.554e+01; + } + if( w==1 ) + { + r = -1.594e+01; + } + if( w<=0 ) + { + r = -1.664e+01; + } + result = r; + return result; +} + + +/************************************************************************* +Tail(S, 25) +*************************************************************************/ +static double wsr_w25(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -5.150509e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.695528e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.437637e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.611906e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -7.625722e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.579892e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.086876e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.906543e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.354881e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, 1.007195e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -8.437327e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 26) +*************************************************************************/ +static double wsr_w26(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -5.117622e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.635159e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.395167e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.382823e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -6.531987e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.060112e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -8.203697e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.516523e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.431364e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, 6.384553e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -3.238369e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 27) +*************************************************************************/ +static double wsr_w27(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -5.089731e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.584248e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.359966e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.203696e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.753344e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.761891e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -7.096897e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.419108e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.581214e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, 3.033766e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.901441e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 28) +*************************************************************************/ +static double wsr_w28(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -5.065046e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.539163e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.328939e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.046376e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.061515e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.469271e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.711578e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -8.389153e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.250575e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, 4.047245e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.128555e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 29) +*************************************************************************/ +static double wsr_w29(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -5.043413e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.499756e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.302137e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.915129e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.516329e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.260064e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.817269e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.478130e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.111668e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, 4.093451e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.135860e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 30) +*************************************************************************/ +static double wsr_w30(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -5.024071e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.464515e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.278342e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.800030e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.046294e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.076162e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -3.968677e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.911679e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -8.619185e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, 5.125362e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -3.984370e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 40) +*************************************************************************/ +static double wsr_w40(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -4.904809e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.248327e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.136698e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.170982e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.824427e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -3.888648e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.344929e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, 2.790407e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.619858e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, 3.359121e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.883026e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 60) +*************************************************************************/ +static double wsr_w60(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -4.809656e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.077191e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.029402e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -7.507931e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, -6.506226e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.391278e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.263635e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, 2.302271e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.384348e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, 1.865587e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.622355e-04, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 120) +*************************************************************************/ +static double wsr_w120(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -4.729426e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.934426e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -9.433231e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.492504e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, 1.673948e-05, &tj, &tj1, &result, _state); + wsr_wcheb(x, -6.077014e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -7.215768e-05, &tj, &tj1, &result, _state); + wsr_wcheb(x, 9.086734e-05, &tj, &tj1, &result, _state); + wsr_wcheb(x, -8.447980e-05, &tj, &tj1, &result, _state); + wsr_wcheb(x, 6.705028e-05, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.828507e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S, 200) +*************************************************************************/ +static double wsr_w200(double s, ae_state *_state) +{ + double x; + double tj; + double tj1; + double result; + + + result = 0; + x = ae_minreal(2*(s-0.000000e+00)/4.000000e+00-1, 1.0, _state); + tj = 1; + tj1 = x; + wsr_wcheb(x, -4.700240e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.883080e+00, &tj, &tj1, &result, _state); + wsr_wcheb(x, -9.132168e-01, &tj, &tj1, &result, _state); + wsr_wcheb(x, -3.512684e-02, &tj, &tj1, &result, _state); + wsr_wcheb(x, 1.726342e-03, &tj, &tj1, &result, _state); + wsr_wcheb(x, -5.189796e-04, &tj, &tj1, &result, _state); + wsr_wcheb(x, -1.628659e-06, &tj, &tj1, &result, _state); + wsr_wcheb(x, 4.261786e-05, &tj, &tj1, &result, _state); + wsr_wcheb(x, -4.002498e-05, &tj, &tj1, &result, _state); + wsr_wcheb(x, 3.146287e-05, &tj, &tj1, &result, _state); + wsr_wcheb(x, -2.727576e-05, &tj, &tj1, &result, _state); + return result; +} + + +/************************************************************************* +Tail(S,N), S>=0 +*************************************************************************/ +static double wsr_wsigma(double s, ae_int_t n, ae_state *_state) +{ + double f0; + double f1; + double f2; + double f3; + double f4; + double x0; + double x1; + double x2; + double x3; + double x4; + double x; + double result; + + + result = 0; + if( n==5 ) + { + result = wsr_w5(s, _state); + } + if( n==6 ) + { + result = wsr_w6(s, _state); + } + if( n==7 ) + { + result = wsr_w7(s, _state); + } + if( n==8 ) + { + result = wsr_w8(s, _state); + } + if( n==9 ) + { + result = wsr_w9(s, _state); + } + if( n==10 ) + { + result = wsr_w10(s, _state); + } + if( n==11 ) + { + result = wsr_w11(s, _state); + } + if( n==12 ) + { + result = wsr_w12(s, _state); + } + if( n==13 ) + { + result = wsr_w13(s, _state); + } + if( n==14 ) + { + result = wsr_w14(s, _state); + } + if( n==15 ) + { + result = wsr_w15(s, _state); + } + if( n==16 ) + { + result = wsr_w16(s, _state); + } + if( n==17 ) + { + result = wsr_w17(s, _state); + } + if( n==18 ) + { + result = wsr_w18(s, _state); + } + if( n==19 ) + { + result = wsr_w19(s, _state); + } + if( n==20 ) + { + result = wsr_w20(s, _state); + } + if( n==21 ) + { + result = wsr_w21(s, _state); + } + if( n==22 ) + { + result = wsr_w22(s, _state); + } + if( n==23 ) + { + result = wsr_w23(s, _state); + } + if( n==24 ) + { + result = wsr_w24(s, _state); + } + if( n==25 ) + { + result = wsr_w25(s, _state); + } + if( n==26 ) + { + result = wsr_w26(s, _state); + } + if( n==27 ) + { + result = wsr_w27(s, _state); + } + if( n==28 ) + { + result = wsr_w28(s, _state); + } + if( n==29 ) + { + result = wsr_w29(s, _state); + } + if( n==30 ) + { + result = wsr_w30(s, _state); + } + if( n>30 ) + { + x = 1.0/n; + x0 = 1.0/30; + f0 = wsr_w30(s, _state); + x1 = 1.0/40; + f1 = wsr_w40(s, _state); + x2 = 1.0/60; + f2 = wsr_w60(s, _state); + x3 = 1.0/120; + f3 = wsr_w120(s, _state); + x4 = 1.0/200; + f4 = wsr_w200(s, _state); + f1 = ((x-x0)*f1-(x-x1)*f0)/(x1-x0); + f2 = ((x-x0)*f2-(x-x2)*f0)/(x2-x0); + f3 = ((x-x0)*f3-(x-x3)*f0)/(x3-x0); + f4 = ((x-x0)*f4-(x-x4)*f0)/(x4-x0); + f2 = ((x-x1)*f2-(x-x2)*f1)/(x2-x1); + f3 = ((x-x1)*f3-(x-x3)*f1)/(x3-x1); + f4 = ((x-x1)*f4-(x-x4)*f1)/(x4-x1); + f3 = ((x-x2)*f3-(x-x3)*f2)/(x3-x2); + f4 = ((x-x2)*f4-(x-x4)*f2)/(x4-x2); + f4 = ((x-x3)*f4-(x-x4)*f3)/(x4-x3); + result = f4; + } + return result; +} + + + +} + diff --git a/psdlag/src/statistics.h b/psdlag/src/statistics.h new file mode 100644 index 0000000..d324946 --- /dev/null +++ b/psdlag/src/statistics.h @@ -0,0 +1,1305 @@ +/************************************************************************* +Copyright (c) Sergey Bochkanov (ALGLIB project). + +>>> SOURCE LICENSE >>> +This program 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. + +A copy of the GNU General Public License is available at +http://www.fsf.org/licensing/licenses +>>> END OF LICENSE >>> +*************************************************************************/ +#ifndef _statistics_pkg_h +#define _statistics_pkg_h +#include "ap.h" +#include "alglibinternal.h" +#include "linalg.h" +#include "specialfunctions.h" + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (DATATYPES) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +/************************************************************************* +Calculation of the distribution moments: mean, variance, skewness, kurtosis. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +OUTPUT PARAMETERS + Mean - mean. + Variance- variance. + Skewness- skewness (if variance<>0; zero otherwise). + Kurtosis- kurtosis (if variance<>0; zero otherwise). + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void samplemoments(const real_1d_array &x, const ae_int_t n, double &mean, double &variance, double &skewness, double &kurtosis); +void samplemoments(const real_1d_array &x, double &mean, double &variance, double &skewness, double &kurtosis); + + +/************************************************************************* +Calculation of the mean. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Mean' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplemean(const real_1d_array &x, const ae_int_t n); +double samplemean(const real_1d_array &x); + + +/************************************************************************* +Calculation of the variance. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Variance' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplevariance(const real_1d_array &x, const ae_int_t n); +double samplevariance(const real_1d_array &x); + + +/************************************************************************* +Calculation of the skewness. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Skewness' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double sampleskewness(const real_1d_array &x, const ae_int_t n); +double sampleskewness(const real_1d_array &x); + + +/************************************************************************* +Calculation of the kurtosis. + +INPUT PARAMETERS: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +NOTE: + +This function return result which calculated by 'SampleMoments' function +and stored at 'Kurtosis' variable. + + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +double samplekurtosis(const real_1d_array &x, const ae_int_t n); +double samplekurtosis(const real_1d_array &x); + + +/************************************************************************* +ADev + +Input parameters: + X - sample + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +Output parameters: + ADev- ADev + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void sampleadev(const real_1d_array &x, const ae_int_t n, double &adev); +void sampleadev(const real_1d_array &x, double &adev); + + +/************************************************************************* +Median calculation. + +Input parameters: + X - sample (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + +Output parameters: + Median + + -- ALGLIB -- + Copyright 06.09.2006 by Bochkanov Sergey +*************************************************************************/ +void samplemedian(const real_1d_array &x, const ae_int_t n, double &median); +void samplemedian(const real_1d_array &x, double &median); + + +/************************************************************************* +Percentile calculation. + +Input parameters: + X - sample (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only leading N elements of X are processed + * if not given, automatically determined from size of X + P - percentile (0<=P<=1) + +Output parameters: + V - percentile + + -- ALGLIB -- + Copyright 01.03.2008 by Bochkanov Sergey +*************************************************************************/ +void samplepercentile(const real_1d_array &x, const ae_int_t n, const double p, double &v); +void samplepercentile(const real_1d_array &x, const double p, double &v); + + +/************************************************************************* +2-sample covariance + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + covariance (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +double cov2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); +double cov2(const real_1d_array &x, const real_1d_array &y); + + +/************************************************************************* +Pearson product-moment correlation coefficient + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + Pearson product-moment correlation coefficient + (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +double pearsoncorr2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); +double pearsoncorr2(const real_1d_array &x, const real_1d_array &y); + + +/************************************************************************* +Spearman's rank correlation coefficient + +Input parameters: + X - sample 1 (array indexes: [0..N-1]) + Y - sample 2 (array indexes: [0..N-1]) + N - N>=0, sample size: + * if given, only N leading elements of X/Y are processed + * if not given, automatically determined from input sizes + +Result: + Spearman's rank correlation coefficient + (zero for N=0 or N=1) + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double spearmancorr2(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); +double spearmancorr2(const real_1d_array &x, const real_1d_array &y); + + +/************************************************************************* +Covariance matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with covariance matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], covariance matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void covm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); +void smp_covm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); +void covm(const real_2d_array &x, real_2d_array &c); +void smp_covm(const real_2d_array &x, real_2d_array &c); + + +/************************************************************************* +Pearson product-moment correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); +void smp_pearsoncorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); +void pearsoncorrm(const real_2d_array &x, real_2d_array &c); +void smp_pearsoncorrm(const real_2d_array &x, real_2d_array &c); + + +/************************************************************************* +Spearman's rank correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X are used + * if not given, automatically determined from input size + M - M>0, number of variables: + * if given, only leading M columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M,M], correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spearmancorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); +void smp_spearmancorrm(const real_2d_array &x, const ae_int_t n, const ae_int_t m, real_2d_array &c); +void spearmancorrm(const real_2d_array &x, real_2d_array &c); +void smp_spearmancorrm(const real_2d_array &x, real_2d_array &c); + + +/************************************************************************* +Cross-covariance matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with covariance matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-covariance matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void covm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); +void smp_covm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); +void covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); +void smp_covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); + + +/************************************************************************* +Pearson product-moment cross-correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); +void smp_pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); +void pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); +void smp_pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); + + +/************************************************************************* +Spearman's rank cross-correlation matrix + +SMP EDITION OF ALGLIB: + + ! This function can utilize multicore capabilities of your system. In + ! order to do this you have to call version with "smp_" prefix, which + ! indicates that multicore code will be used. + ! + ! This note is given for users of SMP edition; if you use GPL edition, + ! or commercial edition of ALGLIB without SMP support, you still will + ! be able to call smp-version of this function, but all computations + ! will be done serially. + ! + ! We recommend you to carefully read ALGLIB Reference Manual, section + ! called 'SMP support', before using parallel version of this function. + ! + ! You should remember that starting/stopping worker thread always have + ! non-zero cost. Although multicore version is pretty efficient on + ! large problems, we do not recommend you to use it on small problems - + ! with correlation matrices smaller than 128*128. + +INPUT PARAMETERS: + X - array[N,M1], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + Y - array[N,M2], sample matrix: + * J-th column corresponds to J-th variable + * I-th row corresponds to I-th observation + N - N>=0, number of observations: + * if given, only leading N rows of X/Y are used + * if not given, automatically determined from input sizes + M1 - M1>0, number of variables in X: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + M2 - M2>0, number of variables in Y: + * if given, only leading M1 columns of X are used + * if not given, automatically determined from input size + +OUTPUT PARAMETERS: + C - array[M1,M2], cross-correlation matrix (zero if N=0 or N=1) + + -- ALGLIB -- + Copyright 28.10.2010 by Bochkanov Sergey +*************************************************************************/ +void spearmancorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); +void smp_spearmancorrm2(const real_2d_array &x, const real_2d_array &y, const ae_int_t n, const ae_int_t m1, const ae_int_t m2, real_2d_array &c); +void spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); +void smp_spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); + + +/************************************************************************* + +*************************************************************************/ +void rankdata(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures); +void smp_rankdata(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures); +void rankdata(real_2d_array &xy); +void smp_rankdata(real_2d_array &xy); + + +/************************************************************************* + +*************************************************************************/ +void rankdatacentered(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures); +void smp_rankdatacentered(const real_2d_array &xy, const ae_int_t npoints, const ae_int_t nfeatures); +void rankdatacentered(real_2d_array &xy); +void smp_rankdatacentered(real_2d_array &xy); + + +/************************************************************************* +Obsolete function, we recommend to use PearsonCorr2(). + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double pearsoncorrelation(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); + + +/************************************************************************* +Obsolete function, we recommend to use SpearmanCorr2(). + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double spearmanrankcorrelation(const real_1d_array &x, const real_1d_array &y, const ae_int_t n); + +/************************************************************************* +Pearson's correlation coefficient significance test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions having zero correlation or whether their +correlation is non-zero. + +The following tests are performed: + * two-tailed test (null hypothesis - X and Y have zero correlation) + * left-tailed test (null hypothesis - the correlation coefficient is + greater than or equal to 0) + * right-tailed test (null hypothesis - the correlation coefficient is + less than or equal to 0). + +Requirements: + * the number of elements in each sample is not less than 5 + * normality of distributions of X and Y. + +Input parameters: + R - Pearson's correlation coefficient for X and Y + N - number of elements in samples, N>=5. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void pearsoncorrelationsignificance(const double r, const ae_int_t n, double &bothtails, double &lefttail, double &righttail); + + +/************************************************************************* +Spearman's rank correlation coefficient significance test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions having zero correlation or whether their +correlation is non-zero. + +The following tests are performed: + * two-tailed test (null hypothesis - X and Y have zero correlation) + * left-tailed test (null hypothesis - the correlation coefficient is + greater than or equal to 0) + * right-tailed test (null hypothesis - the correlation coefficient is + less than or equal to 0). + +Requirements: + * the number of elements in each sample is not less than 5. + +The test is non-parametric and doesn't require distributions X and Y to be +normal. + +Input parameters: + R - Spearman's rank correlation coefficient for X and Y + N - number of elements in samples, N>=5. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void spearmanrankcorrelationsignificance(const double r, const ae_int_t n, double &bothtails, double &lefttail, double &righttail); + +/************************************************************************* +Jarque-Bera test + +This test checks hypotheses about the fact that a given sample X is a +sample of normal random variable. + +Requirements: + * the number of elements in the sample is not less than 5. + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. N>=5 + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +Accuracy of the approximation used (5<=N<=1951): + +p-value relative error (5<=N<=1951) +[1, 0.1] < 1% +[0.1, 0.01] < 2% +[0.01, 0.001] < 6% +[0.001, 0] wasn't measured + +For N>1951 accuracy wasn't measured but it shouldn't be sharply different +from table values. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void jarqueberatest(const real_1d_array &x, const ae_int_t n, double &p); + +/************************************************************************* +Mann-Whitney U-test + +This test checks hypotheses about whether X and Y are samples of two +continuous distributions of the same shape and same median or whether +their medians are different. + +The following tests are performed: + * two-tailed test (null hypothesis - the medians are equal) + * left-tailed test (null hypothesis - the median of the first sample + is greater than or equal to the median of the second sample) + * right-tailed test (null hypothesis - the median of the first sample + is less than or equal to the median of the second sample). + +Requirements: + * the samples are independent + * X and Y are continuous distributions (or discrete distributions well- + approximating continuous distributions) + * distributions of X and Y have the same shape. The only possible + difference is their position (i.e. the value of the median) + * the number of elements in each sample is not less than 5 + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + +The test is non-parametric and doesn't require distributions to be normal. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. N>=5 + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of the sample. M>=5 + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +To calculate p-values, special approximation is used. This method lets us +calculate p-values with satisfactory accuracy in interval [0.0001, 1]. +There is no approximation outside the [0.0001, 1] interval. Therefore, if +the significance level outlies this interval, the test returns 0.0001. + +Relative precision of approximation of p-value: + +N M Max.err. Rms.err. +5..10 N..10 1.4e-02 6.0e-04 +5..10 N..100 2.2e-02 5.3e-06 +10..15 N..15 1.0e-02 3.2e-04 +10..15 N..100 1.0e-02 2.2e-05 +15..100 N..100 6.1e-03 2.7e-06 + +For N,M>100 accuracy checks weren't put into practice, but taking into +account characteristics of asymptotic approximation used, precision should +not be sharply different from the values for interval [5, 100]. + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +void mannwhitneyutest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail); + +/************************************************************************* +Sign test + +This test checks three hypotheses about the median of the given sample. +The following tests are performed: + * two-tailed test (null hypothesis - the median is equal to the given + value) + * left-tailed test (null hypothesis - the median is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the median is less than or + equal to the given value) + +Requirements: + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + +The test is non-parametric and doesn't require distribution X to be normal + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. + Median - assumed median value. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +While calculating p-values high-precision binomial distribution +approximation is used, so significance levels have about 15 exact digits. + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void onesamplesigntest(const real_1d_array &x, const ae_int_t n, const double median, double &bothtails, double &lefttail, double &righttail); + +/************************************************************************* +One-sample t-test + +This test checks three hypotheses about the mean of the given sample. The +following tests are performed: + * two-tailed test (null hypothesis - the mean is equal to the given + value) + * left-tailed test (null hypothesis - the mean is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the mean is less than or equal + to the given value). + +The test is based on the assumption that a given sample has a normal +distribution and an unknown dispersion. If the distribution sharply +differs from normal, the test will work incorrectly. + +INPUT PARAMETERS: + X - sample. Array whose index goes from 0 to N-1. + N - size of sample, N>=0 + Mean - assumed value of the mean. + +OUTPUT PARAMETERS: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0, all p-values are set to 1.0 + * when variance of X[] is exactly zero, p-values are set + to 1.0 or 0.0, depending on difference between sample mean and + value of mean being tested. + + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void studentttest1(const real_1d_array &x, const ae_int_t n, const double mean, double &bothtails, double &lefttail, double &righttail); + + +/************************************************************************* +Two-sample pooled test + +This test checks three hypotheses about the mean of the given samples. The +following tests are performed: + * two-tailed test (null hypothesis - the means are equal) + * left-tailed test (null hypothesis - the mean of the first sample is + greater than or equal to the mean of the second sample) + * right-tailed test (null hypothesis - the mean of the first sample is + less than or equal to the mean of the second sample). + +Test is based on the following assumptions: + * given samples have normal distributions + * dispersions are equal + * samples are independent. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of sample. + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of sample. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0 or M=0, all p-values are set to 1.0 + * when both samples has exactly zero variance, p-values are set + to 1.0 or 0.0, depending on difference between means. + + -- ALGLIB -- + Copyright 18.09.2006 by Bochkanov Sergey +*************************************************************************/ +void studentttest2(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail); + + +/************************************************************************* +Two-sample unpooled test + +This test checks three hypotheses about the mean of the given samples. The +following tests are performed: + * two-tailed test (null hypothesis - the means are equal) + * left-tailed test (null hypothesis - the mean of the first sample is + greater than or equal to the mean of the second sample) + * right-tailed test (null hypothesis - the mean of the first sample is + less than or equal to the mean of the second sample). + +Test is based on the following assumptions: + * given samples have normal distributions + * samples are independent. +Equality of variances is NOT required. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. + Y - sample 2. Array whose index goes from 0 to M-1. + M - size of the sample. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +NOTE: this function correctly handles degenerate cases: + * when N=0 or M=0, all p-values are set to 1.0 + * when both samples has zero variance, p-values are set + to 1.0 or 0.0, depending on difference between means. + * when only one sample has zero variance, test reduces to 1-sample + version. + + -- ALGLIB -- + Copyright 18.09.2006 by Bochkanov Sergey +*************************************************************************/ +void unequalvariancettest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail); + +/************************************************************************* +Two-sample F-test + +This test checks three hypotheses about dispersions of the given samples. +The following tests are performed: + * two-tailed test (null hypothesis - the dispersions are equal) + * left-tailed test (null hypothesis - the dispersion of the first + sample is greater than or equal to the dispersion of the second + sample). + * right-tailed test (null hypothesis - the dispersion of the first + sample is less than or equal to the dispersion of the second sample) + +The test is based on the following assumptions: + * the given samples have normal distributions + * the samples are independent. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - sample size. + Y - sample 2. Array whose index goes from 0 to M-1. + M - sample size. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 19.09.2006 by Bochkanov Sergey +*************************************************************************/ +void ftest(const real_1d_array &x, const ae_int_t n, const real_1d_array &y, const ae_int_t m, double &bothtails, double &lefttail, double &righttail); + + +/************************************************************************* +One-sample chi-square test + +This test checks three hypotheses about the dispersion of the given sample +The following tests are performed: + * two-tailed test (null hypothesis - the dispersion equals the given + number) + * left-tailed test (null hypothesis - the dispersion is greater than + or equal to the given number) + * right-tailed test (null hypothesis - dispersion is less than or + equal to the given number). + +Test is based on the following assumptions: + * the given sample has a normal distribution. + +Input parameters: + X - sample 1. Array whose index goes from 0 to N-1. + N - size of the sample. + Variance - dispersion value to compare with. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + + -- ALGLIB -- + Copyright 19.09.2006 by Bochkanov Sergey +*************************************************************************/ +void onesamplevariancetest(const real_1d_array &x, const ae_int_t n, const double variance, double &bothtails, double &lefttail, double &righttail); + +/************************************************************************* +Wilcoxon signed-rank test + +This test checks three hypotheses about the median of the given sample. +The following tests are performed: + * two-tailed test (null hypothesis - the median is equal to the given + value) + * left-tailed test (null hypothesis - the median is greater than or + equal to the given value) + * right-tailed test (null hypothesis - the median is less than or + equal to the given value) + +Requirements: + * the scale of measurement should be ordinal, interval or ratio (i.e. + the test could not be applied to nominal variables). + * the distribution should be continuous and symmetric relative to its + median. + * number of distinct values in the X array should be greater than 4 + +The test is non-parametric and doesn't require distribution X to be normal + +Input parameters: + X - sample. Array whose index goes from 0 to N-1. + N - size of the sample. + Median - assumed median value. + +Output parameters: + BothTails - p-value for two-tailed test. + If BothTails is less than the given significance level + the null hypothesis is rejected. + LeftTail - p-value for left-tailed test. + If LeftTail is less than the given significance level, + the null hypothesis is rejected. + RightTail - p-value for right-tailed test. + If RightTail is less than the given significance level + the null hypothesis is rejected. + +To calculate p-values, special approximation is used. This method lets us +calculate p-values with two decimal places in interval [0.0001, 1]. + +"Two decimal places" does not sound very impressive, but in practice the +relative error of less than 1% is enough to make a decision. + +There is no approximation outside the [0.0001, 1] interval. Therefore, if +the significance level outlies this interval, the test returns 0.0001. + + -- ALGLIB -- + Copyright 08.09.2006 by Bochkanov Sergey +*************************************************************************/ +void wilcoxonsignedranktest(const real_1d_array &x, const ae_int_t n, const double e, double &bothtails, double &lefttail, double &righttail); +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +void samplemoments(/* Real */ ae_vector* x, + ae_int_t n, + double* mean, + double* variance, + double* skewness, + double* kurtosis, + ae_state *_state); +double samplemean(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +double samplevariance(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +double sampleskewness(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +double samplekurtosis(/* Real */ ae_vector* x, + ae_int_t n, + ae_state *_state); +void sampleadev(/* Real */ ae_vector* x, + ae_int_t n, + double* adev, + ae_state *_state); +void samplemedian(/* Real */ ae_vector* x, + ae_int_t n, + double* median, + ae_state *_state); +void samplepercentile(/* Real */ ae_vector* x, + ae_int_t n, + double p, + double* v, + ae_state *_state); +double cov2(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state); +double pearsoncorr2(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state); +double spearmancorr2(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state); +void covm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, + ae_state *_state); +void _pexec_covm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, ae_state *_state); +void pearsoncorrm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, + ae_state *_state); +void _pexec_pearsoncorrm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, ae_state *_state); +void spearmancorrm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, + ae_state *_state); +void _pexec_spearmancorrm(/* Real */ ae_matrix* x, + ae_int_t n, + ae_int_t m, + /* Real */ ae_matrix* c, ae_state *_state); +void covm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, + ae_state *_state); +void _pexec_covm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, ae_state *_state); +void pearsoncorrm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, + ae_state *_state); +void _pexec_pearsoncorrm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, ae_state *_state); +void spearmancorrm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, + ae_state *_state); +void _pexec_spearmancorrm2(/* Real */ ae_matrix* x, + /* Real */ ae_matrix* y, + ae_int_t n, + ae_int_t m1, + ae_int_t m2, + /* Real */ ae_matrix* c, ae_state *_state); +void rankdata(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_state *_state); +void _pexec_rankdata(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, ae_state *_state); +void rankdatacentered(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, + ae_state *_state); +void _pexec_rankdatacentered(/* Real */ ae_matrix* xy, + ae_int_t npoints, + ae_int_t nfeatures, ae_state *_state); +double pearsoncorrelation(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state); +double spearmanrankcorrelation(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state); +void pearsoncorrelationsignificance(double r, + ae_int_t n, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void spearmanrankcorrelationsignificance(double r, + ae_int_t n, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void jarqueberatest(/* Real */ ae_vector* x, + ae_int_t n, + double* p, + ae_state *_state); +void mannwhitneyutest(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void onesamplesigntest(/* Real */ ae_vector* x, + ae_int_t n, + double median, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void studentttest1(/* Real */ ae_vector* x, + ae_int_t n, + double mean, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void studentttest2(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void unequalvariancettest(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void ftest(/* Real */ ae_vector* x, + ae_int_t n, + /* Real */ ae_vector* y, + ae_int_t m, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void onesamplevariancetest(/* Real */ ae_vector* x, + ae_int_t n, + double variance, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); +void wilcoxonsignedranktest(/* Real */ ae_vector* x, + ae_int_t n, + double e, + double* bothtails, + double* lefttail, + double* righttail, + ae_state *_state); + +} +#endif + diff --git a/psdlag/src/stdafx.h b/psdlag/src/stdafx.h new file mode 100644 index 0000000..99a8091 --- /dev/null +++ b/psdlag/src/stdafx.h @@ -0,0 +1,2 @@ + +