diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 0000000..a087f07 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,135 @@ +# MIA - Mass Isotopolome Analyzer +# Copyright (C) 2012-15 Daniel Weindl +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as +# published by the Free Software Foundation, either version 3 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 Affero General Public License for more details. +# +# You should have received a copy of the GNU Affero General Public License +# along with this program. If not, see . + +project(mia) + +cmake_minimum_required(VERSION 2.8) + +MESSAGE( STATUS "CMAKE_SYSTEM: " ${CMAKE_SYSTEM} ) +MESSAGE( STATUS "CMAKE_SYSTEM_NAME: " ${CMAKE_SYSTEM_NAME} ) +MESSAGE( STATUS "CMAKE_SYSTEM_VERSION: " ${CMAKE_SYSTEM_VERSION} ) +MESSAGE( STATUS "CMAKE_SYSTEM_PROCESSOR: " ${CMAKE_SYSTEM_PROCESSOR} ) + +set(CMAKE_CXX_STANDARD 11) +set(CMAKE_CXX_FLAGS "-s -O3") # -O3 +set(CMAKE_MODULE_PATH "${CMAKE_SOURCE_DIR}/cmake_modules/") +set(CMAKE_AUTOMOC TRUE) + +if(CMAKE_SYSTEM_NAME STREQUAL "Windows") + if(POLICY CMP0020) + cmake_policy(SET CMP0020 NEW) + endif() +endif() + +option(STATIC_LINKING "Link statically?" ON) +if(STATIC_LINKING) + set(CMAKE_FIND_LIBRARY_SUFFIXES ".a") + set(Boost_USE_STATIC_LIBS ON) +endif() + +if(CMAKE_BUILD_TYPE STREQUAL "Debug") + add_definitions(-DMIA_DEBUG_LEVEL=1) +endif() + +option(MIA_WITH_METABOBASE "Use METABOBASE interface?" OFF) +if(MIA_WITH_METABOBASE) + add_definitions(-DMIA_WITH_METABOBASE) # METABOBASE extension + set(METABOBASE_LIBRARY "$ENV{HOME}/src/mddb/build/src/libMDDB.a") + set(METABOBASE_INCLUDE_DIR "$ENV{HOME}/src/mddb/src/") + find_package(PQ REQUIRED) + include_directories(${METABOBASE_INCLUDE_DIR}) +endif() + +option(MIA_WITH_NETCDF_IMPORT "Add netCDF import?" ON) +if(MIA_WITH_NETCDF_IMPORT) + add_definitions(-DMIA_WITH_NETCDF_IMPORT) + find_package(NetCDF REQUIRED) +endif() + +# Set version +set(VERSION_MAJOR "1") +set(VERSION_MINOR "0") +set(VERSION_PATCH "0") +exec_program("bpp.sh" OUTPUT_VARIABLE CMAKE_TWEAK_VERSION) +exec_program("date +%Y%m%d%H%M" OUTPUT_VARIABLE CMAKE_TWEAK_VERSION) +set(VERSION "${VERSION_MAJOR}.${VERSION_MINOR}.${VERSION_PATCH}.${CMAKE_TWEAK_VERSION}") +add_definitions(-DMIA_VERSION="${VERSION}") + +find_package(LabId REQUIRED) +find_package(GSL REQUIRED) +find_package(GCMS REQUIRED) +#find_package(GraphViz REQUIRED) +find_package(Boost COMPONENTS regex system filesystem REQUIRED) +find_package(ZLIB REQUIRED) + +include_directories( + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR} + ${POSTGRESQL_INCLUDE_DIR} + ${NetCDF_INCLUDE_DIR} + ${GCMS_INCLUDE_DIR} + ${GSL_INCLUDE_DIR} + ${LabId_INCLUDE_DIR} +) + +add_subdirectory(src) # Lib +add_subdirectory(gui) # GUI + +############################# +# BEGIN CPACK configuration # +############################# +set(CPACK_PACKAGE_VERSION_MAJOR ${VERSION_MAJOR}) +set(CPACK_PACKAGE_VERSION_MINOR ${VERSION_MINOR}) +set(CPACK_PACKAGE_VERSION_PATCH ${VERSION_PATCH}) +set(CPACK_PACKAGE_VERSION_PATCH ${VERSION_PATCH}) +set(CPACK_PACKAGE_VERSION "${VERSION_MAJOR}.${VERSION_MINOR}.${VERSION_PATCH}.${CMAKE_TWEAK_VERSION}") +set(CPACK_PACKAGE_CONTACT "Daniel WEINDL ") +set(CPACK_PACKAGE_NAME "mia") +set(CPACK_PACKAGE_FILE_NAME "${CPACK_PACKAGE_NAME}_${VERSION_MAJOR}.${VERSION_MINOR}.${VERSION_PATCH}-${CMAKE_TWEAK_VERSION}_${CPACK_DEBIAN_PACKAGE_ARCHITECTURE}") +set(CPACK_PACKAGE_EXECUTABLES "mia-gui" "MIA - Mass Isotopolome Analyzer") + +if(CMAKE_SYSTEM_NAME STREQUAL "Windows") + set(CPACK_GENERATOR "NSIS") + set(CPACK_NSIS_MUI_ICON "${CMAKE_SOURCE_DIR}/gui/icons/programmIcon16x16.ico") + set(CPACK_NSIS_MUI_UNIICON ${CPACK_NSIS_MUI_ICON}) + set(CPACK_NSIS_HELP_LINK "http://massisotopolomeanalyzer.lu/") + set(CPACK_NSIS_URL_INFO_ABOUT "http://massisotopolomeanalyzer.lu/") + set(CPACK_NSIS_CONTACT "daniel.weindl@uni.lu") + set(CPACK_NSIS_CREATE_ICONS "CreateShortCut '\$SMPROGRAMS\\\\$STARTMENU_FOLDER\\\\MIA.lnk' '\$INSTDIR\\\\bin\\\\mia-gui.exe'") + set(CPACK_NSIS_MUI_FINISHPAGE_RUN "mia-gui.exe") + install(FILES "${CMAKE_SOURCE_DIR}/doc/${CPACK_PACKAGE_NAME}-doc.pdf" DESTINATION "doc\\\\") + install(FILES "${CMAKE_SOURCE_DIR}/win32/msvcr100.dll" DESTINATION "bin\\\\") +else() + set(CPACK_GENERATOR "DEB") # ;TGZ + exec_program("dpkg --print-architecture" OUTPUT_VARIABLE CPACK_DEBIAN_PACKAGE_ARCHITECTURE) + set(CPACK_DEBIAN_PACKAGE_DEPENDS "libc6,libpq5,libgsl0ldbl,libx11-xcb1,libxkbcommon-x11-0,libjpeg8,libpng12-0") # objdump -p gui/mia-gui | grep NEEDED + set(CPACK_DEBIAN_PACKAGE_SECTION "Science") + set(CPACK_PACKAGE_DESCRIPTION_SUMMARY "Mass Isotopolome Analyzer + Non-targeted stable isotope labeling analysis tool") + set(CPACK_DEBIAN_PACKAGE_SUGGESTS "metabolitedetector") + install(FILES "${CMAKE_SOURCE_DIR}/doc/${CPACK_PACKAGE_NAME}-doc.pdf" DESTINATION "share/doc/${CPACK_PACKAGE_NAME}") + install(FILES "${CMAKE_SOURCE_DIR}/${CPACK_PACKAGE_NAME}.xpm" DESTINATION "share/pixmaps") + install(FILES "${CMAKE_SOURCE_DIR}/deb/${CPACK_PACKAGE_NAME}.desktop" DESTINATION "share/applications") + install(FILES "${CMAKE_SOURCE_DIR}/deb/copyright" DESTINATION "share/doc/${CPACK_PACKAGE_NAME}") + exec_program("cd ${CMAKE_SOURCE_DIR}/deb; gzip -k9f mia-gui.1; gzip -k9f changelog;") + install(FILES "${CMAKE_SOURCE_DIR}/deb/mia-gui.1.gz" DESTINATION "share/man/man1/") + install(FILES "${CMAKE_SOURCE_DIR}/deb/libstdc++.so.6" DESTINATION "share/${CPACK_PACKAGE_NAME}") + install(FILES "${CMAKE_SOURCE_DIR}/deb/changelog.gz" DESTINATION "share/doc/${CPACK_PACKAGE_NAME}") +endif() +include(CPack) +########################### +# END CPACK configuration # +########################### diff --git a/alg/alglibinternal.cpp b/alg/alglibinternal.cpp new file mode 100755 index 0000000..ae6b851 --- /dev/null +++ b/alg/alglibinternal.cpp @@ -0,0 +1,11972 @@ +/************************************************************************* +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 double apserv_inttoreal(ae_int_t a, ae_state *_state); + + +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 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_int_t ftbase_ftbaseplanentrysize = 8; +static ae_int_t ftbase_ftbasecffttask = 0; +static ae_int_t ftbase_ftbaserfhttask = 1; +static ae_int_t ftbase_ftbaserffttask = 2; +static ae_int_t ftbase_fftcooleytukeyplan = 0; +static ae_int_t ftbase_fftbluesteinplan = 1; +static ae_int_t ftbase_fftcodeletplan = 2; +static ae_int_t ftbase_fhtcooleytukeyplan = 3; +static ae_int_t ftbase_fhtcodeletplan = 4; +static ae_int_t ftbase_fftrealcooleytukeyplan = 5; +static ae_int_t ftbase_fftemptyplan = 6; +static ae_int_t ftbase_fhtn2plan = 999; +static ae_int_t ftbase_ftbaseupdatetw = 4; +static ae_int_t ftbase_ftbasecodeletrecommended = 5; +static double ftbase_ftbaseinefficiencyfactor = 1.3; +static ae_int_t ftbase_ftbasemaxsmoothfactor = 5; +static void ftbase_ftbasegenerateplanrec(ae_int_t n, + ae_int_t tasktype, + ftplan* plan, + ae_int_t* plansize, + ae_int_t* precomputedsize, + ae_int_t* planarraysize, + ae_int_t* tmpmemsize, + ae_int_t* stackmemsize, + ae_int_t stackptr, + ae_state *_state); +static void ftbase_ftbaseprecomputeplanrec(ftplan* plan, + ae_int_t entryoffset, + ae_int_t stackptr, + 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_internalreallintranspose(/* 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); +static void ftbase_fftarrayresize(/* Integer */ ae_vector* a, + ae_int_t* asize, + ae_int_t newasize, + ae_state *_state); +static void ftbase_reffht(/* Real */ ae_vector* a, + ae_int_t n, + ae_int_t offs, + ae_state *_state); + + + + + + + + + +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 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); +} + + +/************************************************************************* +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; +} + + +/************************************************************************* +'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; +} + + +/************************************************************************* +The function convert integer value to real value. + + -- ALGLIB -- + Copyright 17.09.2012 by Bochkanov Sergey +*************************************************************************/ +static double apserv_inttoreal(ae_int_t a, ae_state *_state) +{ + double result; + + + result = a; + return result; +} + + +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); +} + + + + +/************************************************************************* +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 +*************************************************************************/ +void rankx(/* Real */ ae_vector* x, + ae_int_t n, + apbuffers* buf, + ae_state *_state) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t t; + double tmp; + ae_int_t tmpi; + + + + /* + * Prepare + */ + if( n<1 ) + { + return; + } + if( n==1 ) + { + x->ptr.p_double[0] = 1; + 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; + } + + /* + * sort {R, C} + */ + if( n!=1 ) + { + i = 2; + do + { + t = i; + while(t!=1) + { + k = t/2; + if( ae_fp_greater_eq(buf->ra1.ptr.p_double[k-1],buf->ra1.ptr.p_double[t-1]) ) + { + t = 1; + } + else + { + tmp = buf->ra1.ptr.p_double[k-1]; + buf->ra1.ptr.p_double[k-1] = buf->ra1.ptr.p_double[t-1]; + buf->ra1.ptr.p_double[t-1] = tmp; + tmpi = buf->ia1.ptr.p_int[k-1]; + buf->ia1.ptr.p_int[k-1] = buf->ia1.ptr.p_int[t-1]; + buf->ia1.ptr.p_int[t-1] = tmpi; + t = k; + } + } + i = i+1; + } + while(i<=n); + i = n-1; + do + { + tmp = buf->ra1.ptr.p_double[i]; + buf->ra1.ptr.p_double[i] = buf->ra1.ptr.p_double[0]; + buf->ra1.ptr.p_double[0] = tmp; + tmpi = buf->ia1.ptr.p_int[i]; + buf->ia1.ptr.p_int[i] = buf->ia1.ptr.p_int[0]; + buf->ia1.ptr.p_int[0] = tmpi; + t = 1; + while(t!=0) + { + k = 2*t; + if( k>i ) + { + t = 0; + } + else + { + if( kra1.ptr.p_double[k],buf->ra1.ptr.p_double[k-1]) ) + { + k = k+1; + } + } + if( ae_fp_greater_eq(buf->ra1.ptr.p_double[t-1],buf->ra1.ptr.p_double[k-1]) ) + { + t = 0; + } + else + { + tmp = buf->ra1.ptr.p_double[k-1]; + buf->ra1.ptr.p_double[k-1] = buf->ra1.ptr.p_double[t-1]; + buf->ra1.ptr.p_double[t-1] = tmp; + tmpi = buf->ia1.ptr.p_int[k-1]; + buf->ia1.ptr.p_int[k-1] = buf->ia1.ptr.p_int[t-1]; + buf->ia1.ptr.p_int[t-1] = tmpi; + t = k; + } + } + } + i = i-1; + } + while(i>=1); + } + + /* + * 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] = 1+(double)(i+j-1)/(double)2; + } + i = j; + } + + /* + * back to x + */ + for(i=0; i<=n-1; i++) + { + x->ptr.p_double[buf->ia1.ptr.p_int[i]] = buf->ra1.ptr.p_double[i]; + } +} + + + + +/************************************************************************* +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 +} + + + + +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; + double a; + ae_int_t result; + + + result = i1; + a = ae_fabs(x->ptr.p_double[result], _state); + 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; + double a; + ae_int_t result; + + + result = i1; + a = ae_fabs(x->ptr.pp_double[result][j], _state); + 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; + double a; + ae_int_t result; + + + result = j1; + a = ae_fabs(x->ptr.pp_double[i][result], _state); + 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 ccols; + 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; + ccols = bcols; + + /* + * 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 ba2; + 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; + ba2 = i2; + 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; + ba2 = i2; + 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; + ba2 = 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); + + /* + * Add U*x to the result + */ + v = x->ptr.p_complex[i-i1+1]; + by1 = 1; + by2 = i-i1; + ba1 = i1; + ba2 = 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); + } + } + 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; + ae_int_t vm; + + + if( (ae_fp_eq(tau,0)||n1>n2)||m1>m2 ) + { + return; + } + + /* + * w := C' * v + */ + vm = m2-m1+1; + 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); + } +} + + + + +/************************************************************************* +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; + ae_int_t vm; + + + if( (ae_c_eq_d(tau,0)||n1>n2)||m1>m2 ) + { + return; + } + + /* + * w := C^T * conj(v) + */ + vm = m2-m1+1; + 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); +} + + +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 ovfl; + 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; + ovfl = 1/unfl; + 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)); + } + 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 ovfl; + 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(OVFL), overflow should not occur. + */ + unfl = ae_minrealnumber; + ovfl = 1/unfl; + 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; +} + + + + +/************************************************************************* +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); +} + + + + +/************************************************************************* +This subroutine generates FFT plan - a decomposition of a N-length FFT to +the more simpler operations. Plan consists of the root entry and the child +entries. + +Subroutine parameters: + N task size + +Output parameters: + Plan plan + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +void ftbasegeneratecomplexfftplan(ae_int_t n, + ftplan* plan, + ae_state *_state) +{ + ae_int_t planarraysize; + ae_int_t plansize; + ae_int_t precomputedsize; + ae_int_t tmpmemsize; + ae_int_t stackmemsize; + ae_int_t stackptr; + + _ftplan_clear(plan); + + planarraysize = 1; + plansize = 0; + precomputedsize = 0; + stackmemsize = 0; + stackptr = 0; + tmpmemsize = 2*n; + ae_vector_set_length(&plan->plan, planarraysize, _state); + ftbase_ftbasegenerateplanrec(n, ftbase_ftbasecffttask, plan, &plansize, &precomputedsize, &planarraysize, &tmpmemsize, &stackmemsize, stackptr, _state); + ae_assert(stackptr==0, "Internal error in FTBaseGenerateComplexFFTPlan: stack ptr!", _state); + ae_vector_set_length(&plan->stackbuf, ae_maxint(stackmemsize, 1, _state), _state); + ae_vector_set_length(&plan->tmpbuf, ae_maxint(tmpmemsize, 1, _state), _state); + ae_vector_set_length(&plan->precomputed, ae_maxint(precomputedsize, 1, _state), _state); + stackptr = 0; + ftbase_ftbaseprecomputeplanrec(plan, 0, stackptr, _state); + ae_assert(stackptr==0, "Internal error in FTBaseGenerateComplexFFTPlan: stack ptr!", _state); +} + + +/************************************************************************* +Generates real FFT plan +*************************************************************************/ +void ftbasegeneraterealfftplan(ae_int_t n, ftplan* plan, ae_state *_state) +{ + ae_int_t planarraysize; + ae_int_t plansize; + ae_int_t precomputedsize; + ae_int_t tmpmemsize; + ae_int_t stackmemsize; + ae_int_t stackptr; + + _ftplan_clear(plan); + + planarraysize = 1; + plansize = 0; + precomputedsize = 0; + stackmemsize = 0; + stackptr = 0; + tmpmemsize = 2*n; + ae_vector_set_length(&plan->plan, planarraysize, _state); + ftbase_ftbasegenerateplanrec(n, ftbase_ftbaserffttask, plan, &plansize, &precomputedsize, &planarraysize, &tmpmemsize, &stackmemsize, stackptr, _state); + ae_assert(stackptr==0, "Internal error in FTBaseGenerateRealFFTPlan: stack ptr!", _state); + ae_vector_set_length(&plan->stackbuf, ae_maxint(stackmemsize, 1, _state), _state); + ae_vector_set_length(&plan->tmpbuf, ae_maxint(tmpmemsize, 1, _state), _state); + ae_vector_set_length(&plan->precomputed, ae_maxint(precomputedsize, 1, _state), _state); + stackptr = 0; + ftbase_ftbaseprecomputeplanrec(plan, 0, stackptr, _state); + ae_assert(stackptr==0, "Internal error in FTBaseGenerateRealFFTPlan: stack ptr!", _state); +} + + +/************************************************************************* +Generates real FHT plan +*************************************************************************/ +void ftbasegeneraterealfhtplan(ae_int_t n, ftplan* plan, ae_state *_state) +{ + ae_int_t planarraysize; + ae_int_t plansize; + ae_int_t precomputedsize; + ae_int_t tmpmemsize; + ae_int_t stackmemsize; + ae_int_t stackptr; + + _ftplan_clear(plan); + + planarraysize = 1; + plansize = 0; + precomputedsize = 0; + stackmemsize = 0; + stackptr = 0; + tmpmemsize = n; + ae_vector_set_length(&plan->plan, planarraysize, _state); + ftbase_ftbasegenerateplanrec(n, ftbase_ftbaserfhttask, plan, &plansize, &precomputedsize, &planarraysize, &tmpmemsize, &stackmemsize, stackptr, _state); + ae_assert(stackptr==0, "Internal error in FTBaseGenerateRealFHTPlan: stack ptr!", _state); + ae_vector_set_length(&plan->stackbuf, ae_maxint(stackmemsize, 1, _state), _state); + ae_vector_set_length(&plan->tmpbuf, ae_maxint(tmpmemsize, 1, _state), _state); + ae_vector_set_length(&plan->precomputed, ae_maxint(precomputedsize, 1, _state), _state); + stackptr = 0; + ftbase_ftbaseprecomputeplanrec(plan, 0, stackptr, _state); + ae_assert(stackptr==0, "Internal error in FTBaseGenerateRealFHTPlan: stack ptr!", _state); +} + + +/************************************************************************* +This subroutine executes FFT/FHT plan. + +If Plan is a: +* complex FFT plan - sizeof(A)=2*N, + A contains interleaved real/imaginary values +* real FFT plan - sizeof(A)=2*N, + A contains real values interleaved with zeros +* real FHT plan - sizeof(A)=2*N, + A contains real values interleaved with zeros + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +void ftbaseexecuteplan(/* Real */ ae_vector* a, + ae_int_t aoffset, + ae_int_t n, + ftplan* plan, + ae_state *_state) +{ + ae_int_t stackptr; + + + stackptr = 0; + ftbaseexecuteplanrec(a, aoffset, plan, 0, stackptr, _state); +} + + +/************************************************************************* +Recurrent subroutine for the FTBaseExecutePlan + +Parameters: + A FFT'ed array + AOffset offset of the FFT'ed part (distance is measured in doubles) + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +void ftbaseexecuteplanrec(/* Real */ ae_vector* a, + ae_int_t aoffset, + ftplan* plan, + ae_int_t entryoffset, + ae_int_t stackptr, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t n1; + ae_int_t n2; + ae_int_t n; + ae_int_t m; + ae_int_t offs; + ae_int_t offs1; + ae_int_t offs2; + ae_int_t offsa; + ae_int_t offsb; + ae_int_t offsp; + double hk; + double hnk; + double x; + double y; + double bx; + double by; + ae_vector emptyarray; + double a0x; + double a0y; + double a1x; + double a1y; + double a2x; + double a2y; + double a3x; + double a3y; + 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; + ae_vector tmp; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&emptyarray, 0, DT_REAL, _state, ae_true); + ae_vector_init(&tmp, 0, DT_REAL, _state, ae_true); + + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftemptyplan ) + { + ae_frame_leave(_state); + return; + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftcooleytukeyplan ) + { + + /* + * Cooley-Tukey plan + * * transposition + * * row-wise FFT + * * twiddle factors: + * - TwBase is a basis twiddle factor for I=1, J=1 + * - TwRow is a twiddle factor for a second element in a row (J=1) + * - Tw is a twiddle factor for a current element + * * transposition again + * * row-wise FFT again + */ + n1 = plan->plan.ptr.p_int[entryoffset+1]; + n2 = plan->plan.ptr.p_int[entryoffset+2]; + ftbase_internalcomplexlintranspose(a, n1, n2, aoffset, &plan->tmpbuf, _state); + for(i=0; i<=n2-1; i++) + { + ftbaseexecuteplanrec(a, aoffset+i*n1*2, plan, plan->plan.ptr.p_int[entryoffset+5], stackptr, _state); + } + ftbase_ffttwcalc(a, aoffset, n1, n2, _state); + ftbase_internalcomplexlintranspose(a, n2, n1, aoffset, &plan->tmpbuf, _state); + for(i=0; i<=n1-1; i++) + { + ftbaseexecuteplanrec(a, aoffset+i*n2*2, plan, plan->plan.ptr.p_int[entryoffset+6], stackptr, _state); + } + ftbase_internalcomplexlintranspose(a, n1, n2, aoffset, &plan->tmpbuf, _state); + ae_frame_leave(_state); + return; + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftrealcooleytukeyplan ) + { + + /* + * Cooley-Tukey plan + * * transposition + * * row-wise FFT + * * twiddle factors: + * - TwBase is a basis twiddle factor for I=1, J=1 + * - TwRow is a twiddle factor for a second element in a row (J=1) + * - Tw is a twiddle factor for a current element + * * transposition again + * * row-wise FFT again + */ + n1 = plan->plan.ptr.p_int[entryoffset+1]; + n2 = plan->plan.ptr.p_int[entryoffset+2]; + ftbase_internalcomplexlintranspose(a, n2, n1, aoffset, &plan->tmpbuf, _state); + for(i=0; i<=n1/2-1; i++) + { + + /* + * pack two adjacent smaller real FFT's together, + * make one complex FFT, + * unpack result + */ + offs = aoffset+2*i*n2*2; + for(k=0; k<=n2-1; k++) + { + a->ptr.p_double[offs+2*k+1] = a->ptr.p_double[offs+2*n2+2*k+0]; + } + ftbaseexecuteplanrec(a, offs, plan, plan->plan.ptr.p_int[entryoffset+6], stackptr, _state); + plan->tmpbuf.ptr.p_double[0] = a->ptr.p_double[offs+0]; + plan->tmpbuf.ptr.p_double[1] = 0; + plan->tmpbuf.ptr.p_double[2*n2+0] = a->ptr.p_double[offs+1]; + plan->tmpbuf.ptr.p_double[2*n2+1] = 0; + for(k=1; k<=n2-1; k++) + { + offs1 = 2*k; + offs2 = 2*n2+2*k; + hk = a->ptr.p_double[offs+2*k+0]; + hnk = a->ptr.p_double[offs+2*(n2-k)+0]; + plan->tmpbuf.ptr.p_double[offs1+0] = 0.5*(hk+hnk); + plan->tmpbuf.ptr.p_double[offs2+1] = -0.5*(hk-hnk); + hk = a->ptr.p_double[offs+2*k+1]; + hnk = a->ptr.p_double[offs+2*(n2-k)+1]; + plan->tmpbuf.ptr.p_double[offs2+0] = 0.5*(hk+hnk); + plan->tmpbuf.ptr.p_double[offs1+1] = 0.5*(hk-hnk); + } + ae_v_move(&a->ptr.p_double[offs], 1, &plan->tmpbuf.ptr.p_double[0], 1, ae_v_len(offs,offs+2*n2*2-1)); + } + if( n1%2!=0 ) + { + ftbaseexecuteplanrec(a, aoffset+(n1-1)*n2*2, plan, plan->plan.ptr.p_int[entryoffset+6], stackptr, _state); + } + ftbase_ffttwcalc(a, aoffset, n2, n1, _state); + ftbase_internalcomplexlintranspose(a, n1, n2, aoffset, &plan->tmpbuf, _state); + for(i=0; i<=n2-1; i++) + { + ftbaseexecuteplanrec(a, aoffset+i*n1*2, plan, plan->plan.ptr.p_int[entryoffset+5], stackptr, _state); + } + ftbase_internalcomplexlintranspose(a, n2, n1, aoffset, &plan->tmpbuf, _state); + ae_frame_leave(_state); + return; + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fhtcooleytukeyplan ) + { + + /* + * Cooley-Tukey FHT plan: + * * transpose \ + * * smaller FHT's | + * * pre-process | + * * multiply by twiddle factors | corresponds to multiplication by H1 + * * post-process | + * * transpose again / + * * multiply by H2 (smaller FHT's) + * * final transposition + * + * For more details see Vitezslav Vesely, "Fast algorithms + * of Fourier and Hartley transform and their implementation in MATLAB", + * page 31. + */ + n1 = plan->plan.ptr.p_int[entryoffset+1]; + n2 = plan->plan.ptr.p_int[entryoffset+2]; + n = n1*n2; + ftbase_internalreallintranspose(a, n1, n2, aoffset, &plan->tmpbuf, _state); + for(i=0; i<=n2-1; i++) + { + ftbaseexecuteplanrec(a, aoffset+i*n1, plan, plan->plan.ptr.p_int[entryoffset+5], stackptr, _state); + } + for(i=0; i<=n2-1; i++) + { + for(j=0; j<=n1-1; j++) + { + offsa = aoffset+i*n1; + hk = a->ptr.p_double[offsa+j]; + hnk = a->ptr.p_double[offsa+(n1-j)%n1]; + offs = 2*(i*n1+j); + plan->tmpbuf.ptr.p_double[offs+0] = -0.5*(hnk-hk); + plan->tmpbuf.ptr.p_double[offs+1] = 0.5*(hk+hnk); + } + } + ftbase_ffttwcalc(&plan->tmpbuf, 0, n1, n2, _state); + for(j=0; j<=n1-1; j++) + { + a->ptr.p_double[aoffset+j] = plan->tmpbuf.ptr.p_double[2*j+0]+plan->tmpbuf.ptr.p_double[2*j+1]; + } + if( n2%2==0 ) + { + offs = 2*(n2/2)*n1; + offsa = aoffset+n2/2*n1; + for(j=0; j<=n1-1; j++) + { + a->ptr.p_double[offsa+j] = plan->tmpbuf.ptr.p_double[offs+2*j+0]+plan->tmpbuf.ptr.p_double[offs+2*j+1]; + } + } + for(i=1; i<=(n2+1)/2-1; i++) + { + offs = 2*i*n1; + offs2 = 2*(n2-i)*n1; + offsa = aoffset+i*n1; + for(j=0; j<=n1-1; j++) + { + a->ptr.p_double[offsa+j] = plan->tmpbuf.ptr.p_double[offs+2*j+1]+plan->tmpbuf.ptr.p_double[offs2+2*j+0]; + } + offsa = aoffset+(n2-i)*n1; + for(j=0; j<=n1-1; j++) + { + a->ptr.p_double[offsa+j] = plan->tmpbuf.ptr.p_double[offs+2*j+0]+plan->tmpbuf.ptr.p_double[offs2+2*j+1]; + } + } + ftbase_internalreallintranspose(a, n2, n1, aoffset, &plan->tmpbuf, _state); + for(i=0; i<=n1-1; i++) + { + ftbaseexecuteplanrec(a, aoffset+i*n2, plan, plan->plan.ptr.p_int[entryoffset+6], stackptr, _state); + } + ftbase_internalreallintranspose(a, n1, n2, aoffset, &plan->tmpbuf, _state); + ae_frame_leave(_state); + return; + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fhtn2plan ) + { + + /* + * Cooley-Tukey FHT plan + */ + n1 = plan->plan.ptr.p_int[entryoffset+1]; + n2 = plan->plan.ptr.p_int[entryoffset+2]; + n = n1*n2; + ftbase_reffht(a, n, aoffset, _state); + ae_frame_leave(_state); + return; + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftcodeletplan ) + { + n1 = plan->plan.ptr.p_int[entryoffset+1]; + n2 = plan->plan.ptr.p_int[entryoffset+2]; + n = n1*n2; + if( n==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; + ae_frame_leave(_state); + return; + } + if( n==3 ) + { + offs = plan->plan.ptr.p_int[entryoffset+7]; + c1 = plan->precomputed.ptr.p_double[offs+0]; + c2 = plan->precomputed.ptr.p_double[offs+1]; + 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; + ae_frame_leave(_state); + return; + } + if( n==4 ) + { + 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; + ae_frame_leave(_state); + return; + } + if( n==5 ) + { + offs = plan->plan.ptr.p_int[entryoffset+7]; + c1 = plan->precomputed.ptr.p_double[offs+0]; + c2 = plan->precomputed.ptr.p_double[offs+1]; + c3 = plan->precomputed.ptr.p_double[offs+2]; + c4 = plan->precomputed.ptr.p_double[offs+3]; + c5 = plan->precomputed.ptr.p_double[offs+4]; + 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; + ae_frame_leave(_state); + return; + } + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fhtcodeletplan ) + { + n1 = plan->plan.ptr.p_int[entryoffset+1]; + n2 = plan->plan.ptr.p_int[entryoffset+2]; + n = n1*n2; + if( n==2 ) + { + a0x = a->ptr.p_double[aoffset+0]; + a1x = a->ptr.p_double[aoffset+1]; + a->ptr.p_double[aoffset+0] = a0x+a1x; + a->ptr.p_double[aoffset+1] = a0x-a1x; + ae_frame_leave(_state); + return; + } + if( n==3 ) + { + offs = plan->plan.ptr.p_int[entryoffset+7]; + c1 = plan->precomputed.ptr.p_double[offs+0]; + c2 = plan->precomputed.ptr.p_double[offs+1]; + a0x = a->ptr.p_double[aoffset+0]; + a1x = a->ptr.p_double[aoffset+1]; + a2x = a->ptr.p_double[aoffset+2]; + t1x = a1x+a2x; + a0x = a0x+t1x; + m1x = c1*t1x; + m2y = c2*(a2x-a1x); + s1x = a0x+m1x; + a->ptr.p_double[aoffset+0] = a0x; + a->ptr.p_double[aoffset+1] = s1x-m2y; + a->ptr.p_double[aoffset+2] = s1x+m2y; + ae_frame_leave(_state); + return; + } + if( n==4 ) + { + a0x = a->ptr.p_double[aoffset+0]; + a1x = a->ptr.p_double[aoffset+1]; + a2x = a->ptr.p_double[aoffset+2]; + a3x = a->ptr.p_double[aoffset+3]; + t1x = a0x+a2x; + t2x = a1x+a3x; + m2x = a0x-a2x; + m3y = a3x-a1x; + a->ptr.p_double[aoffset+0] = t1x+t2x; + a->ptr.p_double[aoffset+1] = m2x-m3y; + a->ptr.p_double[aoffset+2] = t1x-t2x; + a->ptr.p_double[aoffset+3] = m2x+m3y; + ae_frame_leave(_state); + return; + } + if( n==5 ) + { + offs = plan->plan.ptr.p_int[entryoffset+7]; + c1 = plan->precomputed.ptr.p_double[offs+0]; + c2 = plan->precomputed.ptr.p_double[offs+1]; + c3 = plan->precomputed.ptr.p_double[offs+2]; + c4 = plan->precomputed.ptr.p_double[offs+3]; + c5 = plan->precomputed.ptr.p_double[offs+4]; + t1x = a->ptr.p_double[aoffset+1]+a->ptr.p_double[aoffset+4]; + t2x = a->ptr.p_double[aoffset+2]+a->ptr.p_double[aoffset+3]; + t3x = a->ptr.p_double[aoffset+1]-a->ptr.p_double[aoffset+4]; + t4x = a->ptr.p_double[aoffset+3]-a->ptr.p_double[aoffset+2]; + t5x = t1x+t2x; + v0 = a->ptr.p_double[aoffset+0]+t5x; + a->ptr.p_double[aoffset+0] = v0; + m2x = c2*(t1x-t2x); + m3y = c3*(t3x+t4x); + s3y = m3y-c4*t4x; + s5y = m3y+c5*t3x; + s1x = v0+c1*t5x; + s2x = s1x+m2x; + s4x = s1x-m2x; + a->ptr.p_double[aoffset+1] = s2x-s3y; + a->ptr.p_double[aoffset+2] = s4x-s5y; + a->ptr.p_double[aoffset+3] = s4x+s5y; + a->ptr.p_double[aoffset+4] = s2x+s3y; + ae_frame_leave(_state); + return; + } + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftbluesteinplan ) + { + + /* + * Bluestein plan: + * 1. multiply by precomputed coefficients + * 2. make convolution: forward FFT, multiplication by precomputed FFT + * and backward FFT. backward FFT is represented as + * + * invfft(x) = fft(x')'/M + * + * for performance reasons reduction of inverse FFT to + * forward FFT is merged with multiplication of FFT components + * and last stage of Bluestein's transformation. + * 3. post-multiplication by Bluestein factors + */ + n = plan->plan.ptr.p_int[entryoffset+1]; + m = plan->plan.ptr.p_int[entryoffset+4]; + offs = plan->plan.ptr.p_int[entryoffset+7]; + for(i=stackptr+2*n; i<=stackptr+2*m-1; i++) + { + plan->stackbuf.ptr.p_double[i] = 0; + } + offsp = offs+2*m; + offsa = aoffset; + offsb = stackptr; + for(i=0; i<=n-1; i++) + { + bx = plan->precomputed.ptr.p_double[offsp+0]; + by = plan->precomputed.ptr.p_double[offsp+1]; + x = a->ptr.p_double[offsa+0]; + y = a->ptr.p_double[offsa+1]; + plan->stackbuf.ptr.p_double[offsb+0] = x*bx-y*(-by); + plan->stackbuf.ptr.p_double[offsb+1] = x*(-by)+y*bx; + offsp = offsp+2; + offsa = offsa+2; + offsb = offsb+2; + } + ftbaseexecuteplanrec(&plan->stackbuf, stackptr, plan, plan->plan.ptr.p_int[entryoffset+5], stackptr+2*2*m, _state); + offsb = stackptr; + offsp = offs; + for(i=0; i<=m-1; i++) + { + x = plan->stackbuf.ptr.p_double[offsb+0]; + y = plan->stackbuf.ptr.p_double[offsb+1]; + bx = plan->precomputed.ptr.p_double[offsp+0]; + by = plan->precomputed.ptr.p_double[offsp+1]; + plan->stackbuf.ptr.p_double[offsb+0] = x*bx-y*by; + plan->stackbuf.ptr.p_double[offsb+1] = -(x*by+y*bx); + offsb = offsb+2; + offsp = offsp+2; + } + ftbaseexecuteplanrec(&plan->stackbuf, stackptr, plan, plan->plan.ptr.p_int[entryoffset+5], stackptr+2*2*m, _state); + offsb = stackptr; + offsp = offs+2*m; + offsa = aoffset; + for(i=0; i<=n-1; i++) + { + x = plan->stackbuf.ptr.p_double[offsb+0]/m; + y = -plan->stackbuf.ptr.p_double[offsb+1]/m; + bx = plan->precomputed.ptr.p_double[offsp+0]; + by = plan->precomputed.ptr.p_double[offsp+1]; + a->ptr.p_double[offsa+0] = x*bx-y*(-by); + a->ptr.p_double[offsa+1] = x*(-by)+y*bx; + offsp = offsp+2; + offsa = offsa+2; + offsb = offsb+2; + } + ae_frame_leave(_state); + return; + } + ae_frame_leave(_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(best(*planarraysize) ) + { + ftbase_fftarrayresize(&plan->plan, planarraysize, 8*(*planarraysize), _state); + } + entryoffset = *plansize; + esize = ftbase_ftbaseplanentrysize; + *plansize = *plansize+esize; + + /* + * if N=1, generate empty plan and exit + */ + if( n==1 ) + { + plan->plan.ptr.p_int[entryoffset+0] = esize; + plan->plan.ptr.p_int[entryoffset+1] = -1; + plan->plan.ptr.p_int[entryoffset+2] = -1; + plan->plan.ptr.p_int[entryoffset+3] = ftbase_fftemptyplan; + plan->plan.ptr.p_int[entryoffset+4] = -1; + plan->plan.ptr.p_int[entryoffset+5] = -1; + plan->plan.ptr.p_int[entryoffset+6] = -1; + plan->plan.ptr.p_int[entryoffset+7] = -1; + return; + } + + /* + * generate plans + */ + ftbasefactorize(n, tasktype, &n1, &n2, _state); + if( tasktype==ftbase_ftbasecffttask||tasktype==ftbase_ftbaserffttask ) + { + + /* + * complex FFT plans + */ + if( n1!=1 ) + { + + /* + * Cooley-Tukey plan (real or complex) + * + * Note that child plans are COMPLEX + * (whether plan itself is complex or not). + */ + *tmpmemsize = ae_maxint(*tmpmemsize, 2*n1*n2, _state); + plan->plan.ptr.p_int[entryoffset+0] = esize; + plan->plan.ptr.p_int[entryoffset+1] = n1; + plan->plan.ptr.p_int[entryoffset+2] = n2; + if( tasktype==ftbase_ftbasecffttask ) + { + plan->plan.ptr.p_int[entryoffset+3] = ftbase_fftcooleytukeyplan; + } + else + { + plan->plan.ptr.p_int[entryoffset+3] = ftbase_fftrealcooleytukeyplan; + } + plan->plan.ptr.p_int[entryoffset+4] = 0; + plan->plan.ptr.p_int[entryoffset+5] = *plansize; + ftbase_ftbasegenerateplanrec(n1, ftbase_ftbasecffttask, plan, plansize, precomputedsize, planarraysize, tmpmemsize, stackmemsize, stackptr, _state); + plan->plan.ptr.p_int[entryoffset+6] = *plansize; + ftbase_ftbasegenerateplanrec(n2, ftbase_ftbasecffttask, plan, plansize, precomputedsize, planarraysize, tmpmemsize, stackmemsize, stackptr, _state); + plan->plan.ptr.p_int[entryoffset+7] = -1; + return; + } + else + { + if( ((n==2||n==3)||n==4)||n==5 ) + { + + /* + * hard-coded plan + */ + plan->plan.ptr.p_int[entryoffset+0] = esize; + plan->plan.ptr.p_int[entryoffset+1] = n1; + plan->plan.ptr.p_int[entryoffset+2] = n2; + plan->plan.ptr.p_int[entryoffset+3] = ftbase_fftcodeletplan; + plan->plan.ptr.p_int[entryoffset+4] = 0; + plan->plan.ptr.p_int[entryoffset+5] = -1; + plan->plan.ptr.p_int[entryoffset+6] = -1; + plan->plan.ptr.p_int[entryoffset+7] = *precomputedsize; + if( n==3 ) + { + *precomputedsize = *precomputedsize+2; + } + if( n==5 ) + { + *precomputedsize = *precomputedsize+5; + } + return; + } + else + { + + /* + * Bluestein's plan + * + * Select such M that M>=2*N-1, M is composite, and M's + * factors are 2, 3, 5 + */ + k = 2*n2-1; + m = ftbasefindsmooth(k, _state); + *tmpmemsize = ae_maxint(*tmpmemsize, 2*m, _state); + plan->plan.ptr.p_int[entryoffset+0] = esize; + plan->plan.ptr.p_int[entryoffset+1] = n2; + plan->plan.ptr.p_int[entryoffset+2] = -1; + plan->plan.ptr.p_int[entryoffset+3] = ftbase_fftbluesteinplan; + plan->plan.ptr.p_int[entryoffset+4] = m; + plan->plan.ptr.p_int[entryoffset+5] = *plansize; + stackptr = stackptr+2*2*m; + *stackmemsize = ae_maxint(*stackmemsize, stackptr, _state); + ftbase_ftbasegenerateplanrec(m, ftbase_ftbasecffttask, plan, plansize, precomputedsize, planarraysize, tmpmemsize, stackmemsize, stackptr, _state); + stackptr = stackptr-2*2*m; + plan->plan.ptr.p_int[entryoffset+6] = -1; + plan->plan.ptr.p_int[entryoffset+7] = *precomputedsize; + *precomputedsize = *precomputedsize+2*m+2*n; + return; + } + } + } + if( tasktype==ftbase_ftbaserfhttask ) + { + + /* + * real FHT plans + */ + if( n1!=1 ) + { + + /* + * Cooley-Tukey plan + * + */ + *tmpmemsize = ae_maxint(*tmpmemsize, 2*n1*n2, _state); + plan->plan.ptr.p_int[entryoffset+0] = esize; + plan->plan.ptr.p_int[entryoffset+1] = n1; + plan->plan.ptr.p_int[entryoffset+2] = n2; + plan->plan.ptr.p_int[entryoffset+3] = ftbase_fhtcooleytukeyplan; + plan->plan.ptr.p_int[entryoffset+4] = 0; + plan->plan.ptr.p_int[entryoffset+5] = *plansize; + ftbase_ftbasegenerateplanrec(n1, tasktype, plan, plansize, precomputedsize, planarraysize, tmpmemsize, stackmemsize, stackptr, _state); + plan->plan.ptr.p_int[entryoffset+6] = *plansize; + ftbase_ftbasegenerateplanrec(n2, tasktype, plan, plansize, precomputedsize, planarraysize, tmpmemsize, stackmemsize, stackptr, _state); + plan->plan.ptr.p_int[entryoffset+7] = -1; + return; + } + else + { + + /* + * N2 plan + */ + plan->plan.ptr.p_int[entryoffset+0] = esize; + plan->plan.ptr.p_int[entryoffset+1] = n1; + plan->plan.ptr.p_int[entryoffset+2] = n2; + plan->plan.ptr.p_int[entryoffset+3] = ftbase_fhtn2plan; + plan->plan.ptr.p_int[entryoffset+4] = 0; + plan->plan.ptr.p_int[entryoffset+5] = -1; + plan->plan.ptr.p_int[entryoffset+6] = -1; + plan->plan.ptr.p_int[entryoffset+7] = -1; + if( ((n==2||n==3)||n==4)||n==5 ) + { + + /* + * hard-coded plan + */ + plan->plan.ptr.p_int[entryoffset+0] = esize; + plan->plan.ptr.p_int[entryoffset+1] = n1; + plan->plan.ptr.p_int[entryoffset+2] = n2; + plan->plan.ptr.p_int[entryoffset+3] = ftbase_fhtcodeletplan; + plan->plan.ptr.p_int[entryoffset+4] = 0; + plan->plan.ptr.p_int[entryoffset+5] = -1; + plan->plan.ptr.p_int[entryoffset+6] = -1; + plan->plan.ptr.p_int[entryoffset+7] = *precomputedsize; + if( n==3 ) + { + *precomputedsize = *precomputedsize+2; + } + if( n==5 ) + { + *precomputedsize = *precomputedsize+5; + } + return; + } + return; + } + } +} + + +/************************************************************************* +Recurrent subroutine for precomputing FFT plans + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_ftbaseprecomputeplanrec(ftplan* plan, + ae_int_t entryoffset, + ae_int_t stackptr, + ae_state *_state) +{ + ae_frame _frame_block; + ae_int_t i; + ae_int_t n1; + ae_int_t n2; + ae_int_t n; + ae_int_t m; + ae_int_t offs; + double v; + ae_vector emptyarray; + double bx; + double by; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&emptyarray, 0, DT_REAL, _state, ae_true); + + if( (plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftcooleytukeyplan||plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftrealcooleytukeyplan)||plan->plan.ptr.p_int[entryoffset+3]==ftbase_fhtcooleytukeyplan ) + { + ftbase_ftbaseprecomputeplanrec(plan, plan->plan.ptr.p_int[entryoffset+5], stackptr, _state); + ftbase_ftbaseprecomputeplanrec(plan, plan->plan.ptr.p_int[entryoffset+6], stackptr, _state); + ae_frame_leave(_state); + return; + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftcodeletplan||plan->plan.ptr.p_int[entryoffset+3]==ftbase_fhtcodeletplan ) + { + n1 = plan->plan.ptr.p_int[entryoffset+1]; + n2 = plan->plan.ptr.p_int[entryoffset+2]; + n = n1*n2; + if( n==3 ) + { + offs = plan->plan.ptr.p_int[entryoffset+7]; + plan->precomputed.ptr.p_double[offs+0] = ae_cos(2*ae_pi/3, _state)-1; + plan->precomputed.ptr.p_double[offs+1] = ae_sin(2*ae_pi/3, _state); + ae_frame_leave(_state); + return; + } + if( n==5 ) + { + offs = plan->plan.ptr.p_int[entryoffset+7]; + v = 2*ae_pi/5; + plan->precomputed.ptr.p_double[offs+0] = (ae_cos(v, _state)+ae_cos(2*v, _state))/2-1; + plan->precomputed.ptr.p_double[offs+1] = (ae_cos(v, _state)-ae_cos(2*v, _state))/2; + plan->precomputed.ptr.p_double[offs+2] = -ae_sin(v, _state); + plan->precomputed.ptr.p_double[offs+3] = -(ae_sin(v, _state)+ae_sin(2*v, _state)); + plan->precomputed.ptr.p_double[offs+4] = ae_sin(v, _state)-ae_sin(2*v, _state); + ae_frame_leave(_state); + return; + } + } + if( plan->plan.ptr.p_int[entryoffset+3]==ftbase_fftbluesteinplan ) + { + ftbase_ftbaseprecomputeplanrec(plan, plan->plan.ptr.p_int[entryoffset+5], stackptr, _state); + n = plan->plan.ptr.p_int[entryoffset+1]; + m = plan->plan.ptr.p_int[entryoffset+4]; + offs = plan->plan.ptr.p_int[entryoffset+7]; + for(i=0; i<=2*m-1; i++) + { + plan->precomputed.ptr.p_double[offs+i] = 0; + } + for(i=0; i<=n-1; i++) + { + bx = ae_cos(ae_pi*ae_sqr(i, _state)/n, _state); + by = ae_sin(ae_pi*ae_sqr(i, _state)/n, _state); + plan->precomputed.ptr.p_double[offs+2*i+0] = bx; + plan->precomputed.ptr.p_double[offs+2*i+1] = by; + plan->precomputed.ptr.p_double[offs+2*m+2*i+0] = bx; + plan->precomputed.ptr.p_double[offs+2*m+2*i+1] = by; + if( i>0 ) + { + plan->precomputed.ptr.p_double[offs+2*(m-i)+0] = bx; + plan->precomputed.ptr.p_double[offs+2*(m-i)+1] = by; + } + } + ftbaseexecuteplanrec(&plan->precomputed, offs, plan, plan->plan.ptr.p_int[entryoffset+5], stackptr, _state); + ae_frame_leave(_state); + return; + } + ae_frame_leave(_state); +} + + +/************************************************************************* +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 j; + ae_int_t n; + ae_int_t idx; + 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; + + + 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; + for(i=0; i<=n2-1; i++) + { + twxm1 = 0; + twy = 0; + for(j=0; j<=n1-1; j++) + { + idx = i*n1+j; + offs = aoffset+2*idx; + x = a->ptr.p_double[offs+0]; + y = a->ptr.p_double[offs+1]; + tmpx = x*twxm1-y*twy; + tmpy = x*twy+y*twxm1; + a->ptr.p_double[offs+0] = x+tmpx; + a->ptr.p_double[offs+1] = y+tmpy; + + /* + * update Tw: Tw(new) = Tw(old)*TwRow + */ + if( jptr.p_double[astart], 1, &buf->ptr.p_double[0], 1, ae_v_len(astart,astart+2*m*n-1)); +} + + +/************************************************************************* +Linear transpose: transpose real matrix stored in 1-dimensional array + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_internalreallintranspose(/* Real */ ae_vector* a, + ae_int_t m, + ae_int_t n, + ae_int_t astart, + /* Real */ ae_vector* buf, + ae_state *_state) +{ + + + ftbase_fftirltrec(a, astart, n, buf, 0, m, m, n, _state); + ae_v_move(&a->ptr.p_double[astart], 1, &buf->ptr.p_double[0], 1, ae_v_len(astart,astart+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); + } +} + + +/************************************************************************* +Internal subroutine: array resize + + -- ALGLIB -- + Copyright 01.05.2009 by Bochkanov Sergey +*************************************************************************/ +static void ftbase_fftarrayresize(/* Integer */ ae_vector* a, + ae_int_t* asize, + ae_int_t newasize, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector tmp; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&tmp, 0, DT_INT, _state, ae_true); + + ae_vector_set_length(&tmp, *asize, _state); + for(i=0; i<=*asize-1; i++) + { + tmp.ptr.p_int[i] = a->ptr.p_int[i]; + } + ae_vector_set_length(a, newasize, _state); + for(i=0; i<=*asize-1; i++) + { + a->ptr.p_int[i] = tmp.ptr.p_int[i]; + } + *asize = newasize; + ae_frame_leave(_state); +} + + +/************************************************************************* +Reference FHT stub +*************************************************************************/ +static void ftbase_reffht(/* Real */ ae_vector* a, + ae_int_t n, + ae_int_t offs, + ae_state *_state) +{ + ae_frame _frame_block; + ae_vector buf; + ae_int_t i; + ae_int_t j; + double v; + + ae_frame_make(_state, &_frame_block); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + + ae_assert(n>0, "RefFHTR1D: incorrect N!", _state); + ae_vector_set_length(&buf, n, _state); + for(i=0; i<=n-1; i++) + { + v = 0; + for(j=0; j<=n-1; j++) + { + v = v+a->ptr.p_double[offs+j]*(ae_cos(2*ae_pi*i*j/n, _state)+ae_sin(2*ae_pi*i*j/n, _state)); + } + buf.ptr.p_double[i] = v; + } + for(i=0; i<=n-1; i++) + { + a->ptr.p_double[offs+i] = buf.ptr.p_double[i]; + } + ae_frame_leave(_state); +} + + +ae_bool _ftplan_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + ftplan *p = (ftplan*)_p; + ae_touch_ptr((void*)p); + if( !ae_vector_init(&p->plan, 0, DT_INT, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->precomputed, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->tmpbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->stackbuf, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +ae_bool _ftplan_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + ftplan *dst = (ftplan*)_dst; + ftplan *src = (ftplan*)_src; + if( !ae_vector_init_copy(&dst->plan, &src->plan, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->precomputed, &src->precomputed, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->tmpbuf, &src->tmpbuf, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->stackbuf, &src->stackbuf, _state, make_automatic) ) + return ae_false; + return ae_true; +} + + +void _ftplan_clear(void* _p) +{ + ftplan *p = (ftplan*)_p; + ae_touch_ptr((void*)p); + ae_vector_clear(&p->plan); + ae_vector_clear(&p->precomputed); + ae_vector_clear(&p->tmpbuf); + ae_vector_clear(&p->stackbuf); +} + + +void _ftplan_destroy(void* _p) +{ + ftplan *p = (ftplan*)_p; + ae_touch_ptr((void*)p); + ae_vector_destroy(&p->plan); + ae_vector_destroy(&p->precomputed); + ae_vector_destroy(&p->tmpbuf); + ae_vector_destroy(&p->stackbuf); +} + + + + +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/alg/alglibinternal.h b/alg/alglibinternal.h new file mode 100755 index 0000000..9dd28d0 --- /dev/null +++ b/alg/alglibinternal.h @@ -0,0 +1,868 @@ +/************************************************************************* +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_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_vector plan; + ae_vector precomputed; + ae_vector tmpbuf; + ae_vector stackbuf; +} ftplan; + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS C++ INTERFACE +// +///////////////////////////////////////////////////////////////////////// +namespace alglib +{ + + +} + +///////////////////////////////////////////////////////////////////////// +// +// THIS SECTION CONTAINS COMPUTATIONAL CORE DECLARATIONS (FUNCTIONS) +// +///////////////////////////////////////////////////////////////////////// +namespace alglib_impl +{ +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); +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); +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); +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); +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); +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, + 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); +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 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 ftbasegeneratecomplexfftplan(ae_int_t n, + ftplan* plan, + ae_state *_state); +void ftbasegeneraterealfftplan(ae_int_t n, ftplan* plan, ae_state *_state); +void ftbasegeneraterealfhtplan(ae_int_t n, ftplan* plan, ae_state *_state); +void ftbaseexecuteplan(/* Real */ ae_vector* a, + ae_int_t aoffset, + ae_int_t n, + ftplan* plan, + ae_state *_state); +void ftbaseexecuteplanrec(/* Real */ ae_vector* a, + ae_int_t aoffset, + ftplan* plan, + ae_int_t entryoffset, + ae_int_t stackptr, + 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 _ftplan_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _ftplan_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _ftplan_clear(void* _p); +void _ftplan_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/alg/alglibmisc.cpp b/alg/alglibmisc.cpp new file mode 100755 index 0000000..f79be3b --- /dev/null +++ b/alg/alglibmisc.cpp @@ -0,0 +1,3473 @@ +/************************************************************************* +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. N must be less than HQRNDMax-1. +2. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() + + -- 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 = 2147483563; +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); + + state->s1 = s1%(hqrnd_hqrndm1-1)+1; + state->s2 = s2%(hqrnd_hqrndm2-1)+1; + state->v = (double)1/(double)hqrnd_hqrndmax; + 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 = state->v*hqrnd_hqrndintegerbase(state, _state); + return result; +} + + +/************************************************************************* +This function generates random integer number in [0, N) + +1. N must be less than HQRNDMax-1. +2. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() + + -- ALGLIB -- + Copyright 02.12.2009 by Bochkanov Sergey +*************************************************************************/ +ae_int_t hqrnduniformi(hqrndstate* state, ae_int_t n, ae_state *_state) +{ + ae_int_t mx; + ae_int_t result; + + + + /* + * Correct handling of N's close to RNDBaseMax + * (avoiding skewed distributions for RNDBaseMax<>K*N) + */ + ae_assert(n>0, "HQRNDUniformI: N<=0!", _state); + ae_assert(n=RNDBaseMax-1!", _state); + mx = hqrnd_hqrndmax-1-(hqrnd_hqrndmax-1)%n; + do + { + result = hqrnd_hqrndintegerbase(state, _state)-1; + } + 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; +} + + +/************************************************************************* + +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; + } + 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->v = src->v; + 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; + + + 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 + */ + 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; + } + } + + /* + * Select split position S using sliding midpoint rule, + * rearrange points into [I1,I3) and [I3,I2) + */ + 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( 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*kdt->nx+kdt->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*kdt->nx+kdt->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/alg/alglibmisc.h b/alg/alglibmisc.h new file mode 100755 index 0000000..c101165 --- /dev/null +++ b/alg/alglibmisc.h @@ -0,0 +1,767 @@ +/************************************************************************* +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; + double v; + 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. N must be less than HQRNDMax-1. +2. State structure must be initialized with HQRNDRandomize() or HQRNDSeed() + + -- 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/alg/ap.cpp b/alg/ap.cpp new file mode 100755 index 0000000..51be82f --- /dev/null +++ b/alg/ap.cpp @@ -0,0 +1,10505 @@ +/************************************************************************* +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_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 + +/* + * 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*)))]; + +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->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); + dst->is_owner = 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 +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, 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->destroy = destroy; + } + else + { + dst->ptr = NULL; + dst->is_owner = 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->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) +{ + volatile ae_int_t i; + for(i=0; ip_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 + for(;;) + { + if( InterlockedCompareExchange((LONG volatile *)lock->p_lock, 1, 0)==0 ) + return; + ae_spin_wait(AE_LOCK_CYCLES); + } +#elif AE_OS==AE_POSIX + for(;;) + { + if( pthread_mutex_trylock(&lock->mutex)==0 ) + return; + ae_spin_wait(AE_LOCK_CYCLES); + } + ; +#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); + 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 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, 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, 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, NULL); + return; + } + + /* assign object to smart pointer */ + ae_smart_ptr_assign(pptr, pool->enumeration_counter->obj, 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, 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, NULL); + return; + } + + /* assign object to smart pointer */ + ae_smart_ptr_assign(pptr, pool->enumeration_counter->obj, 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_DEBUG4POSIX +#include +int PosixGetTickCount() +{ + 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); +} + +alglib::ae_vector_wrapper::ae_vector_wrapper(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; +} + +const alglib::ae_vector_wrapper& alglib::ae_vector_wrapper::operator=(const alglib::ae_vector_wrapper &rhs) +{ + if( this==&rhs ) + return *this; + if( p_vec==&vec ) + 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; + return *this; +} + +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; +} + +alglib::boolean_1d_array::boolean_1d_array() +{ + allocate_own(0, alglib_impl::DT_BOOL); +} + +alglib::boolean_1d_array::boolean_1d_array(const char *s) +{ + 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()), alglib_impl::DT_BOOL); + for(i=0; iptr.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) +{ + 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()), alglib_impl::DT_INT); + for(i=0; iptr.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) +{ + 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()), alglib_impl::DT_REAL); + for(i=0; iptr.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) +{ + 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()), alglib_impl::DT_COMPLEX); + for(i=0; iptr.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); +} + +alglib::ae_matrix_wrapper::ae_matrix_wrapper(const alglib::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; +} + +const alglib::ae_matrix_wrapper& alglib::ae_matrix_wrapper::operator=(const alglib::ae_matrix_wrapper &rhs) +{ + if( this==&rhs ) + return *this; + if( p_mat==&mat ) + 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; + return *this; +} + +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(alglib_impl::ae_matrix *p) +{ + p_mat = NULL; + attach_to(p); +} + +alglib::boolean_2d_array::boolean_2d_array(const char *s) +{ + 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()), alglib_impl::DT_BOOL); + for(i=0; iptr.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; i > 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()), alglib_impl::DT_INT); + 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; i > 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()), alglib_impl::DT_REAL); + 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; i > 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()), alglib_impl::DT_COMPLEX); + 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, j, 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,j=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 + +///////////////////////////////////////////////////////////////////////// +// +// 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 +{ +#include +#include +#include +#include +#include + +/* + * 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 + +/* + * 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 + +/* + * Include SMP headers + */ +#if AE_OS==AE_WINDOWS +#include +#include +#elif AE_OS==AE_POSIX +#include +#include +#include +#endif + + +/* + * define ae_int32_t, ae_int64_t, ae_int_t, ae_bool, ae_complex, ae_error_type and ae_datatype + */ +#if defined(AE_HAVE_STDINT) +#include +#endif + +#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 + + +/* + * 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 + +#ifdef AE_USE_CPP +} // end of namespace declaration, subsequent includes must be out of namespace +#endif + +#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 + +#ifdef AE_USE_CPP +namespace alglib_impl { // namespace declaration continued +#endif + +#endif +#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; + + /* 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, void (*destroy)(void*)); +void ae_smart_ptr_release(ae_smart_ptr *dst); + +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); +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 +#include +#include +#define tickcount(s) GetTickCount() +#define flushconsole(s) fflush(stdout) +#endif +#ifdef AE_DEBUG4POSIX +#define tickcount(s) PosixGetTickCount() +#define flushconsole(s) fflush(stdout) +int PosixGetTickCount(); +#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); + +/******************************************************************** +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(); + ae_vector_wrapper(const ae_vector_wrapper &rhs); + const ae_vector_wrapper& operator=(const ae_vector_wrapper &rhs); + + 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(); +protected: + 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(alglib_impl::ae_vector *p); + 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(alglib_impl::ae_vector *p); + integer_1d_array(const char *s); + 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(alglib_impl::ae_vector *p); + real_1d_array(const char *s); + 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(alglib_impl::ae_vector *p); + complex_1d_array(const char *s); + 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(); + ae_matrix_wrapper(const ae_matrix_wrapper &rhs); + 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(); +protected: + 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(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(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(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(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); + +} + + +#endif + diff --git a/alg/dataanalysis.cpp b/alg/dataanalysis.cpp new file mode 100755 index 0000000..89e413e --- /dev/null +++ b/alg/dataanalysis.cpp @@ -0,0 +1,31077 @@ +/************************************************************************* +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 + +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); + } +} + +/************************************************************************* +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 + +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); + } +} + +/************************************************************************* +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); + } +} + +/************************************************************************* + +*************************************************************************/ +_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() +{ +} + + +/************************************************************************* +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() +{ +} + + +/************************************************************************* +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. + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + SSize - 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 ssize) +{ + 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()), 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); + } +} + +/************************************************************************* +Error of the neural network on dataset given by sparse matrix. + +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); + } +} + +/************************************************************************* +Natural error function for neural network, internal subroutine. + + -- 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 + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpclserror(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 + { + alglib_impl::ae_int_t result = alglib_impl::mlpclserror(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); + } +} + +/************************************************************************* +Relative classification error on the test set. + +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); + } +} + +/************************************************************************* +Relative classification error on the test set given by sparse matrix. + +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: +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); + } +} + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set. + +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); + } +} + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set given by +sparse matrix. + +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); + } +} + +/************************************************************************* +RMS error on the test set given. + +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); + } +} + +/************************************************************************* +RMS error on the test set given by sparse matrix. + +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); + } +} + +/************************************************************************* +Average error on the test set. + +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); + } +} + +/************************************************************************* +Average error on the test set given by sparse matrix. + +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); + } +} + +/************************************************************************* +Average relative error on the test set. + +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); + } +} + +/************************************************************************* +Average relative error on the test set given by sparse matrix. + +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); + } +} + +/************************************************************************* +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 + +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(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); + } +} + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs given by sparse +matrices + +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(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); + } +} + +/************************************************************************* +Batch gradient calculation for a subset of dataset + +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. + 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 MLPGradBatch function. + + -- 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); + } +} + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs for a subset of +dataset given by boolean mask. + +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. + 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. + 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); + } +} + +/************************************************************************* +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. + +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); + } +} + +/************************************************************************* +Calculation of all types of errors. + +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); + } +} + +/************************************************************************* +Error of the neural network on dataset. + +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); + } +} + +/************************************************************************* +Error of the neural network on dataset. + +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); + } +} + +/************************************************************************* + +*************************************************************************/ +_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. + + +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 + iterations (NOT gradient calculations). 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. + + -- 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 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. + +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); + } +} + +/************************************************************************* +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. + +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); + } +} + +/************************************************************************* +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). + +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: 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); + } +} + +/************************************************************************* +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_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 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, + 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, + 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_chunksize = 32; +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, + double* e, + /* Real */ ae_vector* grad, + ae_bool naturalerrorfunc, + ae_state *_state); +static double mlpbase_safecrossentropy(double t, + double z, + 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 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, + multilayerperceptron* network, + multilayerperceptron* tnetwork, + minlbfgsstate* state, + ae_int_t nrestarts, + /* Integer */ ae_vector* trnsubset, + ae_int_t trnsubsetsize, + /* Integer */ ae_vector* valsubset, + ae_int_t valsubsetsize, + /* Real */ ae_vector* bufwbest, + /* Real */ ae_vector* bufwfinal, + mlpreport* rep, + ae_state *_state); +static void mlptrain_mlpstarttrainingx(mlptrainer* s, + multilayerperceptron* network, + multilayerperceptron* tnetwork, + minlbfgsstate* state, + ae_bool randomstart, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_state *_state); +static ae_bool mlptrain_mlpcontinuetrainingx(mlptrainer* s, + multilayerperceptron* network, + multilayerperceptron* tnetwork, + minlbfgsstate* state, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_int_t* ngradbatch, + 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); + + + + + + + +/************************************************************************* +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 + */ + 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]; + } + } + 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 + +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); +} + + +/************************************************************************* +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 + +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; + ae_int_t k; + double v; + double vv; + ae_matrix tmpxy; + ae_vector tmpx; + ae_vector tmpy; + 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); + _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 ) + { + + /* + * Chebyshev distance + */ + ae_matrix_set_length(d, npoints, npoints, _state); + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + for(j=i+1; j<=npoints-1; j++) + { + v = 0.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; + } + } + d->ptr.pp_double[i][j] = v; + d->ptr.pp_double[j][i] = v; + } + } + ae_frame_leave(_state); + return; + } + if( disttype==1 ) + { + + /* + * City block distance + */ + ae_matrix_set_length(d, npoints, npoints, _state); + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + for(j=i+1; j<=npoints-1; j++) + { + v = 0.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; + } + v = v+vv; + } + v = v/nfeatures; + d->ptr.pp_double[i][j] = v; + d->ptr.pp_double[j][i] = v; + } + } + ae_frame_leave(_state); + return; + } + if( disttype==2 ) + { + + /* + * Euclidean distance + */ + ae_matrix_set_length(d, npoints, npoints, _state); + ae_matrix_set_length(&tmpxy, npoints, nfeatures, _state); + ae_vector_set_length(&tmpx, nfeatures, _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++) + { + for(j=i+1; j<=npoints-1; j++) + { + v = ae_sqrt(ae_maxreal(d->ptr.pp_double[i][i]+d->ptr.pp_double[j][j]-2*d->ptr.pp_double[i][j], 0.0, _state), _state); + d->ptr.pp_double[i][j] = v; + d->ptr.pp_double[j][i] = v; + } + } + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + } + ae_frame_leave(_state); + return; + } + if( disttype==10||disttype==11 ) + { + + /* + * Absolute/nonabsolute Pearson correlation distance + */ + ae_matrix_set_length(d, npoints, npoints, _state); + ae_matrix_set_length(&tmpxy, nfeatures, npoints, _state); + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&tmpxy.ptr.pp_double[0][i], tmpxy.stride, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1)); + } + pearsoncorrm(&tmpxy, nfeatures, npoints, d, _state); + for(i=0; i<=npoints-1; i++) + { + for(j=i+1; j<=npoints-1; j++) + { + if( disttype==10 ) + { + v = 1-d->ptr.pp_double[i][j]; + } + else + { + v = 1-ae_fabs(d->ptr.pp_double[i][j], _state); + } + v = ae_maxreal(v, 0.0, _state); + d->ptr.pp_double[i][j] = v; + d->ptr.pp_double[j][i] = v; + } + } + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + } + ae_frame_leave(_state); + return; + } + if( disttype==12||disttype==13 ) + { + + /* + * Absolute/nonabsolute uncentered Pearson correlation distance + */ + ae_matrix_set_length(d, npoints, 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++) + { + for(j=i+1; j<=npoints-1; j++) + { + v = d->ptr.pp_double[i][j]/ae_sqrt(d->ptr.pp_double[i][i]*d->ptr.pp_double[j][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; + d->ptr.pp_double[j][i] = 1-v; + } + } + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + } + ae_frame_leave(_state); + return; + } + if( disttype==20||disttype==21 ) + { + + /* + * Spearman rank correlation + */ + ae_matrix_set_length(d, npoints, npoints, _state); + ae_vector_set_length(&tmpx, nfeatures, _state); + ae_vector_set_length(&tmpy, nfeatures, _state); + ae_matrix_set_length(&tmpxy, nfeatures, npoints, _state); + for(i=0; i<=npoints-1; i++) + { + ae_v_move(&tmpx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nfeatures-1)); + rankx(&tmpx, nfeatures, &buf, _state); + ae_v_move(&tmpxy.ptr.pp_double[0][i], tmpxy.stride, &tmpx.ptr.p_double[0], 1, ae_v_len(0,nfeatures-1)); + } + pearsoncorrm(&tmpxy, nfeatures, npoints, d, _state); + for(i=0; i<=npoints-1; i++) + { + for(j=i+1; j<=npoints-1; j++) + { + if( disttype==20 ) + { + v = 1-d->ptr.pp_double[i][j]; + } + else + { + v = 1-ae_fabs(d->ptr.pp_double[i][j], _state); + } + v = ae_maxreal(v, 0.0, _state); + d->ptr.pp_double[i][j] = v; + d->ptr.pp_double[j][i] = v; + } + } + for(i=0; i<=npoints-1; i++) + { + d->ptr.pp_double[i][i] = 0.0; + } + ae_frame_leave(_state); + return; + } + ae_assert(ae_false, "Assertion failed", _state); + ae_frame_leave(_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; + + 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); + + + /* + * 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); +} + + +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; + + 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); + + + /* + * 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 + */ + offs = 0; + for(i=0; i<=ntrees-1; i++) + { + + /* + * Prepare sample + */ + for(k=0; k<=samplesize-1; k++) + { + j = k+ae_randominteger(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, _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, + 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, _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, + 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+ae_randominteger(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+ae_randominteger(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, _state); + bufs->treebuf.ptr.p_double[oldnp+2] = *numprocessed; + dforest_dfbuildtreerec(xy, npoints, nvars, nclasses, nfeatures, nvarsinpool, flags, numprocessed, i2+1, idx2, bufs, _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); +} + + + + +/************************************************************************* +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); + + 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); + copyrealmatrix(&network1->chunks, &network2->chunks, _state); + copyrealarray(&network1->nwbuf, &network2->nwbuf, _state); + copyintegerarray(&network1->integerbuf, &network2->integerbuf, _state); +} + + +/************************************************************************* +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 ntotal; + 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]; + ntotal = network->structinfo.ptr.p_int[3]; + 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_matrix_set_length(&network->chunks, 3*ntotal+1, mlpbase_chunksize-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_int_t i; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + + + mlpproperties(network, &nin, &nout, &wcount, _state); + for(i=0; i<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = ae_randomreal(_state)-0.5; + } +} + + +/************************************************************************* +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 + */ + for(i=0; i<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = ae_randomreal(_state)-0.5; + } + for(i=0; i<=nin-1; i++) + { + network->columnmeans.ptr.p_double[i] = 2*ae_randomreal(_state)-1; + network->columnsigmas.ptr.p_double[i] = 1.5*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 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-ae_sqr(*f, _state); + *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. + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + SSize - 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 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++) + { + 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); + if( mlpissoftmax(network, _state) ) + { + + /* + * class labels outputs + */ + k = ae_round(xy->ptr.pp_double[i][nin], _state); + if( k>=0&&ky.ptr.p_double[k] = network->y.ptr.p_double[k]-1; + } + } + else + { + + /* + * real outputs + */ + 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; + } + return result; +} + + +/************************************************************************* +Error of the neural network on dataset given by sparse matrix. + +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) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double e; + ae_int_t t0; + ae_int_t t1; + ae_bool iscls; + ae_int_t i; + ae_int_t j; + double result; + + + ae_assert(npoints>=0, "MLPErrorSparse: NPoints<0.", _state); + if( npoints==0 ) + { + result = 0; + return result; + } + ae_assert(sparseiscrs(xy, _state), "MLPErrorSparse: sparse matrix XY has not CRS format.", _state); + + /* + * Check dataset correctness + */ + t0 = 0; + t1 = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + iscls = mlpissoftmax(network, _state); + if( !iscls ) + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + ae_assert(ae_isfinite(e, _state), "MLPErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + } + else + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + if( j!=nin ) + { + ae_assert(ae_isfinite(e, _state), "MLPErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + else + { + ae_assert((ae_isfinite(e, _state)&&ae_round(e, _state)>=0)&&ae_round(e, _state)=NClasses).", _state); + } + } + } + result = 0; + for(i=0; i<=npoints-1; i++) + { + sparsegetrow(xy, i, &network->xyrow, _state); + ae_v_move(&network->x.ptr.p_double[0], 1, &network->xyrow.ptr.p_double[0], 1, ae_v_len(0,nin-1)); + mlpprocess(network, &network->x, &network->y, _state); + if( iscls ) + { + + /* + * Class labels outputs + */ + j = ae_round(network->xyrow.ptr.p_double[nin], _state); + ae_assert(j>=0&&j=NOut when J is class number)", _state); + network->y.ptr.p_double[j] = network->y.ptr.p_double[j]-1; + } + else + { + + /* + * Real outputs + */ + ae_v_sub(&network->y.ptr.p_double[0], 1, &network->xyrow.ptr.p_double[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; + } + return result; +} + + +/************************************************************************* +Natural error function for neural network, internal subroutine. + + -- 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 + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpclserror(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 nin; + ae_int_t nout; + ae_int_t wcount; + ae_vector workx; + ae_vector worky; + ae_int_t nn; + ae_int_t ns; + 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); + + mlpproperties(network, &nin, &nout, &wcount, _state); + ae_vector_set_length(&workx, nin-1+1, _state); + ae_vector_set_length(&worky, nout-1+1, _state); + result = 0; + for(i=0; i<=ssize-1; i++) + { + + /* + * Process + */ + ae_v_move(&workx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nin-1)); + mlpprocess(network, &workx, &worky, _state); + + /* + * Network version of the answer + */ + nmax = 0; + for(j=0; j<=nout-1; j++) + { + if( ae_fp_greater(worky.ptr.p_double[j],worky.ptr.p_double[nmax]) ) + { + nmax = j; + } + } + nn = nmax; + + /* + * Right answer + */ + if( mlpissoftmax(network, _state) ) + { + ns = ae_round(xy->ptr.pp_double[i][nin], _state); + } + else + { + nmax = 0; + for(j=0; j<=nout-1; j++) + { + if( ae_fp_greater(xy->ptr.pp_double[i][nin+j],xy->ptr.pp_double[i][nin+nmax]) ) + { + nmax = j; + } + } + ns = nmax; + } + + /* + * compare + */ + if( nn!=ns ) + { + result = result+1; + } + } + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Relative classification error on the test set. + +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; + + + result = (double)mlpclserror(network, xy, npoints, _state)/(double)npoints; + return result; +} + + +/************************************************************************* +Relative classification error on the test set given by sparse matrix. + +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: +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) +{ + ae_frame _frame_block; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double e; + ae_int_t t0; + ae_int_t t1; + ae_bool iscls; + ae_vector workx; + ae_vector worky; + ae_int_t nn; + ae_int_t ns; + ae_int_t nmax; + ae_int_t i; + ae_int_t j; + 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(npoints>=0, "MLPRelClsErrorSparse: NPoints<0.", _state); + if( npoints==0 ) + { + result = 0; + ae_frame_leave(_state); + return result; + } + ae_assert(sparseiscrs(xy, _state), "MLPRelClsErrorSparse: sparse matrix XY has not CRS format.", _state); + + /* + * Check dataset correctness + */ + t0 = 0; + t1 = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + iscls = mlpissoftmax(network, _state); + if( !iscls ) + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + ae_assert(ae_isfinite(e, _state), "MLPRelClsErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + } + else + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + if( j!=nin ) + { + ae_assert(ae_isfinite(e, _state), "MLPRelClsErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + else + { + ae_assert((ae_isfinite(e, _state)&&ae_round(e, _state)>=0)&&ae_round(e, _state)=NClasses).", _state); + } + } + } + ae_vector_set_length(&workx, nin, _state); + ae_vector_set_length(&worky, nout, _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + + /* + * Process + */ + sparsegetrow(xy, i, &network->xyrow, _state); + ae_v_move(&workx.ptr.p_double[0], 1, &network->xyrow.ptr.p_double[0], 1, ae_v_len(0,nin-1)); + mlpprocess(network, &workx, &worky, _state); + + /* + * Network version of the answer + */ + nmax = 0; + for(j=0; j<=nout-1; j++) + { + if( ae_fp_greater(worky.ptr.p_double[j],worky.ptr.p_double[nmax]) ) + { + nmax = j; + } + } + nn = nmax; + + /* + * Right answer + */ + if( iscls ) + { + ns = ae_round(network->xyrow.ptr.p_double[nin], _state); + } + else + { + nmax = 0; + for(j=0; j<=nout-1; j++) + { + if( ae_fp_greater(network->xyrow.ptr.p_double[nin+j],network->xyrow.ptr.p_double[nin+nmax]) ) + { + nmax = j; + } + } + ns = nmax; + } + + /* + * compare + */ + if( nn!=ns ) + { + result = result+1; + } + } + result = result/npoints; + ae_frame_leave(_state); + return result; +} + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set. + +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; + + + if( mlpissoftmax(network, _state) ) + { + result = mlperrorn(network, xy, npoints, _state)/(npoints*ae_log(2, _state)); + } + else + { + result = 0; + } + return result; +} + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set given by +sparse matrix. + +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) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double e; + ae_int_t t0; + ae_int_t t1; + ae_int_t i; + ae_int_t j; + double result; + + + ae_assert(npoints>=0, "MLPAvgCESparse: NPoints<0.", _state); + if( npoints==0 ) + { + result = 0; + return result; + } + ae_assert(sparseiscrs(xy, _state), "MLPAvgCESparse: sparse matrix XY has not CRS format.", _state); + + /* + * Check dataset correctness + */ + t0 = 0; + t1 = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + if( !mlpissoftmax(network, _state) ) + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + ae_assert(ae_isfinite(e, _state), "MLPAvgCESparse: sparse matrix XY contains Infinite or NaN.", _state); + } + } + else + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + if( j!=nin ) + { + ae_assert(ae_isfinite(e, _state), "MLPAvgCESparse: sparse matrix XY contains Infinite or NaN.", _state); + } + else + { + ae_assert((ae_isfinite(e, _state)&&ae_round(e, _state)>=0)&&ae_round(e, _state)=NClasses).", _state); + } + } + } + result = 0; + if( mlpissoftmax(network, _state) ) + { + for(i=0; i<=npoints-1; i++) + { + + /* + * Process vector + */ + sparsegetrow(xy, i, &network->xyrow, _state); + ae_v_move(&network->x.ptr.p_double[0], 1, &network->xyrow.ptr.p_double[0], 1, ae_v_len(0,nin-1)); + mlpprocess(network, &network->x, &network->y, _state); + + /* + * Update cross-entropy error function + */ + j = ae_round(network->xyrow.ptr.p_double[nin], _state); + if( j>=0&&jy.ptr.p_double[j], _state); + } + } + result = result/(npoints*ae_log(2, _state)); + } + return result; +} + + +/************************************************************************* +RMS error on the test set given. + +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) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double result; + + + mlpproperties(network, &nin, &nout, &wcount, _state); + result = ae_sqrt(2*mlperror(network, xy, npoints, _state)/(npoints*nout), _state); + return result; +} + + +/************************************************************************* +RMS error on the test set given by sparse matrix. + +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) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double e; + ae_int_t t0; + ae_int_t t1; + ae_int_t i; + ae_int_t j; + double result; + + + ae_assert(npoints>=0, "MLPRMSErrorSparse: NPoints<0.", _state); + if( npoints==0 ) + { + result = 0; + return result; + } + ae_assert(sparseiscrs(xy, _state), "MLPRMSErrorSparse: sparse matrix XY has not CRS format.", _state); + + /* + * Check dataset correctness + */ + t0 = 0; + t1 = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + if( !mlpissoftmax(network, _state) ) + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + ae_assert(ae_isfinite(e, _state), "MLPRMSErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + } + else + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + if( j!=nin ) + { + ae_assert(ae_isfinite(e, _state), "MLPRMSErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + else + { + ae_assert((ae_isfinite(e, _state)&&ae_round(e, _state)>=0)&&ae_round(e, _state)=NClasses).", _state); + } + } + } + result = ae_sqrt(2*mlperrorsparse(network, xy, npoints, _state)/(npoints*nout), _state); + return result; +} + + +/************************************************************************* +Average error on the test set. + +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) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double result; + + + mlpproperties(network, &nin, &nout, &wcount, _state); + result = 0; + for(i=0; i<=npoints-1; i++) + { + 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); + if( mlpissoftmax(network, _state) ) + { + + /* + * class labels + */ + k = ae_round(xy->ptr.pp_double[i][nin], _state); + for(j=0; j<=nout-1; j++) + { + if( j==k ) + { + result = result+ae_fabs(1-network->y.ptr.p_double[j], _state); + } + else + { + result = result+ae_fabs(network->y.ptr.p_double[j], _state); + } + } + } + else + { + + /* + * real outputs + */ + for(j=0; j<=nout-1; j++) + { + result = result+ae_fabs(xy->ptr.pp_double[i][nin+j]-network->y.ptr.p_double[j], _state); + } + } + } + result = result/(npoints*nout); + return result; +} + + +/************************************************************************* +Average error on the test set given by sparse matrix. + +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) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double e; + ae_int_t t0; + ae_int_t t1; + ae_bool iscls; + ae_int_t i; + ae_int_t j; + ae_int_t k; + double result; + + + ae_assert(npoints>=0, "MLPAvgErrorSparse: NPoints<0.", _state); + if( npoints==0 ) + { + result = 0; + return result; + } + ae_assert(sparseiscrs(xy, _state), "MLPAvgErrorSparse: sparse matrix XY has not CRS format.", _state); + + /* + * Check dataset correctness + */ + t0 = 0; + t1 = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + iscls = mlpissoftmax(network, _state); + if( !iscls ) + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + ae_assert(ae_isfinite(e, _state), "MLPAvgErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + } + else + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + if( j!=nin ) + { + ae_assert(ae_isfinite(e, _state), "MLPAvgErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + else + { + ae_assert((ae_isfinite(e, _state)&&ae_round(e, _state)>=0)&&ae_round(e, _state)=NClasses).", _state); + } + } + } + result = 0; + for(i=0; i<=npoints-1; i++) + { + sparsegetrow(xy, i, &network->x, _state); + mlpprocess(network, &network->x, &network->y, _state); + if( iscls ) + { + + /* + * class labels + */ + k = ae_round(network->x.ptr.p_double[nin], _state); + for(j=0; j<=nout-1; j++) + { + if( j==k ) + { + result = result+ae_fabs(1-network->y.ptr.p_double[j], _state); + } + else + { + result = result+ae_fabs(network->y.ptr.p_double[j], _state); + } + } + } + else + { + + /* + * real outputs + */ + for(j=0; j<=nout-1; j++) + { + result = result+ae_fabs(network->x.ptr.p_double[nin+j]-network->y.ptr.p_double[j], _state); + } + } + } + result = result/(npoints*nout); + return result; +} + + +/************************************************************************* +Average relative error on the test set. + +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) +{ + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t lk; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double result; + + + mlpproperties(network, &nin, &nout, &wcount, _state); + result = 0; + k = 0; + for(i=0; i<=npoints-1; i++) + { + 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); + if( mlpissoftmax(network, _state) ) + { + + /* + * class labels + */ + lk = ae_round(xy->ptr.pp_double[i][nin], _state); + for(j=0; j<=nout-1; j++) + { + if( j==lk ) + { + result = result+ae_fabs(1-network->y.ptr.p_double[j], _state); + k = k+1; + } + } + } + else + { + + /* + * real outputs + */ + for(j=0; j<=nout-1; j++) + { + if( ae_fp_neq(xy->ptr.pp_double[i][nin+j],0) ) + { + result = result+ae_fabs(xy->ptr.pp_double[i][nin+j]-network->y.ptr.p_double[j], _state)/ae_fabs(xy->ptr.pp_double[i][nin+j], _state); + k = k+1; + } + } + } + } + if( k!=0 ) + { + result = result/k; + } + return result; +} + + +/************************************************************************* +Average relative error on the test set given by sparse matrix. + +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) +{ + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double e; + ae_int_t t0; + ae_int_t t1; + ae_bool iscls; + ae_int_t i; + ae_int_t j; + ae_int_t k; + ae_int_t lk; + double result; + + + ae_assert(npoints>=0, "MLPAvgRelErrorSparse: NPoints<0.", _state); + if( npoints==0 ) + { + result = 0; + return result; + } + ae_assert(sparseiscrs(xy, _state), "MLPAvgRelErrorSparse: sparse matrix XY has not CRS format.", _state); + + /* + * Check dataset correctness + */ + t0 = 0; + t1 = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + iscls = mlpissoftmax(network, _state); + if( !iscls ) + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + ae_assert(ae_isfinite(e, _state), "MLPAvgRelErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + } + else + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + if( j!=nin ) + { + ae_assert(ae_isfinite(e, _state), "MLPAvgRelErrorSparse: sparse matrix XY contains Infinite or NaN.", _state); + } + else + { + ae_assert((ae_isfinite(e, _state)&&ae_round(e, _state)>=0)&&ae_round(e, _state)=NClasses).", _state); + } + } + } + result = 0; + k = 0; + for(i=0; i<=npoints-1; i++) + { + sparsegetrow(xy, i, &network->x, _state); + mlpprocess(network, &network->x, &network->y, _state); + if( iscls ) + { + + /* + * class labels + */ + lk = ae_round(network->x.ptr.p_double[nin], _state); + for(j=0; j<=nout-1; j++) + { + if( j==lk ) + { + result = result+ae_fabs(1-network->y.ptr.p_double[j], _state); + k = k+1; + } + } + } + else + { + + /* + * real outputs + */ + for(j=0; j<=nout-1; j++) + { + if( ae_fp_neq(network->x.ptr.p_double[nin+j],0) ) + { + result = result+ae_fabs(network->x.ptr.p_double[nin+j]-network->y.ptr.p_double[j], _state)/ae_fabs(network->x.ptr.p_double[nin+j], _state); + k = k+1; + } + } + } + } + if( k!=0 ) + { + result = result/k; + } + return result; +} + + +/************************************************************************* +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 + +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(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_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t i; + + *e = 0; + + + /* + * Alloc + */ + mlpproperties(network, &nin, &nout, &wcount, _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+mlpbase_chunksize, _state)-i, e, grad, ae_false, _state); + i = i+mlpbase_chunksize; + } +} + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs given by sparse +matrices + +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(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_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t csize; + ae_int_t rowsize; + ae_int_t i; + ae_int_t j; + + *e = 0; + + + /* + * Alloc + */ + mlpproperties(network, &nin, &nout, &wcount, _state); + rvectorsetlengthatleast(grad, wcount, _state); + if( mlpissoftmax(network, _state) ) + { + rowsize = nin+1; + rmatrixsetlengthatleast(&network->xy, mlpbase_chunksize, rowsize, _state); + } + else + { + rowsize = nin+nout; + rmatrixsetlengthatleast(&network->xy, mlpbase_chunksize, rowsize, _state); + } + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = 0; + } + *e = 0; + i = 0; + while(i<=ssize-1) + { + csize = ae_minint(ssize, i+mlpbase_chunksize, _state)-i; + for(j=0; j<=csize-1; j++) + { + sparsegetrow(xy, i+j, &network->xyrow, _state); + ae_v_move(&network->xy.ptr.pp_double[j][0], 1, &network->xyrow.ptr.p_double[0], 1, ae_v_len(0,rowsize-1)); + } + mlpbase_mlpchunkedgradient(network, &network->xy, 0, csize, e, grad, ae_false, _state); + i = i+mlpbase_chunksize; + } +} + + +/************************************************************************* +Batch gradient calculation for a subset of dataset + +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. + 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 MLPGradBatch function. + + -- 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_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t csize; + ae_int_t npoints; + ae_int_t rowsize; + ae_int_t i; + ae_int_t j; + + *e = 0; + + ae_assert(setsize>=0, "MLPGradBatchSubset: SetSize<0", _state); + if( subsetsize<0 ) + { + mlpgradbatch(network, xy, setsize, e, grad, _state); + return; + } + ae_assert(subsetsize<=idx->cnt, "MLPGradBatchSubset: SubsetSize>Length(Idx)", _state); + npoints = setsize; + 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); + } + + /* + * Alloc + */ + mlpproperties(network, &nin, &nout, &wcount, _state); + rvectorsetlengthatleast(grad, wcount, _state); + if( mlpissoftmax(network, _state) ) + { + rowsize = nin+1; + rmatrixsetlengthatleast(&network->xy, mlpbase_chunksize, rowsize, _state); + } + else + { + rowsize = nin+nout; + rmatrixsetlengthatleast(&network->xy, mlpbase_chunksize, rowsize, _state); + } + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = 0; + } + *e = 0; + i = 0; + while(i<=subsetsize-1) + { + csize = ae_minint(subsetsize, i+mlpbase_chunksize, _state)-i; + for(j=0; j<=csize-1; j++) + { + ae_v_move(&network->xy.ptr.pp_double[j][0], 1, &xy->ptr.pp_double[idx->ptr.p_int[i+j]][0], 1, ae_v_len(0,rowsize-1)); + } + mlpbase_mlpchunkedgradient(network, &network->xy, 0, csize, e, grad, ae_false, _state); + i = i+mlpbase_chunksize; + } +} + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs for a subset of +dataset given by boolean mask. + +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. + 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. + 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_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t csize; + ae_int_t npoints; + ae_int_t rowsize; + ae_int_t i; + ae_int_t j; + + *e = 0; + + ae_assert(setsize>=0, "MLPGradBatchSparseSubset: SetSize<0", _state); + if( subsetsize<0 ) + { + mlpgradbatchsparse(network, xy, setsize, e, grad, _state); + return; + } + ae_assert(subsetsize<=idx->cnt, "MLPGradBatchSparseSubset: SubsetSize>Length(Idx)", _state); + npoints = setsize; + 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); + } + + /* + * Alloc + */ + mlpproperties(network, &nin, &nout, &wcount, _state); + rvectorsetlengthatleast(grad, wcount, _state); + if( mlpissoftmax(network, _state) ) + { + rowsize = nin+1; + rmatrixsetlengthatleast(&network->xy, mlpbase_chunksize, rowsize, _state); + } + else + { + rowsize = nin+nout; + rmatrixsetlengthatleast(&network->xy, mlpbase_chunksize, rowsize, _state); + } + for(i=0; i<=wcount-1; i++) + { + grad->ptr.p_double[i] = 0; + } + *e = 0; + i = 0; + while(i<=subsetsize-1) + { + csize = ae_minint(subsetsize, i+mlpbase_chunksize, _state)-i; + for(j=0; j<=csize-1; j++) + { + sparsegetrow(xy, idx->ptr.p_int[i+j], &network->xyrow, _state); + ae_v_move(&network->xy.ptr.pp_double[j][0], 1, &network->xyrow.ptr.p_double[0], 1, ae_v_len(0,rowsize-1)); + } + mlpbase_mlpchunkedgradient(network, &network->xy, 0, csize, e, grad, ae_false, _state); + i = i+mlpbase_chunksize; + } +} + + +/************************************************************************* +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_int_t i; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + + *e = 0; + + + /* + * Alloc + */ + mlpproperties(network, &nin, &nout, &wcount, _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+mlpbase_chunksize, _state)-i, e, grad, ae_true, _state); + i = i+mlpbase_chunksize; + } +} + + +/************************************************************************* +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; + 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. + +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_frame _frame_block; + ae_vector buf; + ae_vector dy; + ae_int_t rowsize; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_bool iscls; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _modelerrors_clear(rep); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); + + ae_assert(setsize>=0, "MLPAllErrorsSubset: SetSize<0", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + iscls = mlpissoftmax(network, _state); + + /* + * Estimate error using subset of training set. + */ + rvectorsetlengthatleast(&network->x, nin, _state); + if( iscls ) + { + rowsize = nin+1; + rvectorsetlengthatleast(&network->y, 1, _state); + ae_vector_set_length(&dy, 1, _state); + dserrallocate(nout, &buf, _state); + } + else + { + rowsize = nin+nout; + rvectorsetlengthatleast(&network->y, nout, _state); + ae_vector_set_length(&dy, nout, _state); + dserrallocate(-nout, &buf, _state); + } + if( subsetsize<0 ) + { + for(i=0; i<=setsize-1; i++) + { + 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); + if( iscls ) + { + dy.ptr.p_double[0] = xy->ptr.pp_double[i][nin]; + } + else + { + ae_v_move(&dy.ptr.p_double[0], 1, &xy->ptr.pp_double[i][nin], 1, ae_v_len(0,nout-1)); + } + dserraccumulate(&buf, &network->y, &dy, _state); + } + } + else + { + for(i=0; i<=subsetsize-1; i++) + { + ae_v_move(&network->x.ptr.p_double[0], 1, &xy->ptr.pp_double[subset->ptr.p_int[i]][0], 1, ae_v_len(0,nin-1)); + mlpprocess(network, &network->x, &network->y, _state); + if( iscls ) + { + dy.ptr.p_double[0] = xy->ptr.pp_double[subset->ptr.p_int[i]][nin]; + } + else + { + ae_v_move(&dy.ptr.p_double[0], 1, &xy->ptr.pp_double[subset->ptr.p_int[i]][nin], 1, ae_v_len(0,nout-1)); + } + dserraccumulate(&buf, &network->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); +} + + +/************************************************************************* +Calculation of all types of errors. + +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_frame _frame_block; + ae_vector buf; + ae_vector dy; + ae_int_t rowsize; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_bool iscls; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _modelerrors_clear(rep); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + ae_vector_init(&dy, 0, DT_REAL, _state, ae_true); + + ae_assert(setsize>=0, "MLPAllErrorsSparseSubset: SetSize<0", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + iscls = mlpissoftmax(network, _state); + + /* + * Estimate error using subset of training set. + */ + rvectorsetlengthatleast(&network->x, nin, _state); + if( iscls ) + { + rowsize = nin+1; + rvectorsetlengthatleast(&network->y, 1, _state); + ae_vector_set_length(&dy, 1, _state); + dserrallocate(nout, &buf, _state); + } + else + { + rowsize = nin+nout; + rvectorsetlengthatleast(&network->y, nout, _state); + ae_vector_set_length(&dy, nout, _state); + dserrallocate(-nout, &buf, _state); + } + if( subsetsize<0 ) + { + for(i=0; i<=setsize-1; i++) + { + sparsegetrow(xy, i, &network->xyrow, _state); + ae_v_move(&network->x.ptr.p_double[0], 1, &network->xyrow.ptr.p_double[0], 1, ae_v_len(0,nin-1)); + mlpprocess(network, &network->x, &network->y, _state); + if( iscls ) + { + dy.ptr.p_double[0] = network->xyrow.ptr.p_double[nin]; + } + else + { + ae_v_move(&dy.ptr.p_double[0], 1, &network->xyrow.ptr.p_double[nin], 1, ae_v_len(0,nout-1)); + } + dserraccumulate(&buf, &network->y, &dy, _state); + } + } + else + { + for(i=0; i<=subsetsize-1; i++) + { + sparsegetrow(xy, subset->ptr.p_int[i], &network->xyrow, _state); + ae_v_move(&network->x.ptr.p_double[0], 1, &network->xyrow.ptr.p_double[0], 1, ae_v_len(0,nin-1)); + mlpprocess(network, &network->x, &network->y, _state); + if( iscls ) + { + dy.ptr.p_double[0] = network->xyrow.ptr.p_double[nin]; + } + else + { + ae_v_move(&dy.ptr.p_double[0], 1, &network->xyrow.ptr.p_double[nin], 1, ae_v_len(0,nout-1)); + } + dserraccumulate(&buf, &network->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); +} + + +/************************************************************************* +Error of the neural network on dataset. + +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 rowsize; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t i; + double result; + + + ae_assert(setsize>=0, "MLPErrorSubset: SetSize<0", _state); + mlpproperties(network, &nin, &nout, &wcount, _state); + + /* + * Estimate error using subset of training set. + */ + if( mlpissoftmax(network, _state) ) + { + rowsize = nin+1; + } + else + { + rowsize = nin+nout; + } + rmatrixsetlengthatleast(&network->xy, 1, rowsize, _state); + if( subsetsize<0 ) + { + result = mlperror(network, xy, setsize, _state); + } + else + { + result = 0; + for(i=0; i<=subsetsize-1; i++) + { + ae_v_move(&network->xy.ptr.pp_double[0][0], 1, &xy->ptr.pp_double[subset->ptr.p_int[i]][0], 1, ae_v_len(0,rowsize-1)); + result = result+mlperror(network, &network->xy, 1, _state); + } + } + return result; +} + + +/************************************************************************* +Error of the neural network on dataset. + +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 rowsize; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + double e; + ae_int_t t0; + ae_int_t t1; + ae_bool iscls; + ae_int_t i; + ae_int_t j; + double result; + + + ae_assert(setsize>=0, "MLPErrorSparseSubset: SetSize<0.", _state); + ae_assert(sparseiscrs(xy, _state), "MLPErrorSparseSubset: sparse matrix XY has not CRS format.", _state); + + /* + * Check dataset correctness + */ + t0 = 0; + t1 = 0; + mlpproperties(network, &nin, &nout, &wcount, _state); + iscls = mlpissoftmax(network, _state); + if( !iscls ) + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + ae_assert(ae_isfinite(e, _state), "MLPErrorSparseSubset: sparse matrix XY contains Infinite or NaN.", _state); + } + } + else + { + while(sparseenumerate(xy, &t0, &t1, &i, &j, &e, _state)) + { + if( j!=nin ) + { + ae_assert(ae_isfinite(e, _state), "MLPErrorSparseSubset: sparse matrix XY contains Infinite or NaN.", _state); + } + else + { + ae_assert((ae_isfinite(e, _state)&&ae_round(e, _state)>=0)&&ae_round(e, _state)=NClasses).", _state); + } + } + } + + /* + * Estimate error using subset of training set. + */ + if( iscls ) + { + rowsize = nin+1; + } + else + { + rowsize = nin+nout; + } + rmatrixsetlengthatleast(&network->xy, 1, rowsize, _state); + if( subsetsize<0 ) + { + result = mlperrorsparse(network, xy, setsize, _state); + } + else + { + result = 0; + for(i=0; i<=subsetsize-1; i++) + { + sparsegetrow(xy, subset->ptr.p_int[i], &network->xyrow, _state); + ae_v_move(&network->xy.ptr.pp_double[0][0], 1, &network->xyrow.ptr.p_double[0], 1, ae_v_len(0,rowsize-1)); + result = result+mlperror(network, &network->xy, 1, _state); + } + } + return result; +} + + +/************************************************************************* +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; + + 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); + + + /* + * 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_matrix_set_length(&network->chunks, 3*ntotal+1, mlpbase_chunksize-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<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = ae_randomreal(_state)-0.5; + } + 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; + } + } + 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; + } + } +} + + +/************************************************************************* +Internal subroutine, chunked gradient +*************************************************************************/ +static void mlpbase_mlpchunkedgradient(multilayerperceptron* network, + /* Real */ ae_matrix* xy, + ae_int_t cstart, + ae_int_t csize, + double* e, + /* Real */ ae_vector* grad, + 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 n1; + ae_int_t n2; + ae_int_t w1; + ae_int_t w2; + ae_int_t c1; + ae_int_t c2; + 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 s; + double fown; + double deown; + double net; + double lnnet; + double mx; + ae_bool bflag; + ae_int_t istart; + ae_int_t ineurons; + ae_int_t idfdnet; + ae_int_t iderror; + ae_int_t izeros; + + + + /* + * 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]; + c1 = cstart; + c2 = cstart+csize-1; + ineurons = 0; + idfdnet = ntotal; + iderror = 2*ntotal; + izeros = 3*ntotal; + for(j=0; j<=csize-1; j++) + { + network->chunks.ptr.pp_double[izeros][j] = 0; + } + + /* + * Forward pass: + * 1. Load inputs from XY to Chunks[0:NIn-1,0:CSize-1] + * 2. Forward pass + */ + for(i=0; i<=nin-1; i++) + { + for(j=0; j<=csize-1; j++) + { + if( ae_fp_neq(network->columnsigmas.ptr.p_double[i],0) ) + { + network->chunks.ptr.pp_double[i][j] = (xy->ptr.pp_double[c1+j][i]-network->columnmeans.ptr.p_double[i])/network->columnsigmas.ptr.p_double[i]; + } + else + { + network->chunks.ptr.pp_double[i][j] = xy->ptr.pp_double[c1+j][i]-network->columnmeans.ptr.p_double[i]; + } + } + } + for(i=0; i<=ntotal-1; i++) + { + offs = istart+i*mlpbase_nfieldwidth; + if( network->structinfo.ptr.p_int[offs+0]>0||network->structinfo.ptr.p_int[offs+0]==-5 ) + { + + /* + * Activation function: + * * calculate F vector, F(i) = F(NET(i)) + */ + n1 = network->structinfo.ptr.p_int[offs+2]; + ae_v_move(&network->chunks.ptr.pp_double[i][0], 1, &network->chunks.ptr.pp_double[n1][0], 1, ae_v_len(0,csize-1)); + for(j=0; j<=csize-1; j++) + { + mlpactivationfunction(network->chunks.ptr.pp_double[i][j], network->structinfo.ptr.p_int[offs+0], &f, &df, &d2f, _state); + network->chunks.ptr.pp_double[i][j] = f; + network->chunks.ptr.pp_double[idfdnet+i][j] = df; + } + continue; + } + if( network->structinfo.ptr.p_int[offs+0]==0 ) + { + + /* + * Adaptive summator: + * * calculate NET vector, NET(i) = SUM(W(j,i)*Neurons(j),j=N1..N2) + */ + 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; + ae_v_move(&network->chunks.ptr.pp_double[i][0], 1, &network->chunks.ptr.pp_double[izeros][0], 1, ae_v_len(0,csize-1)); + for(j=n1; j<=n2; j++) + { + v = network->weights.ptr.p_double[w1+j-n1]; + ae_v_addd(&network->chunks.ptr.pp_double[i][0], 1, &network->chunks.ptr.pp_double[j][0], 1, ae_v_len(0,csize-1), v); + } + continue; + } + if( network->structinfo.ptr.p_int[offs+0]<0 ) + { + bflag = ae_false; + if( network->structinfo.ptr.p_int[offs+0]==-2 ) + { + + /* + * input neuron, left unchanged + */ + bflag = ae_true; + } + if( network->structinfo.ptr.p_int[offs+0]==-3 ) + { + + /* + * "-1" neuron + */ + for(k=0; k<=csize-1; k++) + { + network->chunks.ptr.pp_double[i][k] = -1; + } + bflag = ae_true; + } + if( network->structinfo.ptr.p_int[offs+0]==-4 ) + { + + /* + * "0" neuron + */ + for(k=0; k<=csize-1; k++) + { + network->chunks.ptr.pp_double[i][k] = 0; + } + bflag = ae_true; + } + ae_assert(bflag, "MLPChunkedGradient: internal error - unknown neuron type!", _state); + continue; + } + } + + /* + * Post-processing, error, dError/dOut + */ + for(i=0; i<=ntotal-1; i++) + { + ae_v_move(&network->chunks.ptr.pp_double[iderror+i][0], 1, &network->chunks.ptr.pp_double[izeros][0], 1, ae_v_len(0,csize-1)); + } + 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 output, classification network. + * + * For each K = 0..CSize-1 do: + * 1. place exp(outputs[k]) to NWBuf[0:NOut-1] + * 2. place sum(exp(..)) to NET + * 3. calculate dError/dOut and place it to the second block of Chunks + */ + for(k=0; k<=csize-1; k++) + { + + /* + * Normalize + */ + mx = network->chunks.ptr.pp_double[ntotal-nout][k]; + for(i=1; i<=nout-1; i++) + { + mx = ae_maxreal(mx, network->chunks.ptr.pp_double[ntotal-nout+i][k], _state); + } + net = 0; + for(i=0; i<=nout-1; i++) + { + network->nwbuf.ptr.p_double[i] = ae_exp(network->chunks.ptr.pp_double[ntotal-nout+i][k]-mx, _state); + net = net+network->nwbuf.ptr.p_double[i]; + } + + /* + * Calculate error function and dError/dOut + */ + if( naturalerrorfunc ) + { + + /* + * Natural error func. + * + */ + s = 1; + lnnet = ae_log(net, _state); + kl = ae_round(xy->ptr.pp_double[cstart+k][nin], _state); + for(i=0; i<=nout-1; i++) + { + if( i==kl ) + { + v = 1; + } + else + { + v = 0; + } + network->chunks.ptr.pp_double[iderror+ntotal-nout+i][k] = s*network->nwbuf.ptr.p_double[i]/net-v; + *e = *e+mlpbase_safecrossentropy(v, network->nwbuf.ptr.p_double[i]/net, _state); + } + } + else + { + + /* + * Least squares error func + * Error, dError/dOut(normalized) + */ + kl = ae_round(xy->ptr.pp_double[cstart+k][nin], _state); + for(i=0; i<=nout-1; i++) + { + if( i==kl ) + { + v = network->nwbuf.ptr.p_double[i]/net-1; + } + else + { + v = network->nwbuf.ptr.p_double[i]/net; + } + network->nwbuf.ptr.p_double[nout+i] = v; + *e = *e+ae_sqr(v, _state)/2; + } + + /* + * From dError/dOut(normalized) to dError/dOut(non-normalized) + */ + v = ae_v_dotproduct(&network->nwbuf.ptr.p_double[nout], 1, &network->nwbuf.ptr.p_double[0], 1, ae_v_len(nout,2*nout-1)); + for(i=0; i<=nout-1; i++) + { + fown = network->nwbuf.ptr.p_double[i]; + deown = network->nwbuf.ptr.p_double[nout+i]; + network->chunks.ptr.pp_double[iderror+ntotal-nout+i][k] = (-v+deown*fown+deown*(net-fown))*fown/ae_sqr(net, _state); + } + } + } + } + else + { + + /* + * Normal output, regression network + * + * For each K = 0..CSize-1 do: + * 1. calculate dError/dOut and place it to the second block of Chunks + */ + for(i=0; i<=nout-1; i++) + { + for(j=0; j<=csize-1; j++) + { + v = network->chunks.ptr.pp_double[ntotal-nout+i][j]*network->columnsigmas.ptr.p_double[nin+i]+network->columnmeans.ptr.p_double[nin+i]-xy->ptr.pp_double[cstart+j][nin+i]; + network->chunks.ptr.pp_double[iderror+ntotal-nout+i][j] = v*network->columnsigmas.ptr.p_double[nin+i]; + *e = *e+ae_sqr(v, _state)/2; + } + } + } + + /* + * 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 + */ + n1 = network->structinfo.ptr.p_int[offs+2]; + for(k=0; k<=csize-1; k++) + { + network->chunks.ptr.pp_double[iderror+i][k] = network->chunks.ptr.pp_double[iderror+i][k]*network->chunks.ptr.pp_double[idfdnet+i][k]; + } + ae_v_add(&network->chunks.ptr.pp_double[iderror+n1][0], 1, &network->chunks.ptr.pp_double[iderror+i][0], 1, ae_v_len(0,csize-1)); + continue; + } + if( network->structinfo.ptr.p_int[offs+0]==0 ) + { + + /* + * "Normal" activation function + */ + 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=w1; j<=w2; j++) + { + v = ae_v_dotproduct(&network->chunks.ptr.pp_double[n1+j-w1][0], 1, &network->chunks.ptr.pp_double[iderror+i][0], 1, ae_v_len(0,csize-1)); + grad->ptr.p_double[j] = grad->ptr.p_double[j]+v; + } + for(j=n1; j<=n2; j++) + { + v = network->weights.ptr.p_double[w1+j-n1]; + ae_v_addd(&network->chunks.ptr.pp_double[iderror+j][0], 1, &network->chunks.ptr.pp_double[iderror+i][0], 1, ae_v_len(0,csize-1), 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; + } + } +} + + +/************************************************************************* +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; +} + + +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_matrix_init(&p->chunks, 0, 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; + 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_matrix_init_copy(&dst->chunks, &src->chunks, _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; + 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_matrix_clear(&p->chunks); + ae_vector_clear(&p->nwbuf); + ae_vector_clear(&p->integerbuf); +} + + +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_matrix_destroy(&p->chunks); + ae_vector_destroy(&p->nwbuf); + ae_vector_destroy(&p->integerbuf); +} + + +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); +} + + + + +/************************************************************************* +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 + */ + wdim = (nvars+1)*(nclasses-1); + offs = 5; + expoffs = offs+wdim; + 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 wdim; + ae_int_t ssize; + + _logitmodel_clear(lm); + + wdim = (nvars+1)*(nclasses-1); + 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 mlpeallerrors(mlpensemble* ensemble, + /* 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 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); + ae_vector_set_length(&workx, nin, _state); + ae_vector_set_length(&y, nout, _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++) + { + ae_v_move(&workx.ptr.p_double[0], 1, &xy->ptr.pp_double[i][0], 1, ae_v_len(0,nin-1)); + mlpeprocess(ensemble, &workx, &y, _state); + if( mlpissoftmax(&ensemble->network, _state) ) + { + dy.ptr.p_double[0] = xy->ptr.pp_double[i][nin]; + } + else + { + ae_v_move(&dy.ptr.p_double[0], 1, &xy->ptr.pp_double[i][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); +} + + +/************************************************************************* +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) +{ + double relcls; + double avgce; + double rms; + double avg; + double avgrel; + double result; + + + mlpeallerrors(ensemble, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); + result = relcls; + 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) +{ + double relcls; + double avgce; + double rms; + double avg; + double avgrel; + double result; + + + mlpeallerrors(ensemble, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); + result = avgce; + 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) +{ + double relcls; + double avgce; + double rms; + double avg; + double avgrel; + double result; + + + mlpeallerrors(ensemble, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); + result = rms; + 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) +{ + double relcls; + double avgce; + double rms; + double avg; + double avgrel; + double result; + + + mlpeallerrors(ensemble, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); + result = avg; + 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) +{ + double relcls; + double avgce; + double rms; + double avg; + double avgrel; + double result; + + + mlpeallerrors(ensemble, xy, npoints, &relcls, &avgce, &rms, &avg, &avgrel, _state); + result = avgrel; + 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 lmftol; + 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; + lmftol = 0.001; + 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. + + +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; + + 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); + + 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; + 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+ae_randominteger(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); + mlpcopy(network, &datacv.tnetwork, _state); + ae_vector_set_length(&datacv.subset, s->npoints, _state); + ae_vector_set_length(&datacv.xyrow, rowsize, _state); + ae_vector_set_length(&datacv.bufwbest, wcount, _state); + ae_vector_set_length(&datacv.bufwfinal, wcount, _state); + ae_vector_set_length(&datacv.y, nout, _state); + + /* + * Initialize LBFGS optimizer + */ + minlbfgscreate(wcount, ae_minint(wcount, s->lbfgsfactor, _state), &network->weights, &datacv.state, _state); + minlbfgssetcond(&datacv.state, 0.0, 0.0, s->wstep, s->maxits, _state); + minlbfgssetxrep(&datacv.state, ae_true, _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 = 10; + s->decay = 1.0E-6; + mlpsetcond(s, 0, 0, _state); + s->datatype = 0; + s->npoints = 0; +} + + +/************************************************************************* +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 = 10; + s->decay = 1.0E-6; + mlpsetcond(s, 0, 0, _state); + s->datatype = 0; + s->npoints = 0; +} + + +/************************************************************************* +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; + + + 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); + s->datatype = 1; + s->npoints = npoints; + if( npoints==0 ) + { + return; + } + 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); + } + } + } + } + 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 + iterations (NOT gradient calculations). 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. + + -- 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 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. + +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_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntype; + ae_int_t ttype; + + _mlpreport_clear(rep); + + 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); + rvectorsetlengthatleast(&s->wbest, wcount, _state); + rvectorsetlengthatleast(&s->wfinal, wcount, _state); + + /* + * Create LBFGS optimizer + */ + minlbfgscreate(wcount, ae_minint(wcount, s->lbfgsfactor, _state), &network->weights, &s->tstate, _state); + minlbfgssetcond(&s->tstate, 0.0, 0.0, s->wstep, s->maxits, _state); + minlbfgssetxrep(&s->tstate, ae_true, _state); + + /* + * Create duplicate of the network + */ + mlpcopy(network, &s->tnetwork, _state); + + /* + * Train + */ + mlptrain_mlptrainnetworkx(s, network, &s->tnetwork, &s->tstate, nrestarts, &s->subset, -1, &s->subset, 0, &s->wbest, &s->wfinal, 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); + + /* + * Create LBFGS optimizer + */ + minlbfgscreate(wcount, ae_minint(wcount, s->lbfgsfactor, _state), &network->weights, &s->tstate, _state); + minlbfgssetcond(&s->tstate, 0.0, 0.0, s->wstep, s->maxits, _state); + minlbfgssetxrep(&s->tstate, ae_true, _state); + + /* + * Create duplicate of the network + */ + mlpcopy(network, &s->tnetwork, _state); + + /* + * Train network + */ + mlptrain_mlpstarttrainingx(s, network, &s->tnetwork, &s->tstate, randomstart, &s->subset, -1, _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. + +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, network, &s->tnetwork, &s->tstate, &s->subset, -1, &s->ngradbatch, _state); + return result; +} + + +/************************************************************************* +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; + 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); + + 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; + } + 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). + +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: 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 pcount; + mlpreport tmprep; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t ntype; + ae_int_t ttype; + ae_int_t i; + ae_int_t k; + + ae_frame_make(_state, &_frame_block); + _mlpreport_clear(rep); + _mlpreport_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); + wcount = mlpgetweightscount(&ensemble->network, _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 + */ + if( mlpissoftmax(&ensemble->network, _state) ) + { + pcount = nin; + } + else + { + pcount = nin+nout; + } + ivectorsetlengthatleast(&s->subset, s->npoints, _state); + ivectorsetlengthatleast(&s->valsubset, s->npoints, _state); + rvectorsetlengthatleast(&s->wbest, wcount, _state); + rvectorsetlengthatleast(&s->wfinal, wcount, _state); + + /* + * Create LBFGS optimizer + */ + minlbfgscreate(wcount, ae_minint(wcount, s->lbfgsfactor, _state), &ensemble->network.weights, &s->tstate, _state); + minlbfgssetcond(&s->tstate, 0.0, 0.0, s->wstep, s->maxits, _state); + minlbfgssetxrep(&s->tstate, ae_true, _state); + mlpcopy(&ensemble->network, &s->tnetwork, _state); + + /* + * Train networks + */ + if( (s->datatype==0||s->datatype==1)&&s->npoints>1 ) + { + for(k=0; k<=ensemble->ensemblesize-1; k++) + { + + /* + * Split set + */ + do + { + s->subsetsize = 0; + s->valsubsetsize = 0; + for(i=0; i<=s->npoints-1; i++) + { + if( ae_fp_less(ae_randomreal(_state),0.66) ) + { + + /* + * Assign sample to training set + */ + s->subset.ptr.p_int[s->subsetsize] = i; + s->subsetsize = s->subsetsize+1; + } + else + { + + /* + * Assign sample to validation set + */ + s->valsubset.ptr.p_int[s->valsubsetsize] = i; + s->valsubsetsize = s->valsubsetsize+1; + } + } + } + while(!(s->subsetsize!=0&&s->valsubsetsize!=0)); + + /* + * Train + */ + mlptrain_mlptrainnetworkx(s, &ensemble->network, &s->tnetwork, &s->tstate, nrestarts, &s->subset, s->subsetsize, &s->valsubset, s->valsubsetsize, &s->wbest, &s->wfinal, &tmprep, _state); + rep->ngrad = rep->ngrad+tmprep.ngrad; + + /* + * 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)); + } + } + else + { + for(i=0; i<=ensemble->ensemblesize*wcount-1; i++) + { + ensemble->network.weights.ptr.p_double[i] = 0.0; + ensemble->columnmeans.ptr.p_double[i] = 0.0; + ensemble->columnsigmas.ptr.p_double[i] = 1.0; + } + } + + /* + * Calculate errors. + */ + if( s->datatype==0 ) + { + mlpeallerrors(ensemble, &s->densexy, s->npoints, &rep->relclserror, &rep->avgce, &rep->rmserror, &rep->avgerror, &rep->avgrelerror, _state); + } + if( s->datatype==1 ) + { + mlpeallerrorssparse(ensemble, &s->sparsexy, s->npoints, &rep->relclserror, &rep->avgce, &rep->rmserror, &rep->avgerror, &rep->avgrelerror, _state); + } + ae_frame_leave(_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_int_t i; + ae_int_t j; + ae_int_t k; + + ae_vector_clear(folds); + + + /* + * 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 + */ + 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+ae_randominteger(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; + } + } +} + + +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, &datacv->network, &datacv->tnetwork, &datacv->state, nrestarts, &datacv->subset, datacv->subsetsize, &datacv->subset, 0, &datacv->bufwbest, &datacv->bufwfinal, &datacv->rep, _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); +} + + +/************************************************************************* +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. + +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; + TNetwork - the training neural network. + User may look weights in parameter Network while + continue training process. + It has architecture like Network. You have to copy or + create new network with architecture like Network. + State - created LBFGS optimizer; + 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. + TrnSubset - some subset from training set(it stores row's numbers), + used as trainig set; + TrnSubsetSize- size of subset(if TrnSubsetSize<0 - used full dataset); + when TrnSubsetSize=0, network is filled by zero value, + and ValSubset parameter is IGNORED; + ValSubset - some subset from training set(it stores row's numbers), + used as validation set; + ValSubsetSize- size of subset(if ValSubsetSize<0 - used full dataset); + when ValSubsetSize<>0 this mean that is used early + stopping training algorithm; + BufWBest - buffer for storing interim resuls (BufWBest[0:WCOunt-1] + it has be allocated by user); + BufWFinal - buffer for storing interim resuls(BufWFinal[0:WCOunt-1] + it has be allocated by user). + +OUTPUT PARAMETERS: + Network - trained network; + Rep - training report. + +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 13.08.2012 by Bochkanov Sergey +*************************************************************************/ +static void mlptrain_mlptrainnetworkx(mlptrainer* s, + multilayerperceptron* network, + multilayerperceptron* tnetwork, + minlbfgsstate* state, + ae_int_t nrestarts, + /* Integer */ ae_vector* trnsubset, + ae_int_t trnsubsetsize, + /* Integer */ ae_vector* valsubset, + ae_int_t valsubsetsize, + /* Real */ ae_vector* bufwbest, + /* Real */ ae_vector* bufwfinal, + mlpreport* rep, + ae_state *_state) +{ + ae_frame _frame_block; + modelerrors modrep; + double eval; + double v; + double ebestcur; + double efinal; + ae_int_t ngradbatch; + ae_int_t nin; + ae_int_t nout; + ae_int_t wcount; + ae_int_t twcount; + ae_int_t itbest; + ae_int_t itcnt; + ae_int_t ntype; + ae_int_t ttype; + ae_bool rndstart; + ae_int_t pass; + ae_int_t i; + + ae_frame_make(_state, &_frame_block); + _mlpreport_clear(rep); + _modelerrors_init(&modrep, _state, ae_true); + + 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 resulting network is not similar to network type in trainer object", _state); + if( !mlpissoftmax(tnetwork, _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); + mlpproperties(network, &nin, &nout, &wcount, _state); + ae_assert(s->nin==nin, "MLPTrainNetworkX: internal error - number of inputs in trainer is not equal to number of inputs in the network.", _state); + ae_assert(s->nout==nout, "MLPTrainNetworkX: internal error - number of outputs in trainer is not equal to number of outputs in the network.", _state); + mlpproperties(tnetwork, &nin, &nout, &twcount, _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(twcount==wcount, "MLPTrainNetworkX: internal error - number of weights the resulting network is not equal to number of weights 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); + } + + /* + * 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; + if( ((s->datatype==0||s->datatype==1)&&s->npoints>0)&&trnsubsetsize!=0 ) + { + + /* + * Prepare + */ + efinal = ae_maxrealnumber; + if( nrestarts!=0 ) + { + rndstart = ae_true; + } + else + { + rndstart = ae_false; + nrestarts = 1; + } + ngradbatch = 0; + eval = 0; + ebestcur = 0; + for(pass=1; pass<=nrestarts; pass++) + { + mlptrain_mlpstarttrainingx(s, network, tnetwork, state, rndstart, trnsubset, trnsubsetsize, _state); + itbest = 0; + itcnt = 0; + if( s->datatype==0 ) + { + ebestcur = mlperrorsubset(network, &s->densexy, s->npoints, valsubset, valsubsetsize, _state); + } + if( s->datatype==1 ) + { + ebestcur = mlperrorsparsesubset(network, &s->sparsexy, s->npoints, valsubset, valsubsetsize, _state); + } + ae_v_move(&bufwbest->ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + while(mlptrain_mlpcontinuetrainingx(s, network, tnetwork, state, trnsubset, trnsubsetsize, &ngradbatch, _state)) + { + if( s->datatype==0 ) + { + eval = mlperrorsubset(network, &s->densexy, s->npoints, valsubset, valsubsetsize, _state); + } + if( s->datatype==1 ) + { + eval = mlperrorsparsesubset(network, &s->sparsexy, s->npoints, valsubset, valsubsetsize, _state); + } + if( ae_fp_less_eq(eval,ebestcur) ) + { + ae_v_move(&bufwbest->ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + ebestcur = eval; + itbest = itcnt; + } + if( itcnt>30&&ae_fp_greater(itcnt,1.5*itbest) ) + { + break; + } + itcnt = itcnt+1; + } + ae_v_move(&network->weights.ptr.p_double[0], 1, &bufwbest->ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + + /* + * Compare with final(the best) answer. + */ + v = ae_v_dotproduct(&bufwbest->ptr.p_double[0], 1, &bufwbest->ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + if( s->datatype==0 ) + { + ebestcur = mlperrorsubset(network, &s->densexy, s->npoints, trnsubset, trnsubsetsize, _state)+0.5*s->decay*v; + } + if( s->datatype==1 ) + { + ebestcur = mlperrorsparsesubset(network, &s->sparsexy, s->npoints, trnsubset, trnsubsetsize, _state)+0.5*s->decay*v; + } + if( ae_fp_less(ebestcur,efinal) ) + { + ae_v_move(&bufwfinal->ptr.p_double[0], 1, &bufwbest->ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + efinal = ebestcur; + } + } + + /* + * Final network + */ + ae_v_move(&network->weights.ptr.p_double[0], 1, &bufwfinal->ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + rep->ngrad = ngradbatch; + } + else + { + for(i=0; i<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = 0; + } + } + + /* + * 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; + 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. + +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 which receives A COPY of the actual + network which is trained by the algorithm. After each + training roung state of the network being trained is + copied to this variable. + It must have same number of inputs and output/classes + as was specified during creation of the trainer object + and it must have exactly same architecture as the + second network (TNetwork). + TNetwork - neural network being trained. + State - LBFGS optimizer, already initialized, number of + dimensions must be equal to number of weights in the + networks. + 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. + Subset - some subset from training set(it stores row's numbers); + SubsetSize - size of subset(if SubsetSize<0 - used full dataset). + +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 13.08.2012 by Bochkanov Sergey +*************************************************************************/ +static void mlptrain_mlpstarttrainingx(mlptrainer* s, + multilayerperceptron* network, + multilayerperceptron* tnetwork, + minlbfgsstate* state, + ae_bool randomstart, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + 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; + ae_int_t i; + + + ae_assert(s->npoints>=0, "MLPStartTrainingX: 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, "MLPStartTrainingX: internal error - type of the resulting network is not similar to network type in trainer object", _state); + if( !mlpissoftmax(tnetwork, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + ae_assert(ntype==ttype, "MLPStartTrainingX: internal error - type of the training network is not similar to network type in trainer object", _state); + mlpproperties(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); + mlpproperties(tnetwork, &nin, &nout, &twcount, _state); + ae_assert(s->nin==nin, "MLPStartTrainingX: number of inputs in trainer is not equal to number of inputs in the training network.", _state); + ae_assert(s->nout==nout, "MLPStartTrainingX: number of outputs in trainer is not equal to number of outputs in the training network.", _state); + ae_assert(twcount==wcount, "MLPStartTrainingX: number of weights the resulting network is not equal to number of weights in the training 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); + } + if( ((s->datatype==0||s->datatype==1)&&s->npoints>0)&&subsetsize!=0 ) + { + + /* + * Prepare + */ + if( s->datatype==0 ) + { + mlpinitpreprocessorsubset(network, &s->densexy, s->npoints, subset, subsetsize, _state); + mlpinitpreprocessorsubset(tnetwork, &s->densexy, s->npoints, subset, subsetsize, _state); + } + if( s->datatype==1 ) + { + mlpinitpreprocessorsparsesubset(network, &s->sparsexy, s->npoints, subset, subsetsize, _state); + mlpinitpreprocessorsparsesubset(tnetwork, &s->sparsexy, s->npoints, subset, subsetsize, _state); + } + + /* + * Process + */ + if( randomstart ) + { + mlprandomize(network, _state); + } + minlbfgsrestartfrom(state, &network->weights, _state); + } + else + { + for(i=0; i<=wcount-1; i++) + { + network->weights.ptr.p_double[i] = 0; + } + } + + /* + * Copy weights + */ + ae_v_move(&tnetwork->weights.ptr.p_double[0], 1, &network->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-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] + > + +INPUT PARAMETERS: + S - trainer object + Network - neural network which receives A COPY of the actual + network which is trained by the algorithm. After each + training roung state of the network being trained is + copied to this variable. + It must have same number of inputs and output/classes + as was specified during creation of the trainer object + and it must have exactly same architecture as the + second network (TNetwork). + TNetwork - neural network being trained. + State - LBFGS optimizer, already initialized, number of + dimensions must be equal to number of weights in the + networks. + Subset - some subset from training set(it stores row's numbers); + SubsetSize - size of subset(if SubsetSize<0 - used full dataset). + NGradBatch - number of calls MLPGradBatch function. Initial value + is zero; + +OUTPUT PARAMETERS: + Network - weights of the neural network are rewritten by the + current approximation; + NGradBatch - number of calls MLPGradBatch function after training. + +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 13.08.2012 by Bochkanov Sergey +*************************************************************************/ +static ae_bool mlptrain_mlpcontinuetrainingx(mlptrainer* s, + multilayerperceptron* network, + multilayerperceptron* tnetwork, + minlbfgsstate* state, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_int_t* ngradbatch, + 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_bool result; + + + 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(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); + if( !mlpissoftmax(tnetwork, _state) ) + { + ntype = 0; + } + else + { + ntype = 1; + } + ae_assert(ntype==ttype, "MLPContinueTrainingX: internal error - type of the training network is not similar to network type in trainer object.", _state); + mlpproperties(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); + mlpproperties(tnetwork, &nin, &nout, &twcount, _state); + ae_assert(s->nin==nin, "MLPContinueTrainingX: internal error - number of inputs in trainer is not equal to number of inputs in the training network.", _state); + ae_assert(s->nout==nout, "MLPContinueTrainingX: internal error - number of outputs in trainer is not equal to number of outputs in the training network.", _state); + ae_assert(twcount==wcount, "MLPContinueTrainingX: internal error - number of weights the resulting network is not equal to number of weights in the training 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); + } + if( ((s->datatype==0||s->datatype==1)&&s->npoints>0)&&subsetsize!=0 ) + { + decay = s->decay; + while(minlbfgsiteration(state, _state)) + { + if( state->xupdated ) + { + ae_v_move(&network->weights.ptr.p_double[0], 1, &tnetwork->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + result = ae_true; + return result; + } + ae_v_move(&tnetwork->weights.ptr.p_double[0], 1, &state->x.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + if( s->datatype==0 ) + { + mlpgradbatchsubset(tnetwork, &s->densexy, s->npoints, subset, subsetsize, &state->f, &state->g, _state); + } + if( s->datatype==1 ) + { + mlpgradbatchsparsesubset(tnetwork, &s->sparsexy, s->npoints, subset, subsetsize, &state->f, &state->g, _state); + } + + /* + * Increment number of operations performed on batch gradient + */ + *ngradbatch = *ngradbatch+1; + v = ae_v_dotproduct(&tnetwork->weights.ptr.p_double[0], 1, &tnetwork->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, &tnetwork->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1), decay); + } + ae_v_move(&network->weights.ptr.p_double[0], 1, &tnetwork->weights.ptr.p_double[0], 1, ae_v_len(0,wcount-1)); + } + result = ae_false; + 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; + + 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); + + 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 + */ + 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 = ae_randominteger(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); +} + + +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 _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( !_multilayerperceptron_init(&p->tnetwork, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsstate_init(&p->tstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->wbest, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->wfinal, 0, DT_REAL, _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( !_multilayerperceptron_init_copy(&dst->tnetwork, &src->tnetwork, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsstate_init_copy(&dst->tstate, &src->tstate, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->wbest, &src->wbest, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->wfinal, &src->wfinal, _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; + 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); + _multilayerperceptron_clear(&p->tnetwork); + _minlbfgsstate_clear(&p->tstate); + ae_vector_clear(&p->wbest); + ae_vector_clear(&p->wfinal); + 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); + _multilayerperceptron_destroy(&p->tnetwork); + _minlbfgsstate_destroy(&p->tstate); + ae_vector_destroy(&p->wbest); + ae_vector_destroy(&p->wfinal); + 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( !_multilayerperceptron_init(&p->tnetwork, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsstate_init(&p->state, _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_vector_init(&p->bufwbest, 0, DT_REAL, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init(&p->bufwfinal, 0, DT_REAL, _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( !_multilayerperceptron_init_copy(&dst->tnetwork, &src->tnetwork, _state, make_automatic) ) + return ae_false; + if( !_minlbfgsstate_init_copy(&dst->state, &src->state, _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_vector_init_copy(&dst->bufwbest, &src->bufwbest, _state, make_automatic) ) + return ae_false; + if( !ae_vector_init_copy(&dst->bufwfinal, &src->bufwfinal, _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); + _multilayerperceptron_clear(&p->tnetwork); + _minlbfgsstate_clear(&p->state); + _mlpreport_clear(&p->rep); + ae_vector_clear(&p->subset); + ae_vector_clear(&p->xyrow); + ae_vector_clear(&p->y); + ae_vector_clear(&p->bufwbest); + ae_vector_clear(&p->bufwfinal); +} + + +void _mlpparallelizationcv_destroy(void* _p) +{ + mlpparallelizationcv *p = (mlpparallelizationcv*)_p; + ae_touch_ptr((void*)p); + _multilayerperceptron_destroy(&p->network); + _multilayerperceptron_destroy(&p->tnetwork); + _minlbfgsstate_destroy(&p->state); + _mlpreport_destroy(&p->rep); + ae_vector_destroy(&p->subset); + ae_vector_destroy(&p->xyrow); + ae_vector_destroy(&p->y); + ae_vector_destroy(&p->bufwbest); + ae_vector_destroy(&p->bufwfinal); +} + + + + +/************************************************************************* +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/alg/dataanalysis.h b/alg/dataanalysis.h new file mode 100755 index 0000000..019d8f5 --- /dev/null +++ b/alg/dataanalysis.h @@ -0,0 +1,6349 @@ +/************************************************************************* +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 "specialfunctions.h" +#include "alglibmisc.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 +{ + 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_matrix chunks; + ae_vector nwbuf; + ae_vector integerbuf; +} multilayerperceptron; +typedef struct +{ + double relclserror; + double avgce; + double rmserror; + double avgerror; + double avgrelerror; +} modelerrors; +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_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; + multilayerperceptron tnetwork; + minlbfgsstate tstate; + ae_vector wbest; + ae_vector wfinal; + ae_int_t ngradbatch; + ae_vector subset; + ae_int_t subsetsize; + ae_vector valsubset; + ae_int_t valsubsetsize; +} mlptrainer; +typedef struct +{ + multilayerperceptron network; + multilayerperceptron tnetwork; + minlbfgsstate state; + mlpreport rep; + ae_vector subset; + ae_int_t subsetsize; + ae_vector xyrow; + ae_vector y; + ae_int_t ngrad; + ae_vector bufwbest; + ae_vector bufwfinal; +} 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; + +}; + + + + + +/************************************************************************* + +*************************************************************************/ +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(); + +}; + + +/************************************************************************* +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 _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 + +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); + + +/************************************************************************* +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 + +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); + + +/************************************************************************* +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. + +INPUT PARAMETERS: + Network - neural network; + XY - training set, see below for information on the + training set format; + SSize - 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 ssize); + + +/************************************************************************* +Error of the neural network on dataset given by sparse matrix. + +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); + + +/************************************************************************* +Natural error function for neural network, internal subroutine. + + -- 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 + + -- ALGLIB -- + Copyright 04.11.2007 by Bochkanov Sergey +*************************************************************************/ +ae_int_t mlpclserror(const multilayerperceptron &network, const real_2d_array &xy, const ae_int_t ssize); + + +/************************************************************************* +Relative classification error on the test set. + +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); + + +/************************************************************************* +Relative classification error on the test set given by sparse matrix. + +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: +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); + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set. + +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); + + +/************************************************************************* +Average cross-entropy (in bits per element) on the test set given by +sparse matrix. + +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); + + +/************************************************************************* +RMS error on the test set given. + +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); + + +/************************************************************************* +RMS error on the test set given by sparse matrix. + +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); + + +/************************************************************************* +Average error on the test set. + +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); + + +/************************************************************************* +Average error on the test set given by sparse matrix. + +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); + + +/************************************************************************* +Average relative error on the test set. + +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); + + +/************************************************************************* +Average relative error on the test set given by sparse matrix. + +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); + + +/************************************************************************* +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 + +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(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); + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs given by sparse +matrices + +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(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); + + +/************************************************************************* +Batch gradient calculation for a subset of dataset + +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. + 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 MLPGradBatch function. + + -- 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); + + +/************************************************************************* +Batch gradient calculation for a set of inputs/outputs for a subset of +dataset given by boolean mask. + +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. + 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. + 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); + + +/************************************************************************* +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. + +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); + + +/************************************************************************* +Calculation of all types of errors. + +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); + + +/************************************************************************* +Error of the neural network on dataset. + +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); + + +/************************************************************************* +Error of the neural network on dataset. + +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); + +/************************************************************************* +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. + + +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 + iterations (NOT gradient calculations). 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. + + -- ALGLIB -- + Copyright 23.07.2012 by Bochkanov Sergey +*************************************************************************/ +void mlpsetcond(const mlptrainer &s, const double wstep, const ae_int_t maxits); + + +/************************************************************************* +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. + +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); + + +/************************************************************************* +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. + +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); + + +/************************************************************************* +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). + +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: 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); + +/************************************************************************* +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 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 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); +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 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 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 ssize, + ae_state *_state); +double 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 ssize, + ae_state *_state); +double 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 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 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 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 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); +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 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 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 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 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 mlperrorsparsesubset(multilayerperceptron* network, + sparsematrix* xy, + ae_int_t setsize, + /* Integer */ ae_vector* subset, + ae_int_t subsetsize, + ae_state *_state); +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); +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); +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 mlpeallerrors(mlpensemble* ensemble, + /* Real */ ae_matrix* xy, + ae_int_t npoints, + double* relcls, + double* avgce, + double* rms, + double* avg, + double* avgrel, + 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 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); +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); +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 _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/alg/diffequations.cpp b/alg/diffequations.cpp new file mode 100755 index 0000000..268ecd0 --- /dev/null +++ b/alg/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/alg/diffequations.h b/alg/diffequations.h new file mode 100755 index 0000000..f288f9b --- /dev/null +++ b/alg/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/alg/fasttransforms.cpp b/alg/fasttransforms.cpp new file mode 100755 index 0000000..1f558e1 --- /dev/null +++ b/alg/fasttransforms.cpp @@ -0,0 +1,3556 @@ +/************************************************************************* +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; + ftplan plan; + ae_int_t i; + ae_vector buf; + + ae_frame_make(_state, &_frame_block); + _ftplan_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. + */ + ftbasegeneratecomplexfftplan(n, &plan, _state); + ftbaseexecuteplan(&buf, 0, n, &plan, _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; + ftplan plan; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(f); + ae_vector_init(&buf, 0, DT_REAL, _state, ae_true); + _ftplan_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)); + ftbasegeneratecomplexfftplan(n2, &plan, _state); + ftbaseexecuteplan(&buf, 0, n2, &plan, _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, + ftplan* 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)); + ftbaseexecuteplan(buf, 0, n2, plan, _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, + ftplan* 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); + ftbasegeneratecomplexfftplan(p, &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; + } + ftbaseexecuteplan(&buf, 0, p, &plan, _state); + ftbaseexecuteplan(&buf2, 0, p, &plan, _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; + } + ftbaseexecuteplan(&buf, 0, p, &plan, _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; + ftplan 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); + _ftplan_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 + */ + ftbasegeneratecomplexfftplan(m, &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; + } + ftbaseexecuteplan(&buf, 0, m, &plan, _state); + ftbaseexecuteplan(&buf2, 0, m, &plan, _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; + } + ftbaseexecuteplan(&buf, 0, m, &plan, _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); + ftbasegeneratecomplexfftplan(p/2, &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; + ftplan 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); + _ftplan_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); + ftbasegeneratecomplexfftplan(m/2, &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; + ftplan 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); + _ftplan_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 + */ + ftbasegeneratecomplexfftplan(m, &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; + } + ftbaseexecuteplan(&buf, 0, m, &plan, _state); + ftbaseexecuteplan(&buf2, 0, m, &plan, _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; + } + ftbaseexecuteplan(&buf, 0, m, &plan, _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); + ftbasegeneratecomplexfftplan(p, &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; + } + ftbaseexecuteplan(&buf, 0, p, &plan, _state); + ftbaseexecuteplan(&buf2, 0, p, &plan, _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; + } + ftbaseexecuteplan(&buf, 0, p, &plan, _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 + */ + ftbasegeneratecomplexfftplan(q+n-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; + } + ftbaseexecuteplan(&buf, 0, q+n-1, &plan, _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; + } + ftbaseexecuteplan(&buf, 0, q+n-1, &plan, _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; + ftplan plan; + ae_vector buf; + ae_vector buf2; + ae_vector buf3; + + ae_frame_make(_state, &_frame_block); + ae_vector_clear(r); + _ftplan_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); + ftbasegeneratecomplexfftplan(m/2, &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); + ftbasegeneratecomplexfftplan(p/2, &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); + ftbasegeneratecomplexfftplan((q+n-1)/2, &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; + ftplan plan; + ae_int_t i; + ae_vector fa; + + ae_frame_make(_state, &_frame_block); + _ftplan_init(&plan, _state, ae_true); + 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/alg/fasttransforms.h b/alg/fasttransforms.h new file mode 100755 index 0000000..60348a4 --- /dev/null +++ b/alg/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, + ftplan* plan, + ae_state *_state); +void fftr1dinvinternaleven(/* Real */ ae_vector* a, + ae_int_t n, + /* Real */ ae_vector* buf, + ftplan* 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/alg/integration.cpp b/alg/integration.cpp new file mode 100755 index 0000000..f35b744 --- /dev/null +++ b/alg/integration.cpp @@ -0,0 +1,3961 @@ +/************************************************************************* +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 "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/alg/integration.h b/alg/integration.h new file mode 100755 index 0000000..b0f25c3 --- /dev/null +++ b/alg/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/alg/interpolation.cpp b/alg/interpolation.cpp new file mode 100755 index 0000000..f570688 --- /dev/null +++ b/alg/interpolation.cpp @@ -0,0 +1,30499 @@ +/************************************************************************* +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>=5 + * 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>=5 + * 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. + +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. + + -- 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. + +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. + + -- 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. + +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. + + -- 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. + +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. + + -- 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. + +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. + + -- 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. + +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. + + -- 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. + +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. + + -- 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. + +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. + + -- 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. + + -- 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 nx; + 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 + */ + nx = z->nx; + 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 + */ + nx = z->nx; + 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 s0; + double s1; + 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; + s0 = y->ptr.p_double[i]; + s1 = d1->ptr.p_double[i]; + 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>=5 + * 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>=5, "Spline1DBuildAkima: N<5!", _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. + + -- 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. + + -- 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. + +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. + + -- 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. + + -- 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. + + -- 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]: + * for linear and nonlinear problems - scales of variables + 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_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; + + ae_frame_make(_state, &_frame_block); + _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); + } + } + rep->r2 = 1.0-rss/tss; + } + 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+1), _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); + } + 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/ae_sqr(s->ptr.p_double[i], _state); + } + 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. + */ + 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/ae_sqr(s->ptr.p_double[i], _state); + } + 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/alg/interpolation.h b/alg/interpolation.h new file mode 100755 index 0000000..f8c664c --- /dev/null +++ b/alg/interpolation.h @@ -0,0 +1,5862 @@ +/************************************************************************* +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>=5 + * 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. + +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. + + -- 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. + +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. + + -- 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. + +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. + + -- 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. + +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. + + -- 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. + + -- 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/alg/linalg.cpp b/alg/linalg.cpp new file mode 100755 index 0000000..a0850d1 --- /dev/null +++ b/alg/linalg.cpp @@ -0,0 +1,34328 @@ +/************************************************************************* +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); + } +} + +/************************************************************************* +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); + } +} + +/************************************************************************* +This subroutine calculates X*op(A^-1) where: +* X is MxN general matrix +* A is NxN upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + * 2 - conjugate transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, 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); + } +} + +/************************************************************************* +This subroutine calculates op(A^-1)*X where: +* X is MxN general matrix +* A is MxM upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + * 2 - conjugate transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, 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); + } +} + +/************************************************************************* +This subroutine calculates X*op(A^-1) where: +* X is MxN general matrix +* A is NxN upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, 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); + } +} + +/************************************************************************* +This subroutine calculates op(A^-1)*X where: +* X is MxN general matrix +* A is MxM upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, 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); + } +} + +/************************************************************************* +This subroutine calculates C=alpha*A*A^H+beta*C or C=alpha*A^H*A+beta*C +where: +* C is NxN Hermitian matrix given by its upper/lower triangle +* A is NxK matrix when A*A^H is calculated, KxN matrix otherwise + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + N - matrix size, N>=0 + K - matrix size, K>=0 + Alpha - coefficient + A - matrix + IA - submatrix offset + JA - submatrix offset + OpTypeA - multiplication type: + * 0 - A*A^H is calculated + * 2 - A^H*A is calculated + Beta - coefficient + C - matrix + IC - submatrix offset + JC - submatrix offset + IsUpper - whether C is upper triangular or lower triangular + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, 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); + } +} + +/************************************************************************* +This subroutine calculates C=alpha*A*A^T+beta*C or C=alpha*A^T*A+beta*C +where: +* C is NxN symmetric matrix given by its upper/lower triangle +* A is NxK matrix when A*A^T is calculated, KxN matrix otherwise + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + N - matrix size, N>=0 + K - matrix size, K>=0 + Alpha - coefficient + A - matrix + IA - submatrix offset + JA - submatrix offset + OpTypeA - multiplication type: + * 0 - A*A^T is calculated + * 2 - A^T*A is calculated + Beta - coefficient + C - matrix + IC - submatrix offset + JC - submatrix offset + IsUpper - whether C is upper triangular or lower triangular + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, 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); + } +} + +/************************************************************************* +This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where: +* C is MxN general matrix +* op1(A) is MxK matrix +* op2(B) is KxN matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + 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 - matrix + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, 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 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 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 ablas_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); +static void ablas_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); + + +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); + } + } +} + + +/************************************************************************* +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; + } +} + + +/************************************************************************* +This subroutine calculates X*op(A^-1) where: +* X is MxN general matrix +* A is NxN upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + * 2 - conjugate transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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); + } + 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; + } + } +} + + +/************************************************************************* +This subroutine calculates op(A^-1)*X where: +* X is MxN general matrix +* A is MxM upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + * 2 - conjugate transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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); + } + 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; + } + } +} + + +/************************************************************************* +This subroutine calculates X*op(A^-1) where: +* X is MxN general matrix +* A is NxN upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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); + } + 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; + } + } +} + + +/************************************************************************* +This subroutine calculates op(A^-1)*X where: +* X is MxN general matrix +* A is MxM upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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; + } + } +} + + +/************************************************************************* +This subroutine calculates C=alpha*A*A^H+beta*C or C=alpha*A^H*A+beta*C +where: +* C is NxN Hermitian matrix given by its upper/lower triangle +* A is NxK matrix when A*A^H is calculated, KxN matrix otherwise + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + N - matrix size, N>=0 + K - matrix size, K>=0 + Alpha - coefficient + A - matrix + IA - submatrix offset + JA - submatrix offset + OpTypeA - multiplication type: + * 0 - A*A^H is calculated + * 2 - A^H*A is calculated + Beta - coefficient + C - matrix + IC - submatrix offset + JC - submatrix offset + IsUpper - whether C is upper triangular or lower triangular + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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; + } + } +} + + +/************************************************************************* +This subroutine calculates C=alpha*A*A^T+beta*C or C=alpha*A^T*A+beta*C +where: +* C is NxN symmetric matrix given by its upper/lower triangle +* A is NxK matrix when A*A^T is calculated, KxN matrix otherwise + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + N - matrix size, N>=0 + K - matrix size, K>=0 + Alpha - coefficient + A - matrix + IA - submatrix offset + JA - submatrix offset + OpTypeA - multiplication type: + * 0 - A*A^T is calculated + * 2 - A^T*A is calculated + Beta - coefficient + C - matrix + IC - submatrix offset + JC - submatrix offset + IsUpper - whether C is upper triangular or lower triangular + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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); + if( n<=bs&&k<=bs ) + { + ablas_rmatrixsyrk2(n, k, alpha, a, ia, ja, optypea, beta, c, ic, jc, isupper, _state); + return; + } + 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; + } + } +} + + +/************************************************************************* +This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where: +* C is MxN general matrix +* op1(A) is MxK matrix +* op2(B) is KxN matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + 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 - matrix + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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 ) + { + ablas_cmatrixgemmk(m, n, k, alpha, a, ia, ja, optypea, b, ib, jb, optypeb, beta, c, ic, jc, _state); + return; + } + 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; + } + if( k>=m&&k>=n ) + { + + /* + * 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; + } +} + + +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); + + /* + * Use basecase code + */ + if( (m<=bs&&n<=bs)&&k<=bs ) + { + ablas_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 or equal to 4*BlockSize. + * Magnitude of K is not taken into account because splitting on K does not + * allow us to spawn child tasks. + */ + + /* + * Recursive algorithm + */ + 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; + } + if( k>=m&&k>=n ) + { + + /* + * 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*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; + } +} + + +/************************************************************************* +GEMM kernel + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +static void ablas_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; + + + + /* + * Special case + */ + if( m*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; + } + + /* + * Another special case + */ + if( k==0 ) + { + 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; + } + + /* + * General case + */ + if( optypea==0&&optypeb!=0 ) + { + + /* + * A*B' + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( k==0||ae_c_eq_d(alpha,0) ) + { + v = ae_complex_from_d(0); + } + else + { + if( optypeb==1 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+i][ja], 1, "N", &b->ptr.pp_complex[ib+j][jb], 1, "N", ae_v_len(ja,ja+k-1)); + } + else + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia+i][ja], 1, "N", &b->ptr.pp_complex[ib+j][jb], 1, "Conj", ae_v_len(ja,ja+k-1)); + } + } + if( ae_c_eq_d(beta,0) ) + { + c->ptr.pp_complex[ic+i][jc+j] = ae_c_mul(alpha,v); + } + else + { + c->ptr.pp_complex[ic+i][jc+j] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i][jc+j]),ae_c_mul(alpha,v)); + } + } + } + return; + } + if( optypea==0&&optypeb==0 ) + { + + /* + * A*B + */ + for(i=0; i<=m-1; i++) + { + if( ae_c_neq_d(beta,0) ) + { + ae_v_cmulc(&c->ptr.pp_complex[ic+i][jc], 1, ae_v_len(jc,jc+n-1), beta); + } + else + { + for(j=0; j<=n-1; j++) + { + c->ptr.pp_complex[ic+i][jc+j] = ae_complex_from_d(0); + } + } + if( ae_c_neq_d(alpha,0) ) + { + for(j=0; j<=k-1; j++) + { + v = ae_c_mul(alpha,a->ptr.pp_complex[ia+i][ja+j]); + ae_v_caddc(&c->ptr.pp_complex[ic+i][jc], 1, &b->ptr.pp_complex[ib+j][jb], 1, "N", ae_v_len(jc,jc+n-1), v); + } + } + } + return; + } + if( optypea!=0&&optypeb!=0 ) + { + + /* + * A'*B' + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( ae_c_eq_d(alpha,0) ) + { + v = ae_complex_from_d(0); + } + else + { + if( optypea==1 ) + { + if( optypeb==1 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+i], a->stride, "N", &b->ptr.pp_complex[ib+j][jb], 1, "N", ae_v_len(ia,ia+k-1)); + } + else + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+i], a->stride, "N", &b->ptr.pp_complex[ib+j][jb], 1, "Conj", ae_v_len(ia,ia+k-1)); + } + } + else + { + if( optypeb==1 ) + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+i], a->stride, "Conj", &b->ptr.pp_complex[ib+j][jb], 1, "N", ae_v_len(ia,ia+k-1)); + } + else + { + v = ae_v_cdotproduct(&a->ptr.pp_complex[ia][ja+i], a->stride, "Conj", &b->ptr.pp_complex[ib+j][jb], 1, "Conj", ae_v_len(ia,ia+k-1)); + } + } + } + if( ae_c_eq_d(beta,0) ) + { + c->ptr.pp_complex[ic+i][jc+j] = ae_c_mul(alpha,v); + } + else + { + c->ptr.pp_complex[ic+i][jc+j] = ae_c_add(ae_c_mul(beta,c->ptr.pp_complex[ic+i][jc+j]),ae_c_mul(alpha,v)); + } + } + } + return; + } + if( optypea!=0&&optypeb==0 ) + { + + /* + * A'*B + */ + if( ae_c_eq_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_complex_from_d(0); + } + } + } + else + { + for(i=0; i<=m-1; i++) + { + ae_v_cmulc(&c->ptr.pp_complex[ic+i][jc], 1, ae_v_len(jc,jc+n-1), beta); + } + } + if( ae_c_neq_d(alpha,0) ) + { + for(j=0; j<=k-1; j++) + { + for(i=0; i<=m-1; i++) + { + if( optypea==1 ) + { + v = ae_c_mul(alpha,a->ptr.pp_complex[ia+j][ja+i]); + } + else + { + v = ae_c_mul(alpha,ae_c_conj(a->ptr.pp_complex[ia+j][ja+i], _state)); + } + ae_v_caddc(&c->ptr.pp_complex[ic+i][jc], 1, &b->ptr.pp_complex[ib+j][jb], 1, "N", ae_v_len(jc,jc+n-1), v); + } + } + } + return; + } +} + + +/************************************************************************* +GEMM kernel + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +static void ablas_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; + double v; + + + + /* + * if matrix size is zero + */ + if( m*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 ) + { + 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; + } + + /* + * General case + */ + if( optypea==0&&optypeb!=0 ) + { + + /* + * A*B' + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( k==0||ae_fp_eq(alpha,0) ) + { + v = 0; + } + else + { + v = ae_v_dotproduct(&a->ptr.pp_double[ia+i][ja], 1, &b->ptr.pp_double[ib+j][jb], 1, ae_v_len(ja,ja+k-1)); + } + 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; + } + if( optypea==0&&optypeb==0 ) + { + + /* + * A*B + */ + for(i=0; i<=m-1; i++) + { + if( ae_fp_neq(beta,0) ) + { + ae_v_muld(&c->ptr.pp_double[ic+i][jc], 1, ae_v_len(jc,jc+n-1), beta); + } + else + { + for(j=0; j<=n-1; j++) + { + c->ptr.pp_double[ic+i][jc+j] = 0; + } + } + if( ae_fp_neq(alpha,0) ) + { + for(j=0; j<=k-1; j++) + { + v = alpha*a->ptr.pp_double[ia+i][ja+j]; + ae_v_addd(&c->ptr.pp_double[ic+i][jc], 1, &b->ptr.pp_double[ib+j][jb], 1, ae_v_len(jc,jc+n-1), v); + } + } + } + return; + } + if( optypea!=0&&optypeb!=0 ) + { + + /* + * A'*B' + */ + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + if( ae_fp_eq(alpha,0) ) + { + v = 0; + } + else + { + v = ae_v_dotproduct(&a->ptr.pp_double[ia][ja+i], a->stride, &b->ptr.pp_double[ib+j][jb], 1, ae_v_len(ia,ia+k-1)); + } + 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; + } + if( optypea!=0&&optypeb==0 ) + { + + /* + * A'*B + */ + if( ae_fp_eq(beta,0) ) + { + for(i=0; i<=m-1; i++) + { + for(j=0; j<=n-1; j++) + { + c->ptr.pp_double[ic+i][jc+j] = 0; + } + } + } + else + { + for(i=0; i<=m-1; i++) + { + ae_v_muld(&c->ptr.pp_double[ic+i][jc], 1, ae_v_len(jc,jc+n-1), beta); + } + } + if( ae_fp_neq(alpha,0) ) + { + for(j=0; j<=k-1; j++) + { + for(i=0; i<=m-1; i++) + { + v = alpha*a->ptr.pp_double[ia+j][ja+i]; + ae_v_addd(&c->ptr.pp_double[ic+i][jc], 1, &b->ptr.pp_double[ib+j][jb], 1, ae_v_len(jc,jc+n-1), 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; + ae_int_t minmn; + double tmp; + + + minmn = ae_minint(m, n, _state); + 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 minmn; + 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; + } + minmn = ae_minint(m, n, _state); + 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 sminlo; + 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 rightside; + 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; + rightside = ae_true; + 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; + } + sminlo = sminl; + 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; + } + sminlo = sminl; + 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 mm; + 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 ) + { + mm = l-m+1; + 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); + } + } + } + + /* + * 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 ovfl; + 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; + ovfl = 1/unfl; + 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_int_t i; + ae_int_t j; + double l1; + double l2; + + ae_matrix_clear(a); + + 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; + return; + } + 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(ae_randomreal(_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); +} + + +/************************************************************************* +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; + } + 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(ae_randomreal(_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_int_t i; + ae_int_t j; + double l1; + double l2; + + ae_matrix_clear(a); + + 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; + return; + } + + /* + * Prepare matrix + */ + 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*ae_randominteger(2, _state)-1)*ae_exp(ae_randomreal(_state)*(l2-l1)+l1, _state); + } + a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state); + + /* + * Multiply + */ + smatrixrndmultiply(a, n, _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_int_t i; + ae_int_t j; + double l1; + double l2; + + ae_matrix_clear(a); + + + /* + * Special cases + */ + if( n<=0||ae_fp_less(c,1) ) + { + return; + } + ae_matrix_set_length(a, n, n, _state); + if( n==1 ) + { + a->ptr.pp_double[0][0] = 1; + return; + } + + /* + * Prepare matrix + */ + 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(ae_randomreal(_state)*(l2-l1)+l1, _state); + } + a->ptr.pp_double[n-1][n-1] = ae_exp(l2, _state); + + /* + * Multiply + */ + smatrixrndmultiply(a, n, _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_int_t i; + ae_int_t j; + double l1; + double l2; + + ae_matrix_clear(a); + + 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); + return; + } + + /* + * Prepare matrix + */ + 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*ae_randominteger(2, _state)-1)*ae_exp(ae_randomreal(_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; + } +} + + +/************************************************************************* +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_int_t i; + ae_int_t j; + double l1; + double l2; + + ae_matrix_clear(a); + + + /* + * Special cases + */ + if( n<=0||ae_fp_less(c,1) ) + { + return; + } + ae_matrix_set_length(a, n, n, _state); + if( n==1 ) + { + a->ptr.pp_complex[0][0] = ae_complex_from_d(1); + return; + } + + /* + * Prepare matrix + */ + 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(ae_randomreal(_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; + } +} + + +/************************************************************************* +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*ae_randominteger(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*ae_randominteger(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*ae_randominteger(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_bool mupper; + ae_bool mtrans; + 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; + mtrans = 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); + 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 mtrans; + 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; + mtrans = 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/alg/linalg.h b/alg/linalg.h new file mode 100755 index 0000000..b9b2c1b --- /dev/null +++ b/alg/linalg.h @@ -0,0 +1,5280 @@ +/************************************************************************* +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); + + +/************************************************************************* +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); + + +/************************************************************************* +This subroutine calculates X*op(A^-1) where: +* X is MxN general matrix +* A is NxN upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + * 2 - conjugate transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); + + +/************************************************************************* +This subroutine calculates op(A^-1)*X where: +* X is MxN general matrix +* A is MxM upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + * 2 - conjugate transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, complex_2d_array &x, const ae_int_t i2, const ae_int_t j2); + + +/************************************************************************* +This subroutine calculates X*op(A^-1) where: +* X is MxN general matrix +* A is NxN upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+N-1,J1:J1+N-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, real_2d_array &x, const ae_int_t i2, const ae_int_t j2); + + +/************************************************************************* +This subroutine calculates op(A^-1)*X where: +* X is MxN general matrix +* A is MxM upper/lower triangular/unitriangular matrix +* "op" may be identity transformation, transposition + +Multiplication result replaces X. +Cache-oblivious algorithm is used. + +INPUT PARAMETERS + N - matrix size, N>=0 + M - matrix size, N>=0 + A - matrix, actial matrix is stored in A[I1:I1+M-1,J1:J1+M-1] + I1 - submatrix offset + J1 - submatrix offset + IsUpper - whether matrix is upper triangular + IsUnit - whether matrix is unitriangular + OpType - transformation type: + * 0 - no transformation + * 1 - transposition + X - matrix, actial matrix is stored in X[I2:I2+M-1,J2:J2+N-1] + I2 - submatrix offset + J2 - submatrix offset + + -- ALGLIB routine -- + 15.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, real_2d_array &x, const ae_int_t i2, const ae_int_t j2); + + +/************************************************************************* +This subroutine calculates C=alpha*A*A^H+beta*C or C=alpha*A^H*A+beta*C +where: +* C is NxN Hermitian matrix given by its upper/lower triangle +* A is NxK matrix when A*A^H is calculated, KxN matrix otherwise + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + N - matrix size, N>=0 + K - matrix size, K>=0 + Alpha - coefficient + A - matrix + IA - submatrix offset + JA - submatrix offset + OpTypeA - multiplication type: + * 0 - A*A^H is calculated + * 2 - A^H*A is calculated + Beta - coefficient + C - matrix + IC - submatrix offset + JC - submatrix offset + IsUpper - whether C is upper triangular or lower triangular + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, complex_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); + + +/************************************************************************* +This subroutine calculates C=alpha*A*A^T+beta*C or C=alpha*A^T*A+beta*C +where: +* C is NxN symmetric matrix given by its upper/lower triangle +* A is NxK matrix when A*A^T is calculated, KxN matrix otherwise + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + N - matrix size, N>=0 + K - matrix size, K>=0 + Alpha - coefficient + A - matrix + IA - submatrix offset + JA - submatrix offset + OpTypeA - multiplication type: + * 0 - A*A^T is calculated + * 2 - A^T*A is calculated + Beta - coefficient + C - matrix + IC - submatrix offset + JC - submatrix offset + IsUpper - whether C is upper triangular or lower triangular + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, real_2d_array &c, const ae_int_t ic, const ae_int_t jc, const bool isupper); + + +/************************************************************************* +This subroutine calculates C = alpha*op1(A)*op2(B) +beta*C where: +* C is MxN general matrix +* op1(A) is MxK matrix +* op2(B) is KxN matrix +* "op" may be identity transformation, transposition, conjugate transposition + +Additional info: +* cache-oblivious algorithm is used. +* multiplication result replaces C. If Beta=0, C elements are not used in + calculations (not multiplied by zero - just not referenced) +* if Alpha=0, A is not used (not multiplied by zero - just not referenced) +* if both Beta and Alpha are zero, C is filled by zeros. + +INPUT PARAMETERS + 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 - matrix + IC - submatrix offset + JC - submatrix offset + + -- ALGLIB routine -- + 16.12.2009 + Bochkanov Sergey +*************************************************************************/ +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, 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 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 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 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 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 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/alg/optimization.cpp b/alg/optimization.cpp new file mode 100755 index 0000000..f335582 --- /dev/null +++ b/alg/optimization.cpp @@ -0,0 +1,23977 @@ +/************************************************************************* +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 "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 - ste pvector, 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. + + -- 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 relative step is no more than EpsX. + * 4 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 +* -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 quadratic term for QP solver. + +By default quadratic term is zero. + +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 quadratic term for QP solver. + +By default quadratic term is zero. + +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 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 tells solver to use Cholesky-based algorithm. + +Cholesky-based algorithm can be used when: +* problem is convex +* there is no constraints or only boundary constraints are present + +This algorithm has O(N^3) complexity for unconstrained problem and is up +to several times slower on bound constrained problems (these additional +iterations are needed to identify active constraints). + +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 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 + 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. + + -- 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.0E6; +static double minbleic_initialdecay = 0.5; +static double minbleic_mindecay = 0.01; +static double minbleic_decaycorrection = 0.8; +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 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 maxgparuns; + 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; + maxgparuns = 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; + + /* + * 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. + */ + 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(). + +OUTPUT PARAMETERS: + S - current point and list of active constraints are changed. + + -- 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: + +1) first, it performs projection (orthogonal with respect to scale matrix + S) of X into current active set: X -> X1. + P1 is set to scaled norm of X-X1. +2) next, we perform projection with respect to ALL boundary constraints + which are violated at X1: X1 -> X2. + P2 is set to scaled norm of X2-X1. +3) X is replaced by X2, P1+P2 are returned in "Penalty" parameter. + +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; + double p1; + double p2; + + *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); + + /* + * 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]; + } + } + p1 = 0; + for(i=0; i<=n-1; i++) + { + p1 = p1+ae_sqr((state->corrtmp.ptr.p_double[i]-x->ptr.p_double[i])/state->s.ptr.p_double[i], _state); + } + + /* + * Perform projection 2 + */ + p2 = 0; + 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]; + } + p2 = p2+ae_sqr((state->corrtmp.ptr.p_double[i]-x->ptr.p_double[i])/state->s.ptr.p_double[i], _state); + } + *penalty = p1+p2; +} + + +/************************************************************************* +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 + + -- ALGLIB -- + Copyright 21.12.2012 by Bochkanov Sergey +*************************************************************************/ +void sasstopoptimization(sactiveset* state, ae_state *_state) +{ + + + ae_assert(state->algostate==1, "SASStopOptimization: already stopped", _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 - ste pvector, 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. + + -- 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 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 actstatus; + ae_int_t mcinfo; + 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]; + actstatus = state->rstate.ia.ptr.p_int[6]; + mcinfo = 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; + actstatus = 214; + mcinfo = -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; + } + + /* + * 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 = 5; + 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_40; + } + 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_42: + if( i>n-1 ) + { + goto lbl_44; + } + 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_42; +lbl_44: + state->needfg = ae_false; +lbl_40: + + /* + * Main cycle of BLEIC-PG algorithm + */ + state->repterminationtype = 4; + badbfgsits = 0; + state->lastgoodstep = 0; + state->lastscaledgoodstep = 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_45; + } + state->needfg = ae_true; + state->rstate.stage = 3; + goto lbl_rcomm; +lbl_3: + state->needfg = ae_false; + goto lbl_46; +lbl_45: + state->needf = ae_true; + state->rstate.stage = 4; + goto lbl_rcomm; +lbl_4: + state->needf = ae_false; +lbl_46: + state->fc = state->f; + trimprepare(state->f, &state->trimthreshold, _state); + state->repnfev = state->repnfev+1; + if( !state->xrep ) + { + goto lbl_47; + } + + /* + * 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_47: +lbl_49: + if( ae_false ) + { + goto lbl_50; + } + + /* + * Phase 1 + * + * (a) calculate unconstrained gradient + * (b) determine active set + */ + 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_51; + } + + /* + * Analytic gradient + */ + state->needfg = ae_true; + state->rstate.stage = 6; + goto lbl_rcomm; +lbl_6: + state->needfg = ae_false; + goto lbl_52; +lbl_51: + + /* + * Numerical differentiation + */ + state->needf = ae_true; + state->rstate.stage = 7; + goto lbl_rcomm; +lbl_7: + state->fbase = state->f; + i = 0; +lbl_53: + if( i>n-1 ) + { + goto lbl_55; + } + 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_56; + } + 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_57; +lbl_56: + 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_57: + state->x.ptr.p_double[i] = v; + i = i+1; + goto lbl_53; +lbl_55: + state->f = state->fbase; + state->needf = ae_false; +lbl_52: + 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); + + /* + * 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_58: + if( ae_false ) + { + goto lbl_59; + } + + /* + * 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_59; + } + + /* + * 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_58; + } + if( ae_fp_greater(state->stpmax,0) ) + { + state->curstpmax = ae_minreal(state->curstpmax, state->stpmax, _state); + } + + /* + * 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_60: + if( state->mcstage==0 ) + { + goto lbl_61; + } + + /* + * 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_62; + } + + /* + * Analytic gradient + */ + state->needfg = ae_true; + state->rstate.stage = 14; + goto lbl_rcomm; +lbl_14: + state->needfg = ae_false; + state->repnfev = state->repnfev+1; + goto lbl_63; +lbl_62: + + /* + * Numerical differentiation + */ + state->needf = ae_true; + state->rstate.stage = 15; + goto lbl_rcomm; +lbl_15: + state->fbase = state->f; + i = 0; +lbl_64: + if( i>n-1 ) + { + goto lbl_66; + } + 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_67; + } + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 16; + goto lbl_rcomm; +lbl_16: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 17; + goto lbl_rcomm; +lbl_17: + state->fm1 = 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->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 19; + goto lbl_rcomm; +lbl_19: + 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_68; +lbl_67: + 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 = 20; + goto lbl_rcomm; +lbl_20: + state->fm1 = state->f; + state->x.ptr.p_double[i] = state->xp1; + state->rstate.stage = 21; + goto lbl_rcomm; +lbl_21: + 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_68: + state->x.ptr.p_double[i] = v; + i = i+1; + goto lbl_64; +lbl_66: + state->f = state->fbase; + state->needf = ae_false; +lbl_63: + + /* + * Back to MCSRCH + * + * NOTE: penalty term from correction is added to FN in order + * to penalize increase in infeasibility. + */ + state->fn = state->f+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_60; +lbl_61: + + /* + * 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*ae_machineepsilon))&&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_59; + } + } + + /* + * 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_69; + } + 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 = 22; + goto lbl_rcomm; +lbl_22: + state->xupdated = ae_false; +lbl_69: + + /* + * 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_59; + } + 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_59; + } + } + if( state->maxits>0&&state->repinneriterationscount>=state->maxits ) + { + + /* + * Required number of iterations was performed + */ + state->repterminationtype = 5; + nextaction = 0; + goto lbl_59; + } + + /* + * 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_58; + } + if( actstatus<0 ) + { + nextaction = 1; + } + else + { + nextaction = -1; + } + goto lbl_59; + goto lbl_58; +lbl_59: + if( nextaction<0 ) + { + goto lbl_49; + } + if( nextaction==0 ) + { + goto lbl_50; + } + + /* + * 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_71; + } + + /* + * Analytic gradient + */ + state->needfg = ae_true; + state->rstate.stage = 23; + goto lbl_rcomm; +lbl_23: + state->needfg = ae_false; + state->repnfev = state->repnfev+1; + goto lbl_72; +lbl_71: + + /* + * Numerical differentiation + */ + state->needf = ae_true; + state->rstate.stage = 24; + goto lbl_rcomm; +lbl_24: + state->fbase = state->f; + i = 0; +lbl_73: + if( i>n-1 ) + { + goto lbl_75; + } + 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_76; + } + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 25; + goto lbl_rcomm; +lbl_25: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 26; + goto lbl_rcomm; +lbl_26: + state->fm1 = 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->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 28; + goto lbl_rcomm; +lbl_28: + 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_77; +lbl_76: + 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 = 29; + goto lbl_rcomm; +lbl_29: + state->fm1 = state->f; + state->x.ptr.p_double[i] = state->xp1; + state->rstate.stage = 30; + goto lbl_rcomm; +lbl_30: + 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_77: + state->x.ptr.p_double[i] = v; + i = i+1; + goto lbl_73; +lbl_75: + state->f = state->fbase; + state->needf = ae_false; +lbl_72: + 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 = ae_v_dotproduct(&state->gc.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + ginit = ae_sqrt(ginit, _state); + state->k = 0; +lbl_78: + if( state->k>n ) + { + goto lbl_79; + } + + /* + * 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_79; + } + 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); + } + } + + /* + * 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_80: + if( state->mcstage==0 ) + { + goto lbl_81; + } + + /* + * 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_82; + } + + /* + * Analytic gradient + */ + state->needfg = ae_true; + state->rstate.stage = 31; + goto lbl_rcomm; +lbl_31: + state->needfg = ae_false; + state->repnfev = state->repnfev+1; + goto lbl_83; +lbl_82: + + /* + * Numerical differentiation + */ + state->needf = ae_true; + state->rstate.stage = 32; + goto lbl_rcomm; +lbl_32: + state->fbase = state->f; + i = 0; +lbl_84: + if( i>n-1 ) + { + goto lbl_86; + } + 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_87; + } + state->x.ptr.p_double[i] = v-state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 33; + goto lbl_rcomm; +lbl_33: + state->fm2 = state->f; + state->x.ptr.p_double[i] = v-0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 34; + goto lbl_rcomm; +lbl_34: + state->fm1 = state->f; + state->x.ptr.p_double[i] = v+0.5*state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 35; + goto lbl_rcomm; +lbl_35: + state->fp1 = state->f; + state->x.ptr.p_double[i] = v+state->diffstep*state->s.ptr.p_double[i]; + state->rstate.stage = 36; + goto lbl_rcomm; +lbl_36: + 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_88; +lbl_87: + 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 = 37; + goto lbl_rcomm; +lbl_37: + state->fm1 = state->f; + state->x.ptr.p_double[i] = state->xp1; + state->rstate.stage = 38; + goto lbl_rcomm; +lbl_38: + 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_88: + state->x.ptr.p_double[i] = v; + i = i+1; + goto lbl_84; +lbl_86: + state->f = state->fbase; + state->needf = ae_false; +lbl_83: + + /* + * Back to MCSRCH + * + * NOTE: penalty term from correction is added to FN in order + * to penalize increase in infeasibility. + */ + state->fn = state->f+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_80; +lbl_81: + 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_79; + } + + /* + * 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_89; + } + 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 = 39; + goto lbl_rcomm; +lbl_39: + state->xupdated = ae_false; +lbl_89: + 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) gradient decreased below GDecay + */ + if( actstatus>=0 ) + { + goto lbl_79; + } + v = ae_v_dotproduct(&state->gc.ptr.p_double[0], 1, &state->gc.ptr.p_double[0], 1, ae_v_len(0,n-1)); + if( ae_fp_less(ae_sqrt(v, _state),gdecay*ginit) ) + { + goto lbl_79; + } + + /* + * 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_79; + } + 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_78; +lbl_79: + + /* + * Decrease decay coefficient. Subsequent L-BFGS stages will + * have more stringent stopping criteria. + */ + gdecay = ae_maxreal(gdecay*minbleic_decaycorrection, minbleic_mindecay, _state); + goto lbl_49; +lbl_50: + 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] = actstatus; + state->rstate.ia.ptr.p_int[7] = mcinfo; + 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 relative step is no more than EpsX. + * 4 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); +} + + +/************************************************************************* +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; +} + + +/************************************************************************* +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); + 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->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->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; + 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; + 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); +} + + +/************************************************************************* +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(x->cnt>=n, "MinQPSetStartingPoint: Length(B)n; + ae_assert(xorigin->cnt>=n, "MinQPSetOrigin: Length(B)algokind = 1; +} + + +/************************************************************************* +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; + + + 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; + } + } + + /* + * 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; + } + + /* + * modify starting point XS according to boundary constraints + */ + 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; + } + } + + /* + * Select algo + */ + if( state->algokind==1 ) + { + + /* + * Cholesky-based algorithm for dense bound constrained problems. + * + * This algorithm exists in two variants: + * * unconstrained one, which can solve problem using only one NxN + * double matrix + * * bound constrained one, which needs two NxN matrices + * + * We will try to solve problem using unconstrained algorithm, + * and will use bound constrained version only when constraints + * are actually present + */ + if( nbc==0&&state->nec+state->nic==0 ) + { + + /* + * "Simple" unconstrained version + */ + 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; + } + 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 BLEIC-QP algorithm + */ + state->repterminationtype = 4; + badnewtonits = 0; + for(;;) + { + + /* + * Update iterations count + */ + state->repinneriterationscount = state->repinneriterationscount+1; + + /* + * Phase 1: determine active set + */ + 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); + + /* + * 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 + */ + 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; + + /* + * 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); + 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)||ae_fp_greater_eq(d1,0) ) + { + 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); + 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: Newton method. + * + * NOTE: this phase 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; + } + } + state->repouteriterationscount = 1; + 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; + } +} + + +/************************************************************************* +QP solver results + +INPUT PARAMETERS: + State - algorithm state + +OUTPUT PARAMETERS: + X - array[0..N-1], solution + 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. + + -- 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; + 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( !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( !_normestimatorstate_init(&p->estimator, _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; + if( !_convexquadraticmodel_init_copy(&dst->a, &src->a, _state, make_automatic) ) + return ae_false; + 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; + 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( !_normestimatorstate_init_copy(&dst->estimator, &src->estimator, _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); + 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); + _normestimatorstate_clear(&p->estimator); +} + + +void _minqpstate_destroy(void* _p) +{ + minqpstate *p = (minqpstate*)_p; + ae_touch_ptr((void*)p); + _convexquadraticmodel_destroy(&p->a); + 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); + _normestimatorstate_destroy(&p->estimator); +} + + +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); +} + + + + +ae_bool _linfeassolver_init(void* _p, ae_state *_state, ae_bool make_automatic) +{ + linfeassolver *p = (linfeassolver*)_p; + ae_touch_ptr((void*)p); + return ae_true; +} + + +ae_bool _linfeassolver_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic) +{ + linfeassolver *dst = (linfeassolver*)_dst; + linfeassolver *src = (linfeassolver*)_src; + dst->debugflops = src->debugflops; + return ae_true; +} + + +void _linfeassolver_clear(void* _p) +{ + linfeassolver *p = (linfeassolver*)_p; + ae_touch_ptr((void*)p); +} + + +void _linfeassolver_destroy(void* _p) +{ + linfeassolver *p = (linfeassolver*)_p; + ae_touch_ptr((void*)p); +} + + + +} + diff --git a/alg/optimization.h b/alg/optimization.h new file mode 100755 index 0000000..b457173 --- /dev/null +++ b/alg/optimization.h @@ -0,0 +1,4150 @@ +/************************************************************************* +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; + 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; + 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; + 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; + convexquadraticmodel a; + 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; + 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; + normestimatorstate estimator; +} 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; +typedef struct +{ + double debugflops; +} linfeassolver; + +} + +///////////////////////////////////////////////////////////////////////// +// +// 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 +* -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 - ste pvector, 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. + + -- 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 relative step is no more than EpsX. + * 4 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 quadratic term for QP solver. + +By default quadratic term is zero. + +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 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 tells solver to use Cholesky-based algorithm. + +Cholesky-based algorithm can be used when: +* problem is convex +* there is no constraints or only boundary constraints are present + +This algorithm has O(N^3) complexity for unconstrained problem and is up +to several times slower on bound constrained problems (these additional +iterations are needed to identify active constraints). + +INPUT PARAMETERS: + State - structure which stores algorithm state + + -- ALGLIB -- + Copyright 11.01.2011 by Bochkanov Sergey +*************************************************************************/ +void minqpsetalgocholesky(const minqpstate &state); + + +/************************************************************************* +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 + 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. + + -- 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 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 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 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 minqpsetstartingpoint(minqpstate* state, + /* Real */ ae_vector* x, + ae_state *_state); +void minqpsetorigin(minqpstate* state, + /* Real */ ae_vector* xorigin, + ae_state *_state); +void minqpsetalgocholesky(minqpstate* state, 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); +ae_bool _linfeassolver_init(void* _p, ae_state *_state, ae_bool make_automatic); +ae_bool _linfeassolver_init_copy(void* _dst, void* _src, ae_state *_state, ae_bool make_automatic); +void _linfeassolver_clear(void* _p); +void _linfeassolver_destroy(void* _p); + +} +#endif + diff --git a/alg/solvers.cpp b/alg/solvers.cpp new file mode 100755 index 0000000..6a02b4c --- /dev/null +++ b/alg/solvers.cpp @@ -0,0 +1,8713 @@ +/************************************************************************* +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 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 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: +* 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 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 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: +* 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/alg/solvers.h b/alg/solvers.h new file mode 100755 index 0000000..2c66242 --- /dev/null +++ b/alg/solvers.h @@ -0,0 +1,2018 @@ +/************************************************************************* +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 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 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: +* 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/alg/specialfunctions.cpp b/alg/specialfunctions.cpp new file mode 100755 index 0000000..bd786b6 --- /dev/null +++ b/alg/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/alg/specialfunctions.h b/alg/specialfunctions.h new file mode 100755 index 0000000..167aed3 --- /dev/null +++ b/alg/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/alg/statistics.cpp b/alg/statistics.cpp new file mode 100755 index 0000000..81705ab --- /dev/null +++ b/alg/statistics.cpp @@ -0,0 +1,18486 @@ +/************************************************************************* +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 + +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); + } +} + +/************************************************************************* +Covariance matrix + +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); + } +} + +/************************************************************************* +Pearson product-moment correlation matrix + +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); + } +} + +/************************************************************************* +Pearson product-moment correlation matrix + +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); + } +} + +/************************************************************************* +Spearman's rank correlation matrix + +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); + } +} + +/************************************************************************* +Spearman's rank correlation matrix + +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); + } +} + +/************************************************************************* +Cross-covariance matrix + +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); + } +} + +/************************************************************************* +Cross-covariance matrix + +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); + } +} + +/************************************************************************* +Pearson product-moment cross-correlation matrix + +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); + } +} + +/************************************************************************* +Pearson product-moment cross-correlation matrix + +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); + } +} + +/************************************************************************* +Spearman's rank cross-correlation matrix + +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); + } +} + +/************************************************************************* +Spearman's rank cross-correlation matrix + +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); + } +} + +/************************************************************************* +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. + 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. + + -- 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. + + -- 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. +Dispersion equality 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. + + -- 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 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); + + /* + * force symmetricity + */ + for(i=0; i<=m-2; i++) + { + ae_v_move(&c->ptr.pp_double[i+1][i], c->stride, &c->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,m-1)); + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Pearson product-moment correlation matrix + +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; + + 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], _state); + } + for(i=0; i<=m-1; i++) + { + for(j=0; j<=m-1; j++) + { + if( ae_fp_neq(t.ptr.p_double[i],0)&&ae_fp_neq(t.ptr.p_double[j],0) ) + { + c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]/(t.ptr.p_double[i]*t.ptr.p_double[j]); + } + else + { + c->ptr.pp_double[i][j] = 0.0; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Spearman's rank correlation matrix + +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_matrix _x; + ae_int_t i; + ae_int_t j; + apbuffers buf; + ae_vector t; + double v; + 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); + _apbuffers_init(&buf, _state, ae_true); + 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, "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_vector_set_length(&x0, m, _state); + ae_vector_set_length(&same, m, _state); + ae_matrix_set_length(c, m, m, _state); + + /* + * Replace data with ranks + */ + for(j=0; j<=m-1; j++) + { + ae_v_move(&t.ptr.p_double[0], 1, &x->ptr.pp_double[0][j], x->stride, ae_v_len(0,n-1)); + rankx(&t, n, &buf, _state); + ae_v_move(&x->ptr.pp_double[0][j], x->stride, &t.ptr.p_double[0], 1, ae_v_len(0,n-1)); + } + + /* + * Calculate means, + * check for constant columns + */ + 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 + * artificialy zeroed (they must be zero in exact arithmetics, + * but unfortunately floating point is 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); + + /* + * force symmetricity + */ + for(i=0; i<=m-2; i++) + { + ae_v_move(&c->ptr.pp_double[i+1][i], c->stride, &c->ptr.pp_double[i][i+1], 1, ae_v_len(i+1,m-1)); + } + + /* + * Calculate Pearson coefficients + */ + for(i=0; i<=m-1; i++) + { + t.ptr.p_double[i] = ae_sqrt(c->ptr.pp_double[i][i], _state); + } + for(i=0; i<=m-1; i++) + { + for(j=0; j<=m-1; j++) + { + if( ae_fp_neq(t.ptr.p_double[i],0)&&ae_fp_neq(t.ptr.p_double[j],0) ) + { + c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]/(t.ptr.p_double[i]*t.ptr.p_double[j]); + } + else + { + c->ptr.pp_double[i][j] = 0.0; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Cross-covariance matrix + +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); +} + + +/************************************************************************* +Pearson product-moment cross-correlation matrix + +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++) + { + for(j=0; j<=m2-1; j++) + { + if( ae_fp_neq(sx.ptr.p_double[i],0)&&ae_fp_neq(sy.ptr.p_double[j],0) ) + { + c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]/(sx.ptr.p_double[i]*sy.ptr.p_double[j]); + } + else + { + c->ptr.pp_double[i][j] = 0; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Spearman's rank cross-correlation matrix + +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_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; + apbuffers buf; + + 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); + _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(&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); + + /* + * Replace data with ranks + */ + for(j=0; j<=m1-1; j++) + { + ae_v_move(&t.ptr.p_double[0], 1, &x->ptr.pp_double[0][j], x->stride, ae_v_len(0,n-1)); + rankx(&t, n, &buf, _state); + ae_v_move(&x->ptr.pp_double[0][j], x->stride, &t.ptr.p_double[0], 1, ae_v_len(0,n-1)); + } + for(j=0; j<=m2-1; j++) + { + ae_v_move(&t.ptr.p_double[0], 1, &y->ptr.pp_double[0][j], y->stride, ae_v_len(0,n-1)); + rankx(&t, n, &buf, _state); + ae_v_move(&y->ptr.pp_double[0][j], y->stride, &t.ptr.p_double[0], 1, ae_v_len(0,n-1)); + } + + /* + * * 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++) + { + for(j=0; j<=m2-1; j++) + { + if( ae_fp_neq(sx.ptr.p_double[i],0)&&ae_fp_neq(sy.ptr.p_double[j],0) ) + { + c->ptr.pp_double[i][j] = c->ptr.pp_double[i][j]/(sx.ptr.p_double[i]*sy.ptr.p_double[j]); + } + else + { + c->ptr.pp_double[i][j] = 0; + } + } + } + ae_frame_leave(_state); +} + + +/************************************************************************* +Obsolete function, we recommend to use PearsonCorr2(). + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double pearsoncorrelation(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state) +{ + double result; + + + result = pearsoncorr2(x, y, n, _state); + return result; +} + + +/************************************************************************* +Obsolete function, we recommend to use SpearmanCorr2(). + + -- ALGLIB -- + Copyright 09.04.2007 by Bochkanov Sergey +*************************************************************************/ +double spearmanrankcorrelation(/* Real */ ae_vector* x, + /* Real */ ae_vector* y, + ae_int_t n, + ae_state *_state) +{ + double result; + + + result = spearmancorr2(x, y, n, _state); + return result; +} + + + + +/************************************************************************* +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 = 0.0; + *lefttail = 0.0; + *righttail = 0.0; + return; + } + *bothtails = 2*binomialdistribution(ae_minint(gtcnt, necnt-gtcnt, _state), necnt, 0.5, _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. + 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. + + -- 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 xvariance; + double xstddev; + double v1; + double v2; + double stat; + double s; + + *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 (using corrected two-pass algorithm) + */ + xvariance = 0; + xstddev = 0; + if( n!=1 ) + { + 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. + + -- 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; + double xmean; + double ymean; + double stat; + double s; + double p; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + if( n<=1||m<=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; + ymean = 0; + for(i=0; i<=m-1; i++) + { + ymean = ymean+y->ptr.p_double[i]; + } + ymean = ymean/m; + + /* + * S + */ + s = 0; + 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. +Dispersion equality 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. + + -- 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; + double xmean; + double ymean; + double xvar; + double yvar; + double df; + double p; + double stat; + double c; + + *bothtails = 0; + *lefttail = 0; + *righttail = 0; + + if( n<=1||m<=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; + 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 + */ + 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/alg/statistics.h b/alg/statistics.h new file mode 100755 index 0000000..54fd487 --- /dev/null +++ b/alg/statistics.h @@ -0,0 +1,1098 @@ +/************************************************************************* +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 + +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 covm(const real_2d_array &x, real_2d_array &c); + + +/************************************************************************* +Pearson product-moment correlation matrix + +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 pearsoncorrm(const real_2d_array &x, real_2d_array &c); + + +/************************************************************************* +Spearman's rank correlation matrix + +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 spearmancorrm(const real_2d_array &x, real_2d_array &c); + + +/************************************************************************* +Cross-covariance matrix + +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 covm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); + + +/************************************************************************* +Pearson product-moment cross-correlation matrix + +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 pearsoncorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); + + +/************************************************************************* +Spearman's rank cross-correlation matrix + +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 spearmancorrm2(const real_2d_array &x, const real_2d_array &y, real_2d_array &c); + + +/************************************************************************* +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. + 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. + + -- 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. + + -- 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. +Dispersion equality 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. + + -- 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 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 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 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); +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/alg/stdafx.h b/alg/stdafx.h new file mode 100755 index 0000000..99a8091 --- /dev/null +++ b/alg/stdafx.h @@ -0,0 +1,2 @@ + + diff --git a/bpp.sh b/bpp.sh new file mode 100755 index 0000000..67b5f93 --- /dev/null +++ b/bpp.sh @@ -0,0 +1,8 @@ +#!/bin/bash +# +date +# build-number++ +file="build-number" +bn=`cat $file` +echo $[bn+1] > $file + diff --git a/cmake_modules/FindGCMS.cmake b/cmake_modules/FindGCMS.cmake new file mode 100644 index 0000000..84da0f4 --- /dev/null +++ b/cmake_modules/FindGCMS.cmake @@ -0,0 +1,42 @@ +INCLUDE(LibFindMacros) + +# Include dir +FIND_PATH(GCMS_INCLUDE_DIR + NAMES compound.h + PATHS /usr/include/gcms /usr/local/include/gcms +) +FIND_PATH(andims_INCLUDE_DIR + NAMES ms10.h + PATHS /usr/include/andi-ms /usr/local/include/andims +) + +# Finally the library itself +FIND_LIBRARY(GCMS_LIBRARY + NAMES gcmslib + PATHS /usr/local/lib /usr/lib +) +FIND_LIBRARY(andims_LIBRARY + NAMES andims + PATHS /usr/lib /usr/local/lib +) + +# Set the include dir variables and the libraries and let libfind_process do the rest. +# NOTE: Singular variables for this library, plural for libraries this this lib depends on. +set(GCMS_PROCESS_INCLUDES GCMS_INCLUDE_DIR andims_INCLUDE_DIR) +set(GCMS_PROCESS_LIBS GCMS_LIBRARY andims_LIBRARY) +libfind_process(GCMS) + +IF (GCMS_INCLUDE_DIR AND GCMS_LIBRARY) + SET(GCMS_FOUND TRUE) +ENDIF (GCMS_INCLUDE_DIR AND GCMS_LIBRARY) + + +IF (GCMS_FOUND) + IF (NOT GCMS_FIND_QUIETLY) + MESSAGE(STATUS "Found GCMS: ${GCMS_LIBRARY}") + ENDIF (NOT GCMS_FIND_QUIETLY) +ELSE (GCMS_FOUND) + IF (GCMS_FIND_REQUIRED) + MESSAGE(FATAL_ERROR "Could not find GCMS") + ENDIF (GCMS_FIND_REQUIRED) +ENDIF (GCMS_FOUND) diff --git a/cmake_modules/FindGSL.cmake b/cmake_modules/FindGSL.cmake new file mode 100644 index 0000000..fa506ab --- /dev/null +++ b/cmake_modules/FindGSL.cmake @@ -0,0 +1,178 @@ +# Try to find gnu scientific library GSL +# See +# http://www.gnu.org/software/gsl/ and +# http://gnuwin32.sourceforge.net/packages/gsl.htm +# +# Once run this will define: +# +# GSL_FOUND = system has GSL lib +# +# GSL_LIBRARIES = full path to the libraries +# on Unix/Linux with additional linker flags from "gsl-config --libs" +# +# CMAKE_GSL_CXX_FLAGS = Unix compiler flags for GSL, essentially "`gsl-config --cxxflags`" +# +# GSL_INCLUDE_DIR = where to find headers +# +# GSL_LINK_DIRECTORIES = link directories, useful for rpath on Unix +# GSL_EXE_LINKER_FLAGS = rpath on Unix +# +# Felix Woelk 07/2004 +# Jan Woetzel +# +# www.mip.informatik.uni-kiel.de +# -------------------------------- + +IF(WIN32) +# JW tested with gsl-1.8, Windows XP, MSVS 7.1, MSVS 8.0 + SET(GSL_POSSIBLE_ROOT_DIRS + ${GSL_ROOT_DIR} + $ENV{GSL_ROOT_DIR} + ${GSL_DIR} + ${GSL_HOME} + $ENV{GSL_DIR} + $ENV{GSL_HOME} + $ENV{EXTERN_LIBS_DIR}/gsl + $ENV{EXTRA} +# "C:/home/jw/source2/gsl-1.8" + ) + FIND_PATH(GSL_INCLUDE_DIR + NAMES gsl/gsl_cdf.h gsl/gsl_randist.h + PATHS ${GSL_POSSIBLE_ROOT_DIRS} + PATH_SUFFIXES include + DOC "GSL header include dir" + ) + + FIND_LIBRARY(GSL_GSL_LIBRARY + NAMES gsl libgsl + PATHS ${GSL_POSSIBLE_ROOT_DIRS} + PATH_SUFFIXES lib + DOC "GSL library dir" ) + + FIND_LIBRARY(GSL_GSLCBLAS_LIBRARY + NAMES gslcblas libgslcblas + PATHS ${GSL_POSSIBLE_ROOT_DIRS} + PATH_SUFFIXES lib + DOC "GSL cblas library dir" ) + + SET(GSL_LIBRARIES ${GSL_GSL_LIBRARY} ${GSL_GSLCBLAS_LIBRARY}) + +#MESSAGE("DBG\n" +# "GSL_GSL_LIBRARY=${GSL_GSL_LIBRARY}\n" +# "GSL_GSLCBLAS_LIBRARY=${GSL_GSLCBLAS_LIBRARY}\n" +# "GSL_LIBRARIES=${GSL_LIBRARIES}") + + +ELSE(WIN32) + + IF(UNIX) + SET(GSL_CONFIG_PREFER_PATH + "$ENV{GSL_DIR}/bin" + "$ENV{GSL_DIR}" + "$ENV{GSL_HOME}/bin" + "$ENV{GSL_HOME}" + CACHE STRING "preferred path to GSL (gsl-config)") + FIND_PROGRAM(GSL_CONFIG gsl-config + ${GSL_CONFIG_PREFER_PATH} + /usr/bin/ + ) +# MESSAGE("DBG GSL_CONFIG ${GSL_CONFIG}") + + IF (GSL_CONFIG) + + MESSAGE(STATUS "GSL using gsl-config ${GSL_CONFIG}") +# set CXXFLAGS to be fed into CXX_FLAGS by the user: + EXEC_PROGRAM(${GSL_CONFIG} + ARGS --cflags + OUTPUT_VARIABLE GSL_CXX_FLAGS ) +#SET(GSL_CXX_FLAGS "`${GSL_CONFIG} --cflags`") + +# set INCLUDE_DIRS to prefix+include + EXEC_PROGRAM(${GSL_CONFIG} + ARGS --prefix + OUTPUT_VARIABLE GSL_PREFIX) + SET(GSL_INCLUDE_DIR ${GSL_PREFIX}/include CACHE STRING INTERNAL) + +# set link libraries and link flags + +#SET(GSL_LIBRARIES "`${GSL_CONFIG} --libs`") + +# extract link dirs for rpath + EXEC_PROGRAM(${GSL_CONFIG} + ARGS --libs + OUTPUT_VARIABLE GSL_CONFIG_LIBS ) + SET(GSL_LIBRARIES "${GSL_CONFIG_LIBS}") + +# split off the link dirs (for rpath) +# use regular expression to match wildcard equivalent "-L*" +# with is a space or a semicolon + STRING(REGEX MATCHALL "[-][L]([^ ;])+" + GSL_LINK_DIRECTORIES_WITH_PREFIX + "${GSL_CONFIG_LIBS}" ) +# MESSAGE("DBG GSL_LINK_DIRECTORIES_WITH_PREFIX=${GSL_LINK_DIRECTORIES_WITH_PREFIX}") + +# remove prefix -L because we need the pure directory for LINK_DIRECTORIES + + IF (GSL_LINK_DIRECTORIES_WITH_PREFIX) + STRING(REGEX REPLACE "[-][L]" "" GSL_LINK_DIRECTORIES ${GSL_LINK_DIRECTORIES_WITH_PREFIX} ) + ENDIF (GSL_LINK_DIRECTORIES_WITH_PREFIX) + SET(GSL_EXE_LINKER_FLAGS "-Wl,-rpath,${GSL_LINK_DIRECTORIES}" CACHE STRING INTERNAL) +# MESSAGE("DBG GSL_LINK_DIRECTORIES=${GSL_LINK_DIRECTORIES}") +# MESSAGE("DBG GSL_EXE_LINKER_FLAGS=${GSL_EXE_LINKER_FLAGS}") + +# ADD_DEFINITIONS("-DHAVE_GSL") +# SET(GSL_DEFINITIONS "-DHAVE_GSL") + MARK_AS_ADVANCED( + GSL_CXX_FLAGS + GSL_INCLUDE_DIR + GSL_LIBRARIES + GSL_LINK_DIRECTORIES + GSL_DEFINITIONS + ) + MESSAGE(STATUS "Using GSL from ${GSL_PREFIX}") + + ELSE(GSL_CONFIG) + + INCLUDE(UsePkgConfig) #needed for PKGCONFIG(...) + + MESSAGE(STATUS "GSL using pkgconfig") +# PKGCONFIG(gsl includedir libdir linkflags cflags) + PKGCONFIG(gsl GSL_INCLUDE_DIR GSL_LINK_DIRECTORIES GSL_LIBRARIES GSL_CXX_FLAGS) + IF(GSL_INCLUDE_DIR) + MARK_AS_ADVANCED( + GSL_CXX_FLAGS + GSL_INCLUDE_DIR + GSL_LIBRARIES + GSL_LINK_DIRECTORIES + ) + + ELSE(GSL_INCLUDE_DIR) + MESSAGE("FindGSL.cmake: gsl-config/pkg-config gsl not found. Please set it manually. GSL_CONFIG=${GSL_CONFIG}") + ENDIF(GSL_INCLUDE_DIR) + + ENDIF(GSL_CONFIG) + + ENDIF(UNIX) +ENDIF(WIN32) + + +IF(GSL_LIBRARIES) + IF(GSL_INCLUDE_DIR OR GSL_CXX_FLAGS) + + SET(GSL_FOUND 1) + + ENDIF(GSL_INCLUDE_DIR OR GSL_CXX_FLAGS) +ENDIF(GSL_LIBRARIES) + + +# ========================================== +IF(NOT GSL_FOUND) +# make FIND_PACKAGE friendly + IF(NOT GSL_FIND_QUIETLY) + IF(GSL_FIND_REQUIRED) + MESSAGE(FATAL_ERROR "GSL required, please specify it's location.") + ELSE(GSL_FIND_REQUIRED) + MESSAGE(STATUS "ERROR: GSL was not found.") + ENDIF(GSL_FIND_REQUIRED) + ENDIF(NOT GSL_FIND_QUIETLY) +ENDIF(NOT GSL_FOUND) \ No newline at end of file diff --git a/cmake_modules/FindGraphViz.cmake b/cmake_modules/FindGraphViz.cmake new file mode 100644 index 0000000..a3bd41d --- /dev/null +++ b/cmake_modules/FindGraphViz.cmake @@ -0,0 +1,32 @@ +include(LibFindMacros) + +# Include dir +find_path(GraphViz_INCLUDE_DIR + NAMES gvc.h + PATHS /usr/local/include/graphviz/ /usr/include/graphviz/ +) + +# Library +#find_library(GraphViz_graph_LIBRARY +# NAMES libgraph.so +# PATHS /usr/local/lib /usr/lib +#) +find_library(GraphViz_gvc_LIBRARY + NAMES libgvc.so + PATHS /usr/local/lib /usr/lib +) +find_library(GraphViz_cgraph_LIBRARY + NAMES libcgraph.so + PATHS /usr/local/lib /usr/lib +) +find_library(GraphViz_cdt_LIBRARY + NAMES libcdt.so + PATHS /usr/local/lib /usr/lib +) + + +# Set the include dir variables and the libraries and let libfind_process do the rest. +# NOTE: Singular variables for this library, plural for libraries this this lib depends on. +set(GraphViz_PROCESS_INCLUDES GraphViz_INCLUDE_DIR) +set(GraphViz_PROCESS_LIBS GraphViz_gvc_LIBRARY GraphViz_cdt_LIBRARY GraphViz_cgraph_LIBRARY) +libfind_process(GraphViz) diff --git a/cmake_modules/FindInChi.cmake b/cmake_modules/FindInChi.cmake new file mode 100644 index 0000000..f9adc92 --- /dev/null +++ b/cmake_modules/FindInChi.cmake @@ -0,0 +1,31 @@ +INCLUDE(LibFindMacros) + +FIND_PATH(InChi_INCLUDE_DIR + NAMES inchi_api.h + PATHS /home/dweindl/software/Inchi/1.04/INCHI-1-API/INCHI_API/inchi_dll/ +) + +FIND_LIBRARY(InChi_LIBRARY + NAMES libinchi.so.1 + PATHS /home/dweindl/software/Inchi/1.04/INCHI-1-API/INCHI_API/gcc_so_makefile/result/ +) + +set(InChi_PROCESS_INCLUDES InChi_INCLUDE_DIR ) +set(InChi_PROCESS_LIBS InChi_LIBRARY ) +libfind_process(InChi) + + +IF (InChi_INCLUDE_DIR AND InChi_LIBRARY) + SET(InChi_FOUND TRUE) +ENDIF (InChi_INCLUDE_DIR AND InChi_LIBRARY) + +IF (InChi_FOUND) + IF (NOT InChi_FIND_QUIETLY) + MESSAGE(STATUS "Found InChi: ${InChi_INCLUDE_DIR}") + MESSAGE(STATUS "Found InChi: ${InChi_LIBRARY}") + ENDIF (NOT InChi_FIND_QUIETLY) +ELSE (InChi_FOUND) + IF (InChi_FIND_REQUIRED) + MESSAGE(FATAL_ERROR "Could not find InChi") + ENDIF (InChi_FIND_REQUIRED) +ENDIF (InChi_FOUND) diff --git a/cmake_modules/FindLabId.cmake b/cmake_modules/FindLabId.cmake new file mode 100644 index 0000000..1187bf4 --- /dev/null +++ b/cmake_modules/FindLabId.cmake @@ -0,0 +1,30 @@ +INCLUDE(LibFindMacros) + +FIND_PATH(LabId_INCLUDE_DIR + NAMES labeledcompound.h + PATHS ~/src/labid/src +) + +FIND_LIBRARY(LabId_LIBRARY + NAMES liblabid.a + PATHS ~/src/labid/build/src +) + +set(LabId_PROCESS_INCLUDES LabId_INCLUDE_DIR ) +set(LabId_PROCESS_LIBS LabId_LIBRARY ) +libfind_process(LabId) + +IF (LabId_INCLUDE_DIR AND LabId_LIBRARY) + SET(LabId_FOUND TRUE) +ENDIF (LabId_INCLUDE_DIR AND LabId_LIBRARY) + +IF (LabId_FOUND) + IF (NOT LabId_FIND_QUIETLY) + MESSAGE(STATUS "Found LabId: ${LabId_INCLUDE_DIR}") + MESSAGE(STATUS "Found LabId: ${LabId_LIBRARY}") + ENDIF (NOT LabId_FIND_QUIETLY) +ELSE (LabId_FOUND) + IF (LabId_FIND_REQUIRED) + MESSAGE(FATAL_ERROR "Could not find LabId") + ENDIF (LabId_FIND_REQUIRED) +ENDIF (LabId_FOUND) diff --git a/cmake_modules/FindMD.cmake b/cmake_modules/FindMD.cmake new file mode 100644 index 0000000..2c096a3 --- /dev/null +++ b/cmake_modules/FindMD.cmake @@ -0,0 +1,19 @@ +INCLUDE(LibFindMacros) + +# Include dir +FIND_PATH(MD_INCLUDE_DIR + NAMES chromatogramplot.h + PATHS /usr/include/metabolitedetector /usr/local/include/metabolitedetector ~/src/metabolitedetector/src/ +) + +# Finally the library itself +FIND_LIBRARY(MD_LIBRARY + NAMES metabolitedetector + PATHS /usr/lib /usr/local/lib ~/src/metabolitedetector/build/src +) + +# Set the include dir variables and the libraries and let libfind_process do the rest. +# NOTE: Singular variables for this library, plural for libraries this this lib depends on. +set(MD_PROCESS_INCLUDES MD_INCLUDE_DIR) +set(MD_PROCESS_LIBS MD_LIBRARY) +libfind_process(MD) diff --git a/cmake_modules/FindNetCDF.cmake b/cmake_modules/FindNetCDF.cmake new file mode 100644 index 0000000..d1427bd --- /dev/null +++ b/cmake_modules/FindNetCDF.cmake @@ -0,0 +1,18 @@ +FIND_PATH(NetCDF_INCLUDE_DIR netcdf.h /usr/include/ /usr/local/include/) + +FIND_LIBRARY(NetCDF_LIBRARY NAMES netcdf PATHS /usr/lib /usr/local/lib) + +IF (NetCDF_INCLUDE_DIR AND NetCDF_LIBRARY) + SET(NetCDF_FOUND TRUE) +ENDIF (NetCDF_INCLUDE_DIR AND NetCDF_LIBRARY) + + +IF (NetCDF_FOUND) + IF (NOT NetCDF_FIND_QUIETLY) + MESSAGE(STATUS "Found NetCDF: ${NetCDF_LIBRARY}") + ENDIF (NOT NetCDF_FIND_QUIETLY) +ELSE (NetCDF_FOUND) + IF (NetCDF_FIND_REQUIRED) + MESSAGE(FATAL_ERROR "Could not find NetCDF") + ENDIF (NetCDF_FIND_REQUIRED) +ENDIF (NetCDF_FOUND) diff --git a/cmake_modules/FindPQ.cmake b/cmake_modules/FindPQ.cmake new file mode 100644 index 0000000..b29386c --- /dev/null +++ b/cmake_modules/FindPQ.cmake @@ -0,0 +1,37 @@ +# - Find PostgreSQL library + # + # This module defines: + # POSTGRESQL_FOUND - True if the package is found + # POSTGRESQL_INCLUDE_DIR - containing libpq-fe.h + # POSTGRESQL_LIBRARIES - Libraries to link to use PQ functions. + + if (POSTGRESQL_INCLUDE_DIR AND POSTGRESQL_LIBRARIES) + set(POSTGRESQL_FIND_QUIETLY TRUE) + endif (POSTGRESQL_INCLUDE_DIR AND POSTGRESQL_LIBRARIES) + + # Include dir + find_path(POSTGRESQL_INCLUDE_DIR + NAMES libpq-fe.h + PATH_SUFFIXES pgsql postgresql + ) + + # Library + find_library(POSTGRESQL_LIBRARY + NAMES pq + ) + + # handle the QUIETLY and REQUIRED arguments and set POSTGRESQL_FOUND to TRUE if + # all listed variables are TRUE + INCLUDE(FindPackageHandleStandardArgs) + FIND_PACKAGE_HANDLE_STANDARD_ARGS(POSTGRESQL DEFAULT_MSG POSTGRESQL_LIBRARY POSTGRESQL_INCLUDE_DIR) + + IF(POSTGRESQL_FOUND) + SET( POSTGRESQL_LIBRARIES ${POSTGRESQL_LIBRARY} ) + SET (POSTGRESQL_INCLUDE_DIR ${POSTGRESQL_INCLUDE_DIR}) + ELSE(POSTGRESQL_FOUND) + SET( POSTGRESQL_LIBRARIES ) + ENDIF(POSTGRESQL_FOUND) + + # Lastly make it so that the POSTGRESQL_LIBRARY and POSTGRESQL_INCLUDE_DIR variables + # only show up under the advanced options in the gui cmake applications. + MARK_AS_ADVANCED( POSTGRESQL_LIBRARY POSTGRESQL_INCLUDE_DIR ) diff --git a/cmake_modules/FindQWT.cmake b/cmake_modules/FindQWT.cmake new file mode 100644 index 0000000..453805f --- /dev/null +++ b/cmake_modules/FindQWT.cmake @@ -0,0 +1,40 @@ +# Find Qwt + +# Once run this will define: +# +# QWT_FOUND = system has QWT lib +# +# QWT_LIBRARY = full path to the QWT library +# +# QWT_INCLUDE_DIR = where to find headers +# + +FIND_PATH(QWT_INCLUDE_DIR qwt.h + PATHS /usr/local/qwt-6.1.0-rc3/include/ "$ENV{LIB_DIR}/include" "$ENV{LIB_DIR}/include/qwt" + ) + +FIND_LIBRARY(QWT_LIBRARY qwt + PATHS /usr/local/qwt-6.1.0-rc3/lib/ ) + +IF (NOT QWT_LIBRARY) + #try using ubuntu lib naming + FIND_LIBRARY(QWT_LIBRARY 222 PATHS + /usr/local/qwt-5.2.2/lib + ) +ENDIF (NOT QWT_LIBRARY) + +IF (QWT_INCLUDE_DIR AND QWT_LIBRARY) + SET(QWT_FOUND TRUE) +ENDIF (QWT_INCLUDE_DIR AND QWT_LIBRARY) + +IF (QWT_FOUND) + IF (NOT QWT_FIND_QUIETLY) + MESSAGE(STATUS "Found QWT: ${QWT_LIBRARY}") + MESSAGE(STATUS "Found QWT: ${QWT_INCLUDE_DIR}") + ENDIF (NOT QWT_FIND_QUIETLY) +ELSE (QWT_FOUND) +MESSAGE(FATAL_ERROR "QWT not found") + IF (QWT_FIND_REQUIRED) + MESSAGE(FATAL_ERROR "Could not find QWT") + ENDIF (QWT_FIND_REQUIRED) +ENDIF (QWT_FOUND) diff --git a/cmake_modules/LibFindMacros.cmake b/cmake_modules/LibFindMacros.cmake new file mode 100644 index 0000000..69975c5 --- /dev/null +++ b/cmake_modules/LibFindMacros.cmake @@ -0,0 +1,99 @@ +# Works the same as find_package, but forwards the "REQUIRED" and "QUIET" arguments +# used for the current package. For this to work, the first parameter must be the +# prefix of the current package, then the prefix of the new package etc, which are +# passed to find_package. +macro (libfind_package PREFIX) + set (LIBFIND_PACKAGE_ARGS ${ARGN}) + if (${PREFIX}_FIND_QUIETLY) + set (LIBFIND_PACKAGE_ARGS ${LIBFIND_PACKAGE_ARGS} QUIET) + endif (${PREFIX}_FIND_QUIETLY) + if (${PREFIX}_FIND_REQUIRED) + set (LIBFIND_PACKAGE_ARGS ${LIBFIND_PACKAGE_ARGS} REQUIRED) + endif (${PREFIX}_FIND_REQUIRED) + find_package(${LIBFIND_PACKAGE_ARGS}) +endmacro (libfind_package) + +# CMake developers made the UsePkgConfig system deprecated in the same release (2.6) +# where they added pkg_check_modules. Consequently I need to support both in my scripts +# to avoid those deprecated warnings. Here's a helper that does just that. +# Works identically to pkg_check_modules, except that no checks are needed prior to use. +macro (libfind_pkg_check_modules PREFIX PKGNAME) + if (${CMAKE_MAJOR_VERSION} EQUAL 2 AND ${CMAKE_MINOR_VERSION} EQUAL 4) + include(UsePkgConfig) + pkgconfig(${PKGNAME} ${PREFIX}_INCLUDE_DIRS ${PREFIX}_LIBRARY_DIRS ${PREFIX}_LDFLAGS ${PREFIX}_CFLAGS) + else (${CMAKE_MAJOR_VERSION} EQUAL 2 AND ${CMAKE_MINOR_VERSION} EQUAL 4) + find_package(PkgConfig) + if (PKG_CONFIG_FOUND) + pkg_check_modules(${PREFIX} ${PKGNAME}) + endif (PKG_CONFIG_FOUND) + endif (${CMAKE_MAJOR_VERSION} EQUAL 2 AND ${CMAKE_MINOR_VERSION} EQUAL 4) +endmacro (libfind_pkg_check_modules) + +# Do the final processing once the paths have been detected. +# If include dirs are needed, ${PREFIX}_PROCESS_INCLUDES should be set to contain +# all the variables, each of which contain one include directory. +# Ditto for ${PREFIX}_PROCESS_LIBS and library files. +# Will set ${PREFIX}_FOUND, ${PREFIX}_INCLUDE_DIRS and ${PREFIX}_LIBRARIES. +# Also handles errors in case library detection was required, etc. +macro (libfind_process PREFIX) + # Skip processing if already processed during this run + if (NOT ${PREFIX}_FOUND) + # Start with the assumption that the library was found + set (${PREFIX}_FOUND TRUE) + + # Process all includes and set _FOUND to false if any are missing + foreach (i ${${PREFIX}_PROCESS_INCLUDES}) + if (${i}) + set (${PREFIX}_INCLUDE_DIRS ${${PREFIX}_INCLUDE_DIRS} ${${i}}) + mark_as_advanced(${i}) + else (${i}) + set (${PREFIX}_FOUND FALSE) + endif (${i}) + endforeach (i) + + # Process all libraries and set _FOUND to false if any are missing + foreach (i ${${PREFIX}_PROCESS_LIBS}) + if (${i}) + set (${PREFIX}_LIBRARIES ${${PREFIX}_LIBRARIES} ${${i}}) + mark_as_advanced(${i}) + else (${i}) + set (${PREFIX}_FOUND FALSE) + endif (${i}) + endforeach (i) + + # Print message and/or exit on fatal error + if (${PREFIX}_FOUND) + if (NOT ${PREFIX}_FIND_QUIETLY) + message (STATUS "Found ${PREFIX} ${${PREFIX}_VERSION}") + endif (NOT ${PREFIX}_FIND_QUIETLY) + else (${PREFIX}_FOUND) + if (${PREFIX}_FIND_REQUIRED) + foreach (i ${${PREFIX}_PROCESS_INCLUDES} ${${PREFIX}_PROCESS_LIBS}) + message("${i}=${${i}}") + endforeach (i) + message (FATAL_ERROR "Required library ${PREFIX} NOT FOUND.\nInstall the library (dev version) and try again. If the library is already installed, use ccmake to set the missing variables manually.") + endif (${PREFIX}_FIND_REQUIRED) + endif (${PREFIX}_FOUND) + endif (NOT ${PREFIX}_FOUND) +endmacro (libfind_process) + +macro(libfind_library PREFIX basename) + set(TMP "") + if(MSVC80) + set(TMP -vc80) + endif(MSVC80) + if(MSVC90) + set(TMP -vc90) + endif(MSVC90) + set(${PREFIX}_LIBNAMES ${basename}${TMP}) + if(${ARGC} GREATER 2) + set(${PREFIX}_LIBNAMES ${basename}${TMP}-${ARGV2}) + string(REGEX REPLACE "\\." "_" TMP ${${PREFIX}_LIBNAMES}) + set(${PREFIX}_LIBNAMES ${${PREFIX}_LIBNAMES} ${TMP}) + endif(${ARGC} GREATER 2) + find_library(${PREFIX}_LIBRARY + NAMES ${${PREFIX}_LIBNAMES} + PATHS ${${PREFIX}_PKGCONF_LIBRARY_DIRS} + ) +endmacro(libfind_library) + diff --git a/deb/changelog b/deb/changelog new file mode 100644 index 0000000..4988be4 --- /dev/null +++ b/deb/changelog @@ -0,0 +1,5 @@ +mia (0.1-0) UNRELEASED; urgency=medium + + * Initial release. (Closes: #000000) + + -- Daniel Weindl Mon, 27 Apr 2015 20:35:07 +0200 diff --git a/deb/copyright b/deb/copyright new file mode 100644 index 0000000..713ca8c --- /dev/null +++ b/deb/copyright @@ -0,0 +1,9 @@ +Format: http://www.debian.org/doc/packaging-manuals/copyright-format/1.0/ +Upstream-Name: mia +Upstream-Contact: Daniel Weindl +Source: http://massisotopolomeanalyzer.lu/ + +Files: * +Copyright: 2012-2015 Daniel Weindl +License: GPL-3 + /usr/share/common-licenses/GPL-3 diff --git a/deb/mia-gui.1 b/deb/mia-gui.1 new file mode 100644 index 0000000..41cc7b9 --- /dev/null +++ b/deb/mia-gui.1 @@ -0,0 +1,24 @@ +.\"Created with GNOME Manpages Editor Wizard +.\"http://sourceforge.net/projects/gmanedit2 +.TH mia-gui 1 "April 27, 2015" "" "Mass Isotopolome Analyzer" + +.SH NAME +mia-gui \- program for non-targeted mass isotopolome analysis + +.SH SYNOPSIS +.B mia-gui +.RI [ options ] +.br + +.SH DESCRIPTION +This manual page explains the +.B mia-gui +program. This program... +.PP +\fBmia-gui\fP is for... + +.SH OPTIONS +.B +.IP -OPTION +This option... + diff --git a/deb/mia.desktop b/deb/mia.desktop new file mode 100644 index 0000000..7a7d192 --- /dev/null +++ b/deb/mia.desktop @@ -0,0 +1,9 @@ +[Desktop Entry] +Type=Application +Encoding=UTF-8 +Name=MIA +Comment=Mass Isotopolome Analyzer +Exec=mia-gui +Icon=mia +Terminal=false +Categories=Science;Biology diff --git a/doc/doc.kilepr b/doc/doc.kilepr new file mode 100644 index 0000000..319268d --- /dev/null +++ b/doc/doc.kilepr @@ -0,0 +1,96 @@ +[General] +def_graphic_ext=eps +img_extIsRegExp=false +img_extensions=.eps .jpg .jpeg .png .pdf .ps .fig .gif +kileprversion=2 +kileversion=2.1.3 +lastDocument= +masterDocument= +name=doc +pkg_extIsRegExp=false +pkg_extensions=.cls .sty .bbx .cbx .lbx +src_extIsRegExp=false +src_extensions=.tex .ltx .latex .dtx .ins + +[Tools] +MakeIndex= +QuickBuild= + +[document-settings,item:mia-doc.tex] +Bookmarks= +Encoding=UTF-8 +Highlighting=LaTeX +Indentation Mode=normal +Mode=LaTeX + +[document-settings,item:nwrecon-doc.bib] +Bookmarks= +Encoding=UTF-8 +Highlighting=BibTeX +Indentation Mode=normal +Mode=BibTeX + +[document-settings,item:nwrecon-doc.tex] +Bookmarks= +Encoding=UTF-8 +Highlighting=LaTeX +Indentation Mode=normal +Mode=LaTeX + +[item:doc.kilepr] +archive=true +column=6684777 +encoding= +highlight= +line=0 +mode= +open=false +order=-1 + +[item:mia-doc.tex] +archive=true +column=22 +encoding=UTF-8 +highlight=LaTeX +line=9 +mode=LaTeX +open=false +order=0 + +[item:nwrecon-doc.bib] +archive=true +column=0 +encoding=UTF-8 +highlight=BibTeX +line=0 +mode=BibTeX +open=false +order=-1 + +[item:nwrecon-doc.tex] +archive=true +column=237 +encoding=UTF-8 +highlight=LaTeX +line=173 +mode=LaTeX +open=false +order=-1 + +[view-settings,view=0,item:mia-doc.tex] +CursorColumn=22 +CursorLine=9 +JumpList= +ViMarks=.,218,415,[,218,411,],218,415 + +[view-settings,view=0,item:nwrecon-doc.bib] +CursorColumn=0 +CursorLine=0 +JumpList= +ViMarks= + +[view-settings,view=0,item:nwrecon-doc.tex] +CursorColumn=237 +CursorLine=173 +JumpList= +ViMarks=.,26,14,[,26,13,],26,14 diff --git a/doc/gfx/document-import.png b/doc/gfx/document-import.png new file mode 100644 index 0000000..293b5a0 Binary files /dev/null and b/doc/gfx/document-import.png differ diff --git a/doc/gfx/edit-find.png b/doc/gfx/edit-find.png new file mode 100644 index 0000000..a31a17b Binary files /dev/null and b/doc/gfx/edit-find.png differ diff --git a/doc/gfx/ico_about.png b/doc/gfx/ico_about.png new file mode 100644 index 0000000..8f3a936 Binary files /dev/null and b/doc/gfx/ico_about.png differ diff --git a/doc/gfx/ico_cancel.png b/doc/gfx/ico_cancel.png new file mode 100644 index 0000000..c677487 Binary files /dev/null and b/doc/gfx/ico_cancel.png differ diff --git a/doc/gfx/ico_componentinfo.png b/doc/gfx/ico_componentinfo.png new file mode 100644 index 0000000..2967e4d Binary files /dev/null and b/doc/gfx/ico_componentinfo.png differ diff --git a/doc/gfx/ico_differencemode.png b/doc/gfx/ico_differencemode.png new file mode 100644 index 0000000..81515cd Binary files /dev/null and b/doc/gfx/ico_differencemode.png differ diff --git a/doc/gfx/ico_export-image.png b/doc/gfx/ico_export-image.png new file mode 100644 index 0000000..35da5a2 Binary files /dev/null and b/doc/gfx/ico_export-image.png differ diff --git a/doc/gfx/ico_library.png b/doc/gfx/ico_library.png new file mode 100644 index 0000000..5534c16 Binary files /dev/null and b/doc/gfx/ico_library.png differ diff --git a/doc/gfx/ico_librarysearch.png b/doc/gfx/ico_librarysearch.png new file mode 100644 index 0000000..e0f7d77 Binary files /dev/null and b/doc/gfx/ico_librarysearch.png differ diff --git a/doc/gfx/ico_nonorm.png b/doc/gfx/ico_nonorm.png new file mode 100644 index 0000000..e99f83d Binary files /dev/null and b/doc/gfx/ico_nonorm.png differ diff --git a/doc/gfx/ico_normalmode.png b/doc/gfx/ico_normalmode.png new file mode 100644 index 0000000..ad0ee6a Binary files /dev/null and b/doc/gfx/ico_normalmode.png differ diff --git a/doc/gfx/ico_open.png b/doc/gfx/ico_open.png new file mode 100644 index 0000000..3432ed2 Binary files /dev/null and b/doc/gfx/ico_open.png differ diff --git a/doc/gfx/ico_plus.png b/doc/gfx/ico_plus.png new file mode 100644 index 0000000..eaa48eb Binary files /dev/null and b/doc/gfx/ico_plus.png differ diff --git a/doc/gfx/ico_save.png b/doc/gfx/ico_save.png new file mode 100644 index 0000000..cc380a0 Binary files /dev/null and b/doc/gfx/ico_save.png differ diff --git a/doc/gfx/ico_screenshot.png b/doc/gfx/ico_screenshot.png new file mode 100644 index 0000000..71a3940 Binary files /dev/null and b/doc/gfx/ico_screenshot.png differ diff --git a/doc/gfx/ico_settings.png b/doc/gfx/ico_settings.png new file mode 100644 index 0000000..8d5a1fb Binary files /dev/null and b/doc/gfx/ico_settings.png differ diff --git a/doc/gfx/ico_tsvexport.png b/doc/gfx/ico_tsvexport.png new file mode 100644 index 0000000..0bf9e6c Binary files /dev/null and b/doc/gfx/ico_tsvexport.png differ diff --git a/doc/gfx/ico_zoom-in.png b/doc/gfx/ico_zoom-in.png new file mode 100644 index 0000000..83dec79 Binary files /dev/null and b/doc/gfx/ico_zoom-in.png differ diff --git a/doc/gfx/ico_zoom-original.png b/doc/gfx/ico_zoom-original.png new file mode 100644 index 0000000..2fb963f Binary files /dev/null and b/doc/gfx/ico_zoom-original.png differ diff --git a/doc/gfx/ico_zoom-out.png b/doc/gfx/ico_zoom-out.png new file mode 100644 index 0000000..468b229 Binary files /dev/null and b/doc/gfx/ico_zoom-out.png differ diff --git a/doc/gfx/ntfd-logo.png b/doc/gfx/ntfd-logo.png new file mode 100644 index 0000000..b22602b Binary files /dev/null and b/doc/gfx/ntfd-logo.png differ diff --git a/doc/gfx/schema_v5.png b/doc/gfx/schema_v5.png new file mode 100644 index 0000000..d075e84 Binary files /dev/null and b/doc/gfx/schema_v5.png differ diff --git a/doc/gfx/ss_compound_details.png b/doc/gfx/ss_compound_details.png new file mode 100644 index 0000000..3a2e4b8 Binary files /dev/null and b/doc/gfx/ss_compound_details.png differ diff --git a/doc/gfx/ss_compound_panel.png b/doc/gfx/ss_compound_panel.png new file mode 100644 index 0000000..5a42a46 Binary files /dev/null and b/doc/gfx/ss_compound_panel.png differ diff --git a/doc/gfx/ss_data_import.png b/doc/gfx/ss_data_import.png new file mode 100644 index 0000000..b612ca7 Binary files /dev/null and b/doc/gfx/ss_data_import.png differ diff --git a/doc/gfx/ss_experiment_files.png b/doc/gfx/ss_experiment_files.png new file mode 100644 index 0000000..11c5109 Binary files /dev/null and b/doc/gfx/ss_experiment_files.png differ diff --git a/doc/gfx/ss_experiment_panel.png b/doc/gfx/ss_experiment_panel.png new file mode 100644 index 0000000..7c1af5e Binary files /dev/null and b/doc/gfx/ss_experiment_panel.png differ diff --git a/doc/gfx/ss_experiment_settings.png b/doc/gfx/ss_experiment_settings.png new file mode 100644 index 0000000..9d675de Binary files /dev/null and b/doc/gfx/ss_experiment_settings.png differ diff --git a/doc/gfx/ss_exporteddata.png b/doc/gfx/ss_exporteddata.png new file mode 100644 index 0000000..a937f03 Binary files /dev/null and b/doc/gfx/ss_exporteddata.png differ diff --git a/doc/gfx/ss_graph_panel.png b/doc/gfx/ss_graph_panel.png new file mode 100644 index 0000000..509cf47 Binary files /dev/null and b/doc/gfx/ss_graph_panel.png differ diff --git a/doc/gfx/ss_labeledcompoundlist.png b/doc/gfx/ss_labeledcompoundlist.png new file mode 100644 index 0000000..d872dfc Binary files /dev/null and b/doc/gfx/ss_labeledcompoundlist.png differ diff --git a/doc/gfx/ss_mainwindow_empty.png b/doc/gfx/ss_mainwindow_empty.png new file mode 100644 index 0000000..75260fd Binary files /dev/null and b/doc/gfx/ss_mainwindow_empty.png differ diff --git a/doc/gfx/ss_mainwindow_example.png b/doc/gfx/ss_mainwindow_example.png new file mode 100644 index 0000000..d7179d8 Binary files /dev/null and b/doc/gfx/ss_mainwindow_example.png differ diff --git a/doc/gfx/ss_mainwindow_graphview.png b/doc/gfx/ss_mainwindow_graphview.png new file mode 100644 index 0000000..6b5c207 Binary files /dev/null and b/doc/gfx/ss_mainwindow_graphview.png differ diff --git a/doc/gfx/ss_node.png b/doc/gfx/ss_node.png new file mode 100644 index 0000000..30bdac6 Binary files /dev/null and b/doc/gfx/ss_node.png differ diff --git a/doc/gfx/ss_opendialog.png b/doc/gfx/ss_opendialog.png new file mode 100644 index 0000000..f8080d1 Binary files /dev/null and b/doc/gfx/ss_opendialog.png differ diff --git a/doc/gfx/ss_settings_misc.png b/doc/gfx/ss_settings_misc.png new file mode 100644 index 0000000..cde0ea4 Binary files /dev/null and b/doc/gfx/ss_settings_misc.png differ diff --git a/doc/gfx/ss_settings_paths.png b/doc/gfx/ss_settings_paths.png new file mode 100644 index 0000000..75a466a Binary files /dev/null and b/doc/gfx/ss_settings_paths.png differ diff --git a/doc/gfx/ss_tutorial_dataloaded.png b/doc/gfx/ss_tutorial_dataloaded.png new file mode 100644 index 0000000..330e46a Binary files /dev/null and b/doc/gfx/ss_tutorial_dataloaded.png differ diff --git a/doc/gfx/ss_tutorial_highvar.png b/doc/gfx/ss_tutorial_highvar.png new file mode 100644 index 0000000..410834a Binary files /dev/null and b/doc/gfx/ss_tutorial_highvar.png differ diff --git a/doc/gfx/ss_tutorial_identified.png b/doc/gfx/ss_tutorial_identified.png new file mode 100644 index 0000000..418e7cb Binary files /dev/null and b/doc/gfx/ss_tutorial_identified.png differ diff --git a/doc/gfx/ss_tutorial_midsim.png b/doc/gfx/ss_tutorial_midsim.png new file mode 100644 index 0000000..875ea44 Binary files /dev/null and b/doc/gfx/ss_tutorial_midsim.png differ diff --git a/doc/mia-doc.bib b/doc/mia-doc.bib new file mode 100644 index 0000000..49e1ccc --- /dev/null +++ b/doc/mia-doc.bib @@ -0,0 +1,250 @@ +% This file was created with JabRef 2.10. +% Encoding: UTF8 + + +@Article{Gansner2000, + Title = {An Open Graph Visualization System and Its Applications to Software Engineering}, + Author = {Gansner, Emden R. and North, Stephen C.}, + Journal = {Softw. Pract. Exper.}, + Year = {2000}, + + Month = sep, + Number = {11}, + Pages = {1203--1233}, + Volume = {30}, + + Acmid = {358697}, + Address = {New York, NY, USA}, + Doi = {10.1002/1097-024X(200009)30:11<1203::AID-SPE338>3.3.CO;2-E}, + File = {Gansner2000.pdf:Gansner2000.pdf:PDF}, + ISSN = {0038-0644}, + Issue_date = {Sept. 2000}, + Keywords = {graph visualization, open systems, software engineering}, + Numpages = {31}, + Owner = {Daniel}, + Publisher = {John Wiley \& Sons, Inc.}, + Timestamp = {2014.09.29}, + Url = {http://dx.doi.org/10.1002/1097-024X(200009)30:11<1203::AID-SPE338>3.3.CO;2-E} +} + +@Article{Hiller2009, + Title = {MetaboliteDetector: comprehensive analysis tool for targeted and nontargeted GC/MS based metabolome analysis.}, + Author = {Karsten Hiller and Jasper Hangebrauk and Christian Jäger and Jana Spura and Kerstin Schreiber and Dietmar Schomburg}, + Journal = {Anal Chem}, + Year = {2009}, + + Month = {May}, + Number = {9}, + Pages = {3429--3439}, + Volume = {81}, + + Abstract = {We have developed a new software, MetaboliteDetector, for the efficient and automatic analysis of GC/MS-based metabolomics data. Starting with raw MS data, the program detects and subsequently identifies potential metabolites. Moreover, a comparative analysis of a large number of chromatograms can be performed in either a targeted or nontargeted approach. MetaboliteDetector automatically determines appropriate quantification ions and performs an integration of single ion peaks. The analysis results can directly be visualized with a principal component analysis. Since the manual input is limited to absolutely necessary parameters, the program is also usable for the analysis of high-throughput data. However, the intuitive graphical user interface of MetaboliteDetector additionally allows for a detailed examination of a single GC/MS chromatogram including single ion chromatograms, recorded mass spectra, and identified metabolite spectra in combination with the corresponding reference spectra obtained from a reference library. MetaboliteDetector offers the ability to operate with highly resolved profile mass data. Finally, all analysis results can be exported to tab delimited tables. The features of MetaboliteDetector are demonstrated by the analysis of two experimental metabolomics data sets. MetaboliteDetector is freely available under the GNU public license (GPL) at http://metabolitedetector.tu-bs.de.}, + Doi = {10.1021/ac802689c}, + Institution = {Department of Bioinformatics and Biochemistry, Technische Universität Braunschweig, Langer Kamp 19b, D-38106 Braunschweig, Germany.}, + Keywords = {Aerobiosis; Algorithms; Amino Acids, metabolism; Automatic Data Processing; Calibration; Cell Proliferation; Ethanol, metabolism; Fermentation; Gas Chromatography-Mass Spectrometry; Gene Expression Regulation, Fungal; Glucose, metabolism; Metabolomics, methods; Saccharomyces cerevisiae, cytology/genetics/metabolism; Software}, + Language = {eng}, + Medline-pst = {ppublish}, + Owner = {Daniel}, + Pmid = {19358599}, + Timestamp = {2012.10.25}, + Url = {http://dx.doi.org/10.1021/ac802689c} +} + +@Article{Hiller2010, + Title = {Nontargeted elucidation of metabolic pathways using stable-isotope tracers and mass spectrometry.}, + Author = {Karsten Hiller and Christian M Metallo and Joanne K Kelleher and Gregory Stephanopoulos}, + Journal = {Anal Chem}, + Year = {2010}, + + Month = {Aug}, + Number = {15}, + Pages = {6621--6628}, + Volume = {82}, + + Abstract = {Systems level tools for the quantitative analysis of metabolic networks are required to engineer metabolism for biomedical and industrial applications. While current metabolomics techniques enable high-throughput quantification of metabolites, these methods provide minimal information on the rates and connectivity of metabolic pathways. Here we present a new method, nontargeted tracer fate detection (NTFD), that expands upon the concept of metabolomics to solve the above problems. Through the combined use of stable isotope tracers and chromatography coupled to mass spectrometry, our computational analysis enables the quantitative detection of all measurable metabolites derived from a specific labeled compound. Without a priori knowledge of a reaction network or compound library, NTFD provides information about relative flux magnitudes into each metabolite pool by determining the mass isotopomer distribution for all labeled compounds. This novel method adds a new dimension to the metabolomics tool box and provides a framework for global analysis of metabolic fluxes.}, + Doi = {10.1021/ac1011574}, + File = {Hiller2010.pdf:Hiller2010.pdf:PDF;Hiller2010_ac1011574_si_002.xls:Hiller2010_ac1011574_si_002.xls:Excel;Hiller2010_ac1011574_si_001.pdf:Hiller2010_ac1011574_si_001.pdf:PDF}, + Institution = {Massachusetts Institute of Technology, Department of Chemical Engineering, 77 Massachusetts Ave., 56-439, Cambridge, Massachusetts 02140, USA.}, + Keywords = {Algorithms; Cell Line, Tumor; Gas Chromatography-Mass Spectrometry, methods; Glutamine, chemistry/metabolism; Humans; Isotope Labeling; Metabolic Networks and Pathways; Metabolomics, methods}, + Language = {eng}, + Medline-pst = {ppublish}, + Owner = {Daniel}, + Pmid = {20608743}, + Timestamp = {2012.04.18}, + Url = {http://dx.doi.org/10.1021/ac1011574} +} + +@Article{Hiller2013, + Title = {NTFD--a stand-alone application for the non-targeted detection of stable isotope-labeled compounds in GC/MS data.}, + Author = {Karsten Hiller and André Wegner and Daniel Weindl and Thekla Cordes and Christian M Metallo and Joanne K Kelleher and Gregory Stephanopoulos}, + Journal = {Bioinformatics}, + Year = {2013}, + + Month = {Mar}, + Number = {9}, + Pages = {1226--1228}, + Volume = {29}, + + Abstract = {SUMMARY: Most current stable isotope-based methodologies are targeted and focus only on the well-described aspects of metabolic networks. Here, we present NTFD (non-targeted tracer fate detection), a software for the non-targeted analysis of all detectable compounds derived from a stable isotope-labeled tracer present in a GC/MS dataset. In contrast to traditional metabolic flux analysis approaches, NTFD does not depend on any a priori knowledge or library information. To obtain dynamic information on metabolic pathway activity, NTFD determines mass isotopomer distributions for all detected and labeled compounds. These data provide information on relative fluxes in a metabolic network. The graphical user interface allows users to import GC/MS data in netCDF format and export all information into a tab-separated format. AVAILABILITY: NTFD is C++- and Qt4-based, and it is freely available under an open-source license. Pre-compiled packages for the installation on Debian- and Redhat-based Linux distributions, as well as Windows operating systems, along with example data, are provided for download at http://ntfd.mit.edu/. CONTACT: gregstep@mit.edu.}, + Doi = {10.1093/bioinformatics/btt119}, + Institution = {Luxembourg Centre for Systems Biomedicine, University of Luxembourg, L-4362 Esch-Belval, Luxembourg, Department of Bioengineering, University of California, San Diego, La Jolla, CA 92093, USA and Department of Chemical Engineering, Massachusetts Institute of Technology, Cambridge, MA 02140, USA.}, + Language = {eng}, + Medline-pst = {aheadofprint}, + Owner = {Daniel}, + Pii = {btt119}, + Pmid = {23479350}, + Timestamp = {2013.04.05}, + Url = {http://dx.doi.org/10.1093/bioinformatics/btt119} +} + +@InBook{Hummel2013, + Title = {Mass Spectral Search and Analysis Using the Golm Metabolome Database}, + Author = {Hummel, Jan and Strehmel, Nadine and Bölling, Christian and Schmidt, Stefanie and Walther, Dirk and Kopka, Joachim}, + Chapter = {18}, + Pages = {321--343}, + Publisher = {Wiley-VCH Verlag GmbH \& Co. KGaA}, + Year = {2013}, + + Abstract = {The novel “omics†technologies of the postgenomic era generate large multiplexed phenotyping datasets, which can only inadequately be published in the traditional journal and supplemental formats. For this reason, public databases have been developed that utilize the efficient communication of knowledge through the World Wide Web. This trend also applies to the metabolomics field, which is, after genomics, transcriptomics, and proteomics, the fourth major systems-level phenotyping platform. Each different analytical technology used in metabolomics studies requires specific reference data for metabolite identification and optimal data formats for reporting the complex metabolite profiling data features. Therefore, we envision that every technology platform or even each high-throughput metabolomic laboratory will establish dedicated databases, which will communicate between each other and will be integrated by meta-databases and web services. The Golm Metabolome Database (GMD) (http://gmd.mpimp-golm.mpg.de/) is a metabolomic database, maintained by the Max Planck Institute of Molecular Plant Physiology, that was initiated around a nucleus of reference data from gas chromatography–mass spectrometry metabolite profiling data and is now developing toward a general mass spectrometry-based repository of reference metabolite profiles for essential plant tissues and typical variations of growth conditions. This chapter describes the mass spectral searches and analyses currently supported by the GMD. We specifically address the searches for the different chemical entities within GMD, namely the metabolites, reference substances, and the chemically derivatized analytes. We report the diverse options for mass spectral analyses and highlight the decision tree-supported prediction of chemical substructures, a feature of GMD that currently appears to be a unique among the many tools for the analysis of gas chromatography–electron ionization mass spectra.}, + Booktitle = {The Handbook of Plant Metabolomics}, + Doi = {10.1002/9783527669882.ch18}, + ISBN = {9783527669882}, + Keywords = {Golm Metabolome Database, web service, query spectrum, hit spectrum, decision trees, mass spectral analysis input}, + Owner = {Daniel}, + Timestamp = {2014.12.22}, + Url = {http://dx.doi.org/10.1002/9783527669882.ch18} +} + +@Article{Metallo2012, + Title = {Reductive glutamine metabolism by {IDH1} mediates lipogenesis under hypoxia.}, + Author = {Christian M Metallo and Paulo A Gameiro and Eric L Bell and Katherine R Mattaini and Juanjuan Yang and Karsten Hiller and Christopher M Jewell and Zachary R Johnson and Darrell J Irvine and Leonard Guarente and Joanne K Kelleher and Matthew G Vander Heiden and Othon Iliopoulos and Gregory Stephanopoulos}, + Journal = {Nature}, + Year = {2012}, + + Month = {Jan}, + Number = {7381}, + Pages = {380--384}, + Volume = {481}, + + Abstract = {Acetyl coenzyme A (AcCoA) is the central biosynthetic precursor for fatty-acid synthesis and protein acetylation. In the conventional view of mammalian cell metabolism, AcCoA is primarily generated from glucose-derived pyruvate through the citrate shuttle and ATP citrate lyase in the cytosol. However, proliferating cells that exhibit aerobic glycolysis and those exposed to hypoxia convert glucose to lactate at near-stoichiometric levels, directing glucose carbon away from the tricarboxylic acid cycle and fatty-acid synthesis. Although glutamine is consumed at levels exceeding that required for nitrogen biosynthesis, the regulation and use of glutamine metabolism in hypoxic cells is not well understood. Here we show that human cells use reductive metabolism of α-ketoglutarate to synthesize AcCoA for lipid synthesis. This isocitrate dehydrogenase-1 (IDH1)-dependent pathway is active in most cell lines under normal culture conditions, but cells grown under hypoxia rely almost exclusively on the reductive carboxylation of glutamine-derived α-ketoglutarate for de novo lipogenesis. Furthermore, renal cell lines deficient in the von Hippel-Lindau tumour suppressor protein preferentially use reductive glutamine metabolism for lipid biosynthesis even at normal oxygen levels. These results identify a critical role for oxygen in regulating carbon use to produce AcCoA and support lipid synthesis in mammalian cells.}, + Doi = {10.1038/nature10602}, + File = {Metallo2012.pdf:Metallo2012.pdf:PDF;Metallo2012-s1.pdf:Metallo2012-s1.pdf:PDF}, + Institution = {Department of Chemical Engineering, Massachusetts Institute of Technology, Cambridge, Massachusetts 02139, USA.}, + Keywords = {Acetyl Coenzyme A, biosynthesis/metabolism; Aryl Hydrocarbon Receptor Nuclear Translocator, metabolism; Basic Helix-Loop-Helix Transcription Factors, genetics/metabolism; CD8-Positive T-Lymphocytes, cytology; Carbon, metabolism; Carcinoma, Renal Cell, metabolism/pathology; Cell Hypoxia; Cell Line, Tumor; Cells, Cultured; Citric Acid Cycle; Glutamine, metabolism; Humans; Hypoxia-Inducible Factor 1, alpha Subunit, metabolism; Isocitrate Dehydrogenase, deficiency/genetics/metabolism; Ketoglutaric Acids, metabolism; Kidney Neoplasms, metabolism/pathology; Lipogenesis; Oxidation-Reduction; Oxygen, metabolism; Palmitic Acid, metabolism; Von Hippel-Lindau Tumor Suppressor Protein, genetics/metabolism;}, + Language = {eng}, + Medline-pst = {epublish}, + Owner = {Daniel}, + Pii = {nature10602}, + Pmid = {22101433}, + Review = {TBDMS MID fragments with sum formula atom transitions for 13C MFA fluxes for central carbon metabolism}, + Timestamp = {2012.11.10}, + Url = {http://dx.doi.org/10.1038/nature10602} +} + +@Article{Needleman1970, + Title = {A general method applicable to the search for similarities in the amino acid sequence of two proteins.}, + Author = {S. B. Needleman and C. D. Wunsch}, + Journal = {J Mol Biol}, + Year = {1970}, + + Month = {Mar}, + Number = {3}, + Pages = {443--453}, + Volume = {48}, + + File = {Needleman1970.pdf:Needleman1970.pdf:PDF}, + Keywords = {Amino Acid Sequence; Computers; Hemoglobins; Methods; Muramidase; Myoglobin; Probability; Ribonucleases}, + Language = {eng}, + Medline-pst = {ppublish}, + Owner = {Daniel}, + Pii = {0022-2836(70)90057-4}, + Pmid = {5420325}, + Timestamp = {2012.09.14} +} + +@Other{hdf5, + Title = {{Hierarchical Data Format, version 5}}, + Author = {{The HDF Group}}, + Note = {http://www.hdfgroup.org/HDF5/}, + Year = {1997-2014} +} + +@Article{Weindl2016, + Title = {Bridging the gap between non-targeted stable isotope labeling and metabolic flux analysis}, + Author = {Daniel Weindl and Thekla Cordes and Nadia Battello aand Sean Charles Sapcariu and Xiangyi Dong and André Wegner and Karsten Hiller}, + Journal = {Cancer \& Metabolism}, + Year = {2016}, + + Owner = {Daniel}, + Timestamp = {2016.03.29} +} + +@InCollection{Weindl2015a, + Title = {Non-targeted Tracer Fate Detection}, + Author = {Daniel Weindl and André Wegner and Karsten Hiller}, + Booktitle = {Metabolic Analysis Using Stable Isotopes}, + Publisher = {Academic Press}, + Year = {2015}, + + Address = {Waltham, MA}, + Editor = {Christian M. Metallo}, + Pages = {277 - 302}, + Series = {Methods in Enzymology }, + Volume = {561}, + + Abstract = {Abstract Stable isotopes have been used to trace atoms through metabolism and quantify metabolic fluxes for several decades. Only recently non-targeted stable isotope labeling approaches have emerged as a powerful tool to gain insights into metabolism. However, the manual detection of isotopic enrichment for a non-targeted analysis is tedious and time consuming. To overcome this limitation, the non-targeted tracer fate detection (NTFD) algorithm for the automated metabolome-wide detection of isotopic enrichment has been developed. \{NTFD\} detects and quantifies isotopic enrichment in the form of mass isotopomer distributions (MIDs) in an automated manner, providing the means to trace functional groups, determine \{MIDs\} for metabolic flux analysis, or detect tracer-derived molecules in general. Here, we describe the algorithmic background of NTFD, discuss practical considerations for the freely available \{NTFD\} software package, and present potential applications of non-targeted stable isotope labeling analysis.}, + Doi = {http://dx.doi.org/10.1016/bs.mie.2015.04.003}, + ISSN = {0076-6879}, + Keywords = {NTFD}, + Owner = {Daniel}, + Timestamp = {2015.09.08}, + Url = {http://www.sciencedirect.com/science/article/pii/S0076687915002645} +} + +@Article{Weindl2015b, + Title = {Metabolome-wide analysis of stable isotope labeling - Is it worth the effort?}, + Author = {Weindl, Daniel and Wegner, Andre and Hiller, Karsten}, + Journal = {Frontiers in Physiology}, + Year = {2015}, + Number = {344}, + Volume = {6}, + + Doi = {10.3389/fphys.2015.00344}, + ISSN = {1664-042X}, + Owner = {Daniel}, + Timestamp = {2015.11.09}, + Url = {http://www.frontiersin.org/systems_biology/10.3389/fphys.2015.00344/full} +} + +@Article{Wise2008, + Title = {Myc regulates a transcriptional program that stimulates mitochondrial glutaminolysis and leads to glutamine addiction.}, + Author = {Wise, David R. and DeBerardinis, Ralph J. and Mancuso, Anthony and Sayed, Nabil and Zhang, Xiao-Yong and Pfeiffer, Harla K. and Nissim, Ilana and Daikhin, Evgueni and Yudkoff, Marc and McMahon, Steven B. and Thompson, Craig B.}, + Journal = {Proc Natl Acad Sci U S A}, + Year = {2008}, + + Month = {Dec}, + Number = {48}, + Pages = {18782--18787}, + Volume = {105}, + + Abstract = {Mammalian cells fuel their growth and proliferation through the catabolism of two main substrates: glucose and glutamine. Most of the remaining metabolites taken up by proliferating cells are not catabolized, but instead are used as building blocks during anabolic macromolecular synthesis. Investigations of phosphoinositol 3-kinase (PI3K) and its downstream effector AKT have confirmed that these oncogenes play a direct role in stimulating glucose uptake and metabolism, rendering the transformed cell addicted to glucose for the maintenance of survival. In contrast, less is known about the regulation of glutamine uptake and metabolism. Here, we report that the transcriptional regulatory properties of the oncogene Myc coordinate the expression of genes necessary for cells to engage in glutamine catabolism that exceeds the cellular requirement for protein and nucleotide biosynthesis. A consequence of this Myc-dependent glutaminolysis is the reprogramming of mitochondrial metabolism to depend on glutamine catabolism to sustain cellular viability and TCA cycle anapleurosis. The ability of Myc-expressing cells to engage in glutaminolysis does not depend on concomitant activation of PI3K or AKT. The stimulation of mitochondrial glutamine metabolism resulted in reduced glucose carbon entering the TCA cycle and a decreased contribution of glucose to the mitochondrial-dependent synthesis of phospholipids. These data suggest that oncogenic levels of Myc induce a transcriptional program that promotes glutaminolysis and triggers cellular addiction to glutamine as a bioenergetic substrate.}, + Doi = {10.1073/pnas.0810199105}, + Institution = {Department of Cancer Biology, Abramson Cancer Center, University of Pennsylvania, Philadelphia, PA 19104-6160, USA.}, + Keywords = {Animals; Cell Line; Energy Metabolism, physiology; Fibroblasts, cytology/metabolism; Gene Expression Regulation; Glucose, metabolism; Glutamine, metabolism; Humans; Mice; Mitochondria, metabolism; Phosphatidylinositol 3-Kinases, metabolism; Proto-Oncogene Proteins c-akt, antagonists /&/ inhibitors/genetics/metabolism; Proto-Oncogene Proteins c-myc, genetics/metabolism; Signal Transduction, physiology; Transcription, Genetic}, + Language = {eng}, + Medline-pst = {ppublish}, + Owner = {Daniel}, + Pii = {0810199105}, + Pmid = {19033189}, + Timestamp = {2014.11.03}, + Url = {http://dx.doi.org/10.1073/pnas.0810199105} +} + +@comment{jabref-meta: selector_keywords:} + +@comment{jabref-meta: selector_journal:} + +@comment{jabref-meta: selector_publisher:} + +@comment{jabref-meta: selector_author:} + diff --git a/doc/mia-doc.pdf b/doc/mia-doc.pdf new file mode 100644 index 0000000..78e12c8 Binary files /dev/null and b/doc/mia-doc.pdf differ diff --git a/doc/mia-doc.tex b/doc/mia-doc.tex new file mode 100644 index 0000000..e855ba2 --- /dev/null +++ b/doc/mia-doc.tex @@ -0,0 +1,574 @@ +\documentclass[a4paper,12pt]{scrartcl} +\usepackage{html} +\usepackage[utf8]{inputenc} +\usepackage[english]{babel} +\usepackage[T1]{fontenc} +\usepackage{graphicx} +\usepackage{xcolor} +\usepackage{url} +\usepackage{natbib} +\usepackage{hyperref} +\usepackage{ae,aecompl} +\usepackage[babel=true,final=true]{microtype} +\usepackage{subfigure} +\usepackage{amsmath} +\usepackage{amssymb} +\usepackage{gitinfo} + +\newcommand*\CC{$^{13}$C} +\newcommand*\C{$^{12}$C} +\newcommand*\NN{$^{15}$N} +\newcommand*\N{$^{14}$N} +\newcommand*\OO{$^{18}$O} + +\newcommand*\app{\textsc{MIA}} +\newcommand*\NTFD{\textsc{NTFD}} +\newcommand*\MD{\textsc{MetaboliteDetector}} +\newcommand*\keyctrl{\fbox{\textsc{Ctrl}}} + + +\title{{\large Documentation}\\\app\\{\Large Mass Isotopolome Analyzer}\\ \ \\\small\gitAbbrevHash\\ \gitCommitterIsoDate} +\author{\small Daniel Weindl\footnote{\url{mailto:sci@danielweindl.de}}} +\date{\small 2014--2016} + +\hypersetup{ + colorlinks, + urlcolor=blue, + linkcolor=brown, + pdftitle = {MIA - Documentation - Mass Isotopolome Analyzer}, + pdfauthor = {Daniel Weindl} +} +\setkeys{Gin}{width=5mm} +\linespread{1.2} +\setcounter{tocdepth}{3} + +\begin{document} + +\maketitle + +\begin{abstract} +\textbf{\app\ is an application for non-targeted stable isotope labeling analysis. This document provides a basic overview over \app\ functionality. It is organized in two parts: a user manual and a step-by-step tutorial. The first part describes the graphical user interface (GUI), the underlying algorithms and important settings. The second part is a step-by-step tutorial that demonstrates the analysis of a sample dataset. +\newline +Additional information and the most recent version of \app\ can be found at \url{http://massisotopolomeanalyzer.lu/}. +} +\end{abstract} + +\newpage\tableofcontents\newpage + +\section{Introduction} + +\app\ is a GUI-based software package for the non-targeted analysis of stable isotope labeling data. %TODO \citep{methodspaper}. +The detection and quantification of stable isotope labeling is based on the NTFD algorithm \citep{Hiller2010,Weindl2015a}. \app\ will detect all compounds derived from a stable isotope labeled tracer in a set of GC-MS chromatograms, visualize their corresponding mass isotopomer distributions (MIDs) and allow for further data analyses. \app\ is implemented in C++ and is based on Qt5\footnote{\url{http://qt-project.org/}}, MetaboliteDetector \cite{Hiller2009}, NTFD \cite{Hiller2010} and GraphViz\footnote{\url{http://www.graphviz.org/}} \cite{Gansner2000}. Source code and binaries for Debian-based Linux distributions as well as for Windows systems are freely available at \url{http://massisotopolomeanalyzer.lu/}. + + +\section{Background} +\label{sec:background} + +Stable isotope labeling is widely used in metabolomics to infer metabolic fluxes or to assist chemical structure elucidation. After feeding a stable isotope labeled compound to an organism, the mass isotopomer distributions of metabolites are determined by the metabolic fluxes in the network. This is the basis for \CC\ metabolic flux analysis (\CC-MFA). To date, most mass isotopomer distribution analyses have been very targeted. \app\ offers an easy-to-use interface for determination and analysis of stable isotope labeling GC-EI-MS data in a non-targeted manner. + +\app\ visualizes all detected MIDs, allows to cluster them by their similarity to find metabolically closely related compounds, offers filtering, compound identification and data export capabilities. Stable isotope labeling data from multiple datasets can be analyzed in parallel. The combined analysis of datasets from different tracers can be helpful for compound identification or pathway contextualization. The analysis of mass isotopomer distributions after feeding the same tracer under different experimental conditions can be used to globally analyze alterations in metabolic fluxes \citep{Weindl2016}. + +In \citep{Weindl2016}, we show how \app\ was applied to analyze metabolism of hypoxic cancer cells and how non-targeted stable isotope labeling analysis helps provide novel biological insights. + + +\subsection{Non-targeted tracer fate detection (NTFD)} +\label{sec:ntfd} + +The detection of stable isotope labeling in \app\ is based on the previously published NTFD algorithm \cite{Hiller2010,Hiller2013,Weindl2015a}. For NTFD, an organism is grown on standard medium and in parallel in the same medium with one or more components fully or partially replaced by their stable isotope enriched analogue. Metabolites from both cultures are extracted and subjected to GC-MS analysis. For each analyte, the mass spectra from the isotopically enriched and non-enriched sample are matched. From the difference of these mass spectra isotopically enriched fragments can be detected. For each of these fragments the mass isotopomer distribution can be calculated. + +\subsection{MID-based compound networks} +\label{sec:network} + +A central feature of \app\ is the visualization of labeled compound as MID-similarity-based networks. Metabolically closely related compounds show very similar MIDs. Thus, \app\ analyzes the similarity of MIDs and connects compounds with highly similar MIDs which are a sign of proximity within the metabolic network. MIDs are compared in a pair-wise manner. First, a Needleman-Wunsch-Alignment \ref{Needleman1970} is performed on the MID vectors to account for gains or losses of isotopically enriched groups. Then, the distance of these aligned vectors is calculated and the user can select a similarity threshold for which metabolites should be considered as connected \ref{sec:graph-panel}. %The highest MID similarity is observed between different silylation derivatives of the same metabolite. + +The following distance measures are implemented in \app: +%\app\ uses the following distance measure: + +\begin{itemize} +\item Euclidean distance \[d(p, q) = \sqrt{\sum_{i=0}^{n} (p_i - q_i)^2} \] +\item Canberra distance \[d(p, q) = \sum_{i=0}^{n} \frac{\mid p_i - q_i \mid}{\mid p_i \mid + \mid q_i \mid}\] +\item Manhattan distance \[d(p, q) = \sum_{i=0}^{n} \mid p_i - q_i \mid \] +\end{itemize} + +where $p$ and $q$ are the aligned MID vectors in $\mathbb{R}^n$ of the first and second analyte respectively. The MID distances can be normalized to the length of the MID vectors. + +\subsection{MID variation filtering} +\label{sec:variation} + +When comparing stable isotope labeling after feeding the same tracer under different experimental conditions, it is interesting to detect changes in mass isotopomer distributions since they are indicative of changes in metabolic fluxes \cite{Weindl2015b,Weindl2016}. To detect compounds with varying labeling patterns, \app\ allows to filter the results by variation in their MIDs. Therefor the maximum standard deviation in relative mass isotopomer abundance is determined for every compound and the user can hide compounds with low variation score (\ref{sec:graph-panel}). +\[\text{variation score} = \max \sigma \quad \mid \quad \sigma_i = \sqrt{\frac{1}{n} \cdot \sum_{j=0}^{n} (\overline{p}_i - p_{i,j})^2} \] where $p_{i,j}$ is the relative abundance of the M + $j$ isotopologue of the given compound in the $i$-th dataset. The MIDs of unlabeled compounds are not considered.\footnote{Compounds which are only labeled under specific conditions are also of interest. However, they need to be checked for false positives.} + +\section{User manual} + +\subsection{Installation} + +Installation packages for \app\ can be downloaded from \url{http://massisotopolomeanalyzer.lu/} in the .deb or .exe format. Alternatively, you can download a plain archive with the binaries. + +\subsubsection{Linux} + +Open a terminal and change to the directory containing the downloaded file. Then type the following in the command line: + +% \texttt{sudo rpm -i filename} for rpm based systems + +\texttt{sudo dpkg-i filename.deb} for Debian based systems + +where filename is the name of the deb %or rpm +installation package (e.g \texttt{mia-1.0-Linux.deb}). + +\subsubsection{Windows} + +Unpack the \app-Windows archive and run \texttt{mia-gui.exe} + +\subsection{Graphical user interface (GUI)} +\label{sec:gui} + +The graphical user interface is organized in one mainwindow containing three subwindows which are explained below. Several application settings can be changed in the configuration dialog (\ref{sec:settings}). + +\subsubsection{Main window} + +\label{sec:mainwindow} + +\begin{figure}[htb] + \centering + \includegraphics[width=0.8\linewidth]{./gfx/ss_mainwindow_empty.png} + \caption{\app\ Main window with the graph view in the center, the main toolbar at the top (\ref{sec:maintoolbar}), the compound panel (\ref{sec:compound-panel}) on the left and the experiments (\ref{sec:dataset-panel}) and graph panel (\ref{sec:graph-panel}) on the right.} + \label{fig:mainwindow} +\end{figure} + +The mainwindow toolbar (Fig.~\ref{fig:mainwindow}) provides the following functionality: + +\paragraph{Main toolbar} +\label{sec:maintoolbar} + +\begin{description} +% \item[\includegraphics{gfx/ico_open.png} Open binary data] +% Load dataset from \app\ binary data file. + +\item[\includegraphics{../gui/icons/document-import.png} Import data] +Opens the data import panel (\ref{sec:data-import}) to import GC-MS data from the netCDF format or perform peak detection on chromatograms in the MetaboliteDetector \citep{Hiller2009} format. + +\item[\includegraphics{../gui/icons/document-open-xml.png} Open XML] +Load dataset from \app\ XML configuration file. + +\item[\includegraphics{gfx/ico_save.png} Save binary data] +Save current dataset to \app\ binary data file. + +% \item[\includegraphics{../gui/icons/document-save-hdf5.png} Export results to HDF5] +% Save MID distance matrix (\ref{sec:network}) in HDF5 format\cite{hdf5}. + +\item[\includegraphics{../gui/icons/document-save-csv.png} Export MIDs to CSV] +Save MIDs of all detected labeled fragments to comma separated values (CSV) file. The exported data can be opened with common spreadsheet programs like OpenOffice Calc or Microsoft Excel. + +\item[\includegraphics{gfx/edit-find.png} Library search] +Try to identify the detected compounds (see~\ref{sec:compound-panel}) based on a \MD\ reference library. Matching is performed on spectrum similarity and retention index available (\ref{sec:identification}). % TODO dialog, multiple libraries in the order of selection + +\item[\includegraphics{gfx/ico_about.png} About] +Show \app\ version information. + +\item[\includegraphics{gfx/ico_settings.png} Application settings] +Shows the settings dialog (see~\ref{sec:settings}). + +% \item[\includegraphics{gfx/ico_library.png} Generate \MD\ library] +% Generate a library with the spectra detected labelled compounds for use in \MD. +\end{description} + +\subsubsection{Graph view} + +\label{sec:graph-view} + +The central component of the \app\ GUI is the graph view. Here you can find a lot of information on all labelled compounds detected in the active datasets. +The layout and the compounds shown depend on the settings in the experiment panel (\ref{sec:dataset-panel}), the graph panel (\ref{sec:graph-panel}) and the settings dialog (\ref{sec:settings}). + +\begin{figure}[htb] + \centering + \includegraphics[width=0.7\linewidth]{./gfx/ss_mainwindow_graphview.png} + \caption{The graph view.} + \label{fig:graph-view} +\end{figure} + +\label{sec:node} +For every compound the MID of the selected labeled fragment (usually the largest) is shown for each active dataset (\ref{fig:compound-node}). The background color of the ellipse reflects the variation in relative mass isotopomer abundance, ranging from dark blue (low) to high (white). The MID plots for each dataset set show the relative mass isotopomer abundances as bars with 95\% confidence intervals and numbers, the compound name (after identification - see \ref{sec:identification}), the selected $m/z$, and some quality measures. The background color reflects the amount of isotopic enrichment ($1-M_0$)\footnote{The value of $1-M_0$ is used, since the actual isotopic enrichment $1/n \cdot \sum i\cdot M_i$ cannot be determined because the number of possibly labeled atoms $n$ is not known before compound identification and knowledge on fragmentation.}, ranging from dark gray (unlabeled) to very light gray (fully labeled). As quality measures, there are the coefficient of determination $R^2$ (``R2'') and the sum of absolute mass isotopomer abundances (``S''). Both these values should ideally be equal to 1 \citep{Weindl2015a}. Thresholds for both can be defined in the label detection parameters in the experiment wizard (\ref{sec:experiment-wizard}). + +%TODO coloring + +\begin{figure}[htb] + \centering + \includegraphics[width=0.2\linewidth]{./gfx/ss_node.png} + \caption{A node in the graph view showing mass isotopomer distributions and some quality measures.} + %TODO tool tip screenshot + \label{fig:compound-node} +\end{figure} + +Double click the oval to pop-up the detailed compound view (\ref{sec:compound-details}) (you can open multiple windows) or hold the mouse for a tooltip with additional information. + +%TODO molecular ion, +% TODO Additional information if the graph feature is used line width, distance, ... color + +\paragraph{Navigation} +You can zoom in and out of the graph view by holding \keyctrl\ and using the mouse wheel. You can reset the zoom by clicking \includegraphics{gfx/ico_zoom-original.png} in the toolbar. To navigate through the graph view, you can use the scroll bars, or the mouse wheel or scroll keys, or move the mouse while holding the middle button. + +\paragraph{Toolbar actions} +\begin{description} +\item[\includegraphics{gfx/ico_zoom-original.png} Reset zoom] +Reset zoom to fit all plots into the view. + +% \item[\includegraphics{gfx/.png} Refresh] +% Repaint the graph. + +\item[\includegraphics{gfx/ico_export-image.png} Export image] +Export the current graph as scalable vector graphics (SVG). The exported file can easily be edited with most vector graphics applications like e.g. Inkscape\footnote{\url{http://www.inkscape.org/}}. Individual plots can easily be copied and modified from there to include them in other documents or presentations. +\end{description} + +\subsubsection{Compound detail view} +\label{sec:compound-details} + +Double-clicking a node in the graph pops up the compound details view (Fig.~\ref{fig:compound-details}). There, you can find MID plots for all isotopically enriched fragments in all active datasets and some additional information. + +\begin{figure}[htb] + \centering + \includegraphics[width=0.6\linewidth]{./gfx/ss_compound_details.png} + \caption{The compound details window showing MID plots for all isotopically enriched fragments in all active datasets and some additional information.} + \label{fig:compound-details} +\end{figure} + +Below the name, you can find the datasets in which the given compound was found to show isotopic enrichment along with its retention time (RT) and retention index (RI). The array of plots shows the MIDs of all labeled fragments (in rows) in all active datasets (in columns). The plot details are explained above (\ref{sec:node}). Double-clicking a plot will copy the corresponding mass MID to the system clipboard. + +\subsubsection{Compound panel} + +\label{sec:compound-panel} + +The compound panel (Fig.~\ref{fig:compound-panel}) is displayed in left part of the \app\ main window. It lists all compounds which show isotopic enrichment in any of the currently active datasets. MIDs of all labeled fragments can be viewed after clicking the expand icon in the tree view. Click on the compound name to center the graph view (\ref{fig:graph-view}) on this compound. + +\begin{figure}[htb] + \centering + \includegraphics[width=0.4\linewidth]{./gfx/ss_compound_panel.png} + \caption{The compound panel.} + \label{fig:compound-panel} +\end{figure} + +The toolbar provides the following functionality: + +\begin{description} + +\item[\includegraphics{gfx/ico_zoom-in.png} Expand] + Expand the tree view and see the following information: +\begin{center} +\fbox{ +\begin{tabular}{lllll|l|l} +$+$ & \multicolumn{4}{l|}{Compound name} & \# datasets & \\ + & $\llcorner$ & \multicolumn{3}{l|}{Dataset} & \# ions &\\ + & & $\llcorner$ & \multicolumn{2}{l|}{Labelled fragment $m/z$}& $R^2$ & \\ + & & & $\llcorner$ & Mass isotopomer & abundance & 95\% confidence interval\\ +\end{tabular} +} +\end{center} +This information can be exported as CSV from the main toolbar (\includegraphics{../gui/icons/document-save-csv.png} - \ref{sec:maintoolbar}). + + \item[\includegraphics{gfx/ico_zoom-out.png} Collapse] + Collapse the tree view to only show the list of labelled compounds. +\end{description} + +\subsubsection{Dataset panel} + +\label{sec:dataset-panel} + +This panel shows the currently loaded datasets and allows you to add or remove new data sets (Fig.~\ref{fig:experiment-panel}). The table shows the name of your dataset and the number of isotopically enriched compounds and non-enriched compounds. With the checkbox in the first column you can select which datasets should be used for the network generation (\ref{sec:network} and \ref{sec:graph-panel}). + +To add a new dataset hit ``Add'' and follow the experiment wizard (\ref{sec:experiment-wizard}). To remove a dataset, select it in the table and hit ``Remove''. The settings for label detection and compound identification can be edited by double clicking the corresponding dataset in the table (\ref{sec:experiment-wizard}). + + +\begin{figure}[htb] + \centering + \includegraphics[width=0.4\linewidth]{./gfx/ss_experiment_panel.png} + \caption{List of currently active datasets.} + \label{fig:experiment-panel} +\end{figure} + +\subsubsection{Add and Edit datasets} +\label{sec:experiment-wizard} + +New datasets are added or existing datasets are modified via the experiment wizard which can be opened by clicking ``Add'' or double clicking a dataset in the experiment panel (\ref{sec:dataset-panel}). The first page asks for a name and the data files for the dataset (Fig.~\ref{fig:experiment_files}). + + +\begin{figure}[htb] + \centering + \includegraphics[width=0.4\textwidth]{./gfx/ss_experiment_files.png} + \label{fig:experiment_files} + \includegraphics[width=0.4\textwidth]{./gfx/ss_experiment_settings.png} + \caption{The experiment wizard page for file selection and for label detection and compound identification.} + \label{fig:experiment_settings} +\end{figure} + +\begin{description} + \item[Name] + An arbitrary name for the dataset. + \item[(Un)Labeled chromatograms] + Data files from the measurements of the (un)labelled metabolite extract (\ref{sec:ntfd}). If multiple data files are added here, confidence intervals can be calculated for the MIDs \cite{Hiller2010}. Data from multiple independent experiments should added as separate dataset, not as multiple chromatograms for the same dataset. +\end{description} + +On the second wizard page, a number of parameters can be set for the detection of isotopic enrichment, compound identification, and a few more things:\footnote{The default settings are a good starting point for most applications, but should be adjusted for optimal results.} + +\paragraph[Detection of isotopic enrichment]{Detection of isotopic enrichment:\footnote{See also \NTFD\ documentation available at \url{http://ntfd.mit.edu/} and \cite{Weindl2015a}}} + +\begin{description} + \item[Maximum fragment deviation] + The maximum allowed value for $1 - \sum \mid M_i \mid$ (important quality filter). + + \item[Minimum number of labeled fragments] + Compounds with a number of labeled fragments lower than this number will be ignored. + + \item[Required amount of isotopic enrichment] + Minimum value for $1 - M_0$. + + \item[Minimum R\^ 2] + Minimum allowed coefficient of determination $R^2$ for each fragment. + + \item[Minimum M0 abd.] + The minimum relative abundance of the M+0 mass isotopomer. + + \item[Ignore compounds with M\_n $\mid$ with n > ...] + The upper limit for MID size. +\end{description} + +\paragraph{Compound identification:} +\begin{description} + \item[RI tolerance] + Changes the influence of the retention index (RI) on the compound identification score. + + \item[Matching score cutoff] + Defines the threshold for the spectrum matching score above which a library compound is considered as a hit. + + \item[Show top $n$ hits] + Defines how many compound identification hits should be kept as the label. +\end{description} + +\paragraph{Others:} +\begin{description} + \item[Gap penalty for Needleman-Wunsch-Scoring] + Gap penalty used for the Needleman-Wunsch alignment of MIDs for the distance calculation (\ref{sec:network}). + + \item[Distance cutoff graph edges] + Distance cut-off for MID similarity analysis (\ref{sec:network}). This value should not be modified here, but in the graph settings panel (\ref{sec:graph-panel}). +\end{description} + +\subsubsection{Save XML} + +To avoid repeatedly selecting the data files and adjusting the settings you can save the settings in an XML file which can later be reloaded by clicking \includegraphics{../gui/icons/document-open-xml.png} ``Open XML'' in the main toolbar. + +Note: \app\ saves absolute paths to the data in the .xml files. If the data was moved, the paths can be adjusted in the .xml file using a standard text editor. + +\subsubsection{Graph panel} + +\label{sec:graph-panel} + +The graph panel (Fig.~\ref{fig:graph-panel}) contains the settings for the generation of the compound networks (\ref{sec:network}). + +\begin{figure}[htbp] + \centering + \includegraphics[width=0.3\linewidth]{./gfx/ss_graph_panel.png} + \caption{Graph panel to setup the compound network to connect compounds by MID similarity (\ref{sec:network}).} + \label{fig:graph-panel} +\end{figure} + +\begin{description} + \item[Layout engine] + The \textsc{GraphViz} engine to layout the graph. See \textsc{GraphViz} documentation for more information. ``dot'' is the default and recommended. + + \item[Distance metric] + Metric used to calculate MID distance (\ref{sec:network}). + + \item[Distance normalization] + Optional normalization factor for MID distances. + %TODO norm + + \item[Distance cutoff] + MIDs with distances below the given threshold are considered as connected in the compound graph. + +% \item[Use z-score] +% z-score + + \item[Minimum experiments] + The minimum number of datasets in which the compound has to be detected as isotopically enriched to be considered for the compound graph. Select ``Hide others'' to hide all nodes detected as labeled in a lower number of datasets. + + \item[Variation cutoff] + The minimum value for the variation score (\ref{sec:variation}) for each node to be considered for the compound graph. Select ``Hide others'' to hide all nodes with a lower variation score. +\end{description} + +\subsubsection{Compound identification} +\label{sec:identification} +%TODO id , MD, RI, lib selection, multiple + +The detected isotopically enriched compound can be matched against a mass spectrum library for compound identification by selecting \includegraphics{gfx/edit-find.png} ``Library search'' from the main toolbar. Currently, only MetaboliteDetector \citep{Hiller2009} libraries are supported.\footnote{If you do not have a compound library in the MetaboliteDetector format available already, the \textit{Golm Metabolome Database} (GMD) \cite{Hummel2013} provides a good start. Download their mass spectral database in the MSL format from \url{http://gmd.mpimp-golm.mpg.de/download/} and create a library file from it using MetaboliteDetector (\url{http://metabolitedetector.tu-bs.de/}) by selecting \textit{File} $\rightarrow$ \textit{Import} $\rightarrow$ \textit{Import MSL library}. The resulting .lbr file can be used with \app.} + +\app\ uses a spectrum and RI / RT based algorithm for spectrum matching. The RI tolerance and identification score cutoff can be defined in the experiment wizard (\ref{sec:experiment-wizard}). + + +\subsubsection{Settings} + +\label{sec:settings} + +The settings dialog (Fig.~\ref{fig:settings_paths}) can be opened by clicking \includegraphics{gfx/ico_settings.png} in the main toolbar (\ref{sec:maintoolbar}). +More graph options and certain default paths can be set here (Fig.~\ref{fig:settings_paths}). + +\begin{figure}[htb] + \centering + \includegraphics[width=0.4\linewidth]{./gfx/ss_settings_paths.png} + \label{fig:settings_paths} + \includegraphics[width=0.4\linewidth]{./gfx/ss_settings_misc.png} + \caption{The configuration page for paths and miscellaneous settings.} + \label{fig:settings_misc} +\end{figure} + +\begin{description} + \item[Show unconnected nodes] + Toggle whether nodes which are not connected to any others nodes should be shown or not (see also \ref{sec:graph-panel} and \ref{sec:network}). + + \item[Use largest common ion] + If a compound was detected in multiple datasets, the heaviest labeled fragment common to all datasets can be used in the plot and for distance calculation, or the heaviest fragment for each dataset independently. + + \item[MID plot layout] + MID plots for a compound labeled in multiple experiments can be laid out vertically, horizontally or in a quadratic grid. + + \item[Distance calculation] + Defines on which data the MID distance calculation is performed. The full MID vector can be used (``Include'') or the M+0 can be omitted (``Exclude M0''). If M+0 is omitted, the remaining vector can be divided by the highest value ("normalize to basepeak``) or the sum (''normalize to sum``). + +\end{description} + +\subsubsection{Data export} + +\label{sec:data-export} + +An important feature of \app\ are its data export capabilities. + +The following data can be exported: +\begin{description} + \item[MIDs of all compounds detected as isotopically enriched] + By selecting \includegraphics{../gui/icons/document-save-csv.png} ''Export MIDs to CSV`` from the main toolbar + + \item[MID plots of all compounds and the MID similarity-based network] + By selecting \includegraphics{gfx/ico_export-image.png} ''Export image`` in the graph view toolbar (\ref{sec:graph-view}) + + \item[MID plots for all fragments of each compound] + By selecting \includegraphics{gfx/ico_export-image.png} ''Export image`` in the Compound detail view (\ref{sec:compound-details}) + + \item[The settings used for the analysis] + By selecting ''Save XML`` in the dataset panel (\ref{sec:dataset-panel}) + +\end{description} + +% TODO hdf + +\subsubsection{Data import} + +\label{sec:data-import} + +\app\ requires data in the MetaboliteDetector \citep{Hiller2009} format. GC-MS data can be imported from the netCDF format via the data import dialog (Fig.~\ref{fig:data-import}) which can be accessed via \includegraphics{../gui/icons/document-import.png} ''Import data`` in the main toolbar. This dialog can also be used to re-perform peak picking and spectrum deconvolution on existing MetaboliteDetector data. + +Note: For best control over deconvolution, these steps should be performed in MetaboliteDetector where they can be inspected immediately. Low quality spectra should already be filtered at this stage to increase specificity and speed of the detection of isotopic enrichment. + +\begin{figure}[htb] + \centering + \includegraphics[width=0.4\linewidth]{./gfx/ss_data_import.png} + \caption{Data import window} + \label{fig:data-import} +\end{figure} + +\clearpage + +%\section{FAQ} +%TODO FAQ +%\clearpage + +\section{Step-by-step tutorial} + +On the \app\ website, there is a sample data set available for download. In the following, we will demonstrate the first steps in \app\ to explore this stable isotope labeling data. + +The sample data set contains GC-MS measurements of trimethylsilylated metabolite extracts from A549 cells incubated under 21\% or 1\% oxygen atmosphere (''N`` / ''H``)in the presence of [U-$^{13}$C]glucose (''U13CGlc``), [U-$^{13}$C]glutamine (''U13CGln``) or only unlabeled substrates (''``). The data is supplied ready-to-use in the MetaboliteDetector format (.bin/.idx/.cmp). + +\subsection{Start program and load data} + +Download and unpack the sample data and run \app. For a quick start, the file \texttt{sampleData.xml} contains all parameters for the given data sets and can be loaded by selecting \includegraphics{../gui/icons/document-open-xml.png} ''Open XML`` from the main toolbar. + +Note: \texttt{sampleData.xml} must be located in same folder as the data files. + +After selecting the .xml file, compound detection will start automatically. Depending on your system, this might take up to a few minutes. Once, compound detection is finished, you will see all compounds which were detected as isotopically enriched (Fig.~\ref{fig:tutorial-dataloaded}). + +\begin{figure}[htbp] + \centering + \includegraphics[width=0.8\textwidth]{./gfx/ss_tutorial_dataloaded.png} + \caption{\app\ after loading the sample dataset.} + \label{fig:tutorial-dataloaded} +\end{figure} + +%Although \app\ can import data from the netCDF format it is highly recommended to perform peak detection and deconvolution in \href{http://metabolitedetector.tu-bs.de/}{\MD} \citep{Hiller2009} + + +\subsection{Inspecting the results} + +In the dataset panel, you can see the different experimental conditions and how many compounds were detected as isotopically enriched. In the center, you can see every detected enriched compound as an ellipse with plotted MIDs for each experimental condition with the same color coding as on the list on the right (see \ref{sec:node}). The compound panel on the left shows a list of all compounds which were detected in any of the datasets. For now, these compounds are all named by their retention index (RI). + +$\rightarrow$ Scroll around and zoom in to inspect the MID plots (\ref{sec:graph-view}). Double click them to get more detailed information. When you double click on an entry in the dataset list, you can see which files are associated and can change parameters for the detection of isotopic enrichment (\ref{sec:experiment-wizard}). + + +\subsubsection{Compound identification} + +To find out which compounds were detected as isotopically enriched, you can match their spectra against a library with known mass spectra (\ref{sec:identification}). To this end, select \includegraphics{gfx/edit-find.png} ``Library search'' from the main toolbar, locate the file \texttt{sample-lib-TMS.lbr} which was part of the sample data archive. Select ``No'' in the next dialog. Click on heading of the first column of the compound list to order compounds alphabetically. The result should look similar to Fig.~\ref{fig:tutorial-identified}. + +\begin{figure}[htbp] + \centering + \includegraphics[width=0.8\textwidth]{./gfx/ss_tutorial_identified.png} + \caption{\app\ after loading the sample dataset.} + \label{fig:tutorial-identified} +\end{figure} + +\subsubsection{MID variation} + +You can use \app\ to detect those compounds with changing MIDs, which are indicative of changing fluxes in response to lower oxygen levels. To obtain meaningful results, only data from the same tracer should be used. Let's analyze isotopic enrichment from [U-$^{13}$C]glutamine. Therefor, first remove the [U-$^{13}$C]glucose labeling datasets by selecting them in the data set list and clicking ``remove''. For the MID variation analysis (\ref{sec:variation}), ideally the MIDs from the same mass spectrometric fragment is analyzed. To ensure this, access the configuration dialog from the main toolbar and select \textit{Misc} $\rightarrow$ \textit{Use largest common ion}. + +%Now go to the ``Graph options'' tab, and set ``Minimum experiments for compounds'' to 2 and check ``Hide others''. + +Check ``Hide others'' under ``Variation cutoff'' and move the slider slowly to the right. Some ellipses will start to disappear. Stop, when there are only 5 compounds left. Use the sample library as above to try to identify these compounds (Fig.~\ref{fig:tutorial-highvar}). + +Malic acid and aspartic acid show a strong change in MIDs in response to lower oxygen availability. The strong increase in relative M+3 abundance and the strong decrease in M+4 abundance are indicative of an inversion of isocitrate dehydrogenase flux directionality, an important feature of cancer hypoxic cancer cells \citep{Wise2008,Metallo2012,Weindl2016}. + +\begin{figure}[htbp] + \centering + \includegraphics[width=0.8\textwidth]{./gfx/ss_tutorial_highvar.png} + \caption{Hypoxia-induced changes after [U-$^{13}$C]glutamine labeling.} + \label{fig:tutorial-highvar} +\end{figure} + +\subsubsection{MID similarity} + +Three other compounds of the five selected in the previous step are still unidentified. We try to gain information on their metabolic origin by comparing their MIDs to those of other compounds. Let's try that for the compound RI~1782.98. + +In the configuration dialog, uncheck \textit{Misc} $\rightarrow$ \textit{Use largest common ion}. In the Graph options, uncheck ``Hide others'' under ``Variation cutoff'' and move slider back to 0. Now move the ``Distance cutoff'' slider slowly to the right, to about 1\%. +%In the warning dialog, click ``Yes'' if the edge number is still below 400, otherwise select a lower cutoff value. +When the graph is plotted, click on ``RI~1782.98'' in the compound list to center the view on it. The result will look similar to Fig.~\ref{fig:tutorial-midsim}. + +\begin{figure}[htbp] + \centering + \includegraphics[width=0.8\textwidth]{./gfx/ss_tutorial_midsim.png} + \caption{MID-neighbors of RI~1782.98.} + \label{fig:tutorial-midsim} +\end{figure} + +From the network you can see that our compound of interest RI~1782.98 is has a extremely similar MID as compound RI~1705.96. This is a hint, that both compounds are part of the same linear metabolic pathway, or that these are two derivatives arising during sample preparation from the same native metabolite. +Furthermore, aspartic acid and malic acid show high MID similarity at normoxia, and thus, seem to be closely related. + +And indeed, a more comprehensive reference library will confirm these observations: RI~1782.98 and 1705.96 are the 3TMS and 2TMS derivative of \textit{N}-acetylaspartic acid, respectively. \textit{N}-acetylaspartic acid is derived from aspartic acid which is in turn derived from malic acid, explaining the high observed MID similarity. + +%\subsubsection{Multiple datasets} + +% load second data sets and introduce flux analysis + +\subsubsection{Exporting the data} + +Export the MIDs of all compound as csv file, by selecting \includegraphics{../gui/icons/document-save-csv.png} ``Export MIDs to CSV'' from the main toolbar. Export the MID plots currently shown in the graph view by selecting \includegraphics{gfx/ico_export-image.png} ``Export image'' in the graph view toolbar (\ref{sec:graph-view}). Inspect the exported data in a spreadsheet application (.csv) and a vector graphics editor (.svg). + +%\section{References} + +\bibliographystyle{abbrv} +\bibliography{mia-doc} + +\end{document} diff --git a/gui/CMakeLists.txt b/gui/CMakeLists.txt new file mode 100644 index 0000000..9412ad0 --- /dev/null +++ b/gui/CMakeLists.txt @@ -0,0 +1,203 @@ +# MIA - Mass Isotopolome Analyzer +# Copyright (C) 2012-15 Daniel Weindl +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as +# published by the Free Software Foundation, either version 3 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 Affero General Public License for more details. +# +# You should have received a copy of the GNU Affero General Public License +# along with this program. If not, see . + +if(CMAKE_SYSTEM_NAME STREQUAL "Windows") + set(CMAKE_PREFIX_PATH /usr/local/Qt-5.3.1/) + if(POLICY CMP0043) + cmake_policy(SET CMP0043 OLD) + endif() +else () +endif() + + +find_package(Qt5Widgets REQUIRED) +find_package(MD REQUIRED) +# find_package(GraphViz REQUIRED) +set(GraphViz_INCLUDE_DIR "/usr/local/include/graphviz" CACHE STRING "GraphViz include directory") + +set(CMAKE_AUTOMOC TRUE) + +set(GUI_SRC_LIST + configdialog.cpp + experimentlistwidget.cpp + experimentwizard.cpp + graphvizqt.cpp + labelidentificatorqthread.cpp + main.cpp + miaguiconstants.h + miamainwindow.cpp + midplot.cpp + nodecompounddescriptionwidget.cpp + nodecompoundtreemodel.cpp + nodewidget.cpp + nwview.cpp +) + +option(MIA_WITH_HDF5 "Include HDF5 support?" OFF) +if(MIA_WITH_HDF5) + find_package(HDF5 REQUIRED) + add_definitions(-DMIA_WITH_HDF5) + set(GUI_SRC_LIST ${GUI_SRC_LIST} hdfwriter.cpp) +endif() + +if(MIA_WITH_METABOBASE) + set(GUI_SRC_LIST ${GUI_SRC_LIST} ../kegg_reaction_test/keggreactionmapper.cpp) +endif() + +if(MIA_WITH_NETCDF_IMPORT) + set(GUI_SRC_LIST ${GUI_SRC_LIST} netcdfimportdialog.cpp) +endif() + +qt5_add_resources(GUI_RESOURCES gui-resources.qrc) + +include_directories( + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR} + ../src + ${QWT_INCLUDE_DIR} + ${MD_INCLUDE_DIR} + ${LABID_INCLUDE_DIR} + ${HDF5_INCLUDE_DIRS} + ${GraphViz_INCLUDE_DIR} +) + +add_definitions(-DWITH_CGRAPH) + +if(CMAKE_SYSTEM_NAME STREQUAL "Windows") + set(RES_FILES "win32/mia.rc") + set(CMAKE_RC_COMPILER_INIT windres) + ENABLE_LANGUAGE(RC) + SET(CMAKE_RC_COMPILE_OBJECT " -O coff -i -o ") +endif() + +add_executable(mia-gui ${RES_FILES} ${GUI_SRC_LIST} ${GUI_RESOURCES}) + +qt5_use_modules(mia-gui Widgets Core Concurrent PrintSupport Svg Network) + +################## BEGIN LINKING OPTIONS ################## +set (GraphViz_LIBRARY_PATH "$ENV{HOME}/src/_libs/graphviz-2.30.1" CACHE STRING "GraphViz root dir") +set (GraphViz_LIBRARIES + ${GraphViz_LIBRARY_PATH}/plugin/core/.libs/libgvplugin_core_C.a + ${GraphViz_LIBRARY_PATH}/plugin/dot_layout/.libs/libgvplugin_dot_layout_C.a + ${GraphViz_LIBRARY_PATH}/plugin/neato_layout/.libs/libgvplugin_neato_layout_C.a + ${GraphViz_LIBRARY_PATH}/lib/gvc/.libs/libgvc_C.a + ${GraphViz_LIBRARY_PATH}/lib/cgraph/.libs/libcgraph_C.a + ${GraphViz_LIBRARY_PATH}/lib/cdt/.libs/libcdt_C.a + ${GraphViz_LIBRARY_PATH}/lib/pathplan/.libs/libpathplan_C.a + ${GraphViz_LIBRARY_PATH}/lib/cgraph/.libs/libcgraph_C.a + ${GraphViz_LIBRARY_PATH}/lib/common/.libs/libcommon_C.a +) + +set (Boost_LIBRARIES + ${Boost_FILESYSTEM_LIBRARY_RELEASE} + ${Boost_REGEX_LIBRARY_RELEASE} + ${Boost_SYSTEM_LIBRARY_RELEASE} +) + +if(CMAKE_SYSTEM_NAME STREQUAL "Windows") + + set(CROSSCOMPILE_ROOT "$ENV{HOME}/src/crosscompile/") + set(STATIC_QT_LIBRARIES ${CROSSCOMPILE_ROOT}/mxe/usr/i686-w64-mingw32.static/qt5/plugins/platforms/libqwindows.a -lwinspool -L${CROSSCOMPILE_ROOT}/mxe/usr/i686-w64-mingw32.static/qt5/lib -lQt5PlatformSupport -lQt5Gui -lcomdlg32 -loleaut32 -limm32 -lglu32 -lopengl32 -ljpeg -lharfbuzz -lcairo -lgobject-2.0 -lfontconfig -lusp10 -lmsimg32 -lgdi32 -lpixman-1 -lffi -lexpat -lfreetype -lbz2 -lpng16 -lharfbuzz_too -lglib-2.0 -lwinmm -lshlwapi -lpcre -lintl -liconv -lpng -lQt5Core -lole32 -luuid -lws2_32 -ladvapi32 -lshell32 -luser32 -lkernel32 -lz -lsicuin -lsicuuc -lsicudt -lpcre16) + + target_link_libraries(mia-gui + ${GraphViz_LIBRARIES} + ${CROSSCOMPILE_ROOT}/win32/graphviz-2.38.0/libltdl/.libs/libltdlc.a -ldl + #${CROSSCOMPILE_ROOT}/win32/graphviz-2.38.0/libltdl/.libs/dlopen.a + # /usr/lib/x86_64-linux-gnu/libexpat.a + ${CMAKE_BINARY_DIR}/src/libmia.a + ${MD_LIBRARY} + ) + + if(MIA_WITH_HDF5) + target_link_libraries(mia-gui + #${HDF5_hdf5_LIBRARY_RELEASE} + #${HDF5_C_LIBRARIES} + #${HDF5_CXX_LIBRARIES} + #${HDF5_HL_LIBRARIES} + ${CROSSCOMPILE_ROOT}/mxe/usr/i686-w64-mingw32.static/lib/libhdf5.a + ${CROSSCOMPILE_ROOT}/mxe/usr/i686-w64-mingw32.static/lib/libhdf5_cpp.a + ) + endif() + + target_link_libraries(mia-gui + ${LabId_LIBRARY} + ${GCMS_LIBRARY} + ${Boost_LIBRARIES} + # ${POSTGRESQL_LIBRARY} + ${ZLIB_LIBRARIES} + ${GSL_LIBRARIES} + # ${QWT_LIBRARY} + ${STATIC_QT_LIBRARIES} + -lharfbuzz -lharfbuzz_too -lexpat -lpcre -lpcre16 -lsicuuc -lsicudt -lssl -lcrypt32 -lcrypto -lregex -lws2_32 -lmsvcr100 + ) + if(MIA_WITH_NETCDF_IMPORT) + target_link_libraries(mia-gui + ${NetCDF_LIBRARY} + ) + endif() + +else() + set (STATIC_QT_LIBRARIES + /usr/local/Qt-5.3.1/plugins/platforms/libqxcb.a + # from libqxcb.prl: -lX11-xcb -lXi -lSM -lICE -ldbus-1 -lxcb -L~/src/_libs/qt5/qtbase/src/plugins/platforms/xcb/xcb-static -lxcb-static -lxkbcommon-x11 -lxkbcommon -L/usr/local/Qt-5.3.1/lib -lQt5PlatformSupport -lfontconfig -lfreetype -lXrender -lXext -lX11 -ludev -lQt5DBus -lQt5Gui -ljpeg -lpng -lEGL -lQt5Core -lz -licui18n -licuuc -licudata -lm -ldl -pthread -lgthread-2.0 -lglib-2.0 -lrt -lGL -lpthread + -Wl,-Bstatic -lX11-xcb -lXi -lSM -lICE -ldbus-1 -lxcb -L/home/dweidl/src/_libs/qt5/qtbase/src/plugins/platforms/xcb/xcb-static -lxcb-static -lxkbcommon-x11 -lxkbcommon -L/usr/local/Qt-5.3.1/lib -lQt5PlatformSupport -lfontconfig -lfreetype -lXrender -lXext -lX11 -lQt5DBus -lQt5Gui -ljpeg -lpng -lQt5Core -lpcre16 -lz -licui18n -licuuc -licudata -lm -pthread -lgthread-2.0 -lglib-2.0 -lrt -Wl,-Bdynamic -ludev -lEGL -lGL -lXau -lXdmcp -lltdl -ldl + ) + + target_link_libraries(mia-gui -Wl,-rpath=/usr/share/mia/ + ${GraphViz_LIBRARIES} + -lexpat + mia + ) + + if(MIA_WITH_METABOBASE) + target_link_libraries(mia-gui + ${CMAKE_SOURCE_DIR}/../mddb/build/src/libMDDB.a + #/usr/lib/x86_64-linux-gnu/libpq.a + ${POSTGRESQL_LIBRARY} + ) + endif() + + if(MIA_WITH_NETCDF_IMPORT) + target_link_libraries(mia-gui + ${NetCDF_LIBRARY} + ) + endif() + + if(MIA_WITH_HDF5) + target_link_libraries(mia-gui + #${HDF5_C_LIBRARIES} ${HDF5_CXX_LIBRARIES} ${HDF5_HL_LIBRARIES} ${HDF5_DEFINITIONS} + /usr/lib/x86_64-linux-gnu/hdf5/serial/libhdf5.a + /usr/lib/x86_64-linux-gnu/hdf5/serial/libhdf5_cpp.a + ) + endif() + + target_link_libraries(mia-gui + ${MD_LIBRARY} + ${LabId_LIBRARY} + ${GCMS_LIBRARY} + ${Boost_LIBRARIES} + ${ZLIB_LIBRARIES} + ${GSL_LIBRARIES} + ${QWT_LIBRARY} + ${STATIC_QT_LIBRARIES} + ) +endif() + +################## END LINKING OPTIONS ################## + +################## BEGIN INSTALL OPTIONS ################## +install(TARGETS mia-gui DESTINATION bin) +################## END INSTALL OPTIONS ################## diff --git a/gui/configdialog.cpp b/gui/configdialog.cpp new file mode 100644 index 0000000..fcce622 --- /dev/null +++ b/gui/configdialog.cpp @@ -0,0 +1,285 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "configdialog.h" + +#include +#include "nodewidget.h" +#include "miaguiconstants.h" + +namespace mia { + +ConfigDialog::ConfigDialog(QWidget *parent) : + QDialog(parent) +{ + contentsWidget = new QListWidget; + contentsWidget->setViewMode(QListView::IconMode); + contentsWidget->setIconSize(QSize(48, 48)); + contentsWidget->setMaximumWidth(80); + contentsWidget->setSpacing(2); + + pagesWidget = new QStackedWidget; + + pagePaths = new ConfigurationPagePaths; + pagesWidget->addWidget(pagePaths); + pageMisc = new ConfigurationPageMisc; + pagesWidget->addWidget(pageMisc); + + QPushButton *closeButton = new QPushButton(tr("Close")); + // TODO QPushButton *defaultButton = new QPushButton(tr("Defaults")); + + createTOCIcons(); + contentsWidget->setCurrentRow(0); + + connect(closeButton, SIGNAL(clicked()), this, SLOT(accept())); + // TODO connect(defaultButton, SIGNAL(clicked()), this, SLOT(close())); + + QHBoxLayout *horizontalLayout = new QHBoxLayout; + horizontalLayout->addWidget(contentsWidget); + horizontalLayout->addWidget(pagesWidget, 1); + + QHBoxLayout *buttonsLayout = new QHBoxLayout; + buttonsLayout->addStretch(1); + buttonsLayout->addWidget(closeButton); + + QVBoxLayout *mainLayout = new QVBoxLayout; + mainLayout->addLayout(horizontalLayout); + mainLayout->addStretch(1); + mainLayout->addSpacing(12); + mainLayout->addLayout(buttonsLayout); + setLayout(mainLayout); + + setWindowTitle(QApplication::applicationName() + tr(" Config")); + + connect(this, SIGNAL(accepted()), this, SLOT(saveConfig())); +} + +void ConfigDialog::changePage(QListWidgetItem *current, QListWidgetItem *previous) +{ + if (!current) + current = previous; + + pagesWidget->setCurrentIndex(contentsWidget->row(current)); +} + +void ConfigDialog::saveConfig() +{ + pagePaths->save(); + pageMisc->save(); +} + +void ConfigDialog::createTOCIcons() +{ + QListWidgetItem *pathsButton = new QListWidgetItem(contentsWidget); + pathsButton->setIcon(QIcon::fromTheme("folder-open")); // emblem-system + pathsButton->setText(tr("Paths")); + pathsButton->setTextAlignment(Qt::AlignHCenter); + pathsButton->setFlags(Qt::ItemIsSelectable | Qt::ItemIsEnabled); + + connect(contentsWidget, + SIGNAL(currentItemChanged(QListWidgetItem*, QListWidgetItem*)), + this, SLOT(changePage(QListWidgetItem*, QListWidgetItem*))); + + QListWidgetItem *miscButton = new QListWidgetItem(contentsWidget); + miscButton->setIcon(QIcon::fromTheme("configure")); + miscButton->setText(tr("Misc")); + miscButton->setTextAlignment(Qt::AlignHCenter); + miscButton->setFlags(Qt::ItemIsSelectable | Qt::ItemIsEnabled); + + connect(contentsWidget, + SIGNAL(currentItemChanged(QListWidgetItem*, QListWidgetItem*)), + this, SLOT(changePage(QListWidgetItem*, QListWidgetItem*))); + +} + +ConfigurationPagePaths::ConfigurationPagePaths(QWidget *parent) +{ + QSettings s; + + QVBoxLayout *mainLayout = new QVBoxLayout; + + // XML + QLabel *labelXMLPath = new QLabel("XML directory:"); + textXMLPath = new QLineEdit(s.value("open_xml_path", QDir::homePath()).toString()); + QPushButton *buttonXMLPath = new QPushButton(QIcon::fromTheme("folder-open"), "Select"); + connect(buttonXMLPath, SIGNAL(clicked()), this, SLOT(selectXMLPath())); + + mainLayout->addWidget(labelXMLPath); + mainLayout->addWidget(textXMLPath); + mainLayout->addWidget(buttonXMLPath); + + // Lib + QLabel *labelLibPath = new QLabel("Library directory:"); + textLibPath = new QLineEdit(s.value("open_library_path", QDir::homePath()).toString()); + mainLayout->addWidget(labelLibPath); + mainLayout->addWidget(textLibPath); + + // Data + QLabel *labelDataPath = new QLabel("Binary data directory:"); + textDataPath = new QLineEdit(s.value("open_binary_path", QDir::homePath()).toString()); + mainLayout->addWidget(labelDataPath); + mainLayout->addWidget(textDataPath); + + QLabel *labelChromatogramPath = new QLabel("Chromatogram directory:"); + textChromatogramPath = new QLineEdit(s.value("chromatogram_path", QDir::homePath()).toString()); + mainLayout->addWidget(labelChromatogramPath); + mainLayout->addWidget(textChromatogramPath); + + // ExcludeLib + QLabel *labelExcludeLib = new QLabel("Exclude library:"); + textExcludeLib = new QLineEdit(s.value("exclude_library_file", "").toString()); + mainLayout->addWidget(labelExcludeLib); + mainLayout->addWidget(textExcludeLib); + + setLayout(mainLayout); +} + +void ConfigurationPagePaths::save() +{ + QSettings s; + s.setValue("open_xml_path", textXMLPath->text()); + s.setValue("open_library_path", textLibPath->text()); + s.setValue("open_binary_path", textDataPath->text()); + s.setValue("chromatogram_path", textChromatogramPath->text()); + s.setValue("exclude_library_file", textExcludeLib->text()); +} + +void ConfigurationPagePaths::selectXMLPath() +{ + QString dir = QFileDialog::getExistingDirectory(this, "Select directory...", textXMLPath->text()); + + if(dir.isNull()) + return; + + textXMLPath->setText(dir); +} + +ConfigurationPageMisc::ConfigurationPageMisc(QWidget *parent) +{ + initNodeLayoutGroupBox(); + initM0OptionsGroupBox(); + + QVBoxLayout *vl = new QVBoxLayout(this); + + showUnconnectedNodes = new QCheckBox("Show unconnected nodes", this); + showUnconnectedNodes->setChecked(s.value("graph_show_unconnected_nodes", true).toBool()); + vl->addWidget(showUnconnectedNodes); + + useLargestCommonIon = new QCheckBox("Use largest common ion", this); + useLargestCommonIon->setChecked(s.value("nw_use_common_largest_ion", NW_USE_LARGEST_COMMON_ION).toBool()); + vl->addWidget(useLargestCommonIon); + + vl->addWidget(nodeLayoutGroupBox); + + vl->addWidget(m0OptionsGroupBox); + + setLayout(vl); +} + +void ConfigurationPageMisc::save() +{ + s.setValue("nodewidget_layout_direction", nodeLayoutGroup->checkedId()); + + s.setValue("alignment_m0", m0OptionsGroup->checkedId()); + + s.setValue("graph_show_unconnected_nodes", showUnconnectedNodes->isChecked()); + + s.setValue("nw_use_common_largest_ion", useLargestCommonIon->isChecked()); +} + +void ConfigurationPageMisc::initNodeLayoutGroupBox() +{ + int nodeLayout = s.value("nodewidget_layout_direction", NodeWidget::LAYOUT_VERTICAL).toInt(); + + nodeLayoutGroup = new QButtonGroup(this); + + nodeLayoutVertical = new QRadioButton("Vertical", this); + nodeLayoutHorizontal = new QRadioButton("Horizontal", this); + nodeLayoutSquare = new QRadioButton("Square", this); + + switch (nodeLayout) { + case NodeWidget::LAYOUT_VERTICAL: + nodeLayoutVertical->setChecked(true); + break; + case NodeWidget::LAYOUT_HORIZONTAL: + nodeLayoutHorizontal->setChecked(true); + break; + case NodeWidget::LAYOUT_SQUARE: + nodeLayoutSquare->setChecked(true); + break; + } + + nodeLayoutGroup->addButton(nodeLayoutVertical, NodeWidget::LAYOUT_VERTICAL); + nodeLayoutGroup->addButton(nodeLayoutHorizontal, NodeWidget::LAYOUT_HORIZONTAL); + nodeLayoutGroup->addButton(nodeLayoutSquare, NodeWidget::LAYOUT_SQUARE); + + nodeLayoutGroupBox = new QGroupBox("MID plot layout", this); + QVBoxLayout *vl = new QVBoxLayout(nodeLayoutGroupBox); + vl->addWidget(nodeLayoutVertical); + vl->addWidget(nodeLayoutHorizontal); + vl->addWidget(nodeLayoutSquare); + nodeLayoutGroupBox->setLayout(vl); +} + +void ConfigurationPageMisc::initM0OptionsGroupBox() +{ + int m0 = s.value("alignment_m0", 0).toInt(); + + m0OptionsGroup = new QButtonGroup(this); + + m0Include = new QRadioButton("Include", this); + m0Omit = new QRadioButton("Exclude M0", this); + m0OmitScaleBasepeak = new QRadioButton("Exclude M0, normalize to basepeak", this); + m0OmitScaleSum = new QRadioButton("Exclude M0, normalize to sum", this); + + switch (m0) { + case 0: + m0Include->setChecked(true); + break; + case 1: + m0Omit->setChecked(true); + break; + case 2: + m0OmitScaleBasepeak->setChecked(true); + break; + case 3: + m0OmitScaleSum->setChecked(true); + break; + default: + m0Include->setChecked(true); + } + + m0OptionsGroup->addButton(m0Include, 0); + m0OptionsGroup->addButton(m0Omit, 1); + m0OptionsGroup->addButton(m0OmitScaleBasepeak, 2); + m0OptionsGroup->addButton(m0OmitScaleSum, 3); + + m0OptionsGroupBox = new QGroupBox("Distance calculation M0 options", this); + QVBoxLayout *vl = new QVBoxLayout(m0OptionsGroupBox); + vl->addWidget(m0Include); + vl->addWidget(m0Omit); + vl->addWidget(m0OmitScaleBasepeak); + vl->addWidget(m0OmitScaleSum); + + m0OptionsGroupBox->setLayout(vl); +} + + +} diff --git a/gui/configdialog.h b/gui/configdialog.h new file mode 100644 index 0000000..02fdc12 --- /dev/null +++ b/gui/configdialog.h @@ -0,0 +1,118 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef CONFIGDIALOG_H +#define CONFIGDIALOG_H + +#include +#include +#include +#include + +namespace mia { + +class ConfigurationPagePaths; +class ConfigurationPageMisc; + +//class ConfigurationPageCompoundIdentification; +//class ConfigurationPageColors; + +class ConfigDialog : public QDialog +{ + Q_OBJECT + +public: + explicit ConfigDialog(QWidget *parent = 0); + +signals: + +public slots: + void changePage(QListWidgetItem *current, QListWidgetItem *previous); + void saveConfig(); + +private: + QListWidget *contentsWidget; // TOC list + QStackedWidget *pagesWidget; // individual config pages + + ConfigurationPagePaths* pagePaths; + ConfigurationPageMisc* pageMisc; + + void createTOCIcons(); + +}; + +class ConfigurationPagePaths : public QWidget +{ + Q_OBJECT + +public: + ConfigurationPagePaths(QWidget *parent = 0); + void save(); + +public slots: + void selectXMLPath(); + +private: + + QLineEdit *textXMLPath; + QLineEdit *textLibPath; + QLineEdit *textDataPath; + QLineEdit *textExcludeLib; + QLineEdit *textChromatogramPath; +}; + + +class ConfigurationPageMisc : public QWidget +{ + Q_OBJECT + +public: + ConfigurationPageMisc(QWidget *parent = 0); + void save(); + +public slots: + +private: + QButtonGroup *nodeLayoutGroup; + QRadioButton *nodeLayoutVertical; + QRadioButton *nodeLayoutHorizontal; + QRadioButton *nodeLayoutSquare; + QGroupBox *nodeLayoutGroupBox; + + QButtonGroup *m0OptionsGroup; + QRadioButton *m0Include; + QRadioButton *m0Omit; + QRadioButton *m0OmitScaleBasepeak; + QRadioButton *m0OmitScaleSum; + QGroupBox *m0OptionsGroupBox; + + QCheckBox *showUnconnectedNodes; + QCheckBox *useLargestCommonIon; + + void initNodeLayoutGroupBox(); + void initM0OptionsGroupBox(); + + QSettings s; + +}; + + +} + +#endif // CONFIGDIALOG_H diff --git a/gui/experimentlistwidget.cpp b/gui/experimentlistwidget.cpp new file mode 100644 index 0000000..cc211f0 --- /dev/null +++ b/gui/experimentlistwidget.cpp @@ -0,0 +1,194 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "experimentlistwidget.h" +#include + +namespace mia { + +ExperimentListWidget::ExperimentListWidget(QWidget *parent) : + QWidget(parent) +{ + experimentAddButton = new QPushButton(QIcon(":/gui/icons/list-add.png"), tr("&Add")); + connect(experimentAddButton, SIGNAL(clicked()), this, SLOT(showAddExperimentWizard())); + + experimentRemoveButton = new QPushButton(QIcon(":/gui/icons/list-remove.png"), tr("&Remove")); + connect(experimentRemoveButton, SIGNAL(clicked()), this, SLOT(removeExperiment())); + + saveXMLButton = new QPushButton(QIcon(":/gui/icons/document-save.png"), tr("&Save XML")); + connect(saveXMLButton, SIGNAL(clicked()), this, SLOT(saveXML())); + + QCheckBox *useAll = new QCheckBox("Use all/none for similarity analysis"); + useAll->setCheckState(Qt::Checked); + connect(useAll, SIGNAL(stateChanged(int)), this, SLOT(useAllExperimentsChanged(int))); + + experimentTable = new QTableWidget(); + connect(experimentTable, SIGNAL(cellClicked(int,int)), this, SLOT(experimentClicked(int, int))); + connect(experimentTable, SIGNAL(cellDoubleClicked(int,int)), this, SLOT(experimentDoubleClicked(int, int))); + + QGridLayout *experimentGrid = new QGridLayout(); + experimentGrid->addWidget(experimentAddButton); + experimentGrid->addWidget(experimentRemoveButton); + experimentGrid->addWidget(saveXMLButton); + experimentGrid->addWidget(useAll); + experimentGrid->addWidget(experimentTable); + + setLayout(experimentGrid); + + experimentSelectionMapper = new QSignalMapper(this); + connect(experimentSelectionMapper, SIGNAL(mapped(int)), this, SLOT(experimentSelectionStateChanged(int))); +} + +void ExperimentListWidget::experimentWizardFinished(int idx) +{ + if(tw->result() == QDialog::Rejected) + return; + + Settings s = tw->getSettings(); // TODO add library fileselectiondialog button + + if(idx >= 0) { + // edit dialog, settings were changes + emit(experimentSettingChanged(idx, s)); + } else { + // add new experiment + if(tw->result() == QDialog::Rejected) + return; + + emit(experimentAdded(s)); + } + + delete tw; +} + +void ExperimentListWidget::useAllExperimentsChanged(int state) +{ + for(int row = 0; row < experimentTable->rowCount(); ++row) { + QCheckBox *chk = static_cast(experimentTable->cellWidget(row, 0)); + QVariant v = experimentTable->item(row, nameColIdx)->data(Qt::UserRole); + NetworkLayer *layer = v.value(); + layer->setVisible(state == Qt::Checked); + chk->setCheckState((Qt::CheckState)state); + } + emit(experimentUsageChanged()); +} + +void ExperimentListWidget::showAddExperimentWizard() +{ + tw = new ExperimentWizard(this); // QString("Dataset %1").arg(experimentTable->rowCount() + 1), + tw->show(); + connect(tw, SIGNAL(finished(int)), this, SLOT(experimentWizardFinished())); +} + +void ExperimentListWidget::experimentDoubleClicked(int row, int col) +{ + QVariant v = experimentTable->item(row, nameColIdx)->data(Qt::UserRole); + NetworkLayer *layer = v.value(); + tw = new ExperimentWizard(layer->getSettings(), this); + tw->show(); + signalMapperEditSettings = new QSignalMapper(this); + connect(tw, SIGNAL(finished(int)), signalMapperEditSettings, SLOT(map())); + signalMapperEditSettings->setMapping(tw, row); + connect(signalMapperEditSettings, SIGNAL(mapped(int)), this, SLOT(experimentWizardFinished(int))); +} + +void ExperimentListWidget::experimentClicked(int row, int col) +{ + std::cerr< layers, const QList &experimentColors) +{ + experimentTable->setRowCount(layers.size()); + experimentTable->setColumnCount(4); + experimentTable->setHorizontalHeaderLabels(QStringList()<<"Use"<<"Dataset"<<"Lab"<<"Unlab"); + QTableWidgetItem *item; + int i = 0; + foreach(NetworkLayer* layer, layers) { + item = new QTableWidgetItem(QString::fromStdString(layer->getSettings().experiment)); + item->setTextColor(experimentColors[i % experimentColors.size()]); // TODO wrong color sequence. add colors to layer + item->setData(Qt::UserRole, QVariant::fromValue(layer)); + + int column = 0; + + QCheckBox *chk = new QCheckBox(experimentTable); + chk->setChecked(layer->isVisible()); + connect(chk, SIGNAL(clicked()), experimentSelectionMapper, SLOT(map())); + experimentSelectionMapper->setMapping(chk, i); + experimentTable->setCellWidget(i, column++, chk); + + experimentTable->setItem(i, column++, item); + experimentTable->setItem(i, column++, new QTableWidgetItem(QString::number(layer->cmpLab.size()))); + experimentTable->setItem(i, column++, new QTableWidgetItem(QString::number(layer->cmpUnlab.size()))); + ++i; + } + experimentTable->resizeColumnsToContents(); +} + +/** + * @brief An experiment was selected or deselected + * @param idx index in "layers" + */ +void ExperimentListWidget::experimentSelectionStateChanged(int idx) +{ + QCheckBox *chk = static_cast(experimentTable->cellWidget(idx, 0)); + QVariant v = experimentTable->item(idx, nameColIdx)->data(Qt::UserRole); + NetworkLayer *layer = v.value(); + layer->setVisible(chk->isChecked()); + + emit(experimentUsageChanged()); +} + +void ExperimentListWidget::removeExperiment() +{ + QList items = experimentTable->selectedItems(); + if(!items.size()) + return; + + foreach(QTableWidgetItem* item, items) { + QVariant v = experimentTable->item(item->row(), nameColIdx)->data(Qt::UserRole); + NetworkLayer *layer = v.value(); + emit(experimentRemoved(layer)); + } +} + +void ExperimentListWidget::saveXML() +{ + // write current datasets to XML file for easy reload + QString filename = QFileDialog::getSaveFileName(this, "Save current dataset as XML", "", "XML files (*.xml);;All files (*)"); + + if(filename.isNull()) + return; + + QFile f(filename); + f.open(QIODevice::WriteOnly); + QTextStream out(&f); + + out<<"\n"; + out<<"\n"; + + for(int row = 0; row < experimentTable->rowCount(); ++row) { + QVariant v = experimentTable->item(row, nameColIdx)->data(Qt::UserRole); + NetworkLayer *layer = v.value(); + out<getSettings().toXML().c_str()<<"\n"; + } + out<<"\n"; +} + +} diff --git a/gui/experimentlistwidget.h b/gui/experimentlistwidget.h new file mode 100644 index 0000000..da8b122 --- /dev/null +++ b/gui/experimentlistwidget.h @@ -0,0 +1,70 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef EXPERIMENTLISTWIDGET_H +#define EXPERIMENTLISTWIDGET_H + +#include +#include +#include "experimentwizard.h" +#include "../src/settings.h" +#include "../src/networklayer.h" + +Q_DECLARE_METATYPE(mia::NetworkLayer*) // for use with UserRole + +namespace mia { + +class ExperimentListWidget : public QWidget +{ + Q_OBJECT +public: + explicit ExperimentListWidget(QWidget *parent = 0); + void updateExperimentList(QList layers, const QList &experimentColors); + QList getVisibleExperiments(QList datasets); + +signals: + void experimentSettingChanged(int idx, Settings s); + void experimentAdded(Settings s); + void experimentUsageChanged(); + void experimentRemoved(NetworkLayer *layer); + +public slots: + void useAllExperimentsChanged(int state); + void experimentClicked(int row, int col); + void experimentDoubleClicked(int row, int col); + void showAddExperimentWizard(); + void experimentWizardFinished(int idx = -1); + void experimentSelectionStateChanged(int idx); + void removeExperiment(); + void saveXML(); + +private: + QTableWidget *experimentTable; + QPushButton *experimentAddButton; + QPushButton *experimentRemoveButton; + QPushButton *saveXMLButton; + QSignalMapper *signalMapperEditSettings; + ExperimentWizard *tw; + QSignalMapper *experimentSelectionMapper; + + static const int nameColIdx = 1; +}; + +} +#endif // EXPERIMENTLISTWIDGET_H diff --git a/gui/experimentwizard.cpp b/gui/experimentwizard.cpp new file mode 100644 index 0000000..c1d1718 --- /dev/null +++ b/gui/experimentwizard.cpp @@ -0,0 +1,403 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "experimentwizard.h" +#include "miaguiconstants.h" +#include + +namespace mia { + +ExperimentWizard::ExperimentWizard(QWidget *parent) : QWizard(parent) +{ + addPage(new ExperimentWizardFiles); + addPage(new ExperimentWizardSettings); + setWindowTitle(tr("Add tracer...")); + setDefaultProperty("QDoubleSpinBox", "value", "valueChanged"); +} + +ExperimentWizard::ExperimentWizard(QString title, QWidget *parent) : QWizard(parent) +{ + addPage(new ExperimentWizardFiles(title)); + addPage(new ExperimentWizardSettings); + setWindowTitle(tr("Add tracer...")); + setDefaultProperty("QDoubleSpinBox", "value", "valueChanged"); +} + +ExperimentWizard::ExperimentWizard(Settings s, QWidget *parent) : QWizard(parent) +{ + addPage(new ExperimentWizardFiles(s)); + addPage(new ExperimentWizardSettings(s)); + setWindowTitle(tr("Edit tracer...")); +} + +void ExperimentWizard::accept() +{ + QDialog::accept(); +} + +Settings ExperimentWizard::getSettings() +{ + Settings s = Settings(); + s.experiment = field("tracer_name").toString().toStdString(); + ExperimentWizardFiles* tw = dynamic_cast(page(0)); + foreach (QString i, tw->getLabeledFiles()) + s.labFiles.push_back(i.toStdString()); + foreach (QString i, tw->getUnlabeledFiles()) + s.unlabFiles.push_back(i.toStdString()); + s.cmp_id_ri_tol = field("cmp_id_ri_tol").toDouble(); + s.cmp_id_library = field("cmp_id_library").toString().toStdString(); + // s.cmp_id_mass_filter + s.cmp_id_score_cutoff = field("cmp_id_score_cutoff").toDouble(); + //s.cmp_id_use_ri + s.labels_max_hits = field("cmp_id_maxhits").toInt(); + // TODO for different tracer atoms: s.lid_correction_ratio + s.lid_maximal_frag_dev= field("lid_maximal_frag_dev").toDouble(); + s.lid_min_frag_num = field("lid_min_frag_num").toInt(); + s.lid_req_label_amount = field("lid_req_label_amount").toDouble(); + s.lid_req_r2 = field("lid_req_r2").toDouble(); + s.lid_min_m0 = field("lid_min_m0").toDouble(); + s.lid_max_mass_isotopomer = field("lid_max_mass_isotopomer").toInt(); + s.nw_gap_penalty = field("nw_gap_penalty").toDouble(); + s.mid_distance_cutoff = field("mid_distance_cutoff").toDouble(); + + return s; +} + +ExperimentWizardFiles::ExperimentWizardFiles(QWidget *parent) +{ + tracerNameText = new QLineEdit(); + registerField("tracer_name*", tracerNameText); + labFilesList = new QListWidget(); + labFilesList->setSelectionMode(QListWidget::ExtendedSelection); + unlabFilesList = new QListWidget(); + unlabFilesList->setSelectionMode(QListWidget::ExtendedSelection); + init(); +} + +ExperimentWizardFiles::ExperimentWizardFiles(QString title, QWidget *parent) +{ + tracerNameText = new QLineEdit(title); + registerField("tracer_name*", tracerNameText); + labFilesList = new QListWidget(); + labFilesList->setSelectionMode(QListWidget::ExtendedSelection); + unlabFilesList = new QListWidget(); + unlabFilesList->setSelectionMode(QListWidget::ExtendedSelection); +} + +ExperimentWizardFiles::ExperimentWizardFiles(Settings s, QWidget *parent) +{ + tracerNameText = new QLineEdit(QString::fromStdString(s.experiment)); + registerField("tracer_name", tracerNameText); + labFilesList = new QListWidget(); + + QStringList files; + for(std::vector::iterator it = s.labFiles.begin(); it != s.labFiles.end(); ++it) + files.push_back(QString::fromStdString(*it)); + labFilesList->addItems(files); + + unlabFilesList = new QListWidget(); + files.clear(); + for(std::vector::iterator it = s.unlabFiles.begin(); it != s.unlabFiles.end(); ++it) + files.push_back(QString::fromStdString(*it)); + unlabFilesList->addItems(files); + + init(); +} + +QList ExperimentWizardFiles::getLabeledFiles() +{ + QList files; + for(int i = 0; i < labFilesList->count(); ++i) { + QListWidgetItem *item = labFilesList->item(i); + files.append(item->text()); + } + return files; +} + +QList ExperimentWizardFiles::getUnlabeledFiles() +{ + QList files; + for(int i = 0; i < unlabFilesList->count(); ++i) { + QListWidgetItem *item = unlabFilesList->item(i); + files.append(item->text()); + } + return files; +} + +void ExperimentWizardFiles::init() +{ + setTitle(tr("Select files")); + + tracerNameLabel = new QLabel(tr("Tracer name:")); + labFilesLabel = new QLabel(tr("Labeled chromatograms:")); + unlabFilesLabel = new QLabel(tr("Unlabeled chromatograms:")); + + addLabFilesButton = new QPushButton(QIcon(":/gui/icons/list-add.png"), tr("&Add")); + removeLabFilesButton = new QPushButton(QIcon(":/gui/icons/list-remove.png"), tr("&Remove")); + addUnlabFilesButton = new QPushButton(QIcon(":/gui/icons/list-add.png"), tr("&Add")); + removeUnlabFilesButton = new QPushButton(QIcon(":/gui/icons/list-remove.png"), tr("&Remove")); + + registerField("lab_files", labFilesList); + registerField("unlab_files", unlabFilesList); + + QVBoxLayout *layout = new QVBoxLayout; + layout->addWidget(tracerNameLabel); + layout->addWidget(tracerNameText); + + layout->addWidget(labFilesLabel); + layout->addWidget(labFilesList); + layout->addWidget(addLabFilesButton); + layout->addWidget(removeLabFilesButton); + + layout->addWidget(unlabFilesLabel); + layout->addWidget(unlabFilesList); + layout->addWidget(addUnlabFilesButton); + layout->addWidget(removeUnlabFilesButton); + + setLayout(layout); + + connect(addLabFilesButton, SIGNAL(clicked()), this, SLOT(addLabeledChromatogram())); + connect(removeLabFilesButton, SIGNAL(clicked()), this, SLOT(removeLabeledChromatogram())); + connect(addUnlabFilesButton, SIGNAL(clicked()), this, SLOT(addUnlabeledChromatogram())); + connect(removeUnlabFilesButton, SIGNAL(clicked()), this, SLOT(removeUnlabeledChromatogram())); +} + +void ExperimentWizardFiles::addLabeledChromatogram() +{ + QSettings settings; + QStringList files = QFileDialog::getOpenFileNames(this, "Select labeled chromatograms", settings.value("dir_add_chromatogram", "").toString(), "MetaboliteDetector files (*.cmp)"); + + if(files.size()) { + labFilesList->addItems(files); + QDir dir(files[0]); + settings.setValue("dir_add_chromatogram", dir.absolutePath()); + } +} + +void ExperimentWizardFiles::addUnlabeledChromatogram() +{ + QSettings settings; + QStringList files = QFileDialog::getOpenFileNames(this, "Select labeled chromatograms", settings.value("dir_add_chromatograms", "").toString(), "MetaboliteDetector files (*.cmp)"); + + if(files.size()) { + unlabFilesList->addItems(files); + QDir dir(files[0]); + settings.setValue("dir_add_chromatogram", dir.absolutePath()); + } +} + +void ExperimentWizardFiles::removeLabeledChromatogram() +{ + QList items = labFilesList->selectedItems(); + foreach(QListWidgetItem* item, items) { + delete item; + } + labFilesList->update(); +} + +void ExperimentWizardFiles::removeUnlabeledChromatogram() +{ + QList items = unlabFilesList->selectedItems(); + foreach(QListWidgetItem* item, items) { + delete item; + } + unlabFilesList->update(); +} + +ExperimentWizardSettings::ExperimentWizardSettings(QWidget *parent) +{ + + QSettings settings; + + cmp_id_ri_tol_spinbox = new QSpinBox(); + cmp_id_ri_tol_spinbox->setValue(settings.value("cmp_id_ri_tol", CMP_ID_RI_TOL).toInt()); + cmp_id_score_cutoff_dblspinbox = new QDoubleSpinBox(); + cmp_id_score_cutoff_dblspinbox->setValue(settings.value("cmp_id_score_cutoff", CMP_ID_SCORE_CUTOFF).toDouble()); + cmp_id_maxhits_spinbox = new QSpinBox(); + cmp_id_maxhits_spinbox->setValue(settings.value("cmp_id_maxhits", LABELS_MAX_HITS).toInt()); +// cmp_id_library_text = new QLineEdit(settings.value("cmp_id_library", QString::fromStdString(CMP_ID_LIBRARY)).toString()); + + lid_maximal_frag_dev_dblspinbox = new QDoubleSpinBox(); + lid_maximal_frag_dev_dblspinbox->setValue(settings.value("lid_maximal_frag_dev", LID_MAXIMAL_FRAG_DEV).toDouble()); + lid_min_frag_num_spinbox = new QSpinBox(); + lid_min_frag_num_spinbox->setValue(settings.value("lid_min_frag_num", LID_MIN_FRAG_NUM).toInt()); + lid_req_label_amount_dblspinbox = new QDoubleSpinBox(); + lid_req_label_amount_dblspinbox->setValue(settings.value("lid_req_label_amount", LID_REQ_LABEL_AMOUNT).toDouble()); + lid_req_r2_dblspinbox = new QDoubleSpinBox(); + lid_req_r2_dblspinbox->setValue(settings.value("lid_req_r2", LID_REQ_R2).toDouble()); + lid_max_mass_isotopomer_spinbox = new QSpinBox(); + lid_max_mass_isotopomer_spinbox->setValue(settings.value("lid_max_mass_isotopomer", LID_MAX_MASS_ISOTOPOMER).toInt()); + lid_min_m0_dblspinbox = new QDoubleSpinBox(); + lid_min_m0_dblspinbox->setValue(settings.value("lid_min_m0", LID_MIN_M0).toDouble()); + nw_gap_penalty_dblspinbox = new QDoubleSpinBox(); + nw_gap_penalty_dblspinbox->setValue(settings.value("nw_gap_penalty", NW_GAP_PENALTY).toDouble()); + mid_distance_cutoff_dblspinbox = new QDoubleSpinBox(); + mid_distance_cutoff_dblspinbox->setValue(settings.value("mid_distance_cutoff", MID_DISTANCE_CUTOFF).toDouble()); + + init(); +} + +ExperimentWizardSettings::ExperimentWizardSettings(Settings s, QWidget *parent) +{ + cmp_id_ri_tol_spinbox = new QSpinBox(); + cmp_id_ri_tol_spinbox->setValue(s.cmp_id_ri_tol); + cmp_id_score_cutoff_dblspinbox = new QDoubleSpinBox(); + cmp_id_score_cutoff_dblspinbox->setValue(s.cmp_id_score_cutoff); + cmp_id_maxhits_spinbox = new QSpinBox(); + cmp_id_maxhits_spinbox->setValue(s.labels_max_hits); +// cmp_id_library_text = new QLineEdit(QString::fromStdString(s.cmp_id_library)); + + lid_maximal_frag_dev_dblspinbox = new QDoubleSpinBox(); + lid_maximal_frag_dev_dblspinbox->setValue(s.lid_maximal_frag_dev); + lid_min_frag_num_spinbox = new QSpinBox(); + lid_min_frag_num_spinbox->setValue(s.lid_min_frag_num); + lid_req_label_amount_dblspinbox = new QDoubleSpinBox(); + lid_req_label_amount_dblspinbox->setValue(s.lid_req_label_amount); + lid_req_r2_dblspinbox = new QDoubleSpinBox(); + lid_req_r2_dblspinbox->setValue(s.lid_req_r2); + lid_max_mass_isotopomer_spinbox = new QSpinBox(); + lid_max_mass_isotopomer_spinbox->setValue(s.lid_max_mass_isotopomer); + lid_min_m0_dblspinbox = new QDoubleSpinBox(); + lid_min_m0_dblspinbox->setValue(s.lid_min_m0); + nw_gap_penalty_dblspinbox = new QDoubleSpinBox(); + nw_gap_penalty_dblspinbox->setValue(s.nw_gap_penalty); + mid_distance_cutoff_dblspinbox = new QDoubleSpinBox(); + mid_distance_cutoff_dblspinbox->setValue(s.mid_distance_cutoff); + + init(); +} + +void ExperimentWizardSettings::init() +{ + setTitle(tr("Settings...")); + + cmp_id_ri_tol_spinbox->setToolTip(tr("Retention index tolerance for library matching.")); + cmp_id_maxhits_spinbox->setToolTip(tr("Maximum number of library hits to show (-1 = show all)")); + + cmp_id_ri_tol_label = new QLabel(tr("RI &Tolerance:")); + cmp_id_ri_tol_label->setBuddy(cmp_id_ri_tol_spinbox); + cmp_id_score_cutoff_label = new QLabel(tr("Compound identification cutoff score:")); + cmp_id_maxhits_label = new QLabel(tr("Show top n hits:")); +// cmp_id_library_label = new QLabel(tr("Library for compound identification:")); + lid_maximal_frag_dev_label = new QLabel(tr("Maximum fragment deviation:")); + lid_min_frag_num_label = new QLabel(tr("Minimum number of labeled fragments:")); + lid_req_label_amount_label = new QLabel(tr("Required amount of isotopic enrichment:")); + lid_req_r2_label = new QLabel(tr("Minimum R^2:")); + lid_max_mass_isotopomer_label = new QLabel(tr("Ignore compounds with M_n | with n > ...:")); + lid_min_m0_label = new QLabel(tr("Minimum M0 abd.:")); + nw_gap_penalty_label = new QLabel(tr("Gap penalty for Needleman-Wunsch-Scoring:")); + mid_distance_cutoff_label = new QLabel(tr("Distance cutoff for graph edges:")); + + cmp_id_maxhits_spinbox->setMinimum(-1); + cmp_id_maxhits_spinbox->setMaximum(5); + cmp_id_score_cutoff_dblspinbox->setMinimum(0); + cmp_id_score_cutoff_dblspinbox->setMaximum(1); + cmp_id_score_cutoff_dblspinbox->setSingleStep(0.01); + cmp_id_ri_tol_spinbox->setMinimum(0); + cmp_id_ri_tol_spinbox->setMaximum(1E6); + cmp_id_ri_tol_spinbox->setSingleStep(10); + lid_maximal_frag_dev_dblspinbox->setMinimum(0); + lid_maximal_frag_dev_dblspinbox->setMaximum(1); + lid_maximal_frag_dev_dblspinbox->setSingleStep(0.01); + lid_min_frag_num_spinbox->setMinimum(1); + lid_min_frag_num_spinbox->setMaximum(10); + lid_req_label_amount_dblspinbox->setMinimum(0); + lid_req_label_amount_dblspinbox->setMaximum(1); + lid_req_label_amount_dblspinbox->setSingleStep(0.01); + lid_req_r2_dblspinbox->setMinimum(0); + lid_req_r2_dblspinbox->setMaximum(1); + lid_req_r2_dblspinbox->setSingleStep(0.01); + lid_max_mass_isotopomer_spinbox->setMinimum(1); + lid_max_mass_isotopomer_spinbox->setMaximum(100); + lid_min_m0_dblspinbox->setMinimum(0); + lid_min_m0_dblspinbox->setMaximum(1); + lid_min_m0_dblspinbox->setSingleStep(0.01); + nw_gap_penalty_dblspinbox->setMinimum(0); + nw_gap_penalty_dblspinbox->setMaximum(1); + nw_gap_penalty_dblspinbox->setSingleStep(0.01); + mid_distance_cutoff_dblspinbox->setMinimum(0); + mid_distance_cutoff_dblspinbox->setMaximum(1); + mid_distance_cutoff_dblspinbox->setSingleStep(0.01); + + registerField("cmp_id_ri_tol", cmp_id_ri_tol_spinbox); + registerField("cmp_id_score_cutoff", cmp_id_score_cutoff_dblspinbox, "value"); + registerField("cmp_id_maxhits", cmp_id_maxhits_spinbox); +// registerField("cmp_id_library", cmp_id_library_text); + registerField("lid_maximal_frag_dev", lid_maximal_frag_dev_dblspinbox, "value"); + registerField("lid_min_frag_num", lid_min_frag_num_spinbox); + registerField("lid_req_label_amount", lid_req_label_amount_dblspinbox, "value"); + registerField("lid_req_r2", lid_req_r2_dblspinbox, "value"); + registerField("lid_min_m0", lid_min_m0_dblspinbox, "value"); + registerField("lid_max_mass_isotopomer", lid_max_mass_isotopomer_spinbox); + registerField("nw_gap_penalty", nw_gap_penalty_dblspinbox, "value"); + registerField("mid_distance_cutoff", mid_distance_cutoff_dblspinbox, "value"); + + QGridLayout *layout = new QGridLayout; + + QGridLayout *cmpIDLayout = new QGridLayout; + cmpIDLayout->addWidget(cmp_id_ri_tol_label, 0, 0); + cmpIDLayout->addWidget(cmp_id_ri_tol_spinbox, 0, 1); + cmpIDLayout->addWidget(cmp_id_score_cutoff_label, 1, 0); + cmpIDLayout->addWidget(cmp_id_score_cutoff_dblspinbox, 1, 1); + cmpIDLayout->addWidget(cmp_id_maxhits_label, 2, 0); + cmpIDLayout->addWidget(cmp_id_maxhits_spinbox, 2, 1); +// cmpIDLayout->addWidget(cmp_id_library_label); +// cmpIDLayout->addWidget(cmp_id_library_text); + QGroupBox *cmpIDGroupBox = new QGroupBox("Compound identification", this); + cmpIDGroupBox->setLayout(cmpIDLayout); + layout->addWidget(cmpIDGroupBox, 0, 0, 1, 2); + + QGridLayout *lidLayout = new QGridLayout; + int row = 0; + lidLayout->addWidget(lid_maximal_frag_dev_label, row, 0); + lidLayout->addWidget(lid_maximal_frag_dev_dblspinbox, row++, 1); + lidLayout->addWidget(lid_min_frag_num_label, row, 0); + lidLayout->addWidget(lid_min_frag_num_spinbox, row++, 1); + lidLayout->addWidget(lid_req_label_amount_label, row, 0); + lidLayout->addWidget(lid_req_label_amount_dblspinbox, row++, 1); + lidLayout->addWidget(lid_req_r2_label, row, 0); + lidLayout->addWidget(lid_req_r2_dblspinbox, row++, 1); + lidLayout->addWidget(lid_min_m0_label, row, 0); + lidLayout->addWidget(lid_min_m0_dblspinbox, row++, 1); + lidLayout->addWidget(lid_max_mass_isotopomer_label, row, 0); + lidLayout->addWidget(lid_max_mass_isotopomer_spinbox, row++, 1); + + QGroupBox *lidGroupBox = new QGroupBox("Label detection", this); + lidGroupBox->setLayout(lidLayout); + layout->addWidget(lidGroupBox, 1, 0, 1, 2); + + layout->addWidget(nw_gap_penalty_label, 2, 0); + layout->addWidget(nw_gap_penalty_dblspinbox, 2, 1); + layout->addWidget(mid_distance_cutoff_label, 3, 0); + layout->addWidget(mid_distance_cutoff_dblspinbox, 3, 1); + setLayout(layout); +} + +/* +void ExperimentWizardSettings::selectLibrary() +{ + QSettings settings; + QString file = QFileDialog::getOpenFileName(this, "Select compound library", settings.value("dir_compound_library", "").toString(), "MetaboliteDetector libraries (*.lbr)"); + cmp_id_library_text->setText(file); + QDir dir(file); + settings.setValue("dir_compound_library", dir.absolutePath()); +} +*/ +} diff --git a/gui/experimentwizard.h b/gui/experimentwizard.h new file mode 100644 index 0000000..9863936 --- /dev/null +++ b/gui/experimentwizard.h @@ -0,0 +1,134 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef ExperimentWizard_H +#define ExperimentWizard_H + +#include +#include +#include "src/settings.h" + +namespace mia { + +class ExperimentWizard; +class ExperimentWizardFiles; +class ExperimentWizardSettings; + +/** + * @brief The ExperimentWizard class shows a wizard to add a new label-experiment. + */ +class ExperimentWizard : public QWizard +{ + Q_OBJECT +public: + explicit ExperimentWizard(QWidget *parent = 0); + explicit ExperimentWizard(QString title, QWidget *parent = 0); + explicit ExperimentWizard(Settings s, QWidget *parent = 0); + + void accept(); + Settings getSettings(); +}; + +/** + * @brief The file-selection wizard page. + */ +class ExperimentWizardFiles : public QWizardPage { + Q_OBJECT + +public: + ExperimentWizardFiles(QWidget *parent = 0); + ExperimentWizardFiles(QString title, QWidget *parent = 0); + ExperimentWizardFiles(Settings s, QWidget *parent = 0); + QList getLabeledFiles(); + QList getUnlabeledFiles(); + +private: + void init(); + QLabel *tracerNameLabel; + QLabel *labFilesLabel; + QLabel *unlabFilesLabel; + QLineEdit *tracerNameText; + QListWidget *labFilesList; + QListWidget *unlabFilesList; + QPushButton *addLabFilesButton; + QPushButton *addUnlabFilesButton; + QPushButton *removeLabFilesButton; + QPushButton *removeUnlabFilesButton; + +public slots: + void addLabeledChromatogram(); + void addUnlabeledChromatogram(); + void removeLabeledChromatogram(); + void removeUnlabeledChromatogram(); +}; + +/** + * @brief The settings wizard page. + */ +class ExperimentWizardSettings: public QWizardPage { + Q_OBJECT + +public: + ExperimentWizardSettings(QWidget *parent = 0); + ExperimentWizardSettings(Settings s, QWidget *parent = 0); + +public slots: +// void selectLibrary(); + +private: + void init(); + + QLabel *cmp_id_ri_tol_label; + QSpinBox *cmp_id_ri_tol_spinbox; + QLabel *cmp_id_score_cutoff_label; + QDoubleSpinBox *cmp_id_score_cutoff_dblspinbox; + QLabel *cmp_id_maxhits_label; + QSpinBox *cmp_id_maxhits_spinbox; +// QLabel *cmp_id_library_label; +// QLineEdit *cmp_id_library_text; + QLabel *lid_maximal_frag_dev_label; + QDoubleSpinBox *lid_maximal_frag_dev_dblspinbox; + QLabel *lid_min_frag_num_label; + QSpinBox *lid_min_frag_num_spinbox; + QLabel *lid_req_label_amount_label; + QDoubleSpinBox *lid_req_label_amount_dblspinbox; + QLabel *lid_req_r2_label; + QDoubleSpinBox *lid_req_r2_dblspinbox; + QLabel *lid_max_mass_isotopomer_label; + QSpinBox *lid_max_mass_isotopomer_spinbox; + QLabel *lid_min_m0_label; + QDoubleSpinBox *lid_min_m0_dblspinbox; + QLabel *nw_gap_penalty_label; + QDoubleSpinBox *nw_gap_penalty_dblspinbox; + QLabel *mid_distance_cutoff_label; + QDoubleSpinBox *mid_distance_cutoff_dblspinbox; + + /* TODO + bool lid_filter_by_conf_interval; // NTFD: hardcoded + int lid_min_signal_to_noise; // NTFD: hardcoded + double lid_required_spec_freq; // NTFD: hardcoded + + double lid_sensitivity; + double lid_maximal_frag_dev; + double lid_correction_ratio; + //bool nw_exclude_m0; /** Gap penalty for needleman wunsch scoring */ + +}; +} +#endif // ExperimentWizard_H diff --git a/gui/graphvizmia.h b/gui/graphvizmia.h new file mode 100644 index 0000000..4cdb03c --- /dev/null +++ b/gui/graphvizmia.h @@ -0,0 +1,41 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef GRAPHVIZMIA_H +#define GRAPHVIZMIA_H + +#include +#include +#include "nodecompound.h" + +namespace mia { + +/** + * @brief Struct for use with the GraphvizQt class to link NodeCompound to a graph node. + */ +struct mynode { + Agrec_t h; /**< The pointer from GraphViz node creation. */ + NodeCompound *nc; /**< The linked NodeCompound. */ +}; + +} +Q_DECLARE_METATYPE(mia::mynode) + +#endif // GRAPHVIZMIA_H + diff --git a/gui/graphvizqt.cpp b/gui/graphvizqt.cpp new file mode 100644 index 0000000..7b7da2a --- /dev/null +++ b/gui/graphvizqt.cpp @@ -0,0 +1,700 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include +#include +#include +#include + +#include +#include +#include +#include + +#include "graphvizqt.h" +#include "src/nodecompound.h" + +// not needed for linux. there config6 file enough? +// adapted from graphviz dot: graphviz-2.38.0/cmd/dot/dot_builtins.c +extern gvplugin_library_t gvplugin_dot_layout_LTX_library; +extern gvplugin_library_t gvplugin_neato_layout_LTX_library; +extern gvplugin_library_t gvplugin_core_LTX_library; + +lt_symlist_t lt_preloaded_symbols[] = { + { "gvplugin_dot_layout_LTX_library", (void*)(&gvplugin_dot_layout_LTX_library) }, + { "gvplugin_neato_layout_LTX_library", (void*)(&gvplugin_neato_layout_LTX_library) }, + { "gvplugin_core_LTX_library", (void*)(&gvplugin_core_LTX_library) }, + { 0, 0 } +}; +// end graphviz + + +namespace graphvizqt { + +GraphVizQT::GraphVizQT() +{ +} + +const float Graph::EDGE_STYLE_BOLD_SCALING = 3; + +char Graph::EDGE_ATTR_LABEL[] = "label"; +char Graph::EDGE_ATTR_COLOR[] = "color"; +char Graph::EDGE_ATTR_STYLE[] = "style"; +char Graph::EDGE_ATTR_LABELFONTSIZE[] = "labelfontsize"; +char Graph::EDGE_ATTR_LABELFONTCOLOR[] = "labelfontcolor"; +char Graph::EDGE_ATTR_TOOLTIP[] = "edgetooltip"; +char Graph::EDGE_ATTR_PENWIDTH[] = "penwidth"; + +char Graph::NODE_ATTR_COLOR[] = "color"; +char Graph::NODE_ATTR_FILLCOLOR[] = "fillcolor"; +char Graph::NODE_ATTR_FONTCOLOR[] = "fontcolor"; +char Graph::NODE_ATTR_WIDTH[] = "width"; +char Graph::NODE_ATTR_HEIGHT[] = "height"; + +/** + * @brief Init empty graph. + */ +Graph::Graph() +{ + g = 0; + //gvc = gvContext(); // for linux + gvc = gvContextPlugins(lt_preloaded_symbols, 0); // "0" !!! for static dot on windows + init(); + +} + +/** + * @brief Init graph from graph-viz dot-string. + * @param dot Graph definition in dot-format. + */ +Graph::Graph(std::string dot) +{ + g = 0; + gvc = gvContext(); + char c[dot.size() + 1]; + strcpy(c, dot.c_str()); + if(!(g = agmemread(c))){ + std::cerr<<"Could not read graph."<"<(name.c_str()), TRUE); + + char defaultAttr[] = "NoName"; + agsafeset(n, EDGE_ATTR_LABEL, const_cast(name.c_str()), defaultAttr);// set name as preliminary label // should happen by default?! + //agsafeset(n, "fontsize", "24", "24");// default fontsize; TODO set globally somewhere + + if(recordTypeSize) { + if(userData.indexOf(recordType) < 0) userData.push_back(recordType); + return agbindrec(n, const_cast(recordType), recordTypeSize, FALSE); + } + + return 0; +} + +/** + * @brief Set a QWidget to be drawn within the node. + * @param node Node identifier. + * @param w The widget to add. + */ +void Graph::setNodeGraphicsItem(std::string node, QGraphicsItem *w) +{ + Agnode_t *n = getNode(node); + nodeWidgets[n] = w; + agsafeset(n, NODE_ATTR_WIDTH, const_cast(QString::number(M_SQRT2*2*w->boundingRect().width() / physicalDpiX).toStdString().c_str()), const_cast("")); // need to set in inch + agsafeset(n, NODE_ATTR_HEIGHT, const_cast(QString::number(M_SQRT2*2*w->boundingRect().height() / physicalDpiY).toStdString().c_str()), const_cast("")); +} + +/** + * @brief Convenience function for void Graph::addEdge(std::string nn1, std::string nn2, std::string en, QStyle *style). + */ +void Graph::addEdge(QString nn1, QString nn2, QString en, QStyle *style) +{ + addEdge(nn1.toStdString(), nn2.toStdString(), en.toStdString(), style); +} + +/** + * @brief Adds an undirected edge to the graph. + * @param nn1 Identifier of first node. + * @param nn2 Identifier of second node. + * @param en Identifier of the edge to be added. + * @param style Optional style for the edge. + */ +void Graph::addEdge(std::string nn1, std::string nn2, std::string en, QStyle *style) +{ + Agnode_t *n1 = getNode(nn1); + if(!n1) + throw GraphVizQTException("Invalid node:", nn1); + + Agnode_t *n2 = getNode(nn2); + if(!n2) + throw GraphVizQTException("Invalid node:", nn2); + + // std::cerr<<"Adding edge <"< to <"<"<(en.c_str()), TRUE); + char *defaultAttr = const_cast(en.c_str()); + agsafeset(e, EDGE_ATTR_LABEL, const_cast(en.c_str()), defaultAttr); +} + +/** + * @brief Convenience function for Graph::getNodeRecord(node_t *n, char *recordType) + */ +void *Graph::getNodeRecord(QString nn, char *recordType) +{ + return getNodeRecord(nn.toStdString(), recordType); +} + +/** + * @brief Convenience function for Graph::getNodeRecord(node_t *n, char *recordType) + */ +void *Graph::getNodeRecord(std::string nn, char *recordType) +{ + return getNodeRecord(getNode(nn), recordType); +} + +/** + * @brief Retrieve the user record of type recordType associated with node n. @sa addNode(). + * @param n The node. + * @param recordType Which user-record? + * @return Pointer to user-record. + */ +void *Graph::getNodeRecord(node_t *n, char *recordType) +{ + return aggetrec(n, recordType, 0); // TODO : check moveToFront param +} + +/** + * @brief Create new undirected graph. + */ +void Graph::newGraph() +{ + // stupid workaround; can't recreate graph, thus no initialization in constructor || or need different constructor + char name[] = "network"; + g = agopen(name, Agundirected, 0); + // TODO clear stuff? +} + +/** + * @brief Get number of nodes in this graph. + * @return Number of nodes. + */ +int Graph::nNodes() +{ + return agnnodes(g); +} + +/** + * @brief Get number of edges in this graph. + * @return Number of edges. + */ +int Graph::nEdges() +{ + return agnedges(g); +} + +/** + * @brief Draw this graph onto a QGraphicsScene. + * @param gs Scene to draw on. + */ +void Graph::draw(QGraphicsScene *gs) +{ + if(!g) + return; + + if(!layouted) + layout(); + + Agnode_t *n; + Agedge_t *e; + for (n = agfstnode(g); n; n = agnxtnode(g, n)) { + for(e = agfstout(g, n); e; e = agnxtout(g, e)) { + drawEdge(gs, e); + } + drawNode(gs, n); + } +} + +/** + * @brief Layout the graph using GraphViz engines. + * !!Do not call before previous layouting process has finished (seg fault)!! + * TODO: lock + * @param engine Layout engine to use. + * @return See gvLayout. + */ +int Graph::layout() +{ + std::cout<<"Layouting using " << layoutEngine.toStdString()<<"... "; + + int res = gvLayout(gvc, g, layoutEngine.toStdString().c_str()); + // dpi = QString(agget(g, "dpi")).toDouble(); // is zero?+ + // std::cerr<<"dpi: "<(a.c_str()), const_cast(v.c_str()), const_cast(v.c_str()));//const_cast(defaultGraphAttributes[a].c_str())); // TODO default? +} + +/** + * @brief Get bounding box for node n. + * @param n Node. + * @return Bounding box. + */ +QRectF Graph::getNodeRectF(Agnode_t *n) +{ + // TODO check if layouted? + pointf c = ND_coord(n); // in points + double w = ND_width(n); // in inches + double h = ND_height(n); // in inches + +#ifndef _WINDOWS_ + QRectF rf = QRectF(c.x, c.y, w/2 * physicalDpiX, h/2 * physicalDpiY); +#endif +#ifdef _WINDOWS_ + QRectF rf = QRectF(c.x, c.y, w * 0.75 * physicalDpiX, h * 0.75 * physicalDpiY); // magic factor 0.75... otherwise gap between nodes and edges +#endif + + // coords are topleft of bounding box + rf.moveTo(rf.x() - 0.5 * rf.width(), rf.y() - 0.5 * rf.height()); + return rf; + // TODO edgelabels +} + +/** + * @brief Draw the given edge onto a QGraphicsScene. + * @param gs The scene. + * @param e The edge. + */ +void Graph::drawEdge(QGraphicsScene *gs, Agedge_t *e) +{ + // edge label + char *label = agget(e, EDGE_ATTR_LABEL); + char *tooltip = agget(e, EDGE_ATTR_TOOLTIP); + + splines *spl = ED_spl(e); + // color + QPen pen = QPen(getColor(e, EDGE_ATTR_COLOR)); + + // width + if(double penwidth = QString(agget(e, EDGE_ATTR_PENWIDTH)).toDouble()) + pen.setWidthF(penwidth); + // pen.setWidthF(pen.widthF() * 4); + + // edge style + char *style = agget(e, EDGE_ATTR_STYLE); + if(style) { + std::string sstyle = style; + if(sstyle == "bold") { + pen.setWidthF(EDGE_STYLE_BOLD_SCALING * pen.widthF()); + } else if(sstyle == "dotted") { + pen.setStyle(Qt::DotLine); + } else if(sstyle == "dashed") { + pen.setStyle(Qt::DashLine); + // } else if(sstyle == "solid") { default + } + } + + // Connections are combination of splines + for(int sc = 0; sc < spl->size; ++sc) { + // graphViz bezier holds starting point + n*3 points for cubic bezier + bezier b = spl->list[sc]; + assert(b.size % 3 == 1); + + if(sc == 0) { // draw label to center of first spline + QPointF labelPos; + + if(b.size % 2) { + int idx = (b.size - 1)/ 2; + labelPos.setX(b.list[idx].x); + labelPos.setY(b.list[idx].y); + } else { + int idx = b.size / 2; + labelPos.setX((b.list[idx].x + b.list[idx - 1].x) / 2); + labelPos.setY((b.list[idx].y + b.list[idx - 1].y) / 2); + } + + // Edge label + if(label) { + QGraphicsSimpleTextItem *labelTextItem = new QGraphicsSimpleTextItem(QString(label)); + labelTextItem->setPos(labelPos); + QFont labFont = labelTextItem->font(); + if(int fontsize = QString(agget(e, EDGE_ATTR_LABELFONTSIZE)).toInt()) + labFont.setPointSize(fontsize); + labelTextItem->setPen(QPen(getColor(e, EDGE_ATTR_LABELFONTCOLOR))); + labelTextItem->setToolTip(tooltip); + gs->addItem(labelTextItem); + } + } + + QPainterPath spl; + spl.moveTo(b.list[0].x, b.list[0].y); // starting point + ++b.list; + + for(int i = 1; i < b.size; i += 3) { + //pointf sp = b.sp; // starting point, (0,0) if undirected + spl.cubicTo(b.list[0].x, b.list[0].y, + b.list[1].x, b.list[1].y, + b.list[2].x, b.list[2].y); + b.list += 3; + } + gs->addPath(spl, pen); + } +} + +/** + * @brief Draw the given node onto a QGraphicsScene. + * @param gs The scene. + * @param n The node. + */ +void Graph::drawNode(QGraphicsScene *gs, Agnode_t *n) +{ + QString label = agget(n, const_cast("label")); + QString shape = agget(n, const_cast("shape")); + //std::cerr<setPos(nr.topLeft()); + el->setToolTip(label); + el->setBrush(QBrush(fillColor)); + el->setPen(QPen(strokeColor)); + + // Add user-type data as QVariant to GraphicsItem + foreach(std::string o, userData) { + void *d = getNodeRecord(n, const_cast(o.c_str())); + if(d) { + el->setData(userData.indexOf(o), QVariant::fromValue(d)); + } + } + + gs->addItem(el); + + // Draw Widget? + std::map::const_iterator it; + if((it = nodeWidgets.find(n)) != nodeWidgets.end()) { + // Yes, widget + QGraphicsItem *w = it->second; + + // center in node shape + QPoint newCenter = nr.center().toPoint(); +#ifndef _WINDOWS_ + newCenter.setX(newCenter.x() - w->boundingRect().width() / 2); + newCenter.setY(newCenter.y() - w->boundingRect().height() / 2); +#endif +#ifdef _WINDOWS_ + // magic windows correction to avoid node-edge-gap + w->setScale(1/0.75); + newCenter.setX(newCenter.x() - w->boundingRect().width() / 0.75 / 2); + newCenter.setY(newCenter.y() - w->boundingRect().height() / 0.75 / 2); +#endif + w->setPos(newCenter); + gs->addItem(w); + + } else { + // No widget, text only + + QGraphicsTextItem *li = new QGraphicsTextItem(); + // TODO font color and formatting li->setFont(); + li->setHtml(label); + QFont labelFont = li->font(); + // TODO font attributes bold, ... + if(int fontsize = QString(agget(n, const_cast("fontsize"))).toInt()) + labelFont.setPointSize(fontsize); + li->setFont(labelFont); + li->setPos(nr.center().x() - 0.5 * li->boundingRect().width(), nr.center().y() - 0.5 * li->boundingRect().height()); + QBrush fgBrush; + fgBrush.setColor(fontColor); // todo: check + gs->setForegroundBrush(fgBrush); + gs->addItem(li); + } +} + +/** + * @brief See Graph::setEdgeAttribute(std::string nn1, std::string nn2, std::string en, std::string a, std::string v) + */ +void Graph::setEdgeAttribute(QString nn1, QString nn2, QString en, QString a, QString v) +{ + setEdgeAttribute(nn1.toStdString(), nn2.toStdString(), en.toStdString(), a.toStdString(), v.toStdString()); +} + +/** + * @brief Set GraphViz edge-attribute a to value v on edge between nodes nn1 and nn2 with name en. + * @param nn1 + * @param nn2 + * @param en + * @param a + * @param v + */ +void Graph::setEdgeAttribute(std::string nn1, std::string nn2, std::string en, std::string a, std::string v) +{ + // TODO keep map of edge objects and names? + Agnode_t *n1 = agnode(g, const_cast(nn1.c_str()), FALSE); + if(!n1) + throw GraphVizQTException("Invalid node:", nn1); + Agnode_t *n2 = agnode(g, const_cast(nn2.c_str()), FALSE); + if(!n2) + throw GraphVizQTException("Invalid node:", nn2); + + Agedge_t *e = agedge(g, n1, n2, const_cast(en.c_str()), FALSE); + agsafeset(e, const_cast(a.c_str()), const_cast(v.c_str()), const_cast(defaultNodeAttributes[a].c_str())); // TODO default? +} + + +/** + * @brief See Graph::setNodeAttribute(std::string nn, std::string a, std::string v) + */ + +void Graph::setNodeAttribute(QString nn, QString a, QString v) +{ + setNodeAttribute(nn.toStdString(), a.toStdString(), v.toStdString()); +} + +/** + * @brief Set GraphViz node-attribute a to value v for node named nn. + * @param nn + * @param a + * @param v + */ +void Graph::setNodeAttribute(std::string nn, std::string a, std::string v) +{ + Agnode_t *n = agnode(g, const_cast(nn.c_str()), FALSE); + agsafeset(n, const_cast(a.c_str()), const_cast(v.c_str()), const_cast(defaultNodeAttributes[a].c_str())); // TODO default? +} + +/** + * @brief Set GraphViz node-attribute a to value v for node n. + * @param n + * @param a + * @param v + */ +void Graph::setNodeAttribute(Agnode_t *n, std::string a, std::string v) +{ + agsafeset(n, const_cast(a.c_str()), const_cast(v.c_str()), const_cast(defaultNodeAttributes[a].c_str())); // TODO default? +} + +/** + * @brief User-data-type to index mapping. Used for QVariants when adding user-type data to GraphicsItems. + * @param type Typename. + * @return The index for QGraphicsItem::data(int). + */ +int Graph::getDataIndex(std::string type) +{ + return userData.indexOf(type); +} + +QString Graph::getLayoutEngine() const +{ + return layoutEngine; +} + +void Graph::setLayoutEngine(QString e) +{ + if(e == layoutEngine) + return; + + layoutEngine = e; + layouted = false; +} + +/** + * @brief Get color for attribute attr of the given GraphViz object (node, edge, ...) o and convert to QColor. + * @param o Object. + * @param attr Attribute + * @return Color as QColor. + */ +QColor Graph::getColor(void *o, QString attr) +{ + QString cs = agget(o, const_cast(attr.toStdString().c_str())); + if(cs.size()) { + if(cs.startsWith('#')) { + // #RRGGBB + return QColor::fromRgb(cs.right(6).toUInt(0, 16)); + } + return QColor(cs); + } + + // default values // todo check default attribute maps + if(attr == EDGE_ATTR_COLOR) return QColor("black"); + if(attr == EDGE_ATTR_LABELFONTCOLOR) return QColor("black"); + if(attr == NODE_ATTR_COLOR) return QColor("black"); + if(attr == NODE_ATTR_FILLCOLOR) return QColor("lightgray"); + if(attr == NODE_ATTR_FONTCOLOR) return QColor("black"); + + return QColor("black"); +} + +/** + * @brief Initialize internal variables. + */ +void Graph::init() +{ + //gvAddLibrary(gvc, &gvplugin_dot_layout_LTX_library); + //gvAddLibrary(gvc, &gvplugin_neato_layout_LTX_library); + //gvAddLibrary(gvc, &gvplugin_core_LTX_library); + + agseterr(AGWARN); + layouted = false; + layoutEngine = GRAPHVIZQT_H_DEFAULT_LAYOUT_ENGINE; + + // Determine screen resolution + QDesktopWidget dw; + physicalDpiX = dw.physicalDpiX(); + physicalDpiY = dw.physicalDpiX(); + + defaultEdgeAttributes[EDGE_ATTR_COLOR] = "black"; + defaultEdgeAttributes[EDGE_ATTR_PENWIDTH] = "1 "; + defaultNodeAttributes[NODE_ATTR_COLOR] = "black"; + defaultNodeAttributes["fontsize"] = "12"; // TODO get defaults from graphviz? +} + +/** + * @brief Get GraphViz node object for given node name. + * @param node Node identifier. + * @return GraphViz node object. + */ +Agnode_t *Graph::getNode(std::string node) +{ + return agnode(g, const_cast(node.c_str()), FALSE); +} + +/** @brief See Graph::getNode(std::string node). */ +Agnode_t *Graph::getNode(QString node) +{ + return agnode(g, const_cast(node.toStdString().c_str()), FALSE); +} + +GraphVizQTException::GraphVizQTException() +{ + std::cerr<<"GraphVizQTException"< + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef GRAPHVIZQT_H +#define GRAPHVIZQT_H + +#include +#include +#include + +#include + +#include +#include +#include +#include +#include + +#include "gvplugin.h" + +namespace graphvizqt { + +class GraphVizQTException; + +class GraphVizQT +{ +public: + GraphVizQT(); +}; + +#define GRAPHVIZQT_H_DEFAULT_LAYOUT_ENGINE "dot" + +/** + * @brief The Graph class. QT-Graphviz interface. Draws a graph layouted by GraphViz onto a QGraphicsScene. + */ + +class Graph : public QObject +{ + Q_OBJECT + + //TODO use map ; *edgePainter ; *nodePainter + +public: + Graph(); + Graph(std::string dot); + Graph(QString dot); + + ~Graph(); + + void *addNode(QString name, const char *recordType = "", size_t recordTypeSize = 0, QStyle *style = 0); + void *addNode(std::string name, const char *recordType = "", size_t recordTypeSize = 0, QStyle *style = 0); + void setNodeGraphicsItem(std::string node, QGraphicsItem *w); + void addEdge(QString n1, QString n2, QString e, QStyle *style = 0); + void addEdge(std::string n1, std::string n2, std::string e, QStyle *style = 0); + void *getNodeRecord(QString nn, char *recordType = 0); + void *getNodeRecord(std::string nn, char *recordType = 0); + void *getNodeRecord(node_t *n, char *recordType = 0); + + void newGraph(); + int nNodes(); + int nEdges(); + // int nSubgraphs(); /** Number of subgraphs */ + void draw(QGraphicsScene *gs); + int layout(); + int render(const QString format, const QString filename); + void readFromDotFile(QString filename); + void setGraphAttribute(QString a, QString v); + void setGraphAttribute(std::string a, std::string v); + void setNodeAttribute(QString nn, QString a, QString v); + void setEdgeAttribute(QString nn1, QString nn2, QString en, QString a, QString v); + void setNodeAttribute(std::string nn, std::string a, std::string v); + void setNodeAttribute(Agnode_t *n, std::string a, std::string v); + void setEdgeAttribute(std::string nn1, std::string nn2, std::string en, std::string a, std::string v); + int getDataIndex(std::string type); + + QString getLayoutEngine() const; + +public slots: + void setLayoutEngine(QString e); + +private: + QRectF getNodeRectF(Agnode_t * n); + void drawEdge(QGraphicsScene* gs, Agedge_t *e); + void drawNode(QGraphicsScene* gs, Agnode_t *n); + Agnode_t *getNode(std::string node); + Agnode_t *getNode(QString node); + //void setStyle(Agedge_t *n, QStyle *style = 0); + //void setStyle(Agnode_t *e, QStyle *style = 0); + QColor getColor(void *o, QString a); + void init(); + + static const float EDGE_STYLE_BOLD_SCALING; + + // make not const to avoid const_cast for all graphviz functions + static char EDGE_ATTR_LABEL[]; + static char EDGE_ATTR_COLOR[]; + static char EDGE_ATTR_STYLE[]; + static char EDGE_ATTR_LABELFONTSIZE[]; + static char EDGE_ATTR_LABELFONTCOLOR[]; + static char EDGE_ATTR_TOOLTIP[]; + static char EDGE_ATTR_PENWIDTH[]; + + static char NODE_ATTR_COLOR[]; + static char NODE_ATTR_FILLCOLOR[]; + static char NODE_ATTR_FONTCOLOR[]; + static char NODE_ATTR_WIDTH[]; + static char NODE_ATTR_HEIGHT[]; + + QList userData; /**< Index for Qt setData(int, QVariant) functions. To bind user-types to nodes in graphicsscene. */ + std::map defaultEdgeAttributes; // TODO make static + std::map defaultNodeAttributes; + std::map defaultGraphAttributes; + + std::map nodeWidgets; /**< QWidgets that were added to nodes */ + + GVC_t *gvc; /**< GraphViz context. */ + Agraph_t *g; /**< The GraphViz graph. */ + bool layouted; /**< Is the graph layouted and can be plotted?. */ + QString layoutEngine; + double physicalDpiX; /**< Screen resolution (DPI) for converting GraphViz coordinates and distances. */ + double physicalDpiY; /**< Screen resolution (DPI) for converting GraphViz coordinates and distances. */ + +}; + + +class GraphVizQTException : public std::exception { +public: + GraphVizQTException(); + GraphVizQTException(std::string e); + GraphVizQTException(std::string e1, std::string e2); +}; + + +} +#endif // GRAPHVIZQT_H diff --git a/gui/gui-resources.qrc b/gui/gui-resources.qrc new file mode 100644 index 0000000..621ff38 --- /dev/null +++ b/gui/gui-resources.qrc @@ -0,0 +1,22 @@ + + + icons/document-open-xml.png + icons/document-save-hdf5.png + icons/document-save-tsv.png + icons/document-save-csv.png + splash.png + icons/programmIcon16x16.png + icons/document-import.png + icons/zoom-in.png + icons/zoom-original.png + icons/zoom-out.png + icons/view-refresh.png + icons/video-x-mng.png + icons/help-about.png + icons/preferences-other.png + icons/list-add.png + icons/list-remove.png + icons/document-save.png + icons/edit-find.png + + diff --git a/gui/hdfwriter.cpp b/gui/hdfwriter.cpp new file mode 100644 index 0000000..6e5531f --- /dev/null +++ b/gui/hdfwriter.cpp @@ -0,0 +1,75 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "hdfwriter.h" +#include + + +void HDFStringWriter::operator ()(const std::vector::value_type &v) +{ + // Select the file position, 1 record at position 'pos' + hsize_t count[] = { 1 } ; + hsize_t offset[] = { m_pos++ } ; + m_dataspace.selectHyperslab(H5S_SELECT_SET, count, offset); + + const char * s = v.c_str (); + m_dataset.write(&s, m_datatype + , m_memspace + , m_dataspace + , H5P_DEFAULT + ); +} + +void HDFStringWriter::writeVector(H5::Group group, std::string ds, const std::vector &v) +{ + hsize_t dims[] = { v.size () } ; + H5::DataSpace dataspace(1, dims); +// hsize_t s = distMats.size(); + // H5::DataSpace dataspace(1, &s); + // H5::DataSet dsStr = h5f.createDataSet("/Dists/Names", H5::PredType::ALPHA_U8, dataspace); + + dims[0] = 1; + H5::DataSpace memspace(1, dims); + H5::DataType datatype = H5::DataType(H5T_STRING, H5T_VARIABLE); + +// hid_t datatype = H5Tcopy (H5T_C_S1); +// H5Tset_size (datatype, H5T_VARIABLE); + + H5::DataSet dataset = group.createDataSet(ds, datatype, dataspace); + //hid_t dataset = H5Dcreate1 (group, "files", datatype + // , dataspace, H5P_DEFAULT); + + // + // Select the "memory" to be written out - just 1 record. + hsize_t offset[] = { 0 } ; + hsize_t count[] = { 1 } ; + memspace.selectHyperslab(H5S_SELECT_SET, count, offset); + + std::for_each (v.begin () + , v.end () + , HDFStringWriter (dataset, datatype, dataspace, memspace)); + + dataset.close(); + dataspace.close(); + memspace.close(); + datatype.close(); +} + + diff --git a/gui/hdfwriter.h b/gui/hdfwriter.h new file mode 100644 index 0000000..980d02c --- /dev/null +++ b/gui/hdfwriter.h @@ -0,0 +1,47 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef HDFWRITER_H +#define HDFWRITER_H + +#include +#include +#include + +class HDFStringWriter +{ +public: + HDFStringWriter(H5::DataSet dataset, H5::DataType datatype + , H5::DataSpace dataspace, H5::DataSpace memspace) + : m_dataset (dataset), m_datatype (datatype) + , m_dataspace (dataspace), m_memspace (memspace) + , m_pos () {} + + void operator ()(std::vector::value_type const & v); + static void writeVector (H5::Group group, std::string ds, std::vector const & v); +private: + H5::DataSet m_dataset; + H5::DataType m_datatype; + H5::DataSpace m_dataspace; + H5::DataSpace m_memspace; + int m_pos; + +}; + +#endif // HDFWRITER_H diff --git a/gui/icons/document-import.png b/gui/icons/document-import.png new file mode 100644 index 0000000..293b5a0 Binary files /dev/null and b/gui/icons/document-import.png differ diff --git a/gui/icons/document-open-xml.png b/gui/icons/document-open-xml.png new file mode 100644 index 0000000..32ebda1 Binary files /dev/null and b/gui/icons/document-open-xml.png differ diff --git a/gui/icons/document-open-xml.xcf b/gui/icons/document-open-xml.xcf new file mode 100644 index 0000000..8b638a7 Binary files /dev/null and b/gui/icons/document-open-xml.xcf differ diff --git a/gui/icons/document-save-csv.png b/gui/icons/document-save-csv.png new file mode 100644 index 0000000..5653fb3 Binary files /dev/null and b/gui/icons/document-save-csv.png differ diff --git a/gui/icons/document-save-hdf5.png b/gui/icons/document-save-hdf5.png new file mode 100644 index 0000000..6764666 Binary files /dev/null and b/gui/icons/document-save-hdf5.png differ diff --git a/gui/icons/document-save-tsv.png b/gui/icons/document-save-tsv.png new file mode 100644 index 0000000..5d427d0 Binary files /dev/null and b/gui/icons/document-save-tsv.png differ diff --git a/gui/icons/document-save-tsv.xcf b/gui/icons/document-save-tsv.xcf new file mode 100644 index 0000000..32496f8 Binary files /dev/null and b/gui/icons/document-save-tsv.xcf differ diff --git a/gui/icons/document-save.png b/gui/icons/document-save.png new file mode 100644 index 0000000..cc380a0 Binary files /dev/null and b/gui/icons/document-save.png differ diff --git a/gui/icons/edit-find.png b/gui/icons/edit-find.png new file mode 100644 index 0000000..a31a17b Binary files /dev/null and b/gui/icons/edit-find.png differ diff --git a/gui/icons/help-about.png b/gui/icons/help-about.png new file mode 120000 index 0000000..5fe7ad6 --- /dev/null +++ b/gui/icons/help-about.png @@ -0,0 +1 @@ +/usr/share/icons/oxygen/48x48/status/dialog-information.png \ No newline at end of file diff --git a/gui/icons/list-add.png b/gui/icons/list-add.png new file mode 100644 index 0000000..af5b56e Binary files /dev/null and b/gui/icons/list-add.png differ diff --git a/gui/icons/list-remove.png b/gui/icons/list-remove.png new file mode 100644 index 0000000..678b34d Binary files /dev/null and b/gui/icons/list-remove.png differ diff --git a/gui/icons/logo.svg b/gui/icons/logo.svg new file mode 100644 index 0000000..f2ca59b --- /dev/null +++ b/gui/icons/logo.svg @@ -0,0 +1,14497 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + + + + + + + + + + + + + + + + NTFD + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ✔ + ✗ + ✗ + ν1 + ν4 + ν2 + + + −→ + + + ν + + + = + + +  +  +  +  +  + + + M + + + 0 + + + M + + + 1 + + + . + . + . + + + M + + + m + + +  +  +  +  +  + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - isotopes- ntfd - network- MID- similarity- flux + MIA + + + + C1 + + + + C2 + + + + C3 + + + + C4 + + + + C5 + + + + + + + + + + + + ✔ + + ν1 + ν2 + ν4 + ν3 + ν1 + ν2 + ν4 + ν3 + + + ✗ + + + + ✔ + + + + ✔ + + + + ✔ + + + + + + + + + + ✔ + + + + ✔ + + + + ✗ + + ν5 + ν5 + + + ✔ + + + + + + + ✗ + + + + ✔ + + + + ✔ + + + + + ✔ + + + + ✗ + + + + ✗ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + ✔ + ✗ + ✗ + ν1 + ν4 + ν2 + + + −→ + + + ν + + + = + + +  +  +  +  +  + + + M + + + 0 + + + M + + + 1 + + + . + . + . + + + M + + + m + + +  +  +  +  +  + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Tracer 1 + Tracer 2 + Tracer 3 + Overlay + + + MIA + MassIsotopolomeAnalyzer + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + Tracer 1 + Tracer 2 + Tracer 3 + Overlay + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + MassIsotopolomeAnalyzer + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + MIA + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + MIA + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + MIA + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/gui/icons/preferences-other.png b/gui/icons/preferences-other.png new file mode 100644 index 0000000..8d5a1fb Binary files /dev/null and b/gui/icons/preferences-other.png differ diff --git a/gui/icons/programmIcon16x16.ico b/gui/icons/programmIcon16x16.ico new file mode 100644 index 0000000..dba0584 Binary files /dev/null and b/gui/icons/programmIcon16x16.ico differ diff --git a/gui/icons/programmIcon16x16.png b/gui/icons/programmIcon16x16.png new file mode 100644 index 0000000..a35e86e Binary files /dev/null and b/gui/icons/programmIcon16x16.png differ diff --git a/gui/icons/video-x-mng.png b/gui/icons/video-x-mng.png new file mode 100644 index 0000000..314e5b9 Binary files /dev/null and b/gui/icons/video-x-mng.png differ diff --git a/gui/icons/view-refresh.png b/gui/icons/view-refresh.png new file mode 100644 index 0000000..0b08b23 Binary files /dev/null and b/gui/icons/view-refresh.png differ diff --git a/gui/icons/zoom-in.png b/gui/icons/zoom-in.png new file mode 100644 index 0000000..83dec79 Binary files /dev/null and b/gui/icons/zoom-in.png differ diff --git a/gui/icons/zoom-original.png b/gui/icons/zoom-original.png new file mode 100644 index 0000000..2fb963f Binary files /dev/null and b/gui/icons/zoom-original.png differ diff --git a/gui/icons/zoom-out.png b/gui/icons/zoom-out.png new file mode 100644 index 0000000..468b229 Binary files /dev/null and b/gui/icons/zoom-out.png differ diff --git a/gui/labelidentificatorqthread.cpp b/gui/labelidentificatorqthread.cpp new file mode 100644 index 0000000..694b83a --- /dev/null +++ b/gui/labelidentificatorqthread.cpp @@ -0,0 +1,69 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "labelidentificatorqthread.h" +#include "QApplication" +#include "QMessageBox" +#include "gcmsscanexception.h" + +namespace mia { + +LabelIdentificatorQThread::LabelIdentificatorQThread(LabelingDataset *ds, QObject *parent) : + QThread(parent), ds(ds) +{ +} + +void LabelIdentificatorQThread::setProgress(size_t value, size_t max) +{ + emit(progressMax(max)); + emit(progress(value)); +} + +void LabelIdentificatorQThread::setMessage(std::string message) +{ + emit(progressMessage(message.c_str())); +} + +void LabelIdentificatorQThread::run() +{ + try { + ds->findLabeledCompounds(this); + } catch (gcms::GCMSScanException e) { + QApplication::restoreOverrideCursor(); + + QMessageBox mb; + mb.setWindowTitle("Error..."); + mb.setText(QString::fromStdString("Error loading data:\n\n%1").arg(QString::fromStdString(e.getMessage()))); + mb.setIcon(QMessageBox::Critical); + mb.setStandardButtons(QMessageBox::Ok); + mb.exec(); + } catch (...) { + QApplication::restoreOverrideCursor(); + + QMessageBox mb; + mb.setWindowTitle("Error..."); + mb.setText("Error loading data."); + mb.setIcon(QMessageBox::Critical); + mb.setStandardButtons(QMessageBox::Ok); + mb.exec(); + } +} + +} diff --git a/gui/labelidentificatorqthread.h b/gui/labelidentificatorqthread.h new file mode 100644 index 0000000..e95ceae --- /dev/null +++ b/gui/labelidentificatorqthread.h @@ -0,0 +1,53 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef LABELIDENTIFICATORQTHREAD_H +#define LABELIDENTIFICATORQTHREAD_H + +#include +#include "labelidentificator.h" +#include "src/labelingdataset.h" + +namespace mia { + +class LabelIdentificatorQThread : public QThread, public labid::LabelIdentificatorProgressListener +{ + Q_OBJECT +public: + explicit LabelIdentificatorQThread(LabelingDataset *ds, QObject *parent = 0); + void setProgress(size_t value, size_t max); + void setMessage(std::string message); + void run(); + +signals: + void progress(int value); + void progressMessage(QString message); + void progressMax(int max); + void errorMessage(QString message); + +public slots: + +private: + LabelingDataset *ds; +}; + + +} + +#endif // LABELIDENTIFICATORQTHREAD_H diff --git a/gui/main.cpp b/gui/main.cpp new file mode 100644 index 0000000..85f438c --- /dev/null +++ b/gui/main.cpp @@ -0,0 +1,62 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include + +#include +#include + +#include"miamainwindow.h" +#include"graphvizqt.h" +#include"miaguiconstants.h" + +#ifndef _WINDOWS_ + Q_IMPORT_PLUGIN(QXcbIntegrationPlugin) +#endif +#ifdef _WINDOWS_ + Q_IMPORT_PLUGIN(QWindowsIntegrationPlugin) +#endif + +int main(int argc, char *argv[]) +{ + //Q_INIT_RESOURCE(application); + QApplication app(argc, argv); + app.setApplicationVersion(MIA_VERSION); + std::cout<<"MIA version "< + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef MIAGUICONSTANTS_H +#define MIAGUICONSTANTS_H + +#include +#include"config.h" + +namespace mia { + const double DISTANCE_CUTOFF_SLIDER_IMPLICIT_MAXIMUM = 0.2; +} + +#endif // MIAGUICONSTANTS_H diff --git a/gui/miamainwindow.cpp b/gui/miamainwindow.cpp new file mode 100644 index 0000000..e627c8f --- /dev/null +++ b/gui/miamainwindow.cpp @@ -0,0 +1,1170 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include +#include +#include +#include + +#include +#include +#include +#include + +#ifdef MIA_WITH_HDF5 + #include + #include "hdfwriter.h" +#endif + +#include "spectrum.h" +#include "labeledcompound.h" +#include "libraryhit.h" + +#include "miamainwindow.h" +#include "src/misc.h" +#include "src/settings.h" +#include "src/miaexception.h" +#include "nodecompoundtreemodel.h" +#include "experimentwizard.h" +#include "miaguiconstants.h" +#include "midplot.h" +#include "configdialog.h" + +#ifdef MIA_WITH_METABOBASE + #include "mddb_pgsql.h" +#endif + +namespace mia { + +MIAMainWindow::MIAMainWindow(QWidget *parent) : + QMainWindow(parent) +{ + init(); + setupGUI(); +} + +MIAMainWindow::~MIAMainWindow() +{ + delete view; + delete scene; + delete LabelingNetworkSet::distCalc; + delete g; + +#ifdef MIA_WITH_NETCDF_IMPORT + if(netCDFImportDialog) + delete netCDFImportDialog; +#endif + + delete networkSet; + + if(excludeLib) delete excludeLib; +} + +/** + * @brief Start compound detection. (static function for QtConcurrent::run()) + * @param ds + */ +void MIAMainWindow::findLabeledCompounds(mia::NetworkLayer *ds) +{ + std::cout<getSettings().experiment<<": Starting compound detection."<getSettings().toString().c_str()); + + ds->findLabeledCompounds(); + + std::cout<getSettings().experiment<<": Found "<cmpLab.size()<<" labeled compounds and " + <cmpUnlab.size()<< " unlabeled compounds"<setExcludeM0(qsettings.value("alignment_m0", 0).toInt()); + updateCompoundList(); + setupExperimentOverlayGraph(); +} + +/* +void MIAMainWindow::repaintGraph() +{ + // Create graph from selected MIDs in compound panel + scene->clear(); + g->draw(scene); +} +*/ + +void MIAMainWindow::labelDetectionFinished() +{ + static bool waiting = false; + + if(waiting) + return; // there is already another call waiting + + waiting = true; + + // all threads finished? + foreach(LabelIdentificatorQThread *t, labidThreads) { + t->wait(); + } + while (!labidThreads.isEmpty()) + delete labidThreads.takeFirst(); + + matchCompoundsAcrossExperiments(); // TODO separate thread? + matchCompoundsAgainstLibrary(); + experimentListWidget->updateExperimentList(networkSet->getDatasets(), experimentColors); + updateCompoundList(); + networkSet->createDistanceMatrices(); + recreateGraph(); + + if(progressDialog) { + delete progressDialog; + progressDialog = 0; + } + + QApplication::processEvents(); // first process finished() of other threads + + waiting = false; +} + + +void MIAMainWindow::compoundClicked(QModelIndex mi) +{ + // find corresponding widget to center graphics view on it + int cmpID = compoundTreeView->model()->data(mi, Qt::UserRole).toInt(); + NodeWidget *w = nodeWidgets[cmpID]; + if(w) + view->view()->centerOn(w); +} + +/** + * @brief Setup some class variables + */ +void MIAMainWindow::init() +{ + // overlay colors + experimentColors.push_back(QColor(0xCD, 0x16, 0x16)); // red + experimentColors.push_back(QColor(0x22, 0x8A, 0x27)); // green + experimentColors.push_back(QColor(0x1B, 0x54, 0xD8)); // blue + experimentColors.push_back(QColor(0xEB, 0xC8, 0x16)); // yellow + experimentColors.push_back(QColor(0x81, 0x00, 0x81)); // violett + experimentColors.push_back(QColor(0xB1, 0x32, 0x44)); // darkred + experimentColors.push_back(QColor(0x89, 0xa3, 0x5c)); // some green + experimentColors.push_back(QColor(0x00, 0xff, 0xff)); // cyan + experimentColors.push_back(QColor(0x80, 0x80, 0x00)); // dark yellow + experimentColors.push_back(QColor(0x00, 0x00, 0x80)); // dark blue + + experimentColors.push_back(QColor(0xCD, 0x16, 0x16)); // red + experimentColors.push_back(QColor(0x22, 0x8A, 0x27)); // green + experimentColors.push_back(QColor(0x1B, 0x54, 0xD8)); // blue + experimentColors.push_back(QColor(0xEB, 0xC8, 0x16)); // yellow + experimentColors.push_back(QColor(0x81, 0x00, 0x81)); // violett + experimentColors.push_back(QColor(0xB1, 0x32, 0x44)); // darkred + experimentColors.push_back(QColor(0x89, 0xa3, 0x5c)); // some green + experimentColors.push_back(QColor(0x00, 0xff, 0xff)); // cyan + experimentColors.push_back(QColor(0x80, 0x80, 0x00)); // dark yellow + experimentColors.push_back(QColor(0x00, 0x00, 0x80)); // dark blue +// TODO: autogenerate... rainbow()? + + g = new graphvizqt::Graph(); + + LabelingNetworkSet::distCalc = new MIDDistanceCalculator(NW_GAP_PENALTY); + graphSizeWarningLimit = 200; + excludeLib = 0; + progressDialog = 0; + networkSet = new LabelingNetworkSet(); +#ifdef MIA_WITH_NETCDF_IMPORT + netCDFImportDialog = 0; +#endif +#ifdef MIA_WITH_METABOBASE + keggMapper = new KEGGReactionMapper(); + keggMapper->setupGraph(); +#endif +} + +/** + * @brief Match spectra from the different experiments + * Populate @nodes maps + */ +void MIAMainWindow::matchCompoundsAcrossExperiments() +{ + emit(progressText("Matching compounds across datasets.")); + + qDeleteAll(nodeWidgets); + nodeWidgets.clear(); + + double mylibScoreCutoff = qsettings.value("cmp_matching_score_cutoff", CMP_MATCHING_SCORE_CUTOFF).toDouble(); // TODO use from Settings + bool useLargestCommonIon = qsettings.value("nw_use_common_largest_ion", NW_USE_LARGEST_COMMON_ION).toBool(); + networkSet->matchCompoundsAcrossExperiments(mylibScoreCutoff, useLargestCommonIon); +} + +void MIAMainWindow::startLabelDetection(NetworkLayer *ds) +{ + if(!progressDialog) { + progressDialog = new QProgressDialog(this); + progressDialog->setModal(true); + progressDialog->setMinimumDuration(0); + progressDialog->setMaximum(0); + connect(this, SIGNAL(progressText(QString)), progressDialog, SLOT(setLabelText(QString))); + progressDialog->show(); + } + + std::cout<<"Starting '"<getSettings().experiment<<"'\n"; + qDebug("%s", ds->getSettings().toString().c_str()); + emit(progressText(QString("Detecting labeled compounds for <%1>.").arg(QString::fromStdString(ds->getSettings().experiment)))); + + LabelIdentificatorQThread *labidThread = new LabelIdentificatorQThread(ds, this); + labidThread->start(QThread::LowPriority); + labidThreads.push_back(labidThread); + + connect(labidThread, SIGNAL(progressMessage(QString)), progressDialog, SLOT(setLabelText(QString))); +// connect(labidThread, SIGNAL(progressMax(int)),progressDialog,SLOT(setMaximum(int))); +// connect(labidThread, SIGNAL(progress(int)),progressDialog,SLOT(setValue(int))); + connect(labidThread, SIGNAL(finished()), this, SLOT(labelDetectionFinished())); +} + +void MIAMainWindow::generateNodeWidgets() +{ + const QMap nodes = networkSet->getNodeCompounds(); + for(int n = 0; n < nodes.size(); ++n) { + NodeCompound *nc = nodes[n]; + + // colors for the different experiments + QList colors; + std::vector exps = nc->getExperiments(); + QList datasets = networkSet->getDatasets(); + for(int ds = 0; ds < datasets.size(); ++ds) { + if (std::find(exps.begin(), exps.end(), datasets[ds]->getSettings().experiment) != exps.end()) + colors.push_back(experimentColors[ds]); + } + + NodeWidget *w = new NodeWidget(nc, colors); + nodeWidgets[n] = w; + } +} + + +void MIAMainWindow::matchCompoundsAgainstLibrary(QString libFile, bool overwriteNames) +{ + emit(progressText("Matching compounds against library.")); + + QApplication::setOverrideCursor(QCursor(Qt::WaitCursor)); + networkSet->matchCompoundsAgainstLibrary(libFile, overwriteNames); + QApplication::restoreOverrideCursor(); +} + +void MIAMainWindow::setupCompoundList() +{ + compoundListDockWidget = new QDockWidget(tr("Compounds"), this); + QWidget *w = new QWidget(compoundListDockWidget); + QVBoxLayout *layout = new QVBoxLayout(w); + QToolBar *compoundToolBar = new QToolBar(w); + + // toolbar + QAction *actExpand = new QAction(QIcon(":/gui/icons/zoom-in.png"), tr("&ExpandAll"), this); + actExpand->setToolTip("Expand list"); + compoundToolBar->addAction(actExpand); + QAction *actCollapse = new QAction(QIcon(":/gui/icons/zoom-out.png"), tr("&CollapseAll"), this); + actCollapse->setToolTip("Collapse list"); + compoundToolBar->addAction(actCollapse); +/* + QAction *actRefreshGraph = new QAction(QIcon::fromTheme("system-run"), tr("&Recreate graph"), this); + actRefreshGraph->setToolTip("Recreate graph with selected MIDs."); + compoundToolBar->addAction(actRefreshGraph); +*/ + layout->addWidget(compoundToolBar); + + // compound tree itself + compoundTreeView = new QTreeView; + compoundTreeView->setSelectionMode(QAbstractItemView::ExtendedSelection); + + connect(compoundTreeView, SIGNAL(clicked(QModelIndex)), this, SLOT(compoundClicked(QModelIndex))); + connect(actExpand, SIGNAL(triggered()), compoundTreeView, SLOT(expandAll())); + connect(actCollapse, SIGNAL(triggered()), compoundTreeView, SLOT(collapseAll())); +// connect(actRefreshGraph, SIGNAL(triggered()), this, SLOT(repaintGraph())); + layout->addWidget(compoundTreeView); + + w->setLayout(layout); + compoundListDockWidget->setWidget(w); +} + +void MIAMainWindow::setupGUI() +{ + setupToolbar(); + + setupGraphOptionPanel(); + setupExperimentList(); + setupCompoundList(); + + addDockWidget(Qt::RightDockWidgetArea, graphOptionsDockWidget); + addDockWidget(Qt::RightDockWidgetArea, experimentListDockWidget); + tabifyDockWidget(graphOptionsDockWidget, experimentListDockWidget); + addDockWidget(Qt::LeftDockWidgetArea, compoundListDockWidget); + + // main canvas + scene = new QGraphicsScene(); + view = new NWView(scene, g, this); + + // put all together + setCentralWidget(view); + + // add test graph + // graphvizqt::Graph g(std::string("graph{A--B;A--C;A--D;A--B;B--C; C--E; E--F; A[label=\"AAA\"]};")); + // g->readFromDotFile("networkoverlaytest.dot"); +} + +void MIAMainWindow::setupToolbar() +{ + QToolBar *mainTB = new QToolBar(this); + +#ifdef MIA_WITH_NETCDF_IMPORT + QAction *actImportData = new QAction(QIcon(":/gui/icons/document-import.png"), tr("&Import data"), mainTB); + actImportData->setToolTip("Import netCDF data or redetect compounds"); + mainTB->addAction(actImportData); + connect(actImportData, SIGNAL(triggered()), this, SLOT(showDataImportDialog())); +#endif + + QAction *actOpenXML = new QAction(QIcon(":/gui/icons/document-open-xml.png"), tr("Load experiment from XML config"), mainTB); + actOpenXML->setShortcut(QKeySequence::Open); + actOpenXML->setToolTip("Load experiment from XML config"); + mainTB->addAction(actOpenXML); + + /* // save and open binary mia-data + QAction *actOpen = new QAction(QIcon::fromTheme("document-open"), tr("&Open data"), mainTB); + actOpen->setToolTip("Open data"); + mainTB->addAction(actOpen); + + QAction *actSave = new QAction(QIcon::fromTheme("document-save"), tr("&Save"), mainTB); + actSave->setToolTip("Save data"); + mainTB->addAction(actSave); + */ + +#ifdef MIA_WITH_HDF5 + QAction *actExportHDF = new QAction(QIcon(":/gui/icons/document-save-hdf5.png"), tr("&Save HDF5"), mainTB); + actExportHDF->setToolTip("Export distances to HDF5 file"); + mainTB->addAction(actExportHDF); + connect(actExportHDF, SIGNAL(triggered()), this, SLOT(saveHDF())); +#endif + + QAction *actExportMIDs = new QAction(QIcon(":/gui/icons/document-save-csv.png"), tr("&Save CSV"), mainTB); + actExportMIDs->setToolTip("Export MIDs as comma separated values"); + mainTB->addAction(actExportMIDs); + + QAction *actSelectLibrary = new QAction(QIcon(":/gui/icons/edit-find.png"), tr("&Identify"), mainTB); + actSelectLibrary->setToolTip("Select compound library for identification"); + mainTB->addAction(actSelectLibrary); + + QAction *actAbout = new QAction(QIcon(":/gui/icons/help-about.png"), tr("Abo&ut"), mainTB); + actAbout->setToolTip(QString("About ").append(QApplication::applicationName())); + mainTB->addAction(actAbout); + + QAction *actConfig = new QAction(QIcon(":/gui/icons/preferences-other.png"), tr("&Config"), mainTB); + actConfig->setToolTip("Show config dialog"); + mainTB->addAction(actConfig); + + addToolBar(mainTB); + + //connect(actSave, SIGNAL(triggered()), this, SLOT(saveFile())); + connect(actExportMIDs, SIGNAL(triggered()), this, SLOT(exportMIDs())); + connect(actOpenXML, SIGNAL(triggered()), this, SLOT(openXMLFile())); + //connect(actOpen, SIGNAL(triggered()), this, SLOT(openFile())); + connect(actAbout, SIGNAL(triggered()), this, SLOT(showInfoDialog())); + connect(actConfig, SIGNAL(triggered()), this, SLOT(showConfigDialog())); + connect(actSelectLibrary, SIGNAL(triggered()), this, SLOT(selectCompoundLibraryAndIdentify())); +} + +void MIAMainWindow::setupExperimentList() +{ + // tracer list + experimentListDockWidget = new QDockWidget(tr("Datasets"), this); + experimentListWidget = new ExperimentListWidget(this); + + experimentListDockWidget->setWidget(experimentListWidget); + + connect(experimentListWidget, SIGNAL(experimentSettingChanged(int,Settings)), this, SLOT(experimentSettingChanged(int,Settings))); + connect(experimentListWidget, SIGNAL(experimentAdded(Settings)), this, SLOT(addExperiment(Settings))); + connect(experimentListWidget, SIGNAL(experimentUsageChanged()), this, SLOT(experimentSelectionChanged())); + connect(experimentListWidget, SIGNAL(experimentRemoved(NetworkLayer*)), this, SLOT(experimentRemoved(NetworkLayer*))); + +} + +/** + * @brief MIAMainWindow::setupTracerOverlayGraph Create tracer overlay graph from distance matrices + */ +void MIAMainWindow::setupExperimentOverlayGraph() +{ + std::cout<<"Setup overlay graph"<value() / 10000.0; + bool hideLessVarying = hideLessVaryingNodes->checkState() == Qt::Checked; + bool hideFoundInLessExperiments = this->hideFoundInLessExperiments->checkState() == Qt::Checked; + bool showUnconnectedNodes = qsettings.value("graph_show_unconnected_nodes", true).toBool(); + int excludeIfFoundInLessExperiments = qsettings.value("exclude_if_found_in_less_experiments", 1).toInt(); + + if(!networkSet->getDatasets().size()) + return; // nothing to do + + // count edges + int e = networkSet->getNumberOfEdges(variationCutoff, excludeIfFoundInLessExperiments); + + // check number of edges + if(e > graphSizeWarningLimit) { + if(! showGraphSizeWarning(e)) + return; + } + + // reclaim NodeWidgets before resetting scene, otherwise they will be destroyed -> delete later manually + if(nodeWidgets.size()) { + QList items = scene->items(); + foreach (QGraphicsItem* i, items) { + if(dynamic_cast(i)) + scene->removeItem(i); + } + } + + g->newGraph(); + + g->setGraphAttribute(std::string("overlap"), std::string("false")); + g->setGraphAttribute(std::string("splines"), std::string("true")); + + // add nodes TODO only first time, then just delete and re-add edges + if(!nodeWidgets.size()) { // TODO chekc if size = same, crash after reload -> implement unload() + // generate nodeWidgets TODO: check if stuff changed and need to recreate nodes + generateNodeWidgets(); + } + + // add nodes + std::map visNodes = networkSet->getNodesInGraph(showUnconnectedNodes, hideLessVarying, variationCutoff, hideFoundInLessExperiments, excludeIfFoundInLessExperiments); + for(std::map::iterator it = visNodes.begin(); + it != visNodes.end(); ++it) { + + NodeCompound *nc = it->second; + int n = it->first; + std::string nodeName = nc->getCompoundName(); + + mynode *newNode = reinterpret_cast(g->addNode(nodeName, "mynode", sizeof(mynode))); + newNode->nc = nc; + + // 70 RSD + // 700*sd + //factor = factor < 0 ? 0 : factor; + g->setNodeAttribute(nodeName, "fillcolor", + QColor::fromRgb(0x41, 0x5E, 0x79).lighter(100 + 1200 * nc->getMaxIsotopomerSD()).name().toStdString()); + g->setNodeGraphicsItem(nodeName, nodeWidgets[n]); + } + + addEdgesToGraph(excludeIfFoundInLessExperiments, variationCutoff); + std::cout<<"Added "<clear(); + g->draw(scene); + view->resetView(); + + std::cout<<"Setup overlay graph done."<addItems(listItemsEngine); + engineList->setCurrentRow(0); + vl->addWidget(engineList); + connect(engineList, SIGNAL(currentTextChanged(QString)), g, SLOT(setLayoutEngine(QString))); + + nwGrid->addWidget(layoutGroupBox); + + // distance measure + QGroupBox *distanceGroupBox = new QGroupBox("Distance calculation", nwWidget); + vl = new QVBoxLayout(distanceGroupBox); + + QLabel *metricLabel = new QLabel("Metric:", nwWidget); + vl->addWidget(metricLabel); + QListWidget *distanceList = new QListWidget(nwWidget); + QStringList listItems; + listItems<<"Canberra"<<"Euclidean"<<"Manhattan"<<"Cosine"<<"Custom"; + distanceList->addItems(listItems); + distanceList->setCurrentRow(0); + distanceList->sortItems(); + vl->addWidget(distanceList); + connect(distanceList, SIGNAL(currentTextChanged(QString)), this, SLOT(distanceMeasureChanged(QString))); + + // normalization measure + QLabel *normalizerLabel = new QLabel("Normalization:", nwWidget); + vl->addWidget(normalizerLabel); + QListWidget *normalizerList = new QListWidget(nwWidget); + QStringList listItemsNorm; + listItemsNorm<<"NONE"<<"SUM"<<"PROD"<<"MAX"<<"MIN"; + normalizerList->addItems(listItemsNorm); + normalizerList->setCurrentRow(1); + vl->addWidget(normalizerList); + connect(normalizerList, SIGNAL(currentTextChanged(QString)), this, SLOT(distanceMeasureNormChanged(QString))); + + // distance cutoff + QLabel* distanceLabel = new QLabel("Distance cutoff:", nwWidget); + vl->addWidget(distanceLabel); + + cutOffSlider = new QSlider(Qt::Horizontal, nwWidget); + cutOffSlider->setRange(0, 1000); + cutOffSlider->setSingleStep(1); + vl->addWidget(cutOffSlider); + connect(cutOffSlider, SIGNAL(sliderMoved(int)), this, SLOT(cutOffSliderChanged(int))); + + cutOffLabel = new QLabel("0 %", nwWidget); + vl->addWidget(cutOffLabel); + +#ifdef MIAMAINWINDOW_H_ENABLE_ZSCORE + useZScore = new QCheckBox("Use ZScore", nwWidget); + connect(useZScore, SIGNAL(clicked()), this, SLOT(useZScoreChanged())); + vl->addWidget(useZScore); +#endif + nwGrid->addWidget(distanceGroupBox); + + // experiment count + QGroupBox *experimentCountGroupBox = new QGroupBox("Minimum experiments for compounds", nwWidget); + QHBoxLayout *hl = new QHBoxLayout(experimentCountGroupBox); + + excludeIfFoundInLessExperiments = new QSpinBox(nwWidget); + excludeIfFoundInLessExperiments->setToolTip("Exclude node from network if present in less than n experiments"); + excludeIfFoundInLessExperiments->setMinimum(1); + excludeIfFoundInLessExperiments->setValue(qsettings.value("exclude_if_found_in_less_experiments", 1).toInt()); + hl->addWidget(excludeIfFoundInLessExperiments); + connect(excludeIfFoundInLessExperiments, SIGNAL(valueChanged(int)), this, SLOT(excludeIfFoundInLessExperimentsChanged(int))); + + hideFoundInLessExperiments = new QCheckBox("Hide others", nwWidget); + connect(hideFoundInLessExperiments, SIGNAL(clicked()), this, SLOT(hideFoundInLessExperimentsChanged())); + hl->addWidget(hideFoundInLessExperiments); + + nwGrid->addWidget(experimentCountGroupBox); + + // variation + QGroupBox *variationGroupBox = new QGroupBox("Variation cutoff", nwWidget); + vl = new QVBoxLayout(variationGroupBox); + + variationSlider = new QSlider(Qt::Horizontal, nwWidget); + variationSlider->setRange(0, 10000); + variationSlider->setSingleStep(1); + variationSlider->setValue(0); + vl->addWidget(variationSlider); + connect(variationSlider, SIGNAL(sliderMoved(int)), this, SLOT(variationSliderChanged(int))); + + variationLabel = new QLabel(QString::number(variationSlider->value()), nwWidget); + vl->addWidget(variationLabel); + + hideLessVaryingNodes = new QCheckBox("Hide others", nwWidget); + connect(hideLessVaryingNodes, SIGNAL(clicked()), this, SLOT(hideLessVaryingChanged())); + vl->addWidget(hideLessVaryingNodes); + + nwGrid->addWidget(variationGroupBox); + + graphOptionsDockWidget->setWidget(nwWidget); +} + +void MIAMainWindow::addEdgesToGraph(int excludeIfFoundInLessExperiments, double variationCutoff) +{ + // collect distance info for edge line scaling + double overallMin, overallMax; + networkSet->getMinMaxDistances(overallMin, overallMax); + + // add edges + std::vector edges = networkSet->getEdges(excludeIfFoundInLessExperiments, variationCutoff); + + for(int i = 0; i < edges.size(); ++i) { + LabelingDatasetEdge *e = edges[i]; + + // label / name + std::string edgeLabel = ""; + if(qsettings.value("graph_edge_label", "1").toBool()) { + edgeLabel = QString::number(e->distance).toStdString(); + } + + g->addEdge(e->node1->getCompoundName(), e->node2->getCompoundName(), edgeLabel); + + // weight makes some layouts crash! + // g->setEdgeAttribute(e->compoundName1, e->compoundName2, edgeLabel, + // "weight", QString::number((int)(1.0 / e->distance)).toStdString()); + + + // color + g->setEdgeAttribute(e->node1->getCompoundName(), e->node2->getCompoundName(), edgeLabel, + "color", experimentColors[e->datasetIndex % experimentColors.size()].name().toStdString()); + + // pen width + double minPenWidth = 3; + double maxPenWidth = 30; + double penWidth = minPenWidth; + + penWidth = maxPenWidth - (maxPenWidth - minPenWidth) * (e->distance - overallMin) / (overallMax - overallMin); + + g->setEdgeAttribute(e->node1->getCompoundName(), e->node2->getCompoundName(), edgeLabel, + "penwidth", QString::number(penWidth).toStdString()); + + +#ifdef MIA_WITH_METABOBASE + //int keggCon = keggMapper->findReactions(nodes[i]->getFeature("PRECURSOR_KEGG_ID"), nodes[j]->getFeature("PRECURSOR_KEGG_ID"), true); + std::stringstream keggInfo; + int keggCon = keggMapper->startFindPath(e->node1->getFeature("PRECURSOR_KEGG_ID"), e->node2->getFeature("PRECURSOR_KEGG_ID"), 2, keggInfo); + if(keggCon) { + g->setEdgeAttribute(e->node1->getCompoundName(), e->node2->getCompoundName(), edgeLabel, + "style", "bold"); + } else { + g->setEdgeAttribute(e->node1->getCompoundName(), e->node2->getCompoundName(), edgeLabel, + "style", "dotted"); + } + g->setEdgeAttribute(e->node1->getCompoundName(), e->node2->getCompoundName(), edgeLabel, + "edgetooltip", keggInfo.str()); +#endif + + delete e; + } + // g->setGraphAttribute(std::string("splines"), "false"); +} + +bool MIAMainWindow::showGraphSizeWarning(int edges) +{ + QMessageBox msg; + std::stringstream str; + str<<"Graph contains "<exportMIDs(out); +} + +void MIAMainWindow::updateCompoundList() +{ + QSortFilterProxyModel *sortProxy = new QSortFilterProxyModel(this); + sortProxy->setSourceModel(new NodeCompoundTreeModel(networkSet->getNodeCompounds())); + sortProxy->setDynamicSortFilter(true); + + compoundTreeView->setModel(sortProxy); + compoundTreeView->setAlternatingRowColors(true); + compoundTreeView->setSortingEnabled(true); + compoundTreeView->sortByColumn(1, Qt::AscendingOrder); + compoundTreeView->resizeColumnToContents(0); + compoundTreeView->resizeColumnToContents(1); + compoundTreeView->resizeColumnToContents(2); + compoundTreeView->resizeColumnToContents(3); +} + + +void MIAMainWindow::showInfoDialog() +{ + QMessageBox::about(this, QString("About ").append(QApplication::applicationName()), + QString("%1
" + "Version %2

" + "2013-2016
" + "    Daniel Weindl <sci@danielweindl.de>

" + "Config
" + "%3

" + "Documentation
" + "%4" + "%5" + ).arg(QApplication::applicationName(), + QApplication::applicationVersion(), + QSettings().fileName(), + #ifndef _WINDOWS_ + "/usr/share/doc/mia/mia-doc.pdf", + #endif + #ifdef _WINDOWS_ + QApplication::applicationDirPath().append("/../doc/mia-doc.pdf"), + #endif + "http://massisotopolomeanalyzer.lu/download/mia-doc.pdf" + )); + +} + +void MIAMainWindow::cutOffSliderChanged(int i) +{ +#ifdef MIAMAINWINDOW_H_ENABLE_ZSCORE + if(useZScore->checkState() == Qt::Checked) { + for(int ds = 0; ds < datasets.size(); ++ds) { + Settings s = datasets[ds]->getSettings(); + + double newCutoff = i / 10.0; + std::cout<<"Set cutoff to "<setSettings(s); + + cutOffLabel->setText(QString("d < ") + QString::number(newCutoff)); + } + } else { +#endif + double percent = 100.0 * (i - cutOffSlider->minimum()) + / (cutOffSlider->maximum() - cutOffSlider->minimum()); + // set slider maximum to 70%, because only lower range of interest + percent *= DISTANCE_CUTOFF_SLIDER_IMPLICIT_MAXIMUM; + networkSet->setRelativeDistanceCutoff(percent); + + cutOffLabel->setText(QString::number(percent) + " %"); + +#ifdef MIAMAINWINDOW_H_ENABLE_ZSCORE + } +#endif + + setupExperimentOverlayGraph(); +} + +void MIAMainWindow::variationSliderChanged(int i) +{ + variationLabel->setText(QString::number(i / 10000.0)); + setupExperimentOverlayGraph(); + updateCompoundList(); +} + +void MIAMainWindow::distanceMeasureChanged(QString cur) +{ + if(cur == "Euclidean") + LabelingNetworkSet::distCalc->distanceMeasure = MIDDistanceCalculator::D_EUCLIDEAN; + else if(cur == "Canberra") + LabelingNetworkSet::distCalc->distanceMeasure = MIDDistanceCalculator::D_CANBERRA; + else if(cur == "Cosine") + LabelingNetworkSet::distCalc->distanceMeasure = MIDDistanceCalculator::D_COSINE; + else if(cur == "Manhattan") + LabelingNetworkSet::distCalc->distanceMeasure = MIDDistanceCalculator::D_MANHATTAN; + else if(cur == "Custom") + LabelingNetworkSet::distCalc->distanceMeasure = MIDDistanceCalculator::D_CUSTOM; + + // recalculate all distances + networkSet->createDistanceMatrices(); + + // reset distance slider and cutoff + cutOffSlider->setSliderPosition(0); + networkSet->setDistanceCutoff(0); + + setupExperimentOverlayGraph(); +} + +void MIAMainWindow::distanceMeasureNormChanged(QString cur) +{ + if(cur == "MAX") + LabelingNetworkSet::distCalc->distanceNormalization = MIDDistanceCalculator::DN_MAX; + else if(cur == "MIN") + LabelingNetworkSet::distCalc->distanceNormalization = MIDDistanceCalculator::DN_MIN; + else if(cur == "PROD") + LabelingNetworkSet::distCalc->distanceNormalization = MIDDistanceCalculator::DN_PROD; + else if(cur == "SUM") + LabelingNetworkSet::distCalc->distanceNormalization = MIDDistanceCalculator::DN_SUM; + else if(cur == "NONE") + LabelingNetworkSet::distCalc->distanceNormalization = MIDDistanceCalculator::DN_ONE; + + // recalculate all distances + networkSet->createDistanceMatrices(); + + // reset slider pos and cutoff + cutOffSlider->setSliderPosition(0); + networkSet->setDistanceCutoff(0); + + setupExperimentOverlayGraph(); +} + +void MIAMainWindow::selectCompoundLibraryAndIdentify() +{ + // keep current identification if no new match? + QMessageBox mb; + mb.setWindowTitle("Identify compounds..."); + mb.setText("Keep current names if no new hit is found?"); + mb.setIcon(QMessageBox::Question); + mb.setStandardButtons(QMessageBox::Yes | QMessageBox::No | QMessageBox::Cancel); + mb.setDefaultButton(QMessageBox::No); + int keep = mb.exec(); + + if(keep == QMessageBox::Cancel) + return; + + // Select library + QStringList libFiles = QFileDialog::getOpenFileNames(this, "Select compound library", + QSettings().value("cmp_id_library", QString::fromStdString(CMP_ID_LIBRARY)).toString(), + "Library files (*.lbr);;All files (*)"); + + QStringList::Iterator libIt = libFiles.begin(); + while(libIt != libFiles.end()) { + QString libFile = *libIt; + + if(libFile.isNull()) + return; + + QSettings().setValue("cmp_id_library", libFile); + + if(keep == QMessageBox::Yes) { + matchCompoundsAgainstLibrary(libFile, false); + } else if (QMessageBox::No) { + matchCompoundsAgainstLibrary(libFile, true); + } + + ++libIt; + } + qDeleteAll(nodeWidgets); + nodeWidgets.clear(); // need to recreate with new labels TODO: keep ref to compound in the widget? + + setupExperimentOverlayGraph(); + experimentListWidget->updateExperimentList(networkSet->getDatasets(), experimentColors); + updateCompoundList(); +} + +void MIAMainWindow::showConfigDialog() +{ + ConfigDialog* conf = new ConfigDialog; + + bool oldUseCommonIon = qsettings.value("nw_use_common_largest_ion", NW_USE_LARGEST_COMMON_ION).toBool(); + + //conf->show(); + conf->exec(); + + // update excludelib? + if(excludeLib) delete excludeLib; + QString libFile = qsettings.value("exclude_library_file", "").toString(); + if(libFile.length()) + excludeLib = gcms::LibrarySearch::fromDisk(libFile.toStdString().c_str()); + + bool newUseCommonIon = qsettings.value("nw_use_common_largest_ion", NW_USE_LARGEST_COMMON_ION).toBool(); + if(newUseCommonIon != oldUseCommonIon) { + networkSet->setUseLargestCommonIon(newUseCommonIon); + qDeleteAll(nodeWidgets); + nodeWidgets.clear(); // ... and recreate widgets to show newly selected MID + } + + QApplication::setOverrideCursor(QCursor(Qt::WaitCursor)); + //matchCompoundsAcrossExperiments(); + //matchCompoundsAgainstLibrary(); + + networkSet->setExcludeM0(qsettings.value("alignment_m0", 0).toInt()); + networkSet->createDistanceMatrices(); + setupExperimentOverlayGraph(); + experimentListWidget->updateExperimentList(networkSet->getDatasets(), experimentColors); + updateCompoundList(); + + QApplication::restoreOverrideCursor(); +} + +#ifdef MIAMAINWINDOW_H_ENABLE_ZSCORE +void MIAMainWindow::useZScoreChanged() +{ + if(useZScore->checkState() == Qt::Checked) { + cutOffSlider->setMinimum(-30); + cutOffSlider->setMaximum(0); + cutOffSlider->setValue(-10); + } else { + cutOffSlider->setRange(0, 1000); + cutOffSlider->setSingleStep(1); + } + + LabelingNetworkSet::createDistanceMatrices(); +} +#endif + +void MIAMainWindow::hideLessVaryingChanged() +{ + setupExperimentOverlayGraph(); +} + +void MIAMainWindow::excludeIfFoundInLessExperimentsChanged(int i) +{ + qsettings.setValue("exclude_if_found_in_less_experiments", i); + setupExperimentOverlayGraph(); +} + +void MIAMainWindow::hideFoundInLessExperimentsChanged() +{ + setupExperimentOverlayGraph(); +} + +void MIAMainWindow::experimentSettingChanged(int idx, Settings s) +{ + NetworkLayer *ds = networkSet->getDataset(idx); + ds->setSettings(s); + startLabelDetection(ds); + // TODO rerun label detection if neccessary -> Settings::settingsChanged + // No, TODO: delete and recreate ds with the new settings +} + +void MIAMainWindow::addExperiment(Settings s) +{ + NetworkLayer *ds = new NetworkLayer(s); + networkSet->addDataset(ds); + startLabelDetection(ds); +} + +void MIAMainWindow::experimentSelectionChanged() +{ + setupExperimentOverlayGraph(); +} + +void MIAMainWindow::experimentRemoved(NetworkLayer *ds) +{ + networkSet->removeDataset(ds); + delete ds; + labelDetectionFinished(); +} + +void MIAMainWindow::closeEvent(QCloseEvent *event) +{ + int q = QMessageBox::question(this, "Close MIA?", "Are your sure you want to close MIA?", QMessageBox::Ok, QMessageBox::Cancel); + +#if MIA_DEBUG_LEVELg > 1 + // show all widgets + foreach(QWidget* w, QApplication::topLevelWidgets()) { + std::cout<<"-"<metaObject()->className()<accept(); + } else { + event->ignore(); + } +} + +#ifdef MIA_WITH_NETCDF_IMPORT +void MIAMainWindow::showDataImportDialog() +{ + if(!netCDFImportDialog) { + netCDFImportDialog = new NetCDFImportDialog(); + } + netCDFImportDialog->show(); +} +#endif + + +/* +void MIAMainWindow::openFile() +{ + QString filename = QFileDialog::getOpenFileName(this, "Open file", "", "Data files (*.dat);;All files (*)"); + + if(filename.isNull()) + return; + + std::cout<<"Loading..."; + QApplication::setOverrideCursor(QCursor(Qt::WaitCursor)); + + if(!progressDialog) { + progressDialog = new QProgressDialog(this); + progressDialog->setModal(true); + progressDialog->setMinimumDuration(0); + progressDialog->setMaximum(0); + connect(this, SIGNAL(progressText(QString)), progressDialog, SLOT(setLabelText(QString))); + progressDialog->show(); + } + + QFile file(filename); + file.open(QIODevice::ReadOnly); + QDataStream in(&file); + try { + emit(progressText("Reading file.")); + in >> layers >> nodes; + qDeleteAll(nodeWidgets); + nodeWidgets.clear(); + } catch(DeserializationException const &e) { + file.close(); + QApplication::restoreOverrideCursor(); + QMessageBox mb; + mb.setWindowTitle("Error opening file..."); + mb.setText("Maybe you used data saved with an older program version?"); + mb.setDetailedText(e.what()); + mb.setIcon(QMessageBox::Critical); + mb.setStandardButtons(QMessageBox::Ok); + } + + file.close(); + + // refresh everything + labelDetectionFinished(); + + setWindowTitle(QApplication::applicationName() + " - " + filename); + + QApplication::restoreOverrideCursor(); + std::cout<<"done."<removeAllDatasets(); + + try { + QList datasets = QList::fromVector(QVector::fromStdVector(NetworkLayer::fromXMLFile(filename.toStdString()))); + + if(datasets.size() > experimentColors.size()) { + std::cerr<<"Define more colors"<addDataset(ds); + startLabelDetection(ds); + } + + setWindowTitle(QApplication::applicationName() + " - " + filename); + QApplication::restoreOverrideCursor(); + + } catch (rapidxml::parse_error const &e) { + QApplication::restoreOverrideCursor(); + std::cerr<<"Error reading XML file"< stringVec; + for(std::map > >::iterator mapIt = distMats.begin(); + mapIt != distMats.end(); ++mapIt) { + stringVec.push_back(mapIt->first); + } + HDFStringWriter::writeVector(distsGroup, "Experiments", stringVec); + + // write metabolite names + stringVec.clear(); + foreach (NodeCompound* c, nodes.values()) { + stringVec.push_back(c->getCompoundName()); + } + HDFStringWriter::writeVector(distsGroup, "Metabolites", stringVec); + + // write distance matrices + int count = 0; + for(std::map > >::iterator mapIt = distMats.begin(); + mapIt != distMats.end(); ++mapIt) { + + std::vector > dist = mapIt->second; + + hsize_t dim[2]; + dim[0] = dist.size(); + dim[1] = dist[0].size(); + H5::DataSpace dataspace(2, dim); + std::stringstream name; + name <<"/Dists/Matrix" << count++; // TODO make array, not Matrix1..n + H5::DataSet dataset = h5f.createDataSet(name.str(), H5::PredType::NATIVE_DOUBLE, dataspace); + + double data[dim[0]][dim[1]]; + + for(int i = 0; i < dim[0]; ++i) + for(int j = 0; j < dim[1]; ++j) + data[i][j] = dist[i][j]; + dataset.write(data, H5::PredType::NATIVE_DOUBLE); + } + + h5f.close(); +} +#endif + +} diff --git a/gui/miamainwindow.h b/gui/miamainwindow.h new file mode 100644 index 0000000..830bdbc --- /dev/null +++ b/gui/miamainwindow.h @@ -0,0 +1,164 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef MIAMAINWINDOW_H +#define MIAMAINWINDOW_H + +#include + +#include "rapidxml/rapidxml.hpp" + +#include "compound.h" + +#include "src/config.h" +#include "src/networklayer.h" +#include "src/nodecompound.h" +#include "labelingnetworkset.h" + +#include "nwview.h" +#include "nodewidget.h" +#include "graphvizqt.h" +#include "labelidentificatorqthread.h" +#include "experimentlistwidget.h" +#include "graphvizmia.h" + +// Let user choose z-score normalization for distance cutoff +// needs to be checked +#undef MIAMAINWINDOW_H_ENABLE_ZSCORE + +#ifdef MIA_WITH_NETCDF_IMPORT + #include "netcdfimportdialog.h" +#endif + +#ifdef MIA_WITH_METABOBASE + #include "kegg_reaction_test/keggreactionmapper.h" +#endif + +namespace mia { + +class MIAMainWindow; + +class MIAMainWindow : public QMainWindow +{ + Q_OBJECT + +public: + explicit MIAMainWindow(QWidget *parent = 0); + ~MIAMainWindow(); + + static void findLabeledCompounds(NetworkLayer *ds); + +signals: + // TODO use! + void graphChanged(); + void progressText(QString str); + +public slots: + void recreateGraph(); +// void repaintGraph(); + void labelDetectionFinished(); + void compoundClicked(QModelIndex mi); + //void saveFile(); +#ifdef MIA_WITH_HDF5 + void saveHDF(); +#endif + void exportMIDs(); + //void openFile(); + void openXMLFile(); + void updateCompoundList(); + void showInfoDialog(); + void cutOffSliderChanged(int i); + void variationSliderChanged(int i); + void distanceMeasureChanged(QString cur); + void distanceMeasureNormChanged(QString cur); + void selectCompoundLibraryAndIdentify(); + void showConfigDialog(); +#ifdef MIAMAINWINDOW_H_ENABLE_ZSCORE + void useZScoreChanged(); +#endif + void hideLessVaryingChanged(); + void excludeIfFoundInLessExperimentsChanged(int i); + void hideFoundInLessExperimentsChanged(); + void experimentSettingChanged(int idx, Settings s); + void addExperiment(Settings s); + void experimentSelectionChanged(); + void experimentRemoved(NetworkLayer *ds); + void closeEvent(QCloseEvent *event); +#ifdef MIA_WITH_NETCDF_IMPORT + void showDataImportDialog(); +#endif + +private: + QList experimentColors; /** Colors for the different experiment layers */ + QSettings qsettings; /** Application user settings */ + + NWView *view; + QMap nodeWidgets; /** All the different compounds found in any experiment, index is the ID-feature of the compound */ + graphvizqt::Graph *g; /** The network graph */ + int graphSizeWarningLimit; + QList labidThreads; +#ifdef MIA_WITH_METABOBASE + KEGGReactionMapper *keggMapper; +#endif + +#ifdef MIA_WITH_NETCDF_IMPORT + NetCDFImportDialog *netCDFImportDialog; +#endif + gcms::LibrarySearch *excludeLib; + + // GUI stuff + QDockWidget *compoundListDockWidget; + QDockWidget *experimentListDockWidget; + QDockWidget *graphOptionsDockWidget; +// QMenu *fileMenu; +// QToolBar *fileToolBar; + QGraphicsScene *scene; + QTreeView *compoundTreeView; + QSlider* cutOffSlider; + QLabel* cutOffLabel; +#ifdef MIAMAINWINDOW_H_ENABLE_ZSCORE + QCheckBox* useZScore; +#endif + QSlider* variationSlider; + QLabel* variationLabel; + QCheckBox* hideLessVaryingNodes; + QSpinBox *excludeIfFoundInLessExperiments; + QCheckBox* hideFoundInLessExperiments; + QProgressDialog* progressDialog; + ExperimentListWidget *experimentListWidget; + LabelingNetworkSet *networkSet; + + void init(); + void matchCompoundsAcrossExperiments(); + void startLabelDetection(NetworkLayer *ds); // TODO move to labelingNetworkSet, needs signals & slots first + void generateNodeWidgets(); + void matchCompoundsAgainstLibrary(QString libFile = "", bool overwriteNames = true); + + void setupGUI(); + void setupToolbar(); + void setupCompoundList(); /** GUI stuff */ + void setupExperimentList(); /** GUI stuff */ + void setupExperimentOverlayGraph(); /** Do multi-tracer overlay */ + void setupGraphOptionPanel(); + void addEdgesToGraph(int excludeIfFoundInLessExperiments, double variationCutoff); + + bool showGraphSizeWarning(int edges); +}; +} +#endif // MIAMAINWINDOW_H diff --git a/gui/midplot.cpp b/gui/midplot.cpp new file mode 100644 index 0000000..e48e289 --- /dev/null +++ b/gui/midplot.cpp @@ -0,0 +1,210 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "midplot.h" + +#include +#include +#include + +#include +#include +#include + +MIDPlot::MIDPlot(const QVector& mids, const QString& title, double r2, int ion, QWidget* parent) + :QWidget(parent), + mids(mids), + title(title), + r2(r2), + ion(ion), + bar_width(10), + space(5), + height(220) +{ + bgColor = Qt::lightGray; // this->palette().window().color(); + borderColor = Qt::black; + barColor = Qt::blue; + margin = 10; + + // bar width calculation + QFont f = font(); + f.setPointSize(12); + QFontMetrics fm = QFontMetrics(f); + bar_width = qMax(bar_width, fm.width("M10")); + + setToolTip(title); + displayValues = 1; + + sum = 0; + for(int i = 0; i < mids.size(); ++i) + sum += fabs(mids[i]); + + subtitle = "Ion: " + QString::number(ion) + + " R2 = " + QString::number(r2, 'f', 3) + + " S = " + QString::number(sum, 'f', 2); +} + +void MIDPlot::paintEvent ( QPaintEvent * event ) +{ + + // background box + QPainter p(this); + p.fillRect(rect(), bgColor); + + QPen oldPen = p.pen(); + QPen newPen = p.pen(); + newPen.setColor(borderColor); + p.setPen(newPen); + p.drawRect(rect()); + p.setPen(oldPen); + + + QFont f(font()); + + //paint title + f.setPointSize(16); + p.setFont(f); + QRect rect_title1(margin, margin, 1.01 * (width() - 2 * margin), QFontMetrics(f).height()); + p.drawText(rect_title1, Qt::AlignCenter, title); + + // subtitle + f.setPointSize(14); + p.setFont(f); + QRect rect_title2 = rect_title1; + rect_title2.moveTop(rect_title2.bottom()); + p.drawText(rect_title2, Qt::AlignCenter, subtitle); + p.translate(0, QFontMetrics(f).height() * 2.5); + + f.setPointSize(12); + p.setFont(f); + + int n_mids = mids.size(); + int bw = bar_width; + int bh = height - margin; //border + int fh = QFontMetrics(f).height(); + bh -= fh; + + int x = margin + qMax(0.0, 0.5 * (QFontMetrics(f).width(title) - n_mids * bw - (n_mids-1)*space)); + //int y = height-5; + for(int i = 0; i < n_mids; i++) + { + //paint bar + double rc_mid = mids.at(i); + rc_mid = qMin(1.0, rc_mid); + rc_mid = qMax(0.0, rc_mid); + int rc_bh = bh * rc_mid + 0.5; + p.fillRect(QRect(x, height - rc_bh - fh, bw, rc_bh), barColor); + p.drawRect(QRect(x, height - rc_bh - fh, bw, rc_bh)); + + if(cis.size() && cis[i] > 0) { // -1 if NaN or similar + int ciLen = bh * cis[i] + 0.5; + QPen oldPen = p.pen(); + QPen pen = p.pen(); + pen.setWidth(2); + p.setPen(pen); + p.drawLine(x + 0.5 * bw, height - rc_bh - fh + ciLen, x + 0.5 * bw, height - rc_bh - fh - ciLen); + p.setPen(oldPen); + } + + if(displayValues) { + if(int mid = mids.at(i) * 100) { + QRect rectVal(x, height - rc_bh - 2*fh, bw, fh); + QFont vf; + vf.setPointSize(10); + p.setFont(vf); + p.drawText(rectVal, Qt::AlignHCenter, QString::number(mid)); + p.setFont(f); + } + } + + // "M_n" + QRect rect_text(x, height - margin, bw, fh); + p.drawText(rect_text, Qt::AlignHCenter, "M" + QString::number(i)); + x += bw+space; + } +} + +QSize MIDPlot::sizeHint () const +{ + int width = bar_width * mids.size() + space*(mids.size() - 1) + 2* margin; + + QFont f; + f.setPointSize(16); + int text_width1 = QFontMetrics(f).width(title) + space * 2; + f.setPointSize(14); + int text_width2 = QFontMetrics(f).width(subtitle) + margin * 2; + int rc_width = qMax(width, text_width1); + rc_width = qMax(rc_width, text_width2); + int rc_height = height + QFontMetrics(f).height() * 3 + 5; + return QSize(rc_width, rc_height); +} + +void MIDPlot::setBarColor(QColor c) +{ + barColor = c; +} + +void MIDPlot::setCI(const QVector &ci) +{ + assert(ci.size() == mids.size()); + cis = ci; +} +QColor MIDPlot::getBgColor() const +{ + return bgColor; +} + +void MIDPlot::setBgColor(const QColor &value) +{ + bgColor = value; +} +QColor MIDPlot::getBorderColor() const +{ + return borderColor; +} + +void MIDPlot::setBorderColor(const QColor &value) +{ + borderColor = value; +} + +void MIDPlot::mouseDoubleClickEvent(QMouseEvent *event) +{ + copyToClipboard(); +} + +void MIDPlot::copyToClipboard() +{ + QString colSep = "\t"; + QString rowSep = "\n"; + + QClipboard *clipboard = QApplication::clipboard(); + + QStringList sl; + sl<setText(sl.join(rowSep)); +} + + + diff --git a/gui/midplot.h b/gui/midplot.h new file mode 100644 index 0000000..53cb45a --- /dev/null +++ b/gui/midplot.h @@ -0,0 +1,70 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef MIDPLOT_H +#define MIDPLOT_H + +#include +#include + +/** + * @brief The MIDPlot class creates a bar plot for the given MID. Adapted from ntfd-gui. + */ +class MIDPlot : public QWidget +{ + Q_OBJECT +public: + MIDPlot(const QVector& mids, const QString& title, double r2, int ion, QWidget* parent); + + virtual void paintEvent ( QPaintEvent * event ); + virtual QSize sizeHint () const; + + void setBarColor(QColor c); + void setCI(const QVector& ci); + + QColor getBgColor() const; + void setBgColor(const QColor &value); + + QColor getBorderColor() const; + void setBorderColor(const QColor &value); + + void mouseDoubleClickEvent(QMouseEvent *event); + +public slots: + void copyToClipboard(); + +private: + int margin; + QVector mids; + QVector cis; + QString title; + QString subtitle; + double sum; + double r2; + int ion; + int bar_width; + int space; + int height; + QColor barColor; + QColor bgColor; + QColor borderColor; + bool displayValues; +}; + +#endif // MIDPLOT_H diff --git a/gui/mitrendplot.cpp b/gui/mitrendplot.cpp new file mode 100644 index 0000000..609afe9 --- /dev/null +++ b/gui/mitrendplot.cpp @@ -0,0 +1,64 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "mitrendplot.h" +#include +#include +namespace nwrecon { + +/* +MITrendplot::MITrendplot() : QwtPlot() +{ + +} + +MITrendplot::MITrendplot(NodeCompound *nc, QWidget* parent = 0) : QwtPlot(QwtText("Test"), parent) +{ + // TODO: only if same ion present + QVector > mids; + std::vector exps = nc->getExperiments(); + + int maxMI = 0; + for(int i = 0; i < exps.size(); ++i) { + std::vector mid = nc->getSelectedMID(exps[i]); + mids.push_back(mid); + maxMI = std::max(maxMI, mid.size()); + } + + QVector curves; + for(int i = 0; i < maxMI; ++i) { + curves[i] == new QwtPlotCurve(QString("M%1").arg(i)); + QwtPointSeriesData *sd = new QwtPointSeriesData(); + QVector* points = new QVector; + + int exp = 0; + foreach (std::vector mid, mids) { + ++exp; + if(i < mid.size()) { + points->push_back(QPointF(exp, mid[i])); + } + } + sd->setSamples(*points); + curves[i]->setData(sd); + curves[i]->attach(this); + } + replot(); +}*/ +} diff --git a/gui/mitrendplot.h b/gui/mitrendplot.h new file mode 100644 index 0000000..0702660 --- /dev/null +++ b/gui/mitrendplot.h @@ -0,0 +1,41 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef MITRENDPLOT_H +#define MITRENDPLOT_H + +#include +#include +#include"src/nodecompound.h" + +namespace nwrecon { + +/* mass isotopomer trend plot + * curves for different mass isotopomer abundances over different experiments + */ + +class MITrendplot : public QwtPlot +{ + //Q_OBJECT +public: + MITrendplot(); + //MITrendplot(NodeCompound *nc, QWidget *parent); +}; +} +#endif // MITRENDPLOT_H diff --git a/gui/multiexperiments.cpp b/gui/multiexperiments.cpp new file mode 100644 index 0000000..b392c84 --- /dev/null +++ b/gui/multiexperiments.cpp @@ -0,0 +1,25 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "multiexperiments.h" + +MultiExperiments::MultiExperiments() +{ +} diff --git a/gui/multiexperiments.h b/gui/multiexperiments.h new file mode 100644 index 0000000..5be53d9 --- /dev/null +++ b/gui/multiexperiments.h @@ -0,0 +1,42 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef MULTIEXPERIMENTS_H +#define MULTIEXPERIMENTS_H + +#include "nwrecon.h" +#include "nodecompound.h" +#include "middistancecalculator.h" + + +namespace nwrecon { + + +class MultiExperiments +{ +public: + MultiExperiments(); + +private: + + +}; + +} +#endif // MULTIEXPERIMENTS_H diff --git a/gui/netcdfimportdialog.cpp b/gui/netcdfimportdialog.cpp new file mode 100644 index 0000000..aed39fd --- /dev/null +++ b/gui/netcdfimportdialog.cpp @@ -0,0 +1,216 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "netcdfimportdialog.h" +#include "compounddetector.h" +#include "defaultpeakdetector.h" +#include "cdfimporter.h" + +namespace mia { + +NetCDFImportDialog::NetCDFImportDialog(QWidget *parent) : QWidget(parent) +{ + setWindowTitle("MIA - Data import"); + + listFiles = new QListWidget(); + listFiles->setSelectionMode(QListWidget::ExtendedSelection); + + QPushButton *btAddFiles = new QPushButton(QIcon(":/gui/icons/list-add.png"), tr("&Add"), this); + QPushButton *btRemoveFiles = new QPushButton(QIcon(":/gui/icons/list-remove.png"), tr("&Remove"), this); + + connect(btAddFiles, SIGNAL(clicked()), this, SLOT(addFileClicked())); + connect(btRemoveFiles, SIGNAL(clicked()), this, SLOT(removeFileClicked())); + + QLabel *lbDeconvolutionWidth = new QLabel("Deconvolution width", this); + lbDeconvolutionWidth->setToolTip("Deconvolution width in scans"); + + sbDeconvolutionWidth = new QDoubleSpinBox(this); + sbDeconvolutionWidth->setMinimum(0); + sbDeconvolutionWidth->setValue(5); + sbDeconvolutionWidth->setMaximum(100); + + QLabel *lbPeakThreshold = new QLabel("Peak threshold", this); + lbPeakThreshold->setToolTip("Peak threshold"); + + sbPeakThreshold = new QDoubleSpinBox(this); + sbPeakThreshold->setMinimum(0); + sbPeakThreshold->setValue(10); + sbPeakThreshold->setMaximum(100); + + QLabel *lbMinPeakHeight = new QLabel("Minimum peak height", this); + lbPeakThreshold->setToolTip("Minimum peak height"); + + sbMinPeakHeight = new QDoubleSpinBox(this); + sbMinPeakHeight->setMinimum(0); + sbMinPeakHeight->setValue(10); + sbMinPeakHeight->setMaximum(100); + + QLabel *lbMinPeaks = new QLabel("Minimum number of peaks", this); + lbMinPeaks->setToolTip("Minimum number of peaks"); + + sbMinPeaks = new QSpinBox(this); + sbMinPeaks->setMinimum(1); + sbMinPeaks->setValue(25); + sbMinPeaks->setMaximum(1000); + + QPushButton *btAccept = new QPushButton("Start", this); + QPushButton *btCancel = new QPushButton("Cancel", this); + + connect(btAccept, SIGNAL(clicked()), this, SLOT(okayClicked())); + connect(btCancel, SIGNAL(clicked()), this, SLOT(cancelClicked())); + + + QGridLayout *layout = new QGridLayout(this); + int row = 0; + layout->addWidget(lbDeconvolutionWidth, row, 0); + layout->addWidget(sbDeconvolutionWidth, row, 1); + ++row; + layout->addWidget(lbPeakThreshold, row, 0); + layout->addWidget(sbPeakThreshold, row, 1); + ++row; + layout->addWidget(lbMinPeakHeight, row, 0); + layout->addWidget(sbMinPeakHeight, row, 1); + ++row; + layout->addWidget(lbMinPeaks, row, 0); + layout->addWidget(sbMinPeaks, row, 1); + ++row; + layout->addWidget(listFiles, row, 0, 2, 1); + layout->addWidget(btAddFiles, row, 1); + ++row; + layout->addWidget(btRemoveFiles, row, 1); + layout->setRowStretch(row, 1); + + layout->addWidget(btAccept, 0, 2); + layout->addWidget(btCancel, 1, 2); +} + +void NetCDFImportDialog::addFileClicked() +{ + QSettings settings; + QStringList files = QFileDialog::getOpenFileNames(this, + "Select chromatograms", + settings.value("dir_add_chromatogram", "").toString(), + "MetaboliteDetector files (*.cmp);;netCDF files (*.cdf);;All files (*.*)" + ); + + if(files.size()) { + listFiles->addItems(files); + QDir dir(files[0]); + settings.setValue("dir_add_chromatogram", dir.absolutePath()); + } +} + +void NetCDFImportDialog::removeFileClicked() +{ + QList items = listFiles->selectedItems(); + foreach(QListWidgetItem* item, items) { + delete item; + } + listFiles->update(); +} + +void NetCDFImportDialog::okayClicked() +{ + QProgressDialog progress("Compound detection...\n(This might take a few minutes)", + "Abort", + 0, 2 * listFiles->count(), + this); + progress.setWindowModality(Qt::WindowModal); + progress.show(); + QCoreApplication::processEvents(); + + // peak detection / deconvolution settings + gcms::GCMSSettings::AN_DECONVOLUTION_WIDTH = sbDeconvolutionWidth->value(); + gcms::GCMSSettings::AN_MIN_PEAK_HEIGHT = sbMinPeakHeight->value(); + gcms::GCMSSettings::AN_PEAK_THRESHOLD_BEGIN = sbPeakThreshold->value(); + gcms::GCMSSettings::AN_PEAK_THRESHOLD_END = -1.0 * gcms::GCMSSettings::AN_PEAK_THRESHOLD_BEGIN; + + + gcms::GCMSSettings::AN_MIN_PEAK_NUMBER = sbMinPeaks->value(); + + for(int i = 0; i < listFiles->count(); ++i) { + + QListWidgetItem *item = listFiles->item(i); + // files.append(item->text()); + QString file = item->text(); + QString fileBase = file.left(file.length() - 4); // strip file ending + QString ext = file.right(4); + + std::cout<* detector=new gcms::DefaultPeakDetector(); + CompoundDetector cd(fileBase, detector, true); + cd.run(); + } + + std::cout<<"done\n"; + + if (progress.wasCanceled()) + break; + } + + if(progress.wasCanceled()) { + QMessageBox::information(this, "MIA", "Compound detection finished.", QMessageBox::Ok); + } else { + QMessageBox::critical(this, "MIA", "Compound detection canceled.", QMessageBox::Ok); + } + + close(); +} + +void NetCDFImportDialog::cancelClicked() +{ + close(); +} + +} diff --git a/gui/netcdfimportdialog.h b/gui/netcdfimportdialog.h new file mode 100644 index 0000000..73f4715 --- /dev/null +++ b/gui/netcdfimportdialog.h @@ -0,0 +1,50 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef NETCDFIMPORTDIALOG_H +#define NETCDFIMPORTDIALOG_H + +#include + +namespace mia { + +class NetCDFImportDialog : public QWidget +{ + Q_OBJECT + +public: + explicit NetCDFImportDialog(QWidget *parent = 0); + +public slots: + void addFileClicked(); + void removeFileClicked(); + void okayClicked(); + void cancelClicked(); + +private: + QListWidget *listFiles; + QDoubleSpinBox *sbDeconvolutionWidth; + QDoubleSpinBox *sbMinPeakHeight; + QDoubleSpinBox *sbPeakThreshold; + QSpinBox *sbMinPeaks; +}; + +} + +#endif // NETCDFIMPORTDIALOG_H diff --git a/gui/nodecompounddescriptionwidget.cpp b/gui/nodecompounddescriptionwidget.cpp new file mode 100644 index 0000000..cc61439 --- /dev/null +++ b/gui/nodecompounddescriptionwidget.cpp @@ -0,0 +1,189 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "nodecompounddescriptionwidget.h" +#include +#include "midplot.h" +#include +#include +//#include "libraryspectrumplot.h" + +namespace mia { + +NodeCompoundDescriptionWidget::NodeCompoundDescriptionWidget(NodeCompound *nc, QWidget *parent) : QScrollArea(parent), nc(nc) +{ + setWindowTitle(QString::fromStdString(nc->getCompoundName())); + + w = new QWidget(this); + + QGridLayout *layout = new QGridLayout(w); + + QToolBar *toolBar = new QToolBar(w); + QAction *actExportImage = new QAction(QIcon(":/gui/icons/video-x-mng.png"), tr("Export Image"), this); + toolBar->addAction(actExportImage); + layout->addWidget(toolBar); + connect(actExportImage, SIGNAL(triggered()), this, SLOT(exportWindow())); + + QString text = QString("

%1

").arg(QString::fromStdString(nc->getCompoundName())); + + std::vector exps = nc->getExperiments(); + text.append(QString("" + "" + "" + "" + "" + "")); + + for(int i = 0; i < exps.size(); ++i) { + labid::LabeledCompound *lc = nc->getCompound(exps[i]); + + text.append(QString("").arg(QString::fromStdString(exps[i]), + QString::number(lc->getRetentionIndex(), 'f', 2), + QString::number(lc->getRetentionTime() / 1000 / 60, 'f', 2), + QString::number(lc->getTotalSignal(), 'f', 0) // TODO check if that is normalized from labid + )); + // Intensities of unlabeled compounds + std::list*> cmps = lc->getSourceSpectra(); + for(std::list* >::iterator it = cmps.begin(); it != cmps.end(); ++it) { + const gcms::LibraryCompound* cmp = dynamic_cast*>(*it); + if(!cmp) continue; + text.append(QString("").arg(QString::fromStdString(""), + QString::number(cmp->getRetentionIndex(), 'f', 2), + QString::number(cmp->getRetentionTime() / 1000 / 60, 'f', 2), + QString::number(cmp->getTotalSignal(), 'f', 0) // TODO check if that is normalized from labid + )); + } + } + text.append("
DatasetRIRTIntensity
%1%2%3%4
%1%2%3%4

"); + + /* + // MIDs + int selIdx = nc->getSelectedIndex(exp); + tt.append("
"); + for(int i = 0; i < lc->getLabeledIons().size(); ++i) { // all ions + + if(i == selIdx) + tt.append(QString("
%1 (%2)").arg(QString::number(lc->getLabeledIons()[i]), QString::number(lc->getR2s()[i], 'g', 3))); + else + tt.append(QString(""); + } + tt.append("
m/z %1 (R^2%2)").arg(QString::number(lc->getLabeledIons()[i]), QString::number(lc->getR2s()[i], 'g', 3))); + + std::vector mids = lc->getIsotopomers()[i]; + for(int m = 0; m < mids.size(); ++m) { // all isotopomers + tt.append(QString("").arg(QString::number(m), QString::number(mids[m], 'g', 3))); + } + tt.append("
M%1%2
"); +*/ + + QLabel *lab = new QLabel(text); + lab->setTextFormat(Qt::RichText); + layout->addWidget(lab); + + layout->addWidget(getMIDPlotsWidget()); + +/* metabolitedetector::LibrarySpectrumPlot *specPlot = new metabolitedetector::LibrarySpectrumPlot("", this); + # specPlot->setPlotPeakCaptionEnabled(true); + specPlot->setCentroidButtonEnabled(false); + specPlot->setPlotSliderEnabled(false); + specPlot->setZoomEnabled(true); + layout->addWidget(specPlot);*/ + // connect(lab, SIGNAL(clicked()), this, SLOT(close())); + w->setLayout(layout); + this->setWidget(w); +} + +QWidget *NodeCompoundDescriptionWidget::getMIDPlotsWidget() +{ + QWidget *w = new QWidget(this); + QGridLayout *layout = new QGridLayout(w); + + std::vector exps = nc->getExperiments(); + std::set lions = nc->getAllLabeledIons(); + + int row = 0; + // plots + for(std::set::iterator it = lions.begin(); it != lions.end(); ++it) { + int ion = *it; + + + // header + for(int i = 0; i < exps.size(); ++i) { + layout->addWidget(new QLabel(QString::fromStdString(exps[i]), w), row, i + 1); + } + ++row; + + int col = 0; + layout->addWidget(new QLabel(QString::number(ion, 'f', 0), w), row, col++); + + for(int i = 0; i < exps.size(); ++i) { + labid::LabeledCompound *lc = nc->getCompound(exps[i]); + const std::vector< float > ions = lc->getLabeledIons(); + + std::vector::const_iterator findIt = std::find(ions.begin(), ions.end(), ion); + if(findIt != ions.end()) { + int idx = findIt - ions.begin(); + QVector isotopomers = QVector::fromStdVector(lc->getIsotopomers()[idx]); + MIDPlot* mp = new MIDPlot(isotopomers, "", lc->getR2s()[idx], ion, this); + mp->setCI(QVector::fromStdVector(lc->getConfidenceIntervals()[idx])); + + // color full backbone plots + if(nc->getMMinusNIon(exps[i], 15) == ion) { + mp->setBarColor(Qt::yellow); + } else if(nc->getMMinusNIon(exps[i], 57) == ion) { + mp->setBarColor(Qt::red); + } + + layout->addWidget(mp, row, col); + } + ++col; + } + ++row; + } + + return w; +} + +void NodeCompoundDescriptionWidget::close() +{ +// destroy(); +// delete this; +} + +void NodeCompoundDescriptionWidget::exportWindow() +{ + QString filename = QFileDialog::getSaveFileName(this, "Export svg", "", "SVG files (*.svg);;All files (*)"); + if(filename.isNull()) return; + + // A4 export + double widthInch = 8.27; + double heightInch = 11.69; + + QSvgGenerator svgGen; + svgGen.setFileName(filename); + svgGen.setResolution(QDesktopWidget().physicalDpiX()); + svgGen.setSize(QSize(svgGen.resolution() * widthInch, svgGen.resolution() * heightInch)); + svgGen.setViewBox(QRect(0, 0, svgGen.width(), svgGen.height())); + svgGen.setTitle(tr("MIA export")); + svgGen.setDescription(tr("TODO: Put settings here...")); + w->render(&svgGen, QPoint(), QRegion(), QWidget::DrawChildren); +} + +} diff --git a/gui/nodecompounddescriptionwidget.h b/gui/nodecompounddescriptionwidget.h new file mode 100644 index 0000000..19cd8fe --- /dev/null +++ b/gui/nodecompounddescriptionwidget.h @@ -0,0 +1,50 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef NODECOMPOUNDDESCRIPTIONWIDGET_H +#define NODECOMPOUNDDESCRIPTIONWIDGET_H + +#include +#include + +#include "../src/nodecompound.h" + +namespace mia { + +class NodeCompoundDescriptionWidget : public QScrollArea +{ + Q_OBJECT +public: + NodeCompoundDescriptionWidget(NodeCompound *nc, QWidget *parent = 0); + + QWidget* getMIDPlotsWidget(); +signals: + +public slots: + void close(); + void exportWindow(); + +private: + QWidget *w; + NodeCompound *nc; + QGraphicsScene *scene; +}; + +} +#endif // NODECOMPOUNDDESCRIPTIONWIDGET_H diff --git a/gui/nodecompoundtreemodel.cpp b/gui/nodecompoundtreemodel.cpp new file mode 100644 index 0000000..de4bbf9 --- /dev/null +++ b/gui/nodecompoundtreemodel.cpp @@ -0,0 +1,337 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "nodecompoundtreemodel.h" +#include "src/config.h" + +#include +#include +#include + +namespace mia { + +NodeCompoundTreeModel::NodeCompoundTreeModel(QObject *parent) : + QAbstractItemModel(parent) +{ +} + +NodeCompoundTreeModel::NodeCompoundTreeModel(std::vector ncs, QObject *parent) : QAbstractItemModel(parent) +{ + //TODO + rootItem = new NodeCompoundTreeItem; + + // setup model data + for(std::vector::iterator it = ncs.begin(); it != ncs.end(); ++it) { + // create top-level items i.e. abstract compounds + rootItem->appendChild(new NodeCompoundTreeItem(*it, rootItem)); + } +} + +NodeCompoundTreeModel::NodeCompoundTreeModel(QMap ncs, QObject *parent) +{ + //TODO + rootItem = new NodeCompoundTreeItem; + + // setup model data + foreach(NodeCompound *nc, ncs) { + // create top-level items i.e. abstract compounds + rootItem->appendChild(new NodeCompoundTreeItem(nc, rootItem)); + } +} + +NodeCompoundTreeModel::~NodeCompoundTreeModel() +{ + delete rootItem; +} + +QVariant NodeCompoundTreeModel::data(const QModelIndex &index, int role) const +{ + if (!index.isValid()) + return QVariant(); + + NodeCompoundTreeItem *item = static_cast(index.internalPointer()); + return item->data(index.column(), role); +} + +bool NodeCompoundTreeModel::setData(const QModelIndex &index, const QVariant &value, int role) +{ + if(index.isValid()){ + switch (role) { + case Qt::DisplayRole: + case Qt::EditRole: + case Qt::CheckStateRole: + if(index.column() == CHECKBOX_USE_COLUMN) { + // set checkmarks hierachically + // TODO: set parents grey + setChildrenData(index, value, role); + } + emit dataChanged(index, index); + return static_cast(index.internalPointer())->setData(index.column(), value, role); + break; + } + } + return false; +} + +void NodeCompoundTreeModel::setChildrenData(const QModelIndex &index, const QVariant &value, int role) +{ + //if(index.column() == 0) { + NodeCompoundTreeItem* item = static_cast(index.internalPointer()); + for(int i = 0; i < item->childCount(); ++i) { + setData(this->index(i, index.column(), index), value, role); + setChildrenData(this->index(i, index.column(), index), value, role); + } + emit dataChanged(this->index(0, index.column(), index), this->index(item->childCount() - 1, index.column(), index)); +} + +Qt::ItemFlags NodeCompoundTreeModel::flags(const QModelIndex &index) const +{ + if (!index.isValid()) + return 0; + + if(index.column() == CHECKBOX_USE_COLUMN) // checkboxes in first column | move to item? + return QAbstractItemModel::flags(index) | Qt::ItemIsUserCheckable; + + return QAbstractItemModel::flags(index) | Qt::ItemIsEditable; // Allows copy/paste +} + +QVariant NodeCompoundTreeModel::headerData(int section, Qt::Orientation orientation, int role) const +{ + if (orientation == Qt::Horizontal && role == Qt::DisplayRole) + return rootItem->data(section); + + return QVariant(); +} + +int NodeCompoundTreeModel::rowCount(const QModelIndex &parent) const +{ + NodeCompoundTreeItem *parentItem; + if (parent.column() > 0) + return 0; + + if (!parent.isValid()) + parentItem = rootItem; + else + parentItem = static_cast(parent.internalPointer()); + + return parentItem->childCount(); +} + +int NodeCompoundTreeModel::columnCount(const QModelIndex &parent) const +{ + if (parent.isValid()) + return static_cast(parent.internalPointer())->columnCount(); + else + return rootItem->columnCount(); +} + +QModelIndex NodeCompoundTreeModel::index(int row, int column, const QModelIndex &parent) const +{ + if (!hasIndex(row, column, parent)) + return QModelIndex(); + + NodeCompoundTreeItem *parentItem; + + if (!parent.isValid()) + parentItem = rootItem; + else + parentItem = static_cast(parent.internalPointer()); + + NodeCompoundTreeItem *childItem = parentItem->child(row); + if (childItem) + return createIndex(row, column, childItem); + else + return QModelIndex(); +} + +QModelIndex NodeCompoundTreeModel::parent(const QModelIndex &index) const +{ + if (!index.isValid()) + return QModelIndex(); + + NodeCompoundTreeItem *childItem = static_cast(index.internalPointer()); + NodeCompoundTreeItem *parentItem = childItem->parent(); + + if (parentItem == rootItem) + return QModelIndex(); + + return createIndex(parentItem->row(), 0, parentItem); +} + +NodeCompoundTreeItem::NodeCompoundTreeItem() +{ + // Use root item for header data + parentItem = 0; + header = QStringList(); + header /*<< "Use"*/ << "Compound / Experiment"<< "Abd." << "CI"; + + foreach(QString s, header){ + itemData << s; + } +} + +NodeCompoundTreeItem::NodeCompoundTreeItem(NodeCompound *_nc, NodeCompoundTreeItem *parent) +{ + // Abstract compound level + role = Compound; + parentItem = parent; + nc = _nc; + userRoleData = QString::fromStdString(nc->getFeature(COMPOUND_GROUPING_FEATURE)); + + // create children + std::vector tracers = _nc->getExperiments(); + for(std::vector::iterator it = tracers.begin(); it != tracers.end(); ++it) { + labid::LabeledCompound *lc =_nc->getLabeledCompound(*it); + if(lc > 0) + appendChild(new NodeCompoundTreeItem(*it, lc, this)); + } + + // add data + // itemData.push_back(Qt::Checked); + itemData.push_back(QString::fromStdString(_nc->getCompoundName())); + itemData.push_back(QString::number(childCount()).append(" experiments")); +} + +NodeCompoundTreeItem::NodeCompoundTreeItem(std::string tracer, labid::LabeledCompound *_lc, NodeCompoundTreeItem *parent) +{ + // The tracer experiment + role = LabeledCompound; + parentItem = parent; + lc = _lc; + + // create children + int numIons = _lc->getLabeledIons().size(); + for(int i = 0; i < numIons; ++i) { + appendChild(new NodeCompoundTreeItem(lc, i, this)); + } + + // add data + // itemData.push_back(Qt::Checked); + itemData.push_back(QString::fromStdString(tracer)); + itemData.push_back(QString::number(childCount()).append(" ions")); +} + +NodeCompoundTreeItem::NodeCompoundTreeItem(labid::LabeledCompound *_lc, int _ionIdx, NodeCompoundTreeItem *parent) +{ + // Labeled ion from one compound + role = LabeledIon; + parentItem = parent; + lc = _lc; + ionIdx = _ionIdx; + + // create children + const std::vector< double > abd = lc->getIsotopomers().at(ionIdx); + const std::vector< double > ci = lc->getConfidenceIntervals().at(ionIdx); + for(int i = 0; i < abd.size(); ++i) { + appendChild(new NodeCompoundTreeItem(i, abd[i], ci[i], this)); + } + + // add data + // itemData.push_back(Qt::Checked); + itemData.push_back(QString("m/z %1").arg(lc->getLabeledIons().at(ionIdx))); + itemData.push_back(QVariant(lc->getR2s().at(ionIdx))); + itemData.push_back(QString("R2 = ").append(QString::number(childCount()))); +} + +NodeCompoundTreeItem::NodeCompoundTreeItem(int n, double abundance, double ci, NodeCompoundTreeItem *parent) +{ + // Single mass isotopomer + role = MassIsotopomer; + parentItem = parent; + + // add data + // itemData.push_back(Qt::Checked); + itemData.push_back(QString("M").append(QString::number(n))); + itemData.push_back(QVariant(abundance)); + itemData.push_back(QVariant(ci)); +} + +NodeCompoundTreeItem::~NodeCompoundTreeItem() +{ + qDeleteAll(childItems); +} + +void NodeCompoundTreeItem::appendChild(NodeCompoundTreeItem *child) +{ + childItems.append(child); +} + +NodeCompoundTreeItem *NodeCompoundTreeItem::child(int row) +{ + return childItems.value(row); +} + +int NodeCompoundTreeItem::childCount() const +{ + return childItems.count(); +} + +int NodeCompoundTreeItem::columnCount() const +{ + return itemData.count(); +} + +QVariant NodeCompoundTreeItem::data(int column, int role) const +{ + switch(role){ + case Qt::EditRole: + case Qt::DisplayRole: + if(column != CHECKBOX_USE_COLUMN) { + return itemData.value(column); + } + break; + case Qt::CheckStateRole: + if(column == CHECKBOX_USE_COLUMN) { + return itemData.value(column); + } + break; + case Qt::TextAlignmentRole: + /*if(column == 0) { + return Qt::Checked; + }*/ + break; + case Qt::UserRole: + return userRoleData; + //case Qt::ForegroundRole: +// if(nc && nc->) return Qt::gray; + } + + return QVariant(); +} + +bool NodeCompoundTreeItem::setData(int column, const QVariant &value, int role) +{ + itemData[column] = value; // TODO roles? + return true; +} + +int NodeCompoundTreeItem::row() const +{ + if(parentItem) + return parentItem->childItems.indexOf(const_cast(this)); + return 0; +} + +NodeCompoundTreeItem *NodeCompoundTreeItem::parent() +{ + return parentItem; +} + +} diff --git a/gui/nodecompoundtreemodel.h b/gui/nodecompoundtreemodel.h new file mode 100644 index 0000000..62ef467 --- /dev/null +++ b/gui/nodecompoundtreemodel.h @@ -0,0 +1,115 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef NODECOMPOUNDTREEMODEL_H +#define NODECOMPOUNDTREEMODEL_H + +#include +#include +#include +#include + +#include + +#include "src/nodecompound.h" + +namespace mia { + +class NodeCompoundTreeItem; +class NodeCompoundTreeModel; + + +class NodeCompoundTreeModel : public QAbstractItemModel +{ + Q_OBJECT +public: + explicit NodeCompoundTreeModel(QObject *parent = 0); + explicit NodeCompoundTreeModel(std::vector, QObject *parent = 0); + explicit NodeCompoundTreeModel(QMap, QObject *parent = 0); + + ~NodeCompoundTreeModel(); + + QVariant data(const QModelIndex &index, int role) const; + bool setData(const QModelIndex &index, const QVariant &value, + int role = Qt::EditRole); + Qt::ItemFlags flags(const QModelIndex &index) const; + QVariant headerData(int section, Qt::Orientation orientation, + int role = Qt::DisplayRole) const; + QModelIndex index(int row, int column, + const QModelIndex &parent = QModelIndex()) const; + QModelIndex parent(const QModelIndex &index) const; + + int rowCount(const QModelIndex &parent = QModelIndex()) const; + int columnCount(const QModelIndex &parent = QModelIndex()) const; + void setChildrenData(const QModelIndex &index, const QVariant &value, int role); + +signals: + + +private: + NodeCompoundTreeItem *rootItem; + static const int CHECKBOX_USE_COLUMN = 999; // column number of the checkbox // TODO = 0 to enable checkboxes +}; + +class NodeCompoundTreeItem { +public: + //explicit NodeCompoundTreeItem(const QList &data, NodeCompoundTreeItem *parent = 0); + //explicit NodeCompoundTreeItem(QList, NodeCompoundTreeItem *parent = 0); // + explicit NodeCompoundTreeItem(); // for root + explicit NodeCompoundTreeItem(NodeCompound *nc, NodeCompoundTreeItem *parent = 0); // compound level + explicit NodeCompoundTreeItem(std::string tracer, labid::LabeledCompound *lc, NodeCompoundTreeItem *parent = 0); // compound->tracer level + explicit NodeCompoundTreeItem(labid::LabeledCompound *lc, int _ionIdx, NodeCompoundTreeItem *parent = 0); // compound->tracer->ion level + explicit NodeCompoundTreeItem(int n, double abundance, double ci, NodeCompoundTreeItem *parent = 0); // compound->tracer->ion level + + ~NodeCompoundTreeItem(); + + void appendChild(NodeCompoundTreeItem *child); + + NodeCompoundTreeItem *child(int row); + int childCount() const; + int columnCount() const; + QVariant data(int column, int role = Qt::DisplayRole) const; + bool setData(int column, const QVariant &value, int role); + int row() const; + NodeCompoundTreeItem *parent(); + +private: + enum ItemRole { + Compound, + LabeledCompound, + LabeledIon, + MassIsotopomer + }; + + ItemRole role; // or better subclass for different roles? + QList childItems; + QList itemData; + NodeCompoundTreeItem *parentItem; + + NodeCompound* nc; + labid::LabeledCompound *lc; + int ionIdx; + QVariant userRoleData; + + QStringList header; + static const int CHECKBOX_USE_COLUMN = 999; // column number of the checkbox // TODO = 0 to enable checkboxes +}; + +} +#endif // NODECOMPOUNDTREEMODEL_H diff --git a/gui/nodewidget.cpp b/gui/nodewidget.cpp new file mode 100644 index 0000000..ba1b557 --- /dev/null +++ b/gui/nodewidget.cpp @@ -0,0 +1,297 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include +#include +#include +#include +#include +#include +#include + +//#include "qwt_plot_multi_barchart.h" +//#include "qwt_samples.h" +#include "nodewidget.h" +//#include "mitrendplot.h" + +namespace mia { + +/** + * @brief Default constructor. + * @param parent The parent widget. + */ +NodeWidget::NodeWidget() : QGraphicsObject() +{ + +} + +NodeWidget::NodeWidget(NodeCompound *nc, QList experimentColors, bool multiExperiment) : QGraphicsObject(), nc(nc), experimentColors(experimentColors) +{ + // TODO use multiExperiment to draw compound only once here, and remove from midplots + // MID plot TODO: plot all :: 3D barplot? + // TODO: multirows rowNum = sqrt(exps.size()) + + double width = 0, height = 0; + + if(nc->getFeature("PRECURSOR_KEGG_ID").size()) { + // guess image size and hope we'll find one later + width = 100; + height = 250; + } + + std::vector exps = nc->getExperiments(); + + bool plotUnlabeledCompounds = true; + + for(int i = 0; i < exps.size(); ++i) { + labid::LabeledCompound *lc = nc->getLabeledCompound(exps[i]); + if(lc == (labid::LabeledCompound*)-1) { + if(plotUnlabeledCompounds) { + lc = nc->getCompound(exps[i]); + } else { + continue; + } + } + QVector mids = QVector::fromStdVector(nc->getSelectedMID(exps[i])); + + float ion = nc->getSelectedIon(exps[i]); + MIDPlot *mp = new MIDPlot(mids, QString::fromStdString(lc->getName()), nc->getSelectedR2(exps[i]), ion, 0); + mp->setCI(QVector::fromStdVector(nc->getSelectedCI(exps[i]))); + midPlots.push_back(mp); + mp->setBarColor(experimentColors[experimentColors.size() > 1 ? (i % experimentColors.size()) : 0]); + setToolTip(toolTip() + genToolTipText(exps[i])); + + // color full backbone plots + if(nc->getMMinusNIon(exps[i], 15) == ion) { + //mp->setBgColor(Qt::gray); + mp->setBorderColor(Qt::magenta); + } else if(nc->getMMinusNIon(exps[i], 57) == ion) { + //mp->setBgColor(Qt::gray); + mp->setBorderColor(Qt::magenta); + } + + // adjust color to labeling + //mp->setBgColor(QColor(Qt::lightGray).lighter().darker(100 + 500 * (1 - mids[0]))); + mp->setBgColor(QColor(Qt::lightGray).lighter().darker(100 + 500 * (mids[0] - 0.5))); + } + + + plotLayout = (PLOT_LAYOUT) QSettings().value("nodewidget_layout_direction", LAYOUT_VERTICAL).toInt(); + + switch (plotLayout) { + + case LAYOUT_HORIZONTAL: + for(int i = 0; i < midPlots.size(); ++i) { + MIDPlot *mp = midPlots[i]; + width += mp->sizeHint().width(); + height = qMax(height, (double)mp->sizeHint().height()); + } + break; + + case LAYOUT_VERTICAL: + for(int i = 0; i < exps.size(); ++i) { + MIDPlot *mp = midPlots[i]; + height += mp->sizeHint().height(); + width = qMax(width, (double)mp->sizeHint().width()); + } + + break; + case LAYOUT_SQUARE: + 1; + } + + + boundRect = QRectF(0, 0, width, height); + + //TODO barplot? qwt barplot: // do only if all ions are the same + //QwtPlotMultiBarChart *bc = new QwtPlotMultiBarChart("Testplot"); + //QwtSetSample ss = QwtSetSample(); + //bc->setSamples(); + //layout->addWidget(mp); + + // Trendline for isotopomers + if(exps.size() > 1) { + //layout->addWidget(new MITrendplot(nc, this)); + } + +#ifdef MIA_WITH_METABOBASE + // TODO display all ions midplot tooltip + if(QSettings().value("nodewidget_show_structure", LAYOUT_VERTICAL).toBool()) + addStructure(QString::fromStdString(nc->getFeature("PRECURSOR_KEGG_ID"))); // TODO or use METABOBASE_COMPOUND and find ALL precursors +#endif +} + +NodeWidget::~NodeWidget() +{ + for(int i = 0; i < midPlots.size(); ++i) { + delete midPlots[i]; + } +} + +//bool NodeWidget::event(QEvent *event) +//{ +/* if (event->type() == QEvent::ToolTip) { + QHelpEvent *helpEvent = static_cast(event); + int index = itemAt(helpEvent->pos()); + if (index != -1) { + QToolTip::showText(helpEvent->globalPos(), ); + } else { + QToolTip::hideText(); + event->ignore(); + } + + return true; + }*/ + //return QGraphicsItem::event(event); +//} + +QRectF NodeWidget::boundingRect() const +{ + return boundRect; +} + +void NodeWidget::paint(QPainter *painter, const QStyleOptionGraphicsItem *option, QWidget *widget) +{ + // plot drawing position + QPoint pos(0, 0); + +#ifdef MIA_WITH_METABOBASE + // the structure image + if(structureImage.width()) { + pos.setX((boundRect.width() - structureImage.width()) / 2); + painter->drawPixmap(pos, structureImage); + pos.setX(0); + pos.setY(structureImage.height()); + } +#endif + + // the MID plots + for(int i = 0; i < midPlots.size(); ++i) { + MIDPlot *mp = midPlots[i]; + mp->render(painter, pos); + + QSize s = mp->sizeHint(); + + switch (plotLayout) { + case LAYOUT_HORIZONTAL: + pos.setX(pos.x() + s.width()); // move pos right + break; + case LAYOUT_VERTICAL: + pos.setY(pos.y() + s.height()); // move pos down + break; + case LAYOUT_SQUARE: + // TODO + break; + } + } +} + +#ifdef MIA_WITH_METABOBASE +/** + * @brief Add chemical structure to plot + * @param id KEGG or metabobase ID + */ +void NodeWidget::addStructure(QString id) +{ + if(!id.length()) return; + + QNetworkAccessManager *nam; + nam = new QNetworkAccessManager(this); + + connect(nam, SIGNAL(finished(QNetworkReply*)), this, SLOT(structureReply(QNetworkReply*))); + + QUrl url(QString("XXXXX/mddb/struc_svg.php?cid=").append(id)); + + QNetworkReply *reply = nam->get(QNetworkRequest(url)); +} + +/** + * @brief Reply for the image http get request. + * @param reply + */ +void NodeWidget::structureReply(QNetworkReply *reply) +{ + if(reply->error() == QNetworkReply::NoError) { + QImageReader imageReader(reply); + structureImage = QPixmap::fromImage(imageReader.read()); + } +} + +#endif + +/** + * @brief Generate summary text for the compound in the given experiment to be displayed as tooltip. + * @param exp Which experiment. + * @return Summary text. + */ +QString NodeWidget::genToolTipText(std::string exp) +{ + QString tt = QString("
%1 - %2
").arg(QString::fromStdString(nc->getCompoundName()), QString::fromStdString(exp)); + labid::LabeledCompound* lc = nc->getLabeledCompound(exp); + if(lc == (labid::LabeledCompound*)-1) { + return tt.append("
Unlabeled
"); + } + + // Retention indices of all samples + tt.append("RIs: "); + std::list ris = lc->getRetentionIndices(); + for(std::list::iterator it = ris.begin(); it != ris.end(); ++it) { + if(it != ris.begin()) tt.append(", "); + tt.append(QString::number(*it, 'f', 2)); + } + + // MIDs + int selIdx = nc->getSelectedIndex(exp); + tt.append("
"); + for(int i = 0; i < lc->getLabeledIons().size(); ++i) { // all ions + + if(i == selIdx) + tt.append( + QString(""; + for(int j = 0; j < distMats.size(); ++j) { + std::stringstream imgname; + imgname << "midplotsoverlay/"<"; + else ofs << ""; + } + ofs << "
m/z %1
R2 = %2").arg( + QString::number(lc->getLabeledIons()[i]), + QString::number(lc->getR2s()[i], 'g', 3) + ) + ); + else + tt.append( + QString(""); + } + tt.append("
m/z %1
R2 = %2").arg( + QString::number(lc->getLabeledIons()[i]), + QString::number(lc->getR2s()[i], 'g', 3) + ) + ); + + std::vector mids = lc->getIsotopomers()[i]; + for(int m = 0; m < mids.size(); ++m) { // all isotopomers + // std::cout<getCompoundName()<<" "<getANOVAPvalueForMassIsotopomer(m)<<" "<getANOVAPvalueForMassIsotopomer(m), 'g', 3).toStdString()<").arg( + QString::number(m), + QString::number(mids[m], 'g', 3) + // QString::number(nc->getANOVAPvalueForMassIsotopomer(m), 'g', 3) // p=%3 + ) + ); + } + tt.append("
M%1 = %2
"); + + return tt; +} +} diff --git a/gui/nodewidget.h b/gui/nodewidget.h new file mode 100644 index 0000000..44dd7c4 --- /dev/null +++ b/gui/nodewidget.h @@ -0,0 +1,80 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef NODEWIDGET_H +#define NODEWIDGET_H + +#include +#include +#include +#ifdef MIA_WITH_METABOBASE + #include +#endif +#include "src/nodecompound.h" +#include "midplot.h" + +namespace mia { + +/** + * @brief The NodeWidget class does all the plotting for MID graphs, ... for a node. + */ +class NodeWidget : public QGraphicsObject +{ + Q_OBJECT + +public: + + enum PLOT_LAYOUT { + LAYOUT_VERTICAL, + LAYOUT_HORIZONTAL, + LAYOUT_SQUARE + }; /**< Show plots in row, column or multirow*/ + + explicit NodeWidget(); + explicit NodeWidget(NodeCompound *nc, QList experimentColors, bool multiExperiment = false); + + ~NodeWidget(); + + //bool event(QEvent *event); + + QRectF boundingRect() const; + void paint(QPainter *painter, const QStyleOptionGraphicsItem *option, QWidget *widget); +#ifdef MIA_WITH_METABOBASE + void addStructure(QString url); + +public slots: + void structureReply(QNetworkReply*reply); +#endif + +private: + QRectF boundRect; + QString genToolTipHeader(); + QString genToolTipText(std::string); + std::vector midPlots; + NodeCompound *nc; /**< The label information for this node's compound. */ + QList experimentColors; /**< Colors for the different experiments/conditions. */ + PLOT_LAYOUT plotLayout; + +#ifdef MIA_WITH_METABOBASE + QPixmap structureImage; +#endif + +}; +} +#endif // NODEWIDGET_H diff --git a/gui/nwview.cpp b/gui/nwview.cpp new file mode 100644 index 0000000..c68832b --- /dev/null +++ b/gui/nwview.cpp @@ -0,0 +1,253 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include +#include +#include +#include "nwview.h" +#include "src/nodecompound.h" +#include "midplot.h" +#include "graphvizmia.h" + +namespace mia { + +#ifndef QT_NO_WHEELEVENT +void NWGView::wheelEvent(QWheelEvent *e) +{ + if (e->modifiers() & Qt::ControlModifier) { + if (e->delta() > 0) + view->zoomIn(zoomStep); + else + view->zoomOut(zoomStep); + e->accept(); + } else { + QGraphicsView::wheelEvent(e); + } +} +#endif + +void NWGView::mouseDoubleClickEvent(QMouseEvent *e) +{ + QGraphicsItem *gi = itemAt(e->pos()); + + if(gi) { + QVariant v = gi->data(g->getDataIndex("mynode")); // use for tooltip and so on + if(!v.isNull()) { + if(v.canConvert()) { + mynode *mn = reinterpret_cast(v.value()); + NodeCompound *nc = mn->nc; +// TODO: Neighborplotwindow + + + std::cerr<toString()<buttons() & Qt::MiddleButton) { + QPoint center = rect().center(); + const QPoint newCenter = center - e->globalPos() + lastMousePos; + //std::cerr<<"Center "<accept(); + } + e->ignore(); + lastMousePos = e->globalPos(); +} + +void NWGView::mouseReleaseEvent(QMouseEvent *e) +{ + static NodeCompound *lastSelectedNodeCompound; + + //foreach (QGraphicsItem *gi, scene()->items(QRectF(loc.x(), loc.y(), 1, 1))) { + QGraphicsItem *gi = itemAt(e->pos()); + if(gi) { + //TODO: check for midplot to hide onclick std::cerr<<"midplot"<data(g->getDataIndex("mynode")); // use for tooltip and so on + if(!v.isNull()) { + if(v.canConvert()) { + mynode *mn = reinterpret_cast(v.value()); + NodeCompound *nc = mn->nc; + std::cerr<toString()<move(loc.x(), loc.y()); + desc->show(); + //QGraphicsProxyWidget *p = scene()->addWidget(desc); + + + if(lastSelectedNodeCompound) { + // show distance between current and previously selected component + std::vector ex = nc->getExperiments(); + for(int i = 0; i < ex.size(); ++i) { + + + } + } + lastSelectedNodeCompound = nc; + } else { + std::cerr<<"no convert "<< v.typeName() <key() == Qt::Key_Plus) { + view->zoomIn(zoomStep); + } else if(e->key() == Qt::Key_Minus) { + view->zoomOut(zoomStep); + } else { + QGraphicsView::keyPressEvent(e); + } +} + +NWView::NWView(QWidget *parent) : + QFrame(parent) +{ + gv = new NWGView(this, this); + init(); +} + +NWView::NWView(QGraphicsScene *gs, graphvizqt::Graph *g, QWidget *parent) +{ + gv = new NWGView(this, g, this); + gv->setScene(gs); + init(); +} + + +QGraphicsView *NWView::view() const +{ + return static_cast(gv); +} + +void NWView::zoomIn(int level) +{ + zoom = level; + setupMatrix(); +} + +void NWView::zoomOut(int level) +{ + zoom = 1.0/level; + setupMatrix(); +} + +void NWView::exportImage() +{ + // TODO remember folder in settings + QString filename = QFileDialog::getSaveFileName(this, "Export svg", "", "SVG files (*.svg);;All files (*)"); + if(filename.isNull()) return; + + // A4 export + double widthInch = 8.27; + double heightInch = 11.69; + + QSvgGenerator svgGen; + svgGen.setFileName(filename); + svgGen.setResolution(QDesktopWidget().physicalDpiX()); + svgGen.setSize(QSize(svgGen.resolution() * widthInch, svgGen.resolution() * heightInch)); + svgGen.setViewBox(QRect(0, 0, svgGen.width(), svgGen.height())); + svgGen.setTitle(tr("MIA export")); + svgGen.setDescription(tr("TODO: Put settings here...")); + QPainter painter(&svgGen); + painter.begin(&svgGen); + gv->scene()->render(&painter); + painter.end(); + +} + +void NWView::resetView() +{ + // original scene region, original zoom level + zoom = 1.0; + QRectF itemsBB = gv->scene()->itemsBoundingRect(); + gv->centerOn(itemsBB.center()); + gv->setMatrix(originalMatrix); + gv->fitInView(itemsBB, Qt::KeepAspectRatio); +} + + +void NWView::setupMatrix() +{ + // std::cerr<<"Zoom: "<scale(zoom, zoom); +} + +void NWView::init() +{ + gv->setDragMode(QGraphicsView::RubberBandDrag); + gv->setRenderHint(QPainter::Antialiasing); + + zoom = 1; + + QToolBar *toolBar = new QToolBar(this); + + QAction *actZoomOriginal = new QAction(QIcon(":/gui/icons/zoom-original.png"), tr("Reset Zoom"), this); + toolBar->addAction(actZoomOriginal); + QAction *actRefresh = new QAction(QIcon(":/gui/icons/view-refresh.png"), tr("Refresh view"), this); + toolBar->addAction(actRefresh); + QAction *actExportImage = new QAction(QIcon(":/gui/icons/video-x-mng.png"), tr("Export Image"), this); + toolBar->addAction(actExportImage); + + QGridLayout *layout = new QGridLayout(this); + layout->addWidget(toolBar); + layout->addWidget(gv); + setLayout(layout); + + connect(actExportImage, SIGNAL(triggered()), this, SLOT(exportImage())); + connect(actRefresh, SIGNAL(triggered()), gv, SLOT(invalidateScene())); + connect(actZoomOriginal, SIGNAL(triggered()), this, SLOT(resetView())); + originalMatrix = gv->matrix(); + gv->mapToScene(rect().center()); +} + + +NWGView::NWGView(NWView *v, QWidget *parent) : QGraphicsView(parent), view(v) +{ + init(); +} + +NWGView::NWGView(NWView *v, graphvizqt::Graph *graph, QWidget *parent) : QGraphicsView(parent), view(v), g(graph) +{ + init(); +} + +void NWGView::init() +{ + zoomStep = 2; + setFocusPolicy(Qt::ClickFocus); +} + +NWGView::~NWGView() +{ +} + + +} diff --git a/gui/nwview.h b/gui/nwview.h new file mode 100644 index 0000000..9abd787 --- /dev/null +++ b/gui/nwview.h @@ -0,0 +1,103 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef NWVIEW_H +#define NWVIEW_H + +#include +#include +#include + +#include "graphvizqt.h" +#include "nodewidget.h" +#include "nodecompounddescriptionwidget.h" + +namespace mia { + +class NWView; + +/** + * @brief The NWGView class shows a graphvizqt::Graph and handles its events. + */ + +class NWGView : public QGraphicsView +{ + Q_OBJECT +public: + NWGView(NWView *v, QWidget *parent); + NWGView(NWView *v, graphvizqt::Graph *graph, QWidget *parent); + + void init(); + + ~NWGView(); + + //void centerOn(NodeWidget *w); + +protected: +#ifndef QT_NO_WHEELEVENT + void wheelEvent(QWheelEvent *); +#endif + void mouseDoubleClickEvent(QMouseEvent *e); + void mouseMoveEvent(QMouseEvent *); + void mouseReleaseEvent(QMouseEvent *); + virtual void keyPressEvent(QKeyEvent *e); + //void mousePressEvent(QMouseEvent *); + + +private: + NWView *view; /**< The parent widget. */ + graphvizqt::Graph *g; /**< The graph to be drawn in the scene. */ + QPoint lastMousePos; /**< Mouse position for scrolling. */ + + double zoomStep; +}; + +/** + * @brief The NWView class holds a NWGView and handles the zooming. + */ +class NWView : public QFrame +{ + Q_OBJECT +public: + explicit NWView(QWidget *parent); + explicit NWView(QGraphicsScene *gs, graphvizqt::Graph *g, QWidget *parent); + + QGraphicsView *view() const; + +signals: + +public slots: + void zoomIn(int level = 1); + void zoomOut(int level = 1); + void exportImage(); + void resetView(); + +private slots: + void setupMatrix(); + +private: + void init(); + NWGView *gv; + double zoom; + QMatrix originalMatrix; + QPointF originalCenter; +}; + +} +#endif // NWVIEW_H diff --git a/gui/splash.png b/gui/splash.png new file mode 100644 index 0000000..98b6535 Binary files /dev/null and b/gui/splash.png differ diff --git a/gui/win32/mia.rc b/gui/win32/mia.rc new file mode 100644 index 0000000..181ba15 --- /dev/null +++ b/gui/win32/mia.rc @@ -0,0 +1 @@ +id ICON "icons/programmIcon16x16.ico" diff --git a/mia.xpm b/mia.xpm new file mode 100644 index 0000000..e3ceb79 --- /dev/null +++ b/mia.xpm @@ -0,0 +1,310 @@ +/* XPM */ +static char *icon[] = { +/* columns rows colors chars-per-pixel */ +"48 48 256 2 ", +" c #000F40", +". c #001345", +"X c #071840", +"o c #01144C", +"O c #001250", +"+ c #011A5B", +"@ c #04225D", +"# c #022062", +"$ c #03256B", +"% c #04296F", +"& c #032670", +"* c #052B73", +"= c #053279", +"- c #0F337F", +"; c #264076", +": c #334770", +"> c #09368D", +", c #054191", +"< c #1A4091", +"1 c #224791", +"2 c #2A4E99", +"3 c #2D5C9E", +"4 c #074FA7", +"5 c #1A51AA", +"6 c #005DB3", +"7 c #0A5AB8", +"8 c #2F58A6", +"9 c #0261B5", +"0 c #0B63B5", +"q c #0263BD", +"w c #0A66B8", +"e c #0F6ABA", +"r c #1266B7", +"t c #146BBA", +"y c #1D72BE", +"u c #2477BF", +"i c #506484", +"p c #727F89", +"a c #637599", +"s c #4D6BA8", +"d c #4362A4", +"f c #5F7CAA", +"g c #5672B2", +"h c #577ABC", +"j c #5A7DBD", +"k c #607DAE", +"l c #697EAA", +"z c #005FC0", +"x c #0265C2", +"c c #0E65C6", +"v c #0D6CCF", +"b c #1671C4", +"n c #086FD7", +"m c #046FDC", +"M c #0A6FD9", +"N c #136ED3", +"B c #0470DF", +"V c #0B74DF", +"C c #1272D5", +"Z c #1976DC", +"A c #1678DE", +"S c #197ADC", +"D c #2164C1", +"F c #2871C3", +"G c #277AC4", +"H c #2A7BC2", +"J c #3671CB", +"K c #347DC2", +"L c #2974D2", +"P c #2F7FDD", +"I c #0772E1", +"U c #0A74E2", +"Y c #1076E0", +"T c #157BE6", +"R c #1F7BE1", +"E c #187DE8", +"W c #247FE3", +"Q c #768189", +"! c #7A8AA9", +"~ c #6D87B3", +"^ c #6D86BE", +"/ c #6F88BB", +"( c #778DB5", +") c #7089BE", +"_ c #3381C5", +"` c #3C85C6", +"' c #2180DE", +"] c #3183D8", +"[ c #3688DE", +"{ c #3B8CD8", +"} c #1C81EA", +"| c #2481E1", +" . c #2C82E3", +".. c #2385ED", +"X. c #2886E8", +"o. c #2A89EE", +"O. c #348DED", +"+. c #2789F0", +"@. c #2E8EF2", +"#. c #3D98F8", +"$. c #3693F5", +"%. c #4084C5", +"&. c #4289C8", +"*. c #498ECB", +"=. c #4E91CC", +"-. c #5593CC", +";. c #5B99CF", +":. c #5C9CD1", +">. c #6887C6", +",. c #6888C2", +"<. c #758FC8", +"1. c #7699CD", +"2. c #7C9FCB", +"3. c #7D94C7", +"4. c #639ED3", +"5. c #6697DF", +"6. c #769BD1", +"7. c #5EA1D4", +"8. c #6DA4D5", +"9. c #7BA0D5", +"0. c #7DADDA", +"q. c #72ADDA", +"w. c #79B1DB", +"e. c #4A94E5", +"r. c #4C9AED", +"t. c #449EFB", +"y. c #5FA0E2", +"u. c #4AA1FD", +"i. c #53A3F6", +"p. c #65A2E3", +"a. c #72AEEB", +"s. c #72AAE5", +"d. c #7AB5E0", +"f. c #77B3F2", +"g. c #838C93", +"h. c #8099AA", +"j. c #8294B8", +"k. c #8A9AB9", +"l. c #8AA3B8", +"z. c #85A2BB", +"x. c #9CAFBF", +"c. c #A4AAAE", +"v. c #A7B2B9", +"b. c #B4B9BD", +"n. c #829BCC", +"m. c #889DC9", +"M. c #849BC5", +"N. c #87A3CB", +"B. c #8DA2C2", +"V. c #92A2C4", +"C. c #98ADC0", +"Z. c #9DB3C7", +"A. c #84A5D3", +"S. c #86ACDD", +"D. c #8EAFDB", +"F. c #84A4DC", +"G. c #93A6D3", +"H. c #94A8D7", +"J. c #94ABDD", +"K. c #8AB5DE", +"L. c #97B5D3", +"P. c #9CB2D4", +"I. c #91B6DC", +"U. c #9AB3DA", +"Y. c #92B8DA", +"T. c #A7B9C2", +"R. c #ACBDC5", +"E. c #A0B7CB", +"W. c #A5BACD", +"Q. c #A8BECF", +"!. c #AABFD1", +"~. c #A5B5DA", +"^. c #AABADF", +"/. c #82B0E3", +"(. c #8DB3E1", +"). c #85BAE0", +"_. c #92B3E3", +"`. c #99B3E5", +"'. c #95BCE3", +"]. c #9ABFE3", +"[. c #A5B6E0", +"{. c #A8B9E3", +"}. c #ABBEE9", +"|. c #A4BBE9", +" X c #9EC5DF", +".X c #B4C6CE", +"XX c #B4C8CE", +"oX c #BDC8CE", +"OX c #ADC2D2", +"+X c #B6C8D6", +"@X c #BECDD3", +"#X c #B3C5DF", +"$X c #B4CADF", +"%X c #BFCDD9", +"&X c #BED0DC", +"*X c #93C4E6", +"=X c #9EC1E4", +"-X c #A0C3E7", +";X c #AAC7E2", +":X c #A8C8E7", +">X c #A3C6E8", +",X c #A6C8ED", +"X4._ t 9 6 6 ` *Xy 6 9 9 9 y &.8.3X=X`.^ UXUXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUXUX3.pXzX-X:._ t 9 9 6 7.*Xw 9 9 9 9 t ` 4.:X3X_.H.1 UXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUX~ H.lXgX'.-.H w 6 9 6 w.w.6 6 9 9 6 e _ ;.=X9X(.{.s UXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUX( ~.lXeX(.*.u 0 9 6 9 *X:.6 6 6 9 9 w u ;.K.zX'.}./ UXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUXj.{.lX8XS.*.b w q q b *X{ x x x q q q G *.0.gX=X|.m.UXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUXk.~.hX.< UXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUXUXUX: ; 3 F v n V T } ..+.@.$.#.t.u.t.t.i.e.J 8 > UXUXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUXUXUXUXX . @ = , 4 7 c N Z W W W P P L D 5 > & . UXUXUXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUX o + # $ % * * * & $ + O UXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUX", +"UXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUXUX" +}; diff --git a/rapidxml/rapidxml.hpp b/rapidxml/rapidxml.hpp new file mode 100644 index 0000000..6b82f20 --- /dev/null +++ b/rapidxml/rapidxml.hpp @@ -0,0 +1,2596 @@ +#ifndef RAPIDXML_HPP_INCLUDED +#define RAPIDXML_HPP_INCLUDED + +// Copyright (C) 2006, 2009 Marcin Kalicinski +// Version 1.13 +// Revision $DateTime: 2009/05/13 01:46:17 $ +//! \file rapidxml.hpp This file contains rapidxml parser and DOM implementation + +// If standard library is disabled, user must provide implementations of required functions and typedefs +#if !defined(RAPIDXML_NO_STDLIB) + #include // For std::size_t + #include // For assert + #include // For placement new +#endif + +// On MSVC, disable "conditional expression is constant" warning (level 4). +// This warning is almost impossible to avoid with certain types of templated code +#ifdef _MSC_VER + #pragma warning(push) + #pragma warning(disable:4127) // Conditional expression is constant +#endif + +/////////////////////////////////////////////////////////////////////////// +// RAPIDXML_PARSE_ERROR + +#if defined(RAPIDXML_NO_EXCEPTIONS) + +#define RAPIDXML_PARSE_ERROR(what, where) { parse_error_handler(what, where); assert(0); } + +namespace rapidxml +{ + //! When exceptions are disabled by defining RAPIDXML_NO_EXCEPTIONS, + //! this function is called to notify user about the error. + //! It must be defined by the user. + //!

+ //! This function cannot return. If it does, the results are undefined. + //!

+ //! A very simple definition might look like that: + //! 
+    //! void %rapidxml::%parse_error_handler(const char *what, void *where)
+    //! {
+    //!     std::cout << "Parse error: " << what << "\n";
+    //!     std::abort();
+    //! }
+    //!
+ //! \param what Human readable description of the error. + //! \param where Pointer to character data where error was detected. + void parse_error_handler(const char *what, void *where); +} + +#else + +#include // For std::exception + +#define RAPIDXML_PARSE_ERROR(what, where) throw parse_error(what, where) + +namespace rapidxml +{ + + //! Parse error exception. + //! This exception is thrown by the parser when an error occurs. + //! Use what() function to get human-readable error message. + //! Use where() function to get a pointer to position within source text where error was detected. + //!

+ //! If throwing exceptions by the parser is undesirable, + //! it can be disabled by defining RAPIDXML_NO_EXCEPTIONS macro before rapidxml.hpp is included. + //! This will cause the parser to call rapidxml::parse_error_handler() function instead of throwing an exception. + //! This function must be defined by the user. + //!

+ //! This class derives from std::exception class. + class parse_error: public std::exception + { + + public: + + //! Constructs parse error + parse_error(const char *what, void *where) + : m_what(what) + , m_where(where) + { + } + + //! Gets human readable description of error. + //! \return Pointer to null terminated description of the error. + virtual const char *what() const throw() + { + return m_what; + } + + //! Gets pointer to character data where error happened. + //! Ch should be the same as char type of xml_document that produced the error. + //! \return Pointer to location within the parsed string where error occured. + template + Ch *where() const + { + return reinterpret_cast(m_where); + } + + private: + + const char *m_what; + void *m_where; + + }; +} + +#endif + +/////////////////////////////////////////////////////////////////////////// +// Pool sizes + +#ifndef RAPIDXML_STATIC_POOL_SIZE + // Size of static memory block of memory_pool. + // Define RAPIDXML_STATIC_POOL_SIZE before including rapidxml.hpp if you want to override the default value. + // No dynamic memory allocations are performed by memory_pool until static memory is exhausted. + #define RAPIDXML_STATIC_POOL_SIZE (64 * 1024) +#endif + +#ifndef RAPIDXML_DYNAMIC_POOL_SIZE + // Size of dynamic memory block of memory_pool. + // Define RAPIDXML_DYNAMIC_POOL_SIZE before including rapidxml.hpp if you want to override the default value. + // After the static block is exhausted, dynamic blocks with approximately this size are allocated by memory_pool. + #define RAPIDXML_DYNAMIC_POOL_SIZE (64 * 1024) +#endif + +#ifndef RAPIDXML_ALIGNMENT + // Memory allocation alignment. + // Define RAPIDXML_ALIGNMENT before including rapidxml.hpp if you want to override the default value, which is the size of pointer. + // All memory allocations for nodes, attributes and strings will be aligned to this value. + // This must be a power of 2 and at least 1, otherwise memory_pool will not work. + #define RAPIDXML_ALIGNMENT sizeof(void *) +#endif + +namespace rapidxml +{ + // Forward declarations + template class xml_node; + template class xml_attribute; + template class xml_document; + + //! Enumeration listing all node types produced by the parser. + //! Use xml_node::type() function to query node type. + enum node_type + { + node_document, //!< A document node. Name and value are empty. + node_element, //!< An element node. Name contains element name. Value contains text of first data node. + node_data, //!< A data node. Name is empty. Value contains data text. + node_cdata, //!< A CDATA node. Name is empty. Value contains data text. + node_comment, //!< A comment node. Name is empty. Value contains comment text. + node_declaration, //!< A declaration node. Name and value are empty. Declaration parameters (version, encoding and standalone) are in node attributes. + node_doctype, //!< A DOCTYPE node. Name is empty. Value contains DOCTYPE text. + node_pi //!< A PI node. Name contains target. Value contains instructions. + }; + + /////////////////////////////////////////////////////////////////////// + // Parsing flags + + //! Parse flag instructing the parser to not create data nodes. + //! Text of first data node will still be placed in value of parent element, unless rapidxml::parse_no_element_values flag is also specified. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_no_data_nodes = 0x1; + + //! Parse flag instructing the parser to not use text of first data node as a value of parent element. + //! Can be combined with other flags by use of | operator. + //! Note that child data nodes of element node take precendence over its value when printing. + //! That is, if element has one or more child data nodes and a value, the value will be ignored. + //! Use rapidxml::parse_no_data_nodes flag to prevent creation of data nodes if you want to manipulate data using values of elements. + //!

+ //! See xml_document::parse() function. + const int parse_no_element_values = 0x2; + + //! Parse flag instructing the parser to not place zero terminators after strings in the source text. + //! By default zero terminators are placed, modifying source text. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_no_string_terminators = 0x4; + + //! Parse flag instructing the parser to not translate entities in the source text. + //! By default entities are translated, modifying source text. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_no_entity_translation = 0x8; + + //! Parse flag instructing the parser to disable UTF-8 handling and assume plain 8 bit characters. + //! By default, UTF-8 handling is enabled. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_no_utf8 = 0x10; + + //! Parse flag instructing the parser to create XML declaration node. + //! By default, declaration node is not created. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_declaration_node = 0x20; + + //! Parse flag instructing the parser to create comments nodes. + //! By default, comment nodes are not created. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_comment_nodes = 0x40; + + //! Parse flag instructing the parser to create DOCTYPE node. + //! By default, doctype node is not created. + //! Although W3C specification allows at most one DOCTYPE node, RapidXml will silently accept documents with more than one. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_doctype_node = 0x80; + + //! Parse flag instructing the parser to create PI nodes. + //! By default, PI nodes are not created. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_pi_nodes = 0x100; + + //! Parse flag instructing the parser to validate closing tag names. + //! If not set, name inside closing tag is irrelevant to the parser. + //! By default, closing tags are not validated. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_validate_closing_tags = 0x200; + + //! Parse flag instructing the parser to trim all leading and trailing whitespace of data nodes. + //! By default, whitespace is not trimmed. + //! This flag does not cause the parser to modify source text. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_trim_whitespace = 0x400; + + //! Parse flag instructing the parser to condense all whitespace runs of data nodes to a single space character. + //! Trimming of leading and trailing whitespace of data is controlled by rapidxml::parse_trim_whitespace flag. + //! By default, whitespace is not normalized. + //! If this flag is specified, source text will be modified. + //! Can be combined with other flags by use of | operator. + //!

+ //! See xml_document::parse() function. + const int parse_normalize_whitespace = 0x800; + + // Compound flags + + //! Parse flags which represent default behaviour of the parser. + //! This is always equal to 0, so that all other flags can be simply ored together. + //! Normally there is no need to inconveniently disable flags by anding with their negated (~) values. + //! This also means that meaning of each flag is a negation of the default setting. + //! For example, if flag name is rapidxml::parse_no_utf8, it means that utf-8 is enabled by default, + //! and using the flag will disable it. + //!

+ //! See xml_document::parse() function. + const int parse_default = 0; + + //! A combination of parse flags that forbids any modifications of the source text. + //! This also results in faster parsing. However, note that the following will occur: + //!
    + //!
  • names and values of nodes will not be zero terminated, you have to use xml_base::name_size() and xml_base::value_size() functions to determine where name and value ends
    • + //!
  • entities will not be translated
    • + //!
  • whitespace will not be normalized
    • + //!
+ //! See xml_document::parse() function. + const int parse_non_destructive = parse_no_string_terminators | parse_no_entity_translation; + + //! A combination of parse flags resulting in fastest possible parsing, without sacrificing important data. + //!

+ //! See xml_document::parse() function. + const int parse_fastest = parse_non_destructive | parse_no_data_nodes; + + //! A combination of parse flags resulting in largest amount of data being extracted. + //! This usually results in slowest parsing. + //!

+ //! See xml_document::parse() function. + const int parse_full = parse_declaration_node | parse_comment_nodes | parse_doctype_node | parse_pi_nodes | parse_validate_closing_tags; + + /////////////////////////////////////////////////////////////////////// + // Internals + + //! \cond internal + namespace internal + { + + // Struct that contains lookup tables for the parser + // It must be a template to allow correct linking (because it has static data members, which are defined in a header file). + template + struct lookup_tables + { + static const unsigned char lookup_whitespace[256]; // Whitespace table + static const unsigned char lookup_node_name[256]; // Node name table + static const unsigned char lookup_text[256]; // Text table + static const unsigned char lookup_text_pure_no_ws[256]; // Text table + static const unsigned char lookup_text_pure_with_ws[256]; // Text table + static const unsigned char lookup_attribute_name[256]; // Attribute name table + static const unsigned char lookup_attribute_data_1[256]; // Attribute data table with single quote + static const unsigned char lookup_attribute_data_1_pure[256]; // Attribute data table with single quote + static const unsigned char lookup_attribute_data_2[256]; // Attribute data table with double quotes + static const unsigned char lookup_attribute_data_2_pure[256]; // Attribute data table with double quotes + static const unsigned char lookup_digits[256]; // Digits + static const unsigned char lookup_upcase[256]; // To uppercase conversion table for ASCII characters + }; + + // Find length of the string + template + inline std::size_t measure(const Ch *p) + { + const Ch *tmp = p; + while (*tmp) + ++tmp; + return tmp - p; + } + + // Compare strings for equality + template + inline bool compare(const Ch *p1, std::size_t size1, const Ch *p2, std::size_t size2, bool case_sensitive) + { + if (size1 != size2) + return false; + if (case_sensitive) + { + for (const Ch *end = p1 + size1; p1 < end; ++p1, ++p2) + if (*p1 != *p2) + return false; + } + else + { + for (const Ch *end = p1 + size1; p1 < end; ++p1, ++p2) + if (lookup_tables<0>::lookup_upcase[static_cast(*p1)] != lookup_tables<0>::lookup_upcase[static_cast(*p2)]) + return false; + } + return true; + } + } + //! \endcond + + /////////////////////////////////////////////////////////////////////// + // Memory pool + + //! This class is used by the parser to create new nodes and attributes, without overheads of dynamic memory allocation. + //! In most cases, you will not need to use this class directly. + //! However, if you need to create nodes manually or modify names/values of nodes, + //! you are encouraged to use memory_pool of relevant xml_document to allocate the memory. + //! Not only is this faster than allocating them by using new operator, + //! but also their lifetime will be tied to the lifetime of document, + //! possibly simplyfing memory management. + //!

+ //! Call allocate_node() or allocate_attribute() functions to obtain new nodes or attributes from the pool. + //! You can also call allocate_string() function to allocate strings. + //! Such strings can then be used as names or values of nodes without worrying about their lifetime. + //! Note that there is no free() function -- all allocations are freed at once when clear() function is called, + //! or when the pool is destroyed. + //!

+ //! It is also possible to create a standalone memory_pool, and use it + //! to allocate nodes, whose lifetime will not be tied to any document. + //!

+ //! Pool maintains RAPIDXML_STATIC_POOL_SIZE bytes of statically allocated memory. + //! Until static memory is exhausted, no dynamic memory allocations are done. + //! When static memory is exhausted, pool allocates additional blocks of memory of size RAPIDXML_DYNAMIC_POOL_SIZE each, + //! by using global new[] and delete[] operators. + //! This behaviour can be changed by setting custom allocation routines. + //! Use set_allocator() function to set them. + //!

+ //! Allocations for nodes, attributes and strings are aligned at RAPIDXML_ALIGNMENT bytes. + //! This value defaults to the size of pointer on target architecture. + //!

+ //! To obtain absolutely top performance from the parser, + //! it is important that all nodes are allocated from a single, contiguous block of memory. + //! Otherwise, cache misses when jumping between two (or more) disjoint blocks of memory can slow down parsing quite considerably. + //! If required, you can tweak RAPIDXML_STATIC_POOL_SIZE, RAPIDXML_DYNAMIC_POOL_SIZE and RAPIDXML_ALIGNMENT + //! to obtain best wasted memory to performance compromise. + //! To do it, define their values before rapidxml.hpp file is included. + //! \param Ch Character type of created nodes. + template + class memory_pool + { + + public: + + //! \cond internal + typedef void *(alloc_func)(std::size_t); // Type of user-defined function used to allocate memory + typedef void (free_func)(void *); // Type of user-defined function used to free memory + //! \endcond + + //! Constructs empty pool with default allocator functions. + memory_pool() + : m_alloc_func(0) + , m_free_func(0) + { + init(); + } + + //! Destroys pool and frees all the memory. + //! This causes memory occupied by nodes allocated by the pool to be freed. + //! Nodes allocated from the pool are no longer valid. + ~memory_pool() + { + clear(); + } + + //! Allocates a new node from the pool, and optionally assigns name and value to it. + //! If the allocation request cannot be accomodated, this function will throw std::bad_alloc. + //! If exceptions are disabled by defining RAPIDXML_NO_EXCEPTIONS, this function + //! will call rapidxml::parse_error_handler() function. + //! \param type Type of node to create. + //! \param name Name to assign to the node, or 0 to assign no name. + //! \param value Value to assign to the node, or 0 to assign no value. + //! \param name_size Size of name to assign, or 0 to automatically calculate size from name string. + //! \param value_size Size of value to assign, or 0 to automatically calculate size from value string. + //! \return Pointer to allocated node. This pointer will never be NULL. + xml_node *allocate_node(node_type type, + const Ch *name = 0, const Ch *value = 0, + std::size_t name_size = 0, std::size_t value_size = 0) + { + void *memory = allocate_aligned(sizeof(xml_node)); + xml_node *node = new(memory) xml_node(type); + if (name) + { + if (name_size > 0) + node->name(name, name_size); + else + node->name(name); + } + if (value) + { + if (value_size > 0) + node->value(value, value_size); + else + node->value(value); + } + return node; + } + + //! Allocates a new attribute from the pool, and optionally assigns name and value to it. + //! If the allocation request cannot be accomodated, this function will throw std::bad_alloc. + //! If exceptions are disabled by defining RAPIDXML_NO_EXCEPTIONS, this function + //! will call rapidxml::parse_error_handler() function. + //! \param name Name to assign to the attribute, or 0 to assign no name. + //! \param value Value to assign to the attribute, or 0 to assign no value. + //! \param name_size Size of name to assign, or 0 to automatically calculate size from name string. + //! \param value_size Size of value to assign, or 0 to automatically calculate size from value string. + //! \return Pointer to allocated attribute. This pointer will never be NULL. + xml_attribute *allocate_attribute(const Ch *name = 0, const Ch *value = 0, + std::size_t name_size = 0, std::size_t value_size = 0) + { + void *memory = allocate_aligned(sizeof(xml_attribute)); + xml_attribute *attribute = new(memory) xml_attribute; + if (name) + { + if (name_size > 0) + attribute->name(name, name_size); + else + attribute->name(name); + } + if (value) + { + if (value_size > 0) + attribute->value(value, value_size); + else + attribute->value(value); + } + return attribute; + } + + //! Allocates a char array of given size from the pool, and optionally copies a given string to it. + //! If the allocation request cannot be accomodated, this function will throw std::bad_alloc. + //! If exceptions are disabled by defining RAPIDXML_NO_EXCEPTIONS, this function + //! will call rapidxml::parse_error_handler() function. + //! \param source String to initialize the allocated memory with, or 0 to not initialize it. + //! \param size Number of characters to allocate, or zero to calculate it automatically from source string length; if size is 0, source string must be specified and null terminated. + //! \return Pointer to allocated char array. This pointer will never be NULL. + Ch *allocate_string(const Ch *source = 0, std::size_t size = 0) + { + assert(source || size); // Either source or size (or both) must be specified + if (size == 0) + size = internal::measure(source) + 1; + Ch *result = static_cast(allocate_aligned(size * sizeof(Ch))); + if (source) + for (std::size_t i = 0; i < size; ++i) + result[i] = source[i]; + return result; + } + + //! Clones an xml_node and its hierarchy of child nodes and attributes. + //! Nodes and attributes are allocated from this memory pool. + //! Names and values are not cloned, they are shared between the clone and the source. + //! Result node can be optionally specified as a second parameter, + //! in which case its contents will be replaced with cloned source node. + //! This is useful when you want to clone entire document. + //! \param source Node to clone. + //! \param result Node to put results in, or 0 to automatically allocate result node + //! \return Pointer to cloned node. This pointer will never be NULL. + xml_node *clone_node(const xml_node *source, xml_node *result = 0) + { + // Prepare result node + if (result) + { + result->remove_all_attributes(); + result->remove_all_nodes(); + result->type(source->type()); + } + else + result = allocate_node(source->type()); + + // Clone name and value + result->name(source->name(), source->name_size()); + result->value(source->value(), source->value_size()); + + // Clone child nodes and attributes + for (xml_node *child = source->first_node(); child; child = child->next_sibling()) + result->append_node(clone_node(child)); + for (xml_attribute *attr = source->first_attribute(); attr; attr = attr->next_attribute()) + result->append_attribute(allocate_attribute(attr->name(), attr->value(), attr->name_size(), attr->value_size())); + + return result; + } + + //! Clears the pool. + //! This causes memory occupied by nodes allocated by the pool to be freed. + //! Any nodes or strings allocated from the pool will no longer be valid. + void clear() + { + while (m_begin != m_static_memory) + { + char *previous_begin = reinterpret_cast
(align(m_begin))->previous_begin; + if (m_free_func) + m_free_func(m_begin); + else + delete[] m_begin; + m_begin = previous_begin; + } + init(); + } + + //! Sets or resets the user-defined memory allocation functions for the pool. + //! This can only be called when no memory is allocated from the pool yet, otherwise results are undefined. + //! Allocation function must not return invalid pointer on failure. It should either throw, + //! stop the program, or use longjmp() function to pass control to other place of program. + //! If it returns invalid pointer, results are undefined. + //!

+ //! User defined allocation functions must have the following forms: + //!
+ //!
void *allocate(std::size_t size); + //!
void free(void *pointer); + //!
+ //! \param af Allocation function, or 0 to restore default function + //! \param ff Free function, or 0 to restore default function + void set_allocator(alloc_func *af, free_func *ff) + { + assert(m_begin == m_static_memory && m_ptr == align(m_begin)); // Verify that no memory is allocated yet + m_alloc_func = af; + m_free_func = ff; + } + + private: + + struct header + { + char *previous_begin; + }; + + void init() + { + m_begin = m_static_memory; + m_ptr = align(m_begin); + m_end = m_static_memory + sizeof(m_static_memory); + } + + char *align(char *ptr) + { + std::size_t alignment = ((RAPIDXML_ALIGNMENT - (std::size_t(ptr) & (RAPIDXML_ALIGNMENT - 1))) & (RAPIDXML_ALIGNMENT - 1)); + return ptr + alignment; + } + + char *allocate_raw(std::size_t size) + { + // Allocate + void *memory; + if (m_alloc_func) // Allocate memory using either user-specified allocation function or global operator new[] + { + memory = m_alloc_func(size); + assert(memory); // Allocator is not allowed to return 0, on failure it must either throw, stop the program or use longjmp + } + else + { + memory = new char[size]; +#ifdef RAPIDXML_NO_EXCEPTIONS + if (!memory) // If exceptions are disabled, verify memory allocation, because new will not be able to throw bad_alloc + RAPIDXML_PARSE_ERROR("out of memory", 0); +#endif + } + return static_cast(memory); + } + + void *allocate_aligned(std::size_t size) + { + // Calculate aligned pointer + char *result = align(m_ptr); + + // If not enough memory left in current pool, allocate a new pool + if (result + size > m_end) + { + // Calculate required pool size (may be bigger than RAPIDXML_DYNAMIC_POOL_SIZE) + std::size_t pool_size = RAPIDXML_DYNAMIC_POOL_SIZE; + if (pool_size < size) + pool_size = size; + + // Allocate + std::size_t alloc_size = sizeof(header) + (2 * RAPIDXML_ALIGNMENT - 2) + pool_size; // 2 alignments required in worst case: one for header, one for actual allocation + char *raw_memory = allocate_raw(alloc_size); + + // Setup new pool in allocated memory + char *pool = align(raw_memory); + header *new_header = reinterpret_cast
(pool); + new_header->previous_begin = m_begin; + m_begin = raw_memory; + m_ptr = pool + sizeof(header); + m_end = raw_memory + alloc_size; + + // Calculate aligned pointer again using new pool + result = align(m_ptr); + } + + // Update pool and return aligned pointer + m_ptr = result + size; + return result; + } + + char *m_begin; // Start of raw memory making up current pool + char *m_ptr; // First free byte in current pool + char *m_end; // One past last available byte in current pool + char m_static_memory[RAPIDXML_STATIC_POOL_SIZE]; // Static raw memory + alloc_func *m_alloc_func; // Allocator function, or 0 if default is to be used + free_func *m_free_func; // Free function, or 0 if default is to be used + }; + + /////////////////////////////////////////////////////////////////////////// + // XML base + + //! Base class for xml_node and xml_attribute implementing common functions: + //! name(), name_size(), value(), value_size() and parent(). + //! \param Ch Character type to use + template + class xml_base + { + + public: + + /////////////////////////////////////////////////////////////////////////// + // Construction & destruction + + // Construct a base with empty name, value and parent + xml_base() + : m_name(0) + , m_value(0) + , m_parent(0) + { + } + + /////////////////////////////////////////////////////////////////////////// + // Node data access + + //! Gets name of the node. + //! Interpretation of name depends on type of node. + //! Note that name will not be zero-terminated if rapidxml::parse_no_string_terminators option was selected during parse. + //!

+ //! Use name_size() function to determine length of the name. + //! \return Name of node, or empty string if node has no name. + Ch *name() const + { + return m_name ? m_name : nullstr(); + } + + //! Gets size of node name, not including terminator character. + //! This function works correctly irrespective of whether name is or is not zero terminated. + //! \return Size of node name, in characters. + std::size_t name_size() const + { + return m_name ? m_name_size : 0; + } + + //! Gets value of node. + //! Interpretation of value depends on type of node. + //! Note that value will not be zero-terminated if rapidxml::parse_no_string_terminators option was selected during parse. + //!

+ //! Use value_size() function to determine length of the value. + //! \return Value of node, or empty string if node has no value. + Ch *value() const + { + return m_value ? m_value : nullstr(); + } + + //! Gets size of node value, not including terminator character. + //! This function works correctly irrespective of whether value is or is not zero terminated. + //! \return Size of node value, in characters. + std::size_t value_size() const + { + return m_value ? m_value_size : 0; + } + + /////////////////////////////////////////////////////////////////////////// + // Node modification + + //! Sets name of node to a non zero-terminated string. + //! See \ref ownership_of_strings. + //!

+ //! Note that node does not own its name or value, it only stores a pointer to it. + //! It will not delete or otherwise free the pointer on destruction. + //! It is reponsibility of the user to properly manage lifetime of the string. + //! The easiest way to achieve it is to use memory_pool of the document to allocate the string - + //! on destruction of the document the string will be automatically freed. + //!

+ //! Size of name must be specified separately, because name does not have to be zero terminated. + //! Use name(const Ch *) function to have the length automatically calculated (string must be zero terminated). + //! \param name Name of node to set. Does not have to be zero terminated. + //! \param size Size of name, in characters. This does not include zero terminator, if one is present. + void name(const Ch *name, std::size_t size) + { + m_name = const_cast(name); + m_name_size = size; + } + + //! Sets name of node to a zero-terminated string. + //! See also \ref ownership_of_strings and xml_node::name(const Ch *, std::size_t). + //! \param name Name of node to set. Must be zero terminated. + void name(const Ch *name) + { + this->name(name, internal::measure(name)); + } + + //! Sets value of node to a non zero-terminated string. + //! See \ref ownership_of_strings. + //!

+ //! Note that node does not own its name or value, it only stores a pointer to it. + //! It will not delete or otherwise free the pointer on destruction. + //! It is reponsibility of the user to properly manage lifetime of the string. + //! The easiest way to achieve it is to use memory_pool of the document to allocate the string - + //! on destruction of the document the string will be automatically freed. + //!

+ //! Size of value must be specified separately, because it does not have to be zero terminated. + //! Use value(const Ch *) function to have the length automatically calculated (string must be zero terminated). + //!

+ //! If an element has a child node of type node_data, it will take precedence over element value when printing. + //! If you want to manipulate data of elements using values, use parser flag rapidxml::parse_no_data_nodes to prevent creation of data nodes by the parser. + //! \param value value of node to set. Does not have to be zero terminated. + //! \param size Size of value, in characters. This does not include zero terminator, if one is present. + void value(const Ch *value, std::size_t size) + { + m_value = const_cast(value); + m_value_size = size; + } + + //! Sets value of node to a zero-terminated string. + //! See also \ref ownership_of_strings and xml_node::value(const Ch *, std::size_t). + //! \param value Vame of node to set. Must be zero terminated. + void value(const Ch *value) + { + this->value(value, internal::measure(value)); + } + + /////////////////////////////////////////////////////////////////////////// + // Related nodes access + + //! Gets node parent. + //! \return Pointer to parent node, or 0 if there is no parent. + xml_node *parent() const + { + return m_parent; + } + + protected: + + // Return empty string + static Ch *nullstr() + { + static Ch zero = Ch('\0'); + return &zero; + } + + Ch *m_name; // Name of node, or 0 if no name + Ch *m_value; // Value of node, or 0 if no value + std::size_t m_name_size; // Length of node name, or undefined of no name + std::size_t m_value_size; // Length of node value, or undefined if no value + xml_node *m_parent; // Pointer to parent node, or 0 if none + + }; + + //! Class representing attribute node of XML document. + //! Each attribute has name and value strings, which are available through name() and value() functions (inherited from xml_base). + //! Note that after parse, both name and value of attribute will point to interior of source text used for parsing. + //! Thus, this text must persist in memory for the lifetime of attribute. + //! \param Ch Character type to use. + template + class xml_attribute: public xml_base + { + + friend class xml_node; + + public: + + /////////////////////////////////////////////////////////////////////////// + // Construction & destruction + + //! Constructs an empty attribute with the specified type. + //! Consider using memory_pool of appropriate xml_document if allocating attributes manually. + xml_attribute() + { + } + + /////////////////////////////////////////////////////////////////////////// + // Related nodes access + + //! Gets document of which attribute is a child. + //! \return Pointer to document that contains this attribute, or 0 if there is no parent document. + xml_document *document() const + { + if (xml_node *node = this->parent()) + { + while (node->parent()) + node = node->parent(); + return node->type() == node_document ? static_cast *>(node) : 0; + } + else + return 0; + } + + //! Gets previous attribute, optionally matching attribute name. + //! \param name Name of attribute to find, or 0 to return previous attribute regardless of its name; this string doesn't have to be zero-terminated if name_size is non-zero + //! \param name_size Size of name, in characters, or 0 to have size calculated automatically from string + //! \param case_sensitive Should name comparison be case-sensitive; non case-sensitive comparison works properly only for ASCII characters + //! \return Pointer to found attribute, or 0 if not found. + xml_attribute *previous_attribute(const Ch *name = 0, std::size_t name_size = 0, bool case_sensitive = true) const + { + if (name) + { + if (name_size == 0) + name_size = internal::measure(name); + for (xml_attribute *attribute = m_prev_attribute; attribute; attribute = attribute->m_prev_attribute) + if (internal::compare(attribute->name(), attribute->name_size(), name, name_size, case_sensitive)) + return attribute; + return 0; + } + else + return this->m_parent ? m_prev_attribute : 0; + } + + //! Gets next attribute, optionally matching attribute name. + //! \param name Name of attribute to find, or 0 to return next attribute regardless of its name; this string doesn't have to be zero-terminated if name_size is non-zero + //! \param name_size Size of name, in characters, or 0 to have size calculated automatically from string + //! \param case_sensitive Should name comparison be case-sensitive; non case-sensitive comparison works properly only for ASCII characters + //! \return Pointer to found attribute, or 0 if not found. + xml_attribute *next_attribute(const Ch *name = 0, std::size_t name_size = 0, bool case_sensitive = true) const + { + if (name) + { + if (name_size == 0) + name_size = internal::measure(name); + for (xml_attribute *attribute = m_next_attribute; attribute; attribute = attribute->m_next_attribute) + if (internal::compare(attribute->name(), attribute->name_size(), name, name_size, case_sensitive)) + return attribute; + return 0; + } + else + return this->m_parent ? m_next_attribute : 0; + } + + private: + + xml_attribute *m_prev_attribute; // Pointer to previous sibling of attribute, or 0 if none; only valid if parent is non-zero + xml_attribute *m_next_attribute; // Pointer to next sibling of attribute, or 0 if none; only valid if parent is non-zero + + }; + + /////////////////////////////////////////////////////////////////////////// + // XML node + + //! Class representing a node of XML document. + //! Each node may have associated name and value strings, which are available through name() and value() functions. + //! Interpretation of name and value depends on type of the node. + //! Type of node can be determined by using type() function. + //!

+ //! Note that after parse, both name and value of node, if any, will point interior of source text used for parsing. + //! Thus, this text must persist in the memory for the lifetime of node. + //! \param Ch Character type to use. + template + class xml_node: public xml_base + { + + public: + + /////////////////////////////////////////////////////////////////////////// + // Construction & destruction + + //! Constructs an empty node with the specified type. + //! Consider using memory_pool of appropriate document to allocate nodes manually. + //! \param type Type of node to construct. + xml_node(node_type type) + : m_type(type) + , m_first_node(0) + , m_first_attribute(0) + { + } + + /////////////////////////////////////////////////////////////////////////// + // Node data access + + //! Gets type of node. + //! \return Type of node. + node_type type() const + { + return m_type; + } + + /////////////////////////////////////////////////////////////////////////// + // Related nodes access + + //! Gets document of which node is a child. + //! \return Pointer to document that contains this node, or 0 if there is no parent document. + xml_document *document() const + { + xml_node *node = const_cast *>(this); + while (node->parent()) + node = node->parent(); + return node->type() == node_document ? static_cast *>(node) : 0; + } + + //! Gets first child node, optionally matching node name. + //! \param name Name of child to find, or 0 to return first child regardless of its name; this string doesn't have to be zero-terminated if name_size is non-zero + //! \param name_size Size of name, in characters, or 0 to have size calculated automatically from string + //! \param case_sensitive Should name comparison be case-sensitive; non case-sensitive comparison works properly only for ASCII characters + //! \return Pointer to found child, or 0 if not found. + xml_node *first_node(const Ch *name = 0, std::size_t name_size = 0, bool case_sensitive = true) const + { + if (name) + { + if (name_size == 0) + name_size = internal::measure(name); + for (xml_node *child = m_first_node; child; child = child->next_sibling()) + if (internal::compare(child->name(), child->name_size(), name, name_size, case_sensitive)) + return child; + return 0; + } + else + return m_first_node; + } + + //! Gets last child node, optionally matching node name. + //! Behaviour is undefined if node has no children. + //! Use first_node() to test if node has children. + //! \param name Name of child to find, or 0 to return last child regardless of its name; this string doesn't have to be zero-terminated if name_size is non-zero + //! \param name_size Size of name, in characters, or 0 to have size calculated automatically from string + //! \param case_sensitive Should name comparison be case-sensitive; non case-sensitive comparison works properly only for ASCII characters + //! \return Pointer to found child, or 0 if not found. + xml_node *last_node(const Ch *name = 0, std::size_t name_size = 0, bool case_sensitive = true) const + { + assert(m_first_node); // Cannot query for last child if node has no children + if (name) + { + if (name_size == 0) + name_size = internal::measure(name); + for (xml_node *child = m_last_node; child; child = child->previous_sibling()) + if (internal::compare(child->name(), child->name_size(), name, name_size, case_sensitive)) + return child; + return 0; + } + else + return m_last_node; + } + + //! Gets previous sibling node, optionally matching node name. + //! Behaviour is undefined if node has no parent. + //! Use parent() to test if node has a parent. + //! \param name Name of sibling to find, or 0 to return previous sibling regardless of its name; this string doesn't have to be zero-terminated if name_size is non-zero + //! \param name_size Size of name, in characters, or 0 to have size calculated automatically from string + //! \param case_sensitive Should name comparison be case-sensitive; non case-sensitive comparison works properly only for ASCII characters + //! \return Pointer to found sibling, or 0 if not found. + xml_node *previous_sibling(const Ch *name = 0, std::size_t name_size = 0, bool case_sensitive = true) const + { + assert(this->m_parent); // Cannot query for siblings if node has no parent + if (name) + { + if (name_size == 0) + name_size = internal::measure(name); + for (xml_node *sibling = m_prev_sibling; sibling; sibling = sibling->m_prev_sibling) + if (internal::compare(sibling->name(), sibling->name_size(), name, name_size, case_sensitive)) + return sibling; + return 0; + } + else + return m_prev_sibling; + } + + //! Gets next sibling node, optionally matching node name. + //! Behaviour is undefined if node has no parent. + //! Use parent() to test if node has a parent. + //! \param name Name of sibling to find, or 0 to return next sibling regardless of its name; this string doesn't have to be zero-terminated if name_size is non-zero + //! \param name_size Size of name, in characters, or 0 to have size calculated automatically from string + //! \param case_sensitive Should name comparison be case-sensitive; non case-sensitive comparison works properly only for ASCII characters + //! \return Pointer to found sibling, or 0 if not found. + xml_node *next_sibling(const Ch *name = 0, std::size_t name_size = 0, bool case_sensitive = true) const + { + assert(this->m_parent); // Cannot query for siblings if node has no parent + if (name) + { + if (name_size == 0) + name_size = internal::measure(name); + for (xml_node *sibling = m_next_sibling; sibling; sibling = sibling->m_next_sibling) + if (internal::compare(sibling->name(), sibling->name_size(), name, name_size, case_sensitive)) + return sibling; + return 0; + } + else + return m_next_sibling; + } + + //! Gets first attribute of node, optionally matching attribute name. + //! \param name Name of attribute to find, or 0 to return first attribute regardless of its name; this string doesn't have to be zero-terminated if name_size is non-zero + //! \param name_size Size of name, in characters, or 0 to have size calculated automatically from string + //! \param case_sensitive Should name comparison be case-sensitive; non case-sensitive comparison works properly only for ASCII characters + //! \return Pointer to found attribute, or 0 if not found. + xml_attribute *first_attribute(const Ch *name = 0, std::size_t name_size = 0, bool case_sensitive = true) const + { + if (name) + { + if (name_size == 0) + name_size = internal::measure(name); + for (xml_attribute *attribute = m_first_attribute; attribute; attribute = attribute->m_next_attribute) + if (internal::compare(attribute->name(), attribute->name_size(), name, name_size, case_sensitive)) + return attribute; + return 0; + } + else + return m_first_attribute; + } + + //! Gets last attribute of node, optionally matching attribute name. + //! \param name Name of attribute to find, or 0 to return last attribute regardless of its name; this string doesn't have to be zero-terminated if name_size is non-zero + //! \param name_size Size of name, in characters, or 0 to have size calculated automatically from string + //! \param case_sensitive Should name comparison be case-sensitive; non case-sensitive comparison works properly only for ASCII characters + //! \return Pointer to found attribute, or 0 if not found. + xml_attribute *last_attribute(const Ch *name = 0, std::size_t name_size = 0, bool case_sensitive = true) const + { + if (name) + { + if (name_size == 0) + name_size = internal::measure(name); + for (xml_attribute *attribute = m_last_attribute; attribute; attribute = attribute->m_prev_attribute) + if (internal::compare(attribute->name(), attribute->name_size(), name, name_size, case_sensitive)) + return attribute; + return 0; + } + else + return m_first_attribute ? m_last_attribute : 0; + } + + /////////////////////////////////////////////////////////////////////////// + // Node modification + + //! Sets type of node. + //! \param type Type of node to set. + void type(node_type type) + { + m_type = type; + } + + /////////////////////////////////////////////////////////////////////////// + // Node manipulation + + //! Prepends a new child node. + //! The prepended child becomes the first child, and all existing children are moved one position back. + //! \param child Node to prepend. + void prepend_node(xml_node *child) + { + assert(child && !child->parent() && child->type() != node_document); + if (first_node()) + { + child->m_next_sibling = m_first_node; + m_first_node->m_prev_sibling = child; + } + else + { + child->m_next_sibling = 0; + m_last_node = child; + } + m_first_node = child; + child->m_parent = this; + child->m_prev_sibling = 0; + } + + //! Appends a new child node. + //! The appended child becomes the last child. + //! \param child Node to append. + void append_node(xml_node *child) + { + assert(child && !child->parent() && child->type() != node_document); + if (first_node()) + { + child->m_prev_sibling = m_last_node; + m_last_node->m_next_sibling = child; + } + else + { + child->m_prev_sibling = 0; + m_first_node = child; + } + m_last_node = child; + child->m_parent = this; + child->m_next_sibling = 0; + } + + //! Inserts a new child node at specified place inside the node. + //! All children after and including the specified node are moved one position back. + //! \param where Place where to insert the child, or 0 to insert at the back. + //! \param child Node to insert. + void insert_node(xml_node *where, xml_node *child) + { + assert(!where || where->parent() == this); + assert(child && !child->parent() && child->type() != node_document); + if (where == m_first_node) + prepend_node(child); + else if (where == 0) + append_node(child); + else + { + child->m_prev_sibling = where->m_prev_sibling; + child->m_next_sibling = where; + where->m_prev_sibling->m_next_sibling = child; + where->m_prev_sibling = child; + child->m_parent = this; + } + } + + //! Removes first child node. + //! If node has no children, behaviour is undefined. + //! Use first_node() to test if node has children. + void remove_first_node() + { + assert(first_node()); + xml_node *child = m_first_node; + m_first_node = child->m_next_sibling; + if (child->m_next_sibling) + child->m_next_sibling->m_prev_sibling = 0; + else + m_last_node = 0; + child->m_parent = 0; + } + + //! Removes last child of the node. + //! If node has no children, behaviour is undefined. + //! Use first_node() to test if node has children. + void remove_last_node() + { + assert(first_node()); + xml_node *child = m_last_node; + if (child->m_prev_sibling) + { + m_last_node = child->m_prev_sibling; + child->m_prev_sibling->m_next_sibling = 0; + } + else + m_first_node = 0; + child->m_parent = 0; + } + + //! Removes specified child from the node + // \param where Pointer to child to be removed. + void remove_node(xml_node *where) + { + assert(where && where->parent() == this); + assert(first_node()); + if (where == m_first_node) + remove_first_node(); + else if (where == m_last_node) + remove_last_node(); + else + { + where->m_prev_sibling->m_next_sibling = where->m_next_sibling; + where->m_next_sibling->m_prev_sibling = where->m_prev_sibling; + where->m_parent = 0; + } + } + + //! Removes all child nodes (but not attributes). + void remove_all_nodes() + { + for (xml_node *node = first_node(); node; node = node->m_next_sibling) + node->m_parent = 0; + m_first_node = 0; + } + + //! Prepends a new attribute to the node. + //! \param attribute Attribute to prepend. + void prepend_attribute(xml_attribute *attribute) + { + assert(attribute && !attribute->parent()); + if (first_attribute()) + { + attribute->m_next_attribute = m_first_attribute; + m_first_attribute->m_prev_attribute = attribute; + } + else + { + attribute->m_next_attribute = 0; + m_last_attribute = attribute; + } + m_first_attribute = attribute; + attribute->m_parent = this; + attribute->m_prev_attribute = 0; + } + + //! Appends a new attribute to the node. + //! \param attribute Attribute to append. + void append_attribute(xml_attribute *attribute) + { + assert(attribute && !attribute->parent()); + if (first_attribute()) + { + attribute->m_prev_attribute = m_last_attribute; + m_last_attribute->m_next_attribute = attribute; + } + else + { + attribute->m_prev_attribute = 0; + m_first_attribute = attribute; + } + m_last_attribute = attribute; + attribute->m_parent = this; + attribute->m_next_attribute = 0; + } + + //! Inserts a new attribute at specified place inside the node. + //! All attributes after and including the specified attribute are moved one position back. + //! \param where Place where to insert the attribute, or 0 to insert at the back. + //! \param attribute Attribute to insert. + void insert_attribute(xml_attribute *where, xml_attribute *attribute) + { + assert(!where || where->parent() == this); + assert(attribute && !attribute->parent()); + if (where == m_first_attribute) + prepend_attribute(attribute); + else if (where == 0) + append_attribute(attribute); + else + { + attribute->m_prev_attribute = where->m_prev_attribute; + attribute->m_next_attribute = where; + where->m_prev_attribute->m_next_attribute = attribute; + where->m_prev_attribute = attribute; + attribute->m_parent = this; + } + } + + //! Removes first attribute of the node. + //! If node has no attributes, behaviour is undefined. + //! Use first_attribute() to test if node has attributes. + void remove_first_attribute() + { + assert(first_attribute()); + xml_attribute *attribute = m_first_attribute; + if (attribute->m_next_attribute) + { + attribute->m_next_attribute->m_prev_attribute = 0; + } + else + m_last_attribute = 0; + attribute->m_parent = 0; + m_first_attribute = attribute->m_next_attribute; + } + + //! Removes last attribute of the node. + //! If node has no attributes, behaviour is undefined. + //! Use first_attribute() to test if node has attributes. + void remove_last_attribute() + { + assert(first_attribute()); + xml_attribute *attribute = m_last_attribute; + if (attribute->m_prev_attribute) + { + attribute->m_prev_attribute->m_next_attribute = 0; + m_last_attribute = attribute->m_prev_attribute; + } + else + m_first_attribute = 0; + attribute->m_parent = 0; + } + + //! Removes specified attribute from node. + //! \param where Pointer to attribute to be removed. + void remove_attribute(xml_attribute *where) + { + assert(first_attribute() && where->parent() == this); + if (where == m_first_attribute) + remove_first_attribute(); + else if (where == m_last_attribute) + remove_last_attribute(); + else + { + where->m_prev_attribute->m_next_attribute = where->m_next_attribute; + where->m_next_attribute->m_prev_attribute = where->m_prev_attribute; + where->m_parent = 0; + } + } + + //! Removes all attributes of node. + void remove_all_attributes() + { + for (xml_attribute *attribute = first_attribute(); attribute; attribute = attribute->m_next_attribute) + attribute->m_parent = 0; + m_first_attribute = 0; + } + + private: + + /////////////////////////////////////////////////////////////////////////// + // Restrictions + + // No copying + xml_node(const xml_node &); + void operator =(const xml_node &); + + /////////////////////////////////////////////////////////////////////////// + // Data members + + // Note that some of the pointers below have UNDEFINED values if certain other pointers are 0. + // This is required for maximum performance, as it allows the parser to omit initialization of + // unneded/redundant values. + // + // The rules are as follows: + // 1. first_node and first_attribute contain valid pointers, or 0 if node has no children/attributes respectively + // 2. last_node and last_attribute are valid only if node has at least one child/attribute respectively, otherwise they contain garbage + // 3. prev_sibling and next_sibling are valid only if node has a parent, otherwise they contain garbage + + node_type m_type; // Type of node; always valid + xml_node *m_first_node; // Pointer to first child node, or 0 if none; always valid + xml_node *m_last_node; // Pointer to last child node, or 0 if none; this value is only valid if m_first_node is non-zero + xml_attribute *m_first_attribute; // Pointer to first attribute of node, or 0 if none; always valid + xml_attribute *m_last_attribute; // Pointer to last attribute of node, or 0 if none; this value is only valid if m_first_attribute is non-zero + xml_node *m_prev_sibling; // Pointer to previous sibling of node, or 0 if none; this value is only valid if m_parent is non-zero + xml_node *m_next_sibling; // Pointer to next sibling of node, or 0 if none; this value is only valid if m_parent is non-zero + + }; + + /////////////////////////////////////////////////////////////////////////// + // XML document + + //! This class represents root of the DOM hierarchy. + //! It is also an xml_node and a memory_pool through public inheritance. + //! Use parse() function to build a DOM tree from a zero-terminated XML text string. + //! parse() function allocates memory for nodes and attributes by using functions of xml_document, + //! which are inherited from memory_pool. + //! To access root node of the document, use the document itself, as if it was an xml_node. + //! \param Ch Character type to use. + template + class xml_document: public xml_node, public memory_pool + { + + public: + + //! Constructs empty XML document + xml_document() + : xml_node(node_document) + { + } + + //! Parses zero-terminated XML string according to given flags. + //! Passed string will be modified by the parser, unless rapidxml::parse_non_destructive flag is used. + //! The string must persist for the lifetime of the document. + //! In case of error, rapidxml::parse_error exception will be thrown. + //!

+ //! If you want to parse contents of a file, you must first load the file into the memory, and pass pointer to its beginning. + //! Make sure that data is zero-terminated. + //!

+ //! Document can be parsed into multiple times. + //! Each new call to parse removes previous nodes and attributes (if any), but does not clear memory pool. + //! \param text XML data to parse; pointer is non-const to denote fact that this data may be modified by the parser. + template + void parse(Ch *text) + { + assert(text); + + // Remove current contents + this->remove_all_nodes(); + this->remove_all_attributes(); + + // Parse BOM, if any + parse_bom(text); + + // Parse children + while (1) + { + // Skip whitespace before node + skip(text); + if (*text == 0) + break; + + // Parse and append new child + if (*text == Ch('<')) + { + ++text; // Skip '<' + if (xml_node *node = parse_node(text)) + this->append_node(node); + } + else + RAPIDXML_PARSE_ERROR("expected <", text); + } + + } + + //! Clears the document by deleting all nodes and clearing the memory pool. + //! All nodes owned by document pool are destroyed. + void clear() + { + this->remove_all_nodes(); + this->remove_all_attributes(); + memory_pool::clear(); + } + + private: + + /////////////////////////////////////////////////////////////////////// + // Internal character utility functions + + // Detect whitespace character + struct whitespace_pred + { + static unsigned char test(Ch ch) + { + return internal::lookup_tables<0>::lookup_whitespace[static_cast(ch)]; + } + }; + + // Detect node name character + struct node_name_pred + { + static unsigned char test(Ch ch) + { + return internal::lookup_tables<0>::lookup_node_name[static_cast(ch)]; + } + }; + + // Detect attribute name character + struct attribute_name_pred + { + static unsigned char test(Ch ch) + { + return internal::lookup_tables<0>::lookup_attribute_name[static_cast(ch)]; + } + }; + + // Detect text character (PCDATA) + struct text_pred + { + static unsigned char test(Ch ch) + { + return internal::lookup_tables<0>::lookup_text[static_cast(ch)]; + } + }; + + // Detect text character (PCDATA) that does not require processing + struct text_pure_no_ws_pred + { + static unsigned char test(Ch ch) + { + return internal::lookup_tables<0>::lookup_text_pure_no_ws[static_cast(ch)]; + } + }; + + // Detect text character (PCDATA) that does not require processing + struct text_pure_with_ws_pred + { + static unsigned char test(Ch ch) + { + return internal::lookup_tables<0>::lookup_text_pure_with_ws[static_cast(ch)]; + } + }; + + // Detect attribute value character + template + struct attribute_value_pred + { + static unsigned char test(Ch ch) + { + if (Quote == Ch('\'')) + return internal::lookup_tables<0>::lookup_attribute_data_1[static_cast(ch)]; + if (Quote == Ch('\"')) + return internal::lookup_tables<0>::lookup_attribute_data_2[static_cast(ch)]; + return 0; // Should never be executed, to avoid warnings on Comeau + } + }; + + // Detect attribute value character + template + struct attribute_value_pure_pred + { + static unsigned char test(Ch ch) + { + if (Quote == Ch('\'')) + return internal::lookup_tables<0>::lookup_attribute_data_1_pure[static_cast(ch)]; + if (Quote == Ch('\"')) + return internal::lookup_tables<0>::lookup_attribute_data_2_pure[static_cast(ch)]; + return 0; // Should never be executed, to avoid warnings on Comeau + } + }; + + // Insert coded character, using UTF8 or 8-bit ASCII + template + static void insert_coded_character(Ch *&text, unsigned long code) + { + if (Flags & parse_no_utf8) + { + // Insert 8-bit ASCII character + // Todo: possibly verify that code is less than 256 and use replacement char otherwise? + text[0] = static_cast(code); + text += 1; + } + else + { + // Insert UTF8 sequence + if (code < 0x80) // 1 byte sequence + { + text[0] = static_cast(code); + text += 1; + } + else if (code < 0x800) // 2 byte sequence + { + text[1] = static_cast((code | 0x80) & 0xBF); code >>= 6; + text[0] = static_cast(code | 0xC0); + text += 2; + } + else if (code < 0x10000) // 3 byte sequence + { + text[2] = static_cast((code | 0x80) & 0xBF); code >>= 6; + text[1] = static_cast((code | 0x80) & 0xBF); code >>= 6; + text[0] = static_cast(code | 0xE0); + text += 3; + } + else if (code < 0x110000) // 4 byte sequence + { + text[3] = static_cast((code | 0x80) & 0xBF); code >>= 6; + text[2] = static_cast((code | 0x80) & 0xBF); code >>= 6; + text[1] = static_cast((code | 0x80) & 0xBF); code >>= 6; + text[0] = static_cast(code | 0xF0); + text += 4; + } + else // Invalid, only codes up to 0x10FFFF are allowed in Unicode + { + RAPIDXML_PARSE_ERROR("invalid numeric character entity", text); + } + } + } + + // Skip characters until predicate evaluates to true + template + static void skip(Ch *&text) + { + Ch *tmp = text; + while (StopPred::test(*tmp)) + ++tmp; + text = tmp; + } + + // Skip characters until predicate evaluates to true while doing the following: + // - replacing XML character entity references with proper characters (' & " < > &#...;) + // - condensing whitespace sequences to single space character + template + static Ch *skip_and_expand_character_refs(Ch *&text) + { + // If entity translation, whitespace condense and whitespace trimming is disabled, use plain skip + if (Flags & parse_no_entity_translation && + !(Flags & parse_normalize_whitespace) && + !(Flags & parse_trim_whitespace)) + { + skip(text); + return text; + } + + // Use simple skip until first modification is detected + skip(text); + + // Use translation skip + Ch *src = text; + Ch *dest = src; + while (StopPred::test(*src)) + { + // If entity translation is enabled + if (!(Flags & parse_no_entity_translation)) + { + // Test if replacement is needed + if (src[0] == Ch('&')) + { + switch (src[1]) + { + + // & ' + case Ch('a'): + if (src[2] == Ch('m') && src[3] == Ch('p') && src[4] == Ch(';')) + { + *dest = Ch('&'); + ++dest; + src += 5; + continue; + } + if (src[2] == Ch('p') && src[3] == Ch('o') && src[4] == Ch('s') && src[5] == Ch(';')) + { + *dest = Ch('\''); + ++dest; + src += 6; + continue; + } + break; + + // " + case Ch('q'): + if (src[2] == Ch('u') && src[3] == Ch('o') && src[4] == Ch('t') && src[5] == Ch(';')) + { + *dest = Ch('"'); + ++dest; + src += 6; + continue; + } + break; + + // > + case Ch('g'): + if (src[2] == Ch('t') && src[3] == Ch(';')) + { + *dest = Ch('>'); + ++dest; + src += 4; + continue; + } + break; + + // < + case Ch('l'): + if (src[2] == Ch('t') && src[3] == Ch(';')) + { + *dest = Ch('<'); + ++dest; + src += 4; + continue; + } + break; + + // &#...; - assumes ASCII + case Ch('#'): + if (src[2] == Ch('x')) + { + unsigned long code = 0; + src += 3; // Skip &#x + while (1) + { + unsigned char digit = internal::lookup_tables<0>::lookup_digits[static_cast(*src)]; + if (digit == 0xFF) + break; + code = code * 16 + digit; + ++src; + } + insert_coded_character(dest, code); // Put character in output + } + else + { + unsigned long code = 0; + src += 2; // Skip &# + while (1) + { + unsigned char digit = internal::lookup_tables<0>::lookup_digits[static_cast(*src)]; + if (digit == 0xFF) + break; + code = code * 10 + digit; + ++src; + } + insert_coded_character(dest, code); // Put character in output + } + if (*src == Ch(';')) + ++src; + else + RAPIDXML_PARSE_ERROR("expected ;", src); + continue; + + // Something else + default: + // Ignore, just copy '&' verbatim + break; + + } + } + } + + // If whitespace condensing is enabled + if (Flags & parse_normalize_whitespace) + { + // Test if condensing is needed + if (whitespace_pred::test(*src)) + { + *dest = Ch(' '); ++dest; // Put single space in dest + ++src; // Skip first whitespace char + // Skip remaining whitespace chars + while (whitespace_pred::test(*src)) + ++src; + continue; + } + } + + // No replacement, only copy character + *dest++ = *src++; + + } + + // Return new end + text = src; + return dest; + + } + + /////////////////////////////////////////////////////////////////////// + // Internal parsing functions + + // Parse BOM, if any + template + void parse_bom(Ch *&text) + { + // UTF-8? + if (static_cast(text[0]) == 0xEF && + static_cast(text[1]) == 0xBB && + static_cast(text[2]) == 0xBF) + { + text += 3; // Skup utf-8 bom + } + } + + // Parse XML declaration ( + xml_node *parse_xml_declaration(Ch *&text) + { + // If parsing of declaration is disabled + if (!(Flags & parse_declaration_node)) + { + // Skip until end of declaration + while (text[0] != Ch('?') || text[1] != Ch('>')) + { + if (!text[0]) + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + ++text; + } + text += 2; // Skip '?>' + return 0; + } + + // Create declaration + xml_node *declaration = this->allocate_node(node_declaration); + + // Skip whitespace before attributes or ?> + skip(text); + + // Parse declaration attributes + parse_node_attributes(text, declaration); + + // Skip ?> + if (text[0] != Ch('?') || text[1] != Ch('>')) + RAPIDXML_PARSE_ERROR("expected ?>", text); + text += 2; + + return declaration; + } + + // Parse XML comment (' + return 0; // Do not produce comment node + } + + // Remember value start + Ch *value = text; + + // Skip until end of comment + while (text[0] != Ch('-') || text[1] != Ch('-') || text[2] != Ch('>')) + { + if (!text[0]) + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + ++text; + } + + // Create comment node + xml_node *comment = this->allocate_node(node_comment); + comment->value(value, text - value); + + // Place zero terminator after comment value + if (!(Flags & parse_no_string_terminators)) + *text = Ch('\0'); + + text += 3; // Skip '-->' + return comment; + } + + // Parse DOCTYPE + template + xml_node *parse_doctype(Ch *&text) + { + // Remember value start + Ch *value = text; + + // Skip to > + while (*text != Ch('>')) + { + // Determine character type + switch (*text) + { + + // If '[' encountered, scan for matching ending ']' using naive algorithm with depth + // This works for all W3C test files except for 2 most wicked + case Ch('['): + { + ++text; // Skip '[' + int depth = 1; + while (depth > 0) + { + switch (*text) + { + case Ch('['): ++depth; break; + case Ch(']'): --depth; break; + case 0: RAPIDXML_PARSE_ERROR("unexpected end of data", text); + } + ++text; + } + break; + } + + // Error on end of text + case Ch('\0'): + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + + // Other character, skip it + default: + ++text; + + } + } + + // If DOCTYPE nodes enabled + if (Flags & parse_doctype_node) + { + // Create a new doctype node + xml_node *doctype = this->allocate_node(node_doctype); + doctype->value(value, text - value); + + // Place zero terminator after value + if (!(Flags & parse_no_string_terminators)) + *text = Ch('\0'); + + text += 1; // skip '>' + return doctype; + } + else + { + text += 1; // skip '>' + return 0; + } + + } + + // Parse PI + template + xml_node *parse_pi(Ch *&text) + { + // If creation of PI nodes is enabled + if (Flags & parse_pi_nodes) + { + // Create pi node + xml_node *pi = this->allocate_node(node_pi); + + // Extract PI target name + Ch *name = text; + skip(text); + if (text == name) + RAPIDXML_PARSE_ERROR("expected PI target", text); + pi->name(name, text - name); + + // Skip whitespace between pi target and pi + skip(text); + + // Remember start of pi + Ch *value = text; + + // Skip to '?>' + while (text[0] != Ch('?') || text[1] != Ch('>')) + { + if (*text == Ch('\0')) + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + ++text; + } + + // Set pi value (verbatim, no entity expansion or whitespace normalization) + pi->value(value, text - value); + + // Place zero terminator after name and value + if (!(Flags & parse_no_string_terminators)) + { + pi->name()[pi->name_size()] = Ch('\0'); + pi->value()[pi->value_size()] = Ch('\0'); + } + + text += 2; // Skip '?>' + return pi; + } + else + { + // Skip to '?>' + while (text[0] != Ch('?') || text[1] != Ch('>')) + { + if (*text == Ch('\0')) + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + ++text; + } + text += 2; // Skip '?>' + return 0; + } + } + + // Parse and append data + // Return character that ends data. + // This is necessary because this character might have been overwritten by a terminating 0 + template + Ch parse_and_append_data(xml_node *node, Ch *&text, Ch *contents_start) + { + // Backup to contents start if whitespace trimming is disabled + if (!(Flags & parse_trim_whitespace)) + text = contents_start; + + // Skip until end of data + Ch *value = text, *end; + if (Flags & parse_normalize_whitespace) + end = skip_and_expand_character_refs(text); + else + end = skip_and_expand_character_refs(text); + + // Trim trailing whitespace if flag is set; leading was already trimmed by whitespace skip after > + if (Flags & parse_trim_whitespace) + { + if (Flags & parse_normalize_whitespace) + { + // Whitespace is already condensed to single space characters by skipping function, so just trim 1 char off the end + if (*(end - 1) == Ch(' ')) + --end; + } + else + { + // Backup until non-whitespace character is found + while (whitespace_pred::test(*(end - 1))) + --end; + } + } + + // If characters are still left between end and value (this test is only necessary if normalization is enabled) + // Create new data node + if (!(Flags & parse_no_data_nodes)) + { + xml_node *data = this->allocate_node(node_data); + data->value(value, end - value); + node->append_node(data); + } + + // Add data to parent node if no data exists yet + if (!(Flags & parse_no_element_values)) + if (*node->value() == Ch('\0')) + node->value(value, end - value); + + // Place zero terminator after value + if (!(Flags & parse_no_string_terminators)) + { + Ch ch = *text; + *end = Ch('\0'); + return ch; // Return character that ends data; this is required because zero terminator overwritten it + } + + // Return character that ends data + return *text; + } + + // Parse CDATA + template + xml_node *parse_cdata(Ch *&text) + { + // If CDATA is disabled + if (Flags & parse_no_data_nodes) + { + // Skip until end of cdata + while (text[0] != Ch(']') || text[1] != Ch(']') || text[2] != Ch('>')) + { + if (!text[0]) + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + ++text; + } + text += 3; // Skip ]]> + return 0; // Do not produce CDATA node + } + + // Skip until end of cdata + Ch *value = text; + while (text[0] != Ch(']') || text[1] != Ch(']') || text[2] != Ch('>')) + { + if (!text[0]) + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + ++text; + } + + // Create new cdata node + xml_node *cdata = this->allocate_node(node_cdata); + cdata->value(value, text - value); + + // Place zero terminator after value + if (!(Flags & parse_no_string_terminators)) + *text = Ch('\0'); + + text += 3; // Skip ]]> + return cdata; + } + + // Parse element node + template + xml_node *parse_element(Ch *&text) + { + // Create element node + xml_node *element = this->allocate_node(node_element); + + // Extract element name + Ch *name = text; + skip(text); + if (text == name) + RAPIDXML_PARSE_ERROR("expected element name", text); + element->name(name, text - name); + + // Skip whitespace between element name and attributes or > + skip(text); + + // Parse attributes, if any + parse_node_attributes(text, element); + + // Determine ending type + if (*text == Ch('>')) + { + ++text; + parse_node_contents(text, element); + } + else if (*text == Ch('/')) + { + ++text; + if (*text != Ch('>')) + RAPIDXML_PARSE_ERROR("expected >", text); + ++text; + } + else + RAPIDXML_PARSE_ERROR("expected >", text); + + // Place zero terminator after name + if (!(Flags & parse_no_string_terminators)) + element->name()[element->name_size()] = Ch('\0'); + + // Return parsed element + return element; + } + + // Determine node type, and parse it + template + xml_node *parse_node(Ch *&text) + { + // Parse proper node type + switch (text[0]) + { + + // <... + default: + // Parse and append element node + return parse_element(text); + + // (text); + } + else + { + // Parse PI + return parse_pi(text); + } + + // (text); + } + break; + + // (text); + } + break; + + // (text); + } + + } // switch + + // Attempt to skip other, unrecognized node types starting with ')) + { + if (*text == 0) + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + ++text; + } + ++text; // Skip '>' + return 0; // No node recognized + + } + } + + // Parse contents of the node - children, data etc. + template + void parse_node_contents(Ch *&text, xml_node *node) + { + // For all children and text + while (1) + { + // Skip whitespace between > and node contents + Ch *contents_start = text; // Store start of node contents before whitespace is skipped + skip(text); + Ch next_char = *text; + + // After data nodes, instead of continuing the loop, control jumps here. + // This is because zero termination inside parse_and_append_data() function + // would wreak havoc with the above code. + // Also, skipping whitespace after data nodes is unnecessary. + after_data_node: + + // Determine what comes next: node closing, child node, data node, or 0? + switch (next_char) + { + + // Node closing or child node + case Ch('<'): + if (text[1] == Ch('/')) + { + // Node closing + text += 2; // Skip '(text); + if (!internal::compare(node->name(), node->name_size(), closing_name, text - closing_name, true)) + RAPIDXML_PARSE_ERROR("invalid closing tag name", text); + } + else + { + // No validation, just skip name + skip(text); + } + // Skip remaining whitespace after node name + skip(text); + if (*text != Ch('>')) + RAPIDXML_PARSE_ERROR("expected >", text); + ++text; // Skip '>' + return; // Node closed, finished parsing contents + } + else + { + // Child node + ++text; // Skip '<' + if (xml_node *child = parse_node(text)) + node->append_node(child); + } + break; + + // End of data - error + case Ch('\0'): + RAPIDXML_PARSE_ERROR("unexpected end of data", text); + + // Data node + default: + next_char = parse_and_append_data(node, text, contents_start); + goto after_data_node; // Bypass regular processing after data nodes + + } + } + } + + // Parse XML attributes of the node + template + void parse_node_attributes(Ch *&text, xml_node *node) + { + // For all attributes + while (attribute_name_pred::test(*text)) + { + // Extract attribute name + Ch *name = text; + ++text; // Skip first character of attribute name + skip(text); + if (text == name) + RAPIDXML_PARSE_ERROR("expected attribute name", name); + + // Create new attribute + xml_attribute *attribute = this->allocate_attribute(); + attribute->name(name, text - name); + node->append_attribute(attribute); + + // Skip whitespace after attribute name + skip(text); + + // Skip = + if (*text != Ch('=')) + RAPIDXML_PARSE_ERROR("expected =", text); + ++text; + + // Add terminating zero after name + if (!(Flags & parse_no_string_terminators)) + attribute->name()[attribute->name_size()] = 0; + + // Skip whitespace after = + skip(text); + + // Skip quote and remember if it was ' or " + Ch quote = *text; + if (quote != Ch('\'') && quote != Ch('"')) + RAPIDXML_PARSE_ERROR("expected ' or \"", text); + ++text; + + // Extract attribute value and expand char refs in it + Ch *value = text, *end; + const int AttFlags = Flags & ~parse_normalize_whitespace; // No whitespace normalization in attributes + if (quote == Ch('\'')) + end = skip_and_expand_character_refs, attribute_value_pure_pred, AttFlags>(text); + else + end = skip_and_expand_character_refs, attribute_value_pure_pred, AttFlags>(text); + + // Set attribute value + attribute->value(value, end - value); + + // Make sure that end quote is present + if (*text != quote) + RAPIDXML_PARSE_ERROR("expected ' or \"", text); + ++text; // Skip quote + + // Add terminating zero after value + if (!(Flags & parse_no_string_terminators)) + attribute->value()[attribute->value_size()] = 0; + + // Skip whitespace after attribute value + skip(text); + } + } + + }; + + //! \cond internal + namespace internal + { + + // Whitespace (space \n \r \t) + template + const unsigned char lookup_tables::lookup_whitespace[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, // 0 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 1 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 2 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 3 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 4 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 5 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 6 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 7 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 8 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // 9 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // A + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // B + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // C + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // D + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, // E + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 // F + }; + + // Node name (anything but space \n \r \t / > ? \0) + template + const unsigned char lookup_tables::lookup_node_name[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, // 0 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 1 + 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Text (i.e. PCDATA) (anything but < \0) + template + const unsigned char lookup_tables::lookup_text[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 0 + 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, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Text (i.e. PCDATA) that does not require processing when ws normalization is disabled + // (anything but < \0 &) + template + const unsigned char lookup_tables::lookup_text_pure_no_ws[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 0 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 1 + 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Text (i.e. PCDATA) that does not require processing when ws normalizationis is enabled + // (anything but < \0 & space \n \r \t) + template + const unsigned char lookup_tables::lookup_text_pure_with_ws[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, // 0 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 1 + 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Attribute name (anything but space \n \r \t / < > = ? ! \0) + template + const unsigned char lookup_tables::lookup_attribute_name[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, // 0 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 1 + 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Attribute data with single quote (anything but ' \0) + template + const unsigned char lookup_tables::lookup_attribute_data_1[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 0 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 1 + 1, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Attribute data with single quote that does not require processing (anything but ' \0 &) + template + const unsigned char lookup_tables::lookup_attribute_data_1_pure[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 0 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 1 + 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Attribute data with double quote (anything but " \0) + template + const unsigned char lookup_tables::lookup_attribute_data_2[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 0 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 1 + 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Attribute data with double quote that does not require processing (anything but " \0 &) + template + const unsigned char lookup_tables::lookup_attribute_data_2_pure[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 0 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 1 + 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 2 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 3 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 4 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 5 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 6 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 7 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 8 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // 9 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // A + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // B + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // C + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // D + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, // E + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 // F + }; + + // Digits (dec and hex, 255 denotes end of numeric character reference) + template + const unsigned char lookup_tables::lookup_digits[256] = + { + // 0 1 2 3 4 5 6 7 8 9 A B C D E F + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // 0 + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // 1 + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // 2 + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,255,255,255,255,255,255, // 3 + 255, 10, 11, 12, 13, 14, 15,255,255,255,255,255,255,255,255,255, // 4 + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // 5 + 255, 10, 11, 12, 13, 14, 15,255,255,255,255,255,255,255,255,255, // 6 + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // 7 + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // 8 + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // 9 + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // A + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // B + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // C + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // D + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255, // E + 255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255 // F + }; + + // Upper case conversion + template + const unsigned char lookup_tables::lookup_upcase[256] = + { + // 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, A B C D E F + 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, // 0 + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, // 1 + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, // 2 + 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, // 3 + 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, // 4 + 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, // 5 + 96, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, // 6 + 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 123,124,125,126,127, // 7 + 128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143, // 8 + 144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159, // 9 + 160,161,162,163,164,165,166,167,168,169,170,171,172,173,174,175, // A + 176,177,178,179,180,181,182,183,184,185,186,187,188,189,190,191, // B + 192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,207, // C + 208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223, // D + 224,225,226,227,228,229,230,231,232,233,234,235,236,237,238,239, // E + 240,241,242,243,244,245,246,247,248,249,250,251,252,253,254,255 // F + }; + } + //! \endcond + +} + +// Undefine internal macros +#undef RAPIDXML_PARSE_ERROR + +// On MSVC, restore warnings state +#ifdef _MSC_VER + #pragma warning(pop) +#endif + +#endif diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt new file mode 100644 index 0000000..611becc --- /dev/null +++ b/src/CMakeLists.txt @@ -0,0 +1,74 @@ +# MIA - Mass Isotopolome Analyzer +# Copyright (C) 2012-15 Daniel Weindl +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as +# published by the Free Software Foundation, either version 3 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 Affero General Public License for more details. +# +# You should have received a copy of the GNU Affero General Public License +# along with this program. If not, see . + +find_package(Qt5Concurrent REQUIRED) +set(CMAKE_BUILD_TYPE Debug) + +set(SRC_LIST + ../alg/alglibinternal.cpp + ../alg/alglibmisc.cpp + ../alg/ap.cpp + ../alg/linalg.cpp + ../alg/specialfunctions.cpp + ../alg/statistics.cpp + config.h + labelingdataset.cpp + labelingnetworkset.cpp + miaexception.cpp + middistancecalculator.cpp + misc.cpp + networklayer.cpp + nodecompound.cpp + serializationqt.cpp + settings.cpp + utilities.cpp +) + +if(MIA_WITH_NETCDF_IMPORT) + set(SRC_LIST ${SRC_LIST} compounddetector.cpp) +endif() + + +set(CMAKE_BUILD_TYPE Debug) + +include_directories( + ${CMAKE_CURRENT_SOURCE_DIR} + ${CMAKE_CURRENT_BINARY_DIR} +) + +add_library(mia ${SRC_LIST}) + +qt5_use_modules(mia Core Concurrent) + + +if(MIA_WITH_METABOBASE) + target_link_libraries(mia ${POSTGRESQL_LIBRARY} ${METABOBASE_LIBRARY}) +endif() + +set (Boost_LIBRARIES + ${Boost_FILESYSTEM_LIBRARY_RELEASE} + ${Boost_REGEX_LIBRARY_RELEASE} + ${Boost_SYSTEM_LIBRARY_RELEASE} + ${Boost_IOSTREAMS_LIBRARY_RELEASE} +) + +target_link_libraries(mia + ${LabId_LIBRARY} + ${GCMS_LIBRARY} + ${Boost_LIBRARIES} + ${ZLIB_LIBRARIES} + ${GSL_LIBRARIES} +) diff --git a/src/compounddetector.cpp b/src/compounddetector.cpp new file mode 100644 index 0000000..15331cb --- /dev/null +++ b/src/compounddetector.cpp @@ -0,0 +1,135 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +/* Adapted from NTFD and MetaboliteDetector source code */ + +#include "compounddetector.h" + +#include +#include + +#include"gcmsanalyzer.h" +#include"gcmsmemoryscan.h" +#include"gcmsdiskscan.h" +#include"ricalculator.h" + + +CompoundDetector::CompoundDetector (const QString& file, gcms::AbstractPeakDetector* det, bool redetect ) + : + scan(0), + det ( det ), + //comps_returned(false), + file(file), + redetect(redetect) +{ +} + +CompoundDetector::~CompoundDetector () +{ + + /*if(!comps_returned){ + //delete compounds + for(std::vector*>::const_iterator it=comps.begin();it!=comps.end();++it) + { + delete *it; + } + comps.clear(); + }*/ +} + +void CompoundDetector::run() +{ + try + { + QFileInfo info(file); + QDir dir(info.absoluteDir()); + + std::cout<<"Redetect:"<* scan; + QFile f (file + ".bin"); //QFile f ( file +tr ( ".bin" ) ); + f.open ( QIODevice::ReadOnly ); + qint64 size=f.size(); + f.close(); + std::cout<<"INFORMATION: file size: "< ( file.toStdString().c_str()); + } + else + { + scan=new gcms::GCMSDiskScan ( file.toStdString().c_str() ); + std::cout<<"INFORMATION: Using GCMSDiskScan."<setBaselineCorrectionEnabled ( baseline ); + + gcms::GCMSAnalyzer an ( *scan, det ); + + an.detectAllPeaks ( true, 10, 0.05 ); //TODO: SETTINGS + an.deconvoluteChromatogram(); + comps=an.getCompounds(); + + QString file_out ( file ); + file_out+=".cmp"; + gcms::Compound::toDisk ( comps,file_out.toStdString().c_str() ); + + for ( std::vector* >::const_iterator it=comps.begin();it!=comps.end();++it ) + { + delete *it; + } + comps.clear(); + + if(scan) + { + delete scan; + } + } + catch ( ... ) + { + error= "Error detecting compounds " ; + } +} + +QString CompoundDetector::getFileName()const +{ + return file; +} + +std::vector*> CompoundDetector::getCompounds() +{ + // comps_returned=true; + return comps; +} + +QString CompoundDetector::getErrorMessage() const +{ + return error; +} + diff --git a/src/compounddetector.h b/src/compounddetector.h new file mode 100644 index 0000000..bb7cf95 --- /dev/null +++ b/src/compounddetector.h @@ -0,0 +1,57 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +/* Adapted from NTFD source code */ + +#ifndef COMPOUNDDETECTOR_H +#define COMPOUNDDETECTOR_H + +#include +#include + +#include + +#include"compound.h" +#include"gcmsdiskscan.h" +#include"abstractpeakdetector.h" + +class CompoundDetector +{ + //Q_OBJECT +public: + CompoundDetector (const QString& file, gcms::AbstractPeakDetector*, bool redetect); + ~CompoundDetector(); + + void run(); + QString getFileName()const; + QString getErrorMessage() const; + std::vector*> getCompounds(); + +private: + const gcms::GCMSDiskScan* scan; + gcms::AbstractPeakDetector* det; + bool baseline; + QString error; + std::vector*> comps; + // bool comps_returned; + QString file; + bool redetect; +}; + +#endif // COMPOUNDDETECTOR_H diff --git a/src/config.h b/src/config.h new file mode 100644 index 0000000..8dba3b7 --- /dev/null +++ b/src/config.h @@ -0,0 +1,51 @@ +#ifndef CONFIG_H +#define CONFIG_H + +#define STRINGIFY(str) # str +#define COMPOUND_GROUPING_FEATURE STRINGIFY(CMP_ID) + +namespace mia { + +// check settings.cpp + + +static const bool CMP_ID_USE_RI = true; /** use retention index */ +static const int CMP_ID_RI_TOL = 100; /** tolerance for retention index difference */ +static const double CMP_ID_SCORE_CUTOFF = 0.75; /** Cutoff for spectrum matching score */ + +static const double CMP_MATCHING_RI_TOL = 5; /** RI tolerance for peak matching different chromatograms */ +//TODO: to config +static const double CMP_MATCHING_SCORE_CUTOFF = 0.85; /** Spec score for peak matching different chromatograms */ + +static const double GCMS_PURE_FACTOR = 0.5; /** ... */ +static const double GCMS_IMPURE_FACTOR = 0.5; /** ... */ +static const std::string CMP_ID_LIBRARY = ""; /** MD library file */ + +static const int LABELS_MAX_HITS = 1; +static const bool LID_FILTER_BY_CONF_INTERVAL = true; // NTFD: hardcoded +static const double LID_MIN_SIGNAL_TO_NOISE = 5; // NTFD: hardcoded +static const double LID_REQUIRED_SPEC_FREQ = 0.75; // NTFD: hardcoded + +/*std::list > filter; +filter.push_back(std::make_pair(0,100)); +lid.setMassFilter(filter);*/ + +static const double LID_REQ_LABEL_AMOUNT = 0.05; +static const double LID_REQ_R2 = 0.95; +static const double LID_MIN_M0 = 0.0; +static const int LID_MIN_FRAG_NUM = 2; +// Removed in NTFD1.1 static const double LID_SENSITIVITY = 1/10000.0; // .0 !! +static const double LID_MAXIMAL_FRAG_DEV = 0.1; +static const double LID_CORRECTION_RATIO = 0.010934; // C tracer: correct for natural M+1 carbon abundance +static const int LID_MAX_MASS_ISOTOPOMER = 20; + +static const double NW_GAP_PENALTY = 0.2; // Gap penalty for needleman wunsch scoring +static const bool NW_EXCLUDE_M0 = false; +static const double MID_DISTANCE_CUTOFF = 0.0; /** distance threshold for network edges */ + +static const bool NW_USE_LARGEST_COMMON_ION = false; /** Use largest *common* ion of group for network, instead individual largest */ + +} + +#endif // CONFIG_H + diff --git a/src/labelingdataset.cpp b/src/labelingdataset.cpp new file mode 100644 index 0000000..0a57a23 --- /dev/null +++ b/src/labelingdataset.cpp @@ -0,0 +1,689 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "misc.h" + +#include +#include +#include +#include +#include + +#include +#include +#include +#include + +#include "librarysearch.h" +#include "libraryhit.h" +#include "gcmssettings.h" +#include "compound.h" + +#include "nodecompound.h" +#include "labelingdataset.h" +#include "utilities.h" + + + +namespace mia +{ + +/** + * @brief Default constructor using default settings. + */ +LabelingDataset::LabelingDataset() +{ + settings = Settings(); + lid = 0; + excludeLib = 0; +} + +/** + * @brief Constructor + * @param _settings Settings to be used for compound detection, ... + */ +LabelingDataset::LabelingDataset(Settings _settings) +{ + settings = _settings; + lid = 0; + excludeLib = 0; +} + +void LabelingDataset::setExcludeLib(gcms::LibrarySearch *_excludeLib) +{ + excludeLib = _excludeLib; +} + +bool LabelingDataset::isExcludedMetabolite(const gcms::Compound cmp) +{ + if(!excludeLib) + return false; + + gcms::GCMSSettings::LS_USE_RI = true; + gcms::GCMSSettings::LS_RI_DIFF = 100; // TODO: to config + + std::vector > hits = excludeLib->getLibraryHits(cmp); + + double mylibScoreCutoff = 0.92; // TODO: to config + + if(hits.size() && hits.at(0).getOverallScore() >= mylibScoreCutoff) { + return true; + } + + return false; +} + +std::vector LabelingDataset::fromXMLFile(std::string file) +{ + std::cout<<"Opening "< doc; + doc.parse<0>(xmldata); // 0 means default parse flags + + rapidxml::xml_node<> *nodeExperiments = doc.first_node("experiments"); + if(!nodeExperiments) throw MIAException("experiments"); + + Settings globalSettings; + globalSettings.cmp_id_mass_filter.insert(std::make_pair (0.0, 100.0)); + + rapidxml::xml_node<> *nodeGlobalSettings = nodeExperiments->first_node("globalsettings"); + if(nodeGlobalSettings) { + parseXMLSettings(nodeGlobalSettings, globalSettings); + } + + std::vector LabelingDatasets; + + for (rapidxml::xml_node<> *nodeExperiment = nodeExperiments->first_node("experiment"); nodeExperiment; nodeExperiment = nodeExperiment->next_sibling("experiment")) { + LabelingDataset *dataset = parseXMLExperiment(nodeExperiment, globalSettings, xmlDir); + LabelingDatasets.push_back(dataset); + } + + doc.clear(); + delete[] xmldata; + + return LabelingDatasets; +} + +void LabelingDataset::parseXMLSettings(rapidxml::xml_node<> *nodeSettings, Settings &s) +{ + for (rapidxml::xml_node<> *nodeParam = nodeSettings->first_node(); nodeParam; nodeParam = nodeParam->next_sibling()) { + + std::string param = nodeParam->name(); + + if(param == "cmp_id_library") { + s.cmp_id_library = parseXMLGetString(nodeParam); + if(!Utilities::fileExists(s.cmp_id_library)) { + std::cerr<<"Compound library "< *nodeExperiment, Settings settings, std::string curDir) +{ + rapidxml::xml_attribute<> *attr = nodeExperiment->first_attribute("name"); + if(!attr || !(settings.experiment = attr->value()).length()) { + std::stringstream ss; + ss< *nodeLocalSettings = nodeExperiment->first_node("localsettings"); + if(nodeLocalSettings) { + parseXMLSettings(nodeLocalSettings, settings); + } + + rapidxml::xml_node<> *nodeLabeledFiles = nodeExperiment->first_node("labeledfiles"); + if(nodeLabeledFiles) { + settings.labFiles = parseXMLFileSection(nodeLabeledFiles, true, curDir); + } + + rapidxml::xml_node<> *nodeUnlabeledFiles = nodeExperiment->first_node("unlabeledfiles"); + if(nodeUnlabeledFiles) { + settings.unlabFiles = parseXMLFileSection(nodeUnlabeledFiles, true, curDir); + } + + return new LabelingDataset(settings); +} + +std::vector LabelingDataset::parseXMLFileSection(rapidxml::xml_node<> *nodeFiles, bool reportNonExistance, std::string curDir) +{ + std::vector files; + + for (rapidxml::xml_node<> *nodeFile = nodeFiles->first_node("file"); nodeFile; nodeFile = nodeFile->next_sibling("file")) { + rapidxml::xml_attribute<> * attr = nodeFile->first_attribute("name"); + + if(!attr) + throw MIAException("experiments"); + + std::string fileName = attr->value(); + + if(fileName[0] != '/' || fileName[1] != ':') { // is absolute or relative path? + std::cout<<"Assuming relative path for "< *node, std::string attr, bool mandatory) +{ + rapidxml::xml_attribute<> *a = node->first_attribute(attr.c_str()); + + if(!a) { + std::stringstream ss; + ss<<"Attribute "<name()<value()); +} + +double LabelingDataset::parseXMLGetDouble(rapidxml::xml_node<> *node, std::string attr, bool mandatory) +{ + rapidxml::xml_attribute<> *a = node->first_attribute(attr.c_str()); + + if(!a) { + std::stringstream ss; + ss<<"Attribute "<name()<value(); + size_t ret = tmp.find_first_of('.'); + if(ret != std::string::npos) { + lconv *lconv = localeconv(); + tmp[ret] = *(lconv->decimal_point); + } + + return (float)atof(tmp.c_str()); +} + +bool LabelingDataset::parseXMLGetBool(rapidxml::xml_node<> *node, std::string attr, bool mandatory) +{ + rapidxml::xml_attribute<> *a = node->first_attribute(attr.c_str()); + + if(!a) { + std::stringstream ss; + ss<<"Attribute "<name()<value(); + if(val == "true" || val == "1") { + return true; + } else if(val == "false" || val == "0") { + return false; + } + std::cerr<<"Attribute "<name()<<": "< *node, std::string attr, bool mandatory) +{ + rapidxml::xml_attribute<> *a = node->first_attribute(attr.c_str()); + + if(!a) { + std::stringstream ss; + ss<<"Attribute "<name()<value(); +} + + +void LabelingDataset::removeScoresBelow() +{ + distsCut = removeScoresBelow(dists, 4); +} + + +std::vector > LabelingDataset::removeScoresBelow(std::vector > dists, double cutoff) { + std::vector > distsCut; + // apply cutoff i.e. filter out everything below + distsCut.resize(dists.size()); + for(int i = 0; i < distsCut.size(); ++i) { + distsCut[i].resize(dists[i].size()); + for(int j = 0; j < distsCut[i].size(); ++j) { + if(i == j) // diagonal + distsCut[i][j] = 1; + else if (i < j) // do only upper half + distsCut[i][j] = (dists[i][j] >= 5)?dists[i][j]:0; + } + } + + return distsCut; +} + + +std::vector > LabelingDataset::removeScoresAbove(std::vector > dists, double cutoff) { + std::vector > distsCut; + // apply cutoff i.e. filter out everything below + distsCut.resize(dists.size()); + for(int i = 0; i < distsCut.size(); ++i) { + distsCut[i].resize(dists[i].size()); + for(int j = 0; j < distsCut[i].size(); ++j) { + if(i == j) // diagonal + distsCut[i][j] = 1; + else if (i < j) // do only upper half + distsCut[i][j] = (dists[i][j] < cutoff)?dists[i][j]:0; + } + } + + return distsCut; +} + +/** + * @brief Normalize vector to highest intensity = 1. + * @param v Vector to normalize. + * @return The normalized vector. + */ +std::vector LabelingDataset::basePeakNormalization(const std::vector &v) +{ + double base = 0; + for(std::vector::const_iterator it = v.begin(); it != v.end(); ++it) { + base = std::max(base, *it); + } + + std::vector vv = v; + for(std::vector::iterator it = vv.begin(); it != vv.end(); ++it) { + *it /= base; + } +} + +/** + * @brief Write simple Dot-format file for graphviz visualization. + * + * @param mat Network matrix. Values > 0 represent nodes + * @param fname Output filename + * @param labs Node labels + */ +void LabelingDataset::distMatsToDot(std::vector > > distMats, std::string fname, std::vector labels) +{ + std::ofstream ofs; + std::cerr<<"writing " << fname< colors; + colors.push_back("blue"); + colors.push_back("red"); + colors.push_back("darkgreen"); + colors.push_back("orange"); + colors.push_back("pink"); + + ofs << "graph G {" << std::endl; + + // write edges for each matrix: + for(int t = 0; t < distMats.size(); ++t) { + // each tracer + std::vector > mat = distMats[t]; + for(int i = 0; i < mat[0].size(); ++i) { // row + for(int j = 0; j < mat.size(); ++j) { // col + if(mat[i][j] > 0 && j > i) { + // i--j [weight=..]; + double weight = 1 / mat[i][j]; + //double penwidth = log(1 / mat[i][j]) * 4 / distRange; // maxwidth 4 + //ofs << i << " -- " << j << " [weight=" << weight << ",penwidth=" << "1" <<"];" << std::endl; + ofs << i << " -- " << j << " [penwidth=" << "2" <<",label="<
"<
>,style=filled,fillcolor=\"#ACD9FF\","; + ofs << "];" << std::endl; + } + + ofs << "}" << std::endl; // close graph + ofs.close(); +} + +void LabelingDataset::distsOverviewHTML(std::string fname) { + std::ofstream ofs; + std::cerr<<"writing " << fname<\n\ndists\n\n\n"; + ofs << ""; + for(int i = 0; i < dists.size(); ++i) { + for(int j = 0; j < dists[i].size(); ++j) { + if(i >= j) continue; + ofs <<""<<"\n"; + } + } + ofs << "
"<"; + if(settings.nw_exclude_m0) { // skip M0 + ofs << nwHTML(basePeakNormalization(std::vector(&(mids[i][1]), &(mids[i][mids[i].size() - 1]))), + basePeakNormalization(std::vector(&(mids[j][1]), &(mids[j][mids[j].size() - 1]))), + settings.nw_gap_penalty, ofs + ); + } else { + ofs << nwHTML(mids[i], mids[j], settings.nw_gap_penalty, ofs); + } + + ofs <<"
"; + ofs << "\n"; +} + +// TODO: use middistancecalculator +void LabelingDataset::doScoring() +{ + // keep some stats on distances: + double dMin = 0; + double dMax = 0; + double dSum = 0; + + // calc needleman-wunsch scores + dists.resize(mids.size()); + for(int i = 0; i < dists.size(); ++i) { + dists[i].resize(mids.size()); + for(int j = 0; j < dists[i].size(); ++j) { + if(i == j) { // diagonal + dists[i][j] = 1; + } else if (i < j) { // do only upper half + if(settings.nw_exclude_m0) { // skip M0 + dists[i][j] = nw(basePeakNormalization(std::vector(&(mids[i][1]), &(mids[i][mids[i].size() - 1]))), + basePeakNormalization(std::vector(&(mids[j][1]), &(mids[j][mids[j].size() - 1]))), + settings.nw_gap_penalty + ); + } else { + dists[i][j] = nw(mids[i], mids[j], settings.nw_gap_penalty); + } + // stats + dMin = dists[i][j] < dMin ? dists[i][j] : dMin; + dMax = dists[i][j] > dMax ? dists[i][j] : dMax; + dSum += dists[i][j]; + } + } + } + // problem: nw scores not comparable... + // normalize by score / meanlength? + // use euclidean distance after alignment? + std::cerr<< "Distances ("<setMaximumLabel(1.0 - settings.lid_min_m0); + lid->setEnsureM0PresenceInLabeledSpec(true); + lid->setEnsureM1LessThanM0(true); + lid->setFragmentDetectionPlateauTolerance(1.1); + lid->setMaxMMinusOne(0.25); + lid->setMinimumM1(0.01); + if(listener) + lid->setProgressListener(listener); + + // DW: No TMS-O-TMS, no < 80 + std::list > filter; + filter.push_back(std::pair(0, 80)); + filter.push_back(std::pair(147, 147)); + lid->setMassFilter(filter); + + /* LabelIdentificator Settings */ + lid->setFilterByConfidenceInterval(settings.lid_filter_by_conf_interval); + lid->setMinimalSN(settings.lid_min_signal_to_noise); + lid->setRequiredSpectrumFrequency(settings.lid_required_spec_freq); + // TODO lid->setMassFilter(settings.lid_mass_filter);*/ + lid->setRequiredLabelAmount(settings.lid_req_label_amount); + lid->setRequiredR2(settings.lid_req_label_amount); + lid->setMinimalNumberOfFragments(settings.lid_min_frag_num); + lid->setMaximalFragmentDeviation(settings.lid_maximal_frag_dev); + lid->setCorrectionRatio(settings.lid_correction_ratio); + /* LabelIdentificator Settings */ + + lid->startAnalysis(); + + cmpLab = lid->getLabeledCompounds(); + cmpUnlab = lid->getUnlabeledCompounds(); + + // Set nicer compound names + for(std::vector::iterator it = cmpLab.begin(); it != cmpLab.end(); ++it) { + labid::LISpectrum* cmp = *it; + std::stringstream ss; + ss.precision(6); + if(cmp->getRetentionIndex() > 0) + ss<<"Unidentified RI"<getRetentionIndex(); + else + ss<<"Unidentified RT"<<(cmp->getRetentionTime() / 1000.0 / 60.0); + cmp->setName(ss.str()); + } + for(std::vector::iterator it = cmpUnlab.begin(); it != cmpUnlab.end(); ++it) { + labid::LISpectrum* cmp = *it; + std::stringstream ss; + ss.precision(6); + if(cmp->getRetentionIndex() > 0) + ss<<"Unidentified RI"<getRetentionIndex(); + else + ss<<"Unidentified RT"<<(cmp->getRetentionTime() / 1000.0 / 60.0); + cmp->setName(ss.str()); + } + + std::cout<<"Finished label detection thread.\n"; +} + +/** + * @brief Match compounds against a library. + * @param comps Compounds to match + * @param settings Settings for spectrum matching including library path. + * @return Compounds with name set according to identification. + */ +std::vector *> LabelingDataset::identifyCompounds(std::set *> comps, mia::Settings settings) { + // gcms settings for identification (mapCompoundsToLibrary overrides LS_CUTOFF + gcms::GCMSSettings::LS_USE_RI = settings.cmp_id_use_ri; + gcms::GCMSSettings::LS_RI_DIFF = settings.cmp_id_ri_tol; + gcms::GCMSSettings::LS_PURE_FACTOR = settings.gcms_pure_factor; + gcms::GCMSSettings::LS_IMPURE_FACTOR = settings.gcms_impure_factor; + gcms::GCMSSettings::LS_MASS_FILTER = settings.cmp_id_mass_filter; + + // Library matching + std::cout<<"Loading library: "< *lib(gcms::LibrarySearch::fromDisk(settings.cmp_id_library.c_str())); + std::vector *> compsV; + + for(std::set* >::iterator it = comps.begin(); it != comps.end(); ++it) { + + gcms::Compound *cmp = *it; + std::vector > hits = lib->getLibraryHits(*cmp); + + std::stringstream ss; + + int hitCount = settings.labels_max_hits; // how many possible identifications are already appended? + + for (std::vector >::const_iterator hitIt = hits.begin(); hitIt != hits.end() && hitCount--; ++hitIt) { + + if(hitIt->getOverallScore() < settings.cmp_id_score_cutoff) break; + + // copy features from best hit (need e.g. KEGG ids later) + if(hitIt == hits.begin()) { + std::map libFeatures = hitIt->getLibraryCompound()->getFeatures(); + libFeatures.insert(cmp->getFeatures().begin(), cmp->getFeatures().end()); // preserve previously set features + cmp->setFeatures(libFeatures); + } + + ss<getLibraryCompound()->getName()<<"("<getOverallScore()<<")"; +#define LabelingDataset_H_DBG_CMP_ID +#ifdef LabelingDataset_H_DBG_CMP_ID + std::cout<<"ID"<getFeature(COMPOUND_GROUPING_FEATURE)<<" identified as " + <getLibraryCompound()->getName()<<"("<getOverallScore()<<")" << + hitIt->getRISimilarityScore() << " " << hitIt->getSpectrumSimilarityScore()<getRetentionIndex(); + } + cmp->setName(ss.str()); + +#ifdef LabelingDataset_H_DBG_CMP_ID + std::cout<getRetentionIndex()<<" "<getFeature(COMPOUND_GROUPING_FEATURE)<<" "<getName()< > mids, std::vector names, std::string fname) { + if(mids.size() != names.size()) { + std::cerr<<"Error: Size mismatch\n"; + return; + } + + std::ofstream ofs; + ofs.open(fname.c_str()); + for(int i = 0; i < mids.size(); ++i) {// compounds + std::vector mid = mids[i]; + for(int j = 0; j < mid.size(); ++j) { // isotopomers + ofs << "\""<< names[i] << "\","; + ofs << "\""<< j << "\","; + ofs << "\"" << mid[j] << "\","; + ofs << std::endl; + } + } + ofs.close(); +} + +/** + * @brief Returns the current Settings. + * @return Settings + */ +const Settings &LabelingDataset::getSettings() const +{ + return settings; +} + +/** + * @brief Set new settings. + * @param s Settings + */ +void LabelingDataset::setSettings(Settings s) +{ + settings = s; +} + +} diff --git a/src/labelingdataset.h b/src/labelingdataset.h new file mode 100644 index 0000000..27a807b --- /dev/null +++ b/src/labelingdataset.h @@ -0,0 +1,126 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef LABELINGDATASET_H +#define LABELINGDATASET_H + +#include +#include + +#include "labelidentificator.h" + +#include "labelingdataset.h" +#include "miaexception.h" +#include "settings.h" +#include "config.h" + +#include "../rapidxml/rapidxml.hpp" + +namespace mia +{ + +// class MyLabelIdentificator ? +// TODO: select / deselect detected ions: unselect on filtering, do not remove +// +// Wrap in FilteredLabelingDataset for use with multiple views? +// LabelingDataset(labid::LabelIdentificator) +// LabelingDataset(textfile?) + +class LabelingDataset; + +/** + * @brief The LabelingDataset detects labeled compounds from labeled and unlabeled reference spectra based on the labid::LabelIdentificator class. + * It calculates MID similarities and holds the distance matrices, allows for redetection of given ions. + */ + +class LabelingDataset +{ + +public: + + LabelingDataset(); + LabelingDataset(Settings); + + // TODO getNearestNeighborGraph + + void setExcludeLib(gcms::LibrarySearch *excludeLib); + bool isExcludedMetabolite(const gcms::Compound cmp); + + static std::vector fromXMLFile(std::string file); + + void removeScoresBelow(); + + static std::vector > removeScoresBelow(std::vector > dists, double cutoff); + + static std::vector > removeScoresAbove(std::vector > dists, double cutoff); + + static std::vector basePeakNormalization(const std::vector &v); + + static void distMatsToDot(std::vector > > distMats, std::string fname, std::vector labels); + + void distsOverviewHTML(std::string fname); + + void doScoring(); + + void findLabeledCompounds(labid::LabelIdentificatorProgressListener *listener = 0); + + void saveMIDsCsv(std::vector > mids, std::vector names, std::string fname); + + void fetchLabeledCompoundsFromDB(int id, std::vector< labid::LabeledCompound*> &lcs); + + labid::LabelIdentificator * getLabelIdentificator() {return lid;} + + //void identifyLabeledCompounds(); + static std::vector *> identifyCompounds(std::set *>, Settings settings); + + const Settings &getSettings() const; + void setSettings(Settings s); + + friend QDataStream &operator << (QDataStream &out, const LabelingDataset*); + friend QDataStream &operator >> (QDataStream &in, LabelingDataset*&) throw(DeserializationException); + + std::vector cmpLab; /**< Detected labeled compounds. */ + std::vector cmpUnlab; /**< Detected unlabeled compounds. */ + std::vector > dists; /**< Distance matrix. */ + std::vector > distsCut; /**< Adjacency matrix. (Distance matrix after cutoff applied. */ + + std::vector > mids; /**< Selected fragment MIDs for network. */ + std::vector > midsAll; /**< All MIDs for debug. */ + std::vector nodeLabs; /**< Labels for network nodes. Compound names if library matching was done. */ + std::vector nodeLabsAll; /**< All labels for debug. */ + +protected: + Settings settings; /**< Settings for the compound detection and distance calculation, ... */ + labid::LabelIdentificator *lid; /**< The LabelIdentificator object used for labeled compound detection. */ + +private: + // TODO: move xml functions to mia::Settings + static void parseXMLSettings(rapidxml::xml_node<> *nodeSettings, Settings &s); + static LabelingDataset *parseXMLExperiment(rapidxml::xml_node<> *nodeExperiment, Settings settings, std::string curDir = ""); + static std::vector parseXMLFileSection(rapidxml::xml_node<> *nodeFiles, bool reportNonExistance = false, std::string curDir = ""); + static int parseXMLGetInt(rapidxml::xml_node<> *node, std::string attr = "value", bool mandatory = true); + static double parseXMLGetDouble(rapidxml::xml_node<> *node, std::string attr = "value", bool mandatory = true); + static bool parseXMLGetBool(rapidxml::xml_node<> *node, std::string attr = "value", bool mandatory = true); + static std::string parseXMLGetString(rapidxml::xml_node<> *node, std::string attr = "value", bool mandatory = true); + + gcms::LibrarySearch *excludeLib; +}; + +} +#endif // LABELINGDATASET_H diff --git a/src/labelingnetworkset.cpp b/src/labelingnetworkset.cpp new file mode 100644 index 0000000..ce8f395 --- /dev/null +++ b/src/labelingnetworkset.cpp @@ -0,0 +1,709 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include +#include "labelingnetworkset.h" +#include "misc.h" + +namespace mia { + +MIDDistanceCalculator *LabelingNetworkSet::distCalc = 0; + +LabelingNetworkSet::LabelingNetworkSet() +{ + excludeM0 = 0; +} + +LabelingNetworkSet::~LabelingNetworkSet() +{ + for(int i = 0; i < nodes.size(); ++i) { + delete nodes[i]; + } + + for(int i = 0; i < datasets.size(); ++i) { + delete datasets[i]; + } +} + +void LabelingNetworkSet::exportMIDs(QTextStream &qout) +{ + std::stringstream out; + std::string sep = ","; + std::string quote = "\""; + + // header + out<<"Metabolite"<getSettings().experiment; + if(ds) + out<getSettings().experiment; + if(nc->hasDataForExperiment(t)) { + midLen = std::max(midLen, (int) (nc->getSelectedMID(t).size())); + } + } + + // ri + double ri = 0; + double riCount = 0; + for(int ds = 0; ds < datasets.size(); ++ds) { // each experiment + std::string t = datasets[ds]->getSettings().experiment; + if(nc->hasDataForExperiment(t)) { + ri += nc->getLabeledCompound(t)->getRetentionIndex(); + ++riCount; + } + } + + ri /= riCount; + + + std::stringstream ions; + + for(int ds = 0; ds < datasets.size(); ++ds) { // each experiment + std::string t = datasets[ds]->getSettings().experiment; + double ion = 0; + + if(nc->hasDataForExperiment(t)) + ion = nc->getSelectedIon(t); + + ions << ion << " "; + } + + // abundance + for(int i = 0; i < midLen; ++i) { + out<getCompoundName()<getSettings().experiment; + std::vector mid; + if(nc->hasDataForExperiment(t)) + mid = nc->getSelectedMID(t); + + if(ds) + out< i ? mid[i] : 0); + } +// out<getANOVAPvalueForMassIsotopomer(i); + out<isVisible()) + continue; + + std::string t = datasets[ds]->getSettings().experiment; + std::vector > dists = distMats[t]; + + for(int j = n + 1; j < dists[n].size(); ++j) { // second node + if(!std::isnan(dists[n][j]) && dists[n][j] <= datasets[ds]->getSettings().mid_distance_cutoff) { + connected = true; + break; + } + } + + for(int i = n - 1; i >= 0; --i) { // second node + if(!std::isnan(dists[i][n]) && dists[i][n] <= datasets[ds]->getSettings().mid_distance_cutoff) { + connected = true; + break; + } + } + + } + + return connected; +} + + +/** + Create distance matrix map with the different tracers from the nodes vector +*/ + +void LabelingNetworkSet::createDistanceMatrices() +{ + std::cout<<"Creating distance matrics... number of nodes: "<< nodes.size()<getSettings().nw_gap_penalty != datasets[ds - 1]->getSettings().nw_gap_penalty) { + if(ds) { + delete LabelingNetworkSet::distCalc; + } + LabelingNetworkSet::distCalc = new MIDDistanceCalculator(datasets[ds]->getSettings().nw_gap_penalty); // TODO reuse if same gap penalty + } + + std::string t = datasets[ds]->getSettings().experiment; + std::cout<<"### t = "< > dists; + // calc needleman-wunsch scores + dists.resize(nodes.size()); + + int n1 = 0; + for(QMap::iterator it1 = nodes.begin(); it1 != nodes.end(); ++it1) { + dists[n1].resize(dists.size()); + + NodeCompound *node1 = it1.value(); + std::vector mid1 = std::vector(); + if(node1->hasDataForExperiment(t)) { + mid1 = node1->getSelectedMID(t); + } + + int n2 = 0; + for(QMap::iterator it2 = nodes.begin(); it2 != nodes.end(); ++it2) { + NodeCompound *node2 = it2.value(); + std::vector mid2 = std::vector(); + if(node2->hasDataForExperiment(t)) { + mid2 = node2->getSelectedMID(t); + } + if(n1 == n2) { // diagonal + dists[n1][n2] = 1; + } else if (n1 < n2) { // do only upper half + if(mid1.size() && mid2.size()) { + double dist = getDistance(mid1, mid2, excludeM0); + +#ifdef MIAMAINWINDOW_H_ENABLE_ZSCORE + if(useZScore->checkState() == Qt::Checked) { + dist = distCalc->getMonteCarloZScore(dist, mid1.size(), mid2.size()); + } +#endif + + dists[n1][n2] = dist; + + // stats + dMin = dist < dMin ? dist : dMin; + dMax = dist > dMax ? dist : dMax; + dSum += dist; + } else { + dists[n1][n2] = std::numeric_limits::infinity(); + } + } + ++n2; + } + ++n1; + } + double dMean = dSum / (dists.size() * (dists.size() - 1)); + std::cout<<"Using "<distanceMeasure<<" / "<distanceNormalization<(dMin, dMax); + } + + std::cout<<"Done creating distance matrics..."< mylib; + + for(int tracerID = 0; tracerID < datasets.size(); ++tracerID){ + + mia::NetworkLayer *ds = datasets[tracerID]; + + for(std::vector::iterator it = ds->cmpLab.begin(); it != ds->cmpLab.end(); ++it) { + + labid::LabeledCompound* lc = *it; + NodeCompound::filterMIDs(*lc, ds->getSettings()); + + if(!lc->getLabeledIons().size()) + continue; // skip if no proper label detected + + // check exclude lib + if(ds->isExcludedMetabolite(*lc)) { + std::cout<<"Excludelib match: RI"<getRetentionTime()<* matchingCompound = 0; + + if(tracerID > 0) { + // check if compounds already there, otherwise add to library + std::vector > hits = mylib.getLibraryHits(*lc); + + if(hits.size() && hits.at(0).getOverallScore() >= mylibScoreCutoff) { + // already there, make association + matchingCompound = hits.at(0).getLibraryCompound(); + int prevID = atoi(matchingCompound->getFeature(COMPOUND_GROUPING_FEATURE).c_str()); + NodeCompound* prevNode = nodes[prevID]; + // but check that no other association made before for this experiment + // TODO: first check if others match better? + if(prevNode->hasDataForExperiment(ds->getSettings().experiment)) { + matchingCompound = 0; // add as new + } else { + prevNode->addLabeledCompound(ds->getSettings().experiment, lc); + } + } + } + + if(!matchingCompound) { + // first tracer or not yet in library -> add new + + // set unique ID as feature + std::stringstream s; + s<addFeature(COMPOUND_GROUPING_FEATURE, s.str().c_str()); + + mylib.addCompound(*lc, ds->getSettings().experiment); + + std::string compoundName = lc->getName(); + nodes[cmpID] = new NodeCompound(compoundName); + nodes[cmpID]->setUseLargestCommonIon(useLargestCommonIon); + nodes[cmpID]->addLabeledCompound(ds->getSettings().experiment, lc); + nodes[cmpID]->addFeature(COMPOUND_GROUPING_FEATURE, s.str()); + ++cmpID; + } + } + } + std::cout<<"Detected "< datasetMap; + for(int i = 0; i < datasets.size(); ++i) { + datasetMap[datasets[i]->getSettings().experiment] = i; + } + + foreach (NodeCompound *nc, nodes) { + nc->redetectFragments(); + std::vector exps = nc->getExperiments(); + + for(std::vector::iterator it = exps.begin(); it != exps.end(); ++it) { + labid::LabeledCompound *lc = nc->getLabeledCompound(*it); + NodeCompound::filterMIDs(*lc, datasets[datasetMap[*it]]->getSettings()); + if(!lc->getLabeledIons().size()) { + nc->removeLabeledCompound(lc); + } + } + } + +} + +void LabelingNetworkSet::filterAndReIndexNodeCompounds() +{ + std::cout<<"Filtering..."< nodesOld = nodes; + nodes.clear(); + + int i = 0; // assign continuous keys to be compatible with distance matrix indexes. Why used map in the first place? + for(QMap::iterator it = nodesOld.begin(); it != nodesOld.end(); ++it) { + + if((*it)->getExperiments().size()) { + nodes[i] = it.value(); + + std::vector exps = nodes[i]->getExperiments(); + + for(int e = 0; e < exps.size(); ++e) { + labid::LabeledCompound *lc = nodes[i]->getCompound(exps[e]); + lc->addFeature(COMPOUND_GROUPING_FEATURE, std::to_string(i)); + } + nodes[i]->addFeature(COMPOUND_GROUPING_FEATURE, std::to_string(i)); + i++; + } else { + std::cout<<"Remove compound with no labeled fragments: "<< (it.value())->getCompoundName()<isVisible()) + continue; + + std::string t = datasets[ds]->getSettings().experiment; + std::vector > dists = distMats[t]; + for(int i = 0; i < dists.size(); ++i) { // first node + + if(excludeIfFoundInLessExperiments > 1 && nodes[i]->getExperiments().size() < excludeIfFoundInLessExperiments) + continue; + if(datasets.size() > 1 && nodes[i]->getMaxIsotopomerSD() < variationCutoff) + continue; + + for(int j = i + 1; j < dists[i].size(); ++j) { // second node + if(excludeIfFoundInLessExperiments > 1 && nodes[j]->getExperiments().size() < excludeIfFoundInLessExperiments) + continue; + if(datasets.size() > 1 && nodes[j]->getMaxIsotopomerSD() < variationCutoff) + continue; + if(dists[i][j] <= datasets[ds]->getSettings().mid_distance_cutoff) + ++e; + } + } + } + + return e; +} + +void LabelingNetworkSet::matchCompoundsAgainstLibrary(QString libFile, bool overwriteNames) +{ + if(!datasets.size() || ! nodes.size()) + return; // nothing to do + + // Identify compounds from library and set names to @node and @LabeledCompound + std::cout<<"Identifying "<getSettings(); + if(libFile.length()) + s.cmp_id_library = libFile.toStdString(); + + // gcms settings for identification (mapCompoundsToLibrary overrides LS_CUTOFF + gcms::GCMSSettings::LS_USE_RI = s.cmp_id_use_ri; + gcms::GCMSSettings::LS_RI_DIFF = s.cmp_id_ri_tol; + gcms::GCMSSettings::LS_PURE_FACTOR = s.gcms_pure_factor; + gcms::GCMSSettings::LS_IMPURE_FACTOR = s.gcms_impure_factor; + gcms::GCMSSettings::LS_MASS_FILTER = s.cmp_id_mass_filter; + + // Library matching + gcms::LibrarySearch *lib; + std::cout<<"Loading library: "<::fromDisk(s.cmp_id_library.c_str()); + std::cout<<"done."<(); + std::cout<<"failed."< exps = nc->getExperiments(); + std::string label; + + for(int i = 0; i < exps.size(); ++i) { + if(i == 0) { + label = generateCompoundLabel(nc->getLabeledCompound(exps[i]), lib, s); + + // keep old label if no match in new lib + if(!overwriteNames && label.substr(0, 8) == "UNIDENTIFIED") + break; + + nc->setCompoundName(label); + // copy new features from identification + nc->addFeature("PRECURSOR_KEGG_ID", nc->getCompound(exps[i])->getFeature("PRECURSOR_KEGG_ID")); + } + nc->getCompound(exps[i])->setName(label); + } + } + + delete lib; + + std::cout<<"Done identifying."< *cmp, gcms::LibrarySearch *lib, Settings const &settings) +{ + gcms::GCMSSettings::LS_USE_RI = gcms::GCMSSettings::LS_USE_RI && (cmp->getRetentionIndex() > 0); + + std::vector > hits = lib->getLibraryHits(*cmp); + + std::stringstream ss; + + int hitCount = settings.labels_max_hits; // how many possible identifications are already appended? + + for (std::vector >::const_iterator hitIt = hits.begin(); hitIt != hits.end() && hitCount--; ++hitIt) { + + if(hitIt->getOverallScore() < settings.cmp_id_score_cutoff) + break; + + // copy features from best hit (need e.g. KEGG ids later) + if(hitIt == hits.begin()) { + // preserve previously set features + //std::map libFeatures = hitIt->getLibraryCompound()->getFeatures(); + //libFeatures.insert(cmp->getFeatures().begin(), cmp->getFeatures().end()); + // overwrite old features + std::map libFeatures = cmp->getFeatures(); + libFeatures.insert(hitIt->getLibraryCompound()->getFeatures().begin(), hitIt->getLibraryCompound()->getFeatures().end()); + cmp->setFeatures(libFeatures); + } + + ss.precision(4); + ss<getLibraryCompound()->getName()<<"("<getOverallScore()<<")"; + } + + if(!ss.str().length()){ + ss.precision(6); + if(cmp->getRetentionIndex() > 0) + ss<<"UNIDENTIFIED RI "<getRetentionIndex(); + else + ss<<"UNIDENTIFIED RT "<getRetentionTime() / 1000.0 / 60.0; // RT in ms->min + } + + return ss.str(); +} + + +std::vector LabelingNetworkSet::getEdges(int excludeIfFoundInLessExperiments, double variationCutoff) +{ + std::vector edges; + + for(int ds = 0; ds < datasets.size(); ++ds) { // each experiment + + // Include this layer? + if(!datasets[ds]->isVisible()) + continue; + + std::string t = datasets[ds]->getSettings().experiment; + std::vector > dists = distMats[t]; + + for(int i = 0; i < dists.size(); ++i) { // first node + + if(excludeIfFoundInLessExperiments > 1 && nodes[i]->getExperiments().size() < excludeIfFoundInLessExperiments) { + continue; + } + + if(datasets.size() > 1 && nodes[i]->getMaxIsotopomerSD() < variationCutoff) + continue; + + + for(int j = i + 1; j < dists[i].size(); ++j) { // second node + + if(excludeIfFoundInLessExperiments > 1 && nodes[j]->getExperiments().size() < excludeIfFoundInLessExperiments) { + continue; + } + + if(datasets.size() > 1 && nodes[j]->getMaxIsotopomerSD() < variationCutoff) + continue; + + if(std::isnan(dists[i][j]) || dists[i][j] > datasets[ds]->getSettings().mid_distance_cutoff) + continue; + + LabelingDatasetEdge *e = new LabelingDatasetEdge(); + e->datasetIndex = ds; + e->node1 = nodes[i]; + e->node2 = nodes[j]; + e->distance = dists[i][j]; + edges.push_back(e); + } + } + } + return edges; +} + +std::map LabelingNetworkSet::getNodesInGraph(bool showUnconnectedNodes, bool hideLessVarying, double variationCutoff, bool hideFoundInLessExperiments, int excludeIfFoundInLessExperiments) +{ + std::map visNodes; + + for(int n = 0; n < nodes.size(); ++n) { + + if(!showUnconnectedNodes && !nodeHasEdges(n)) { + continue; // not show if node has no edges + } + + NodeCompound *nc = nodes[n]; + + double variation = nc->getMaxIsotopomerSD(); + + if(datasets.size() > 1 && hideLessVarying && variation < variationCutoff) + continue; + + if(datasets.size() > 1 && hideFoundInLessExperiments && nodes[n]->getExperiments().size() < excludeIfFoundInLessExperiments) + continue; + + visNodes[n] = nc; + } + + return visNodes; +} + + +void LabelingNetworkSet::getMinMaxDistances(double &overallMin, double &overallMax) +{ + // collect distance info for edge line scaling + overallMin = std::numeric_limits::max(); + overallMax = 0; + + std::vector > minDistances(distMats[datasets[0]->getSettings().experiment]); + std::vector > maxDistances(distMats[datasets[0]->getSettings().experiment]); + for(int i = 0; i < minDistances.size(); ++i) { + minDistances[i] = std::vector(minDistances.size(), std::numeric_limits::max()); + maxDistances[i] = std::vector(minDistances.size(), 0); + } + + for(int ds = 0; ds < datasets.size(); ++ds) { // each experiment + + // Include this layer? + if(!datasets[ds]->isVisible()) + continue; + + std::string t = datasets[ds]->getSettings().experiment; + std::vector > &dists = distMats[t]; + + for(int i = 0; i < dists.size(); ++i) { // first node + + for(int j = i + 1; j < dists[i].size(); ++j) { // second node + + if(std::isnan(dists[i][j]) || dists[i][j] > datasets[ds]->getSettings().mid_distance_cutoff) + continue; + + minDistances[i][j] = std::min(minDistances[i][j], dists[i][j]); + maxDistances[i][j] = std::max(maxDistances[i][j], dists[i][j]); + + overallMin = std::min(overallMin, dists[i][j]); + overallMax = std::max(overallMax, dists[i][j]); + } + } + } + +} + +QMap LabelingNetworkSet::getNodeCompounds() const +{ + return nodes; +} + +void LabelingNetworkSet::setUseLargestCommonIon(bool newUseCommonIon) +{ + // Need to tell NodeCompounds + foreach (NodeCompound* c, nodes.values()) { + c->setUseLargestCommonIon(newUseCommonIon); + } +} + +QList LabelingNetworkSet::getDatasets() +{ + return datasets; +} + +NetworkLayer *LabelingNetworkSet::getDataset(int idx) +{ + return datasets[idx]; +} + +void LabelingNetworkSet::addDataset(NetworkLayer *ds) +{ + datasets.push_back(ds); +} + +int LabelingNetworkSet::getSize() +{ + return datasets.size(); +} + +void LabelingNetworkSet::removeDataset(NetworkLayer *ds) +{ + datasets.removeOne(ds); + createDistanceMatrices(); +} + +void LabelingNetworkSet::removeAllDatasets() +{ + qDeleteAll(datasets); + datasets.clear(); +} + +void LabelingNetworkSet::setDistanceCutoff(double cutoff) +{ + for(int ds = 0; ds < datasets.size(); ++ds) { + Settings s = datasets[ds]->getSettings(); + s.mid_distance_cutoff = cutoff; + datasets[ds]->setSettings(s); + } +} + +void LabelingNetworkSet::setRelativeDistanceCutoff(double cutoff) +{ + for(int ds = 0; ds < datasets.size(); ++ds) { + Settings s = datasets[ds]->getSettings(); + std::pair distRange = distRanges[s.experiment]; + double min = distRange.first; + double max = distRange.second; + double newCutoff = min + cutoff / 100.0 * (max - min); + std::cout<<"Set '"<setSettings(s); + } +} + +void LabelingNetworkSet::setExcludeM0(int excludeM0) +{ + if(this->excludeM0 != excludeM0) { + this->excludeM0 = excludeM0; + createDistanceMatrices(); + } +} + +double LabelingNetworkSet::getDistance(std::vector mid1, std::vector mid2, int excludeM0) +{ + switch(excludeM0) { + case 1: + return distCalc->getMIDDistance(std::vector(&(mid1[1]), &(mid1[mid1.size()])), + std::vector(&(mid2[1]), &(mid2[mid2.size()]))); + case 2: + return distCalc->getMIDDistance(basePeakNormalization(std::vector(&(mid1[1]), &(mid1[mid1.size()]))), + basePeakNormalization(std::vector(&(mid2[1]), &(mid2[mid2.size()])))); + case 3: + return distCalc->getMIDDistance(sumNormalization(std::vector(&(mid1[1]), &(mid1[mid1.size()]))), + sumNormalization(std::vector(&(mid2[1]), &(mid2[mid2.size()])))); + default: + return distCalc->getMIDDistance(mid1, mid2); + //dist = distCalc->getMIDDistance(basePeakNormalization(mid1), basePeakNormalization(mid2)); + } +} + +} diff --git a/src/labelingnetworkset.h b/src/labelingnetworkset.h new file mode 100644 index 0000000..66551e8 --- /dev/null +++ b/src/labelingnetworkset.h @@ -0,0 +1,121 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef LABELINGNETWORKSET_H +#define LABELINGNETWORKSET_H + +#include +#include +#include + +#include "nodecompound.h" +#include "networklayer.h" +#include "middistancecalculator.h" + +namespace mia { + +class LabelingDatasetEdge { +public: + int datasetIndex; + NodeCompound *node1; + NodeCompound *node2; + double distance; +}; + + +/** + * @brief The LabelingNetworkSet class holds several LabelingDatasets, matches all compounds across these datasets, invokes reanalysis of undetected + * labeled fragments and manages the overlay of compound networks in its LabelingDatasets. + */ +class LabelingNetworkSet : public QObject +{ + Q_OBJECT + +public: + // TODO: refactor: subclass Labelidentificator + // addLabelingNetwork(); + // setActive(tracer); + // getGraph() // as dot? + + LabelingNetworkSet(); + ~LabelingNetworkSet(); + + void exportMIDs(QTextStream &qout); + + bool nodeHasEdges(int n); + + void createDistanceMatrices(); /** Setup the distance matrices */ + + void matchCompoundsAcrossExperiments(double mylibScoreCutoff, bool useLargestCommonIon); + + void redetectAllIons(); + + void filterAndReIndexNodeCompounds(); + + int getNumberOfEdges(double variationCutoff, int excludeIfFoundInLessExperiments); + + void matchCompoundsAgainstLibrary(QString libFile, bool overwriteNames); + + std::string generateCompoundLabel(gcms::Compound *cmp, gcms::LibrarySearch *lib, Settings const &settings); + + std::vector getEdges(int excludeIfFoundInLessExperiments, double variationCutoff); + + std::map getNodesInGraph(bool showUnconnectedNodes, + bool hideLessVarying, double variationCutoff, + bool hideFoundInLessExperiments, int excludeIfFoundInLessExperiments + ); + + void getMinMaxDistances(double &overallMin, double &overallMax); + + QMap getNodeCompounds() const; + + void setUseLargestCommonIon(bool newUseCommonIon); + + QList getDatasets(); + NetworkLayer* getDataset(int idx); + void addDataset(NetworkLayer *ds); + + int getSize(); + + void removeDataset(NetworkLayer *ds); + void removeAllDatasets(); + + void setDistanceCutoff(double cutoff); + void setRelativeDistanceCutoff(double cutoff); + + void setExcludeM0(int excludeM0); + + double getDistance(std::vector mid1, std::vector mid2, int excludeM0); + + static MIDDistanceCalculator *distCalc; + +signals: + +public slots: + +private: + std::map > > distMats; /** Distance matrices */ + QMap nodes; /** All the different compounds found in any experiment, index is the ID-feature of the compound */ + QList datasets; /** The "raw" data from the different experiments */ + std::map > distRanges; /** Distance matrices (min, max) */ + int excludeM0; +}; + +} +#endif // LABELINGNETWORKSET_H diff --git a/src/miaexception.cpp b/src/miaexception.cpp new file mode 100644 index 0000000..4e77d8f --- /dev/null +++ b/src/miaexception.cpp @@ -0,0 +1,52 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "miaexception.h" + +namespace mia { + +/** + * @brief Standard constructor with default error message. + */ +MIAException::MIAException() +{ + std::cerr<<"LabelingDatasetException: "< + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef MIAEXCEPTION_H +#define MIAEXCEPTION_H + +#include +#include + +namespace mia { + +/** + * @brief Exception class. + */ +class MIAException : public std::exception +{ +public: + MIAException(); + MIAException(std::string); +}; + +class DeserializationException : public MIAException +{ +public: + DeserializationException(); + DeserializationException(std::string e); +}; + +} +#endif // MIAEXCEPTION_H diff --git a/src/middistancecalculator.cpp b/src/middistancecalculator.cpp new file mode 100644 index 0000000..a8cd280 --- /dev/null +++ b/src/middistancecalculator.cpp @@ -0,0 +1,375 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include +#include +#include + +#include + +#include "alg/ap.h" +#include "alg/statistics.h" + +#include "src/misc.h" +#include "middistancecalculator.h" + +namespace mia { + +// initialize distance measures +MIDDistanceCalculator::DISTANCE_MEASURE MIDDistanceCalculator::distanceMeasure = MIDDistanceCalculator::D_EUCLIDEAN; +MIDDistanceCalculator::DISTANCE_NORMALIZATION MIDDistanceCalculator::distanceNormalization = MIDDistanceCalculator::DN_SUM; + +double MIDDistanceCalculator::gapPenalty = 0.3; +std::map, std::pair > MIDDistanceCalculator::MCModels; + +MIDDistanceCalculator::MIDDistanceCalculator(double gapPenalty) +{ + gapPenalty = gapPenalty; +} + +void MIDDistanceCalculator::setDistanceMeasure(MIDDistanceCalculator::DISTANCE_MEASURE d) +{ + // doesnt make sense, is static + distanceMeasure = d; +} + +double MIDDistanceCalculator::getMIDDistance(std::vector mid1, std::vector mid2) +{ + return getMIDDistance(nw(mid1, mid2), mid1.size(), mid2.size()); +} + +double MIDDistanceCalculator::getMIDDistance(std::vector mid1, std::vector mid2, double gapPenalty) +{ + return getMIDDistance(nw(mid1, mid2, gapPenalty), mid1.size(), mid2.size()); +} + +double MIDDistanceCalculator::getMIDDistance(std::pair, std::vector > const &aligned, size_t origSize1, size_t origSize2) +{ + const std::vector &alV1 = aligned.first; + const std::vector &alV2 = aligned.second; + + // printAlignedVectors(alV1, alV2); + + double dist; + + switch(distanceMeasure) { + case D_EUCLIDEAN: + dist = getEuclideanDistance(alV1, alV2); + break; + case D_CANBERRA: + dist = getCanberraDistance(alV1, alV2); + break; + case D_MANHATTAN: + dist = getManhattanDistance(alV1, alV2); + break; + case D_COSINE: + dist = getCosineCorrelation(alV1, alV2); + break; + case D_CUSTOM: + dist = getCustomDistance(alV1, alV2); + break; + default: + dist = getEuclideanDistance(alV1, alV2); + } + + double divideBy = 1; + + origSize1 = origSize1?alV1.size():origSize1; + origSize2 = origSize2?alV2.size():origSize2; + + switch(MIDDistanceCalculator::distanceNormalization) { + case DN_MAX: + divideBy = std::max(origSize1, origSize2); + break; + case DN_MIN: + divideBy = std::min(origSize1, origSize2); + break; + case DN_PROD: + divideBy = origSize1 * origSize2; + break; + case DN_SUM: + divideBy = origSize1 + origSize2; + break; + } + + // log(alV2.size()) + + return fabs(dist / divideBy); +} + +/** + * @brief MIDDistanceCalculator::createMonteCarloModel + * @param len1 + * @param len2 + * @param size + * @return Pair of mean and standard deviation. + */ +std::pair MIDDistanceCalculator::createMonteCarloModel(int len1, int len2, int size) +{ + alglib::real_1d_array dists; + dists.setlength(size); + + // Perform sampling in separate threads + int sizePerThread = size / QThread::idealThreadCount(); + QVector threads; + for(int t = 0; t < QThread::idealThreadCount(); ++t) { + int num = (t == QThread::idealThreadCount())?size - sizePerThread * t : sizePerThread; // take the rest in the last round + MonteCarloHelper *mch = new MonteCarloHelper(&dists[sizePerThread * t], num, len1, len2, gapPenalty); + mch->start(); + threads.push_back(mch); + } + + bool allFinished = 0; // wait for finished + while(!allFinished && threads.size()) { + allFinished = 0; + for(int t = 0; t < threads.size(); ++t) { + MonteCarloHelper *mch = threads[t]; + if(mch->isFinished()) { + delete mch; + threads.remove(t); + allFinished = 1; + } else { + allFinished = 0; + mch->wait(); + } + } + // std::cerr<<"threads "< 1) + std::cout< v1 = MIDDistanceCalculator::getNormalizedRandomVector(len1, 1); + std::vector v2 = MIDDistanceCalculator::getNormalizedRandomVector(len2, 1); + + arr[i] = MIDDistanceCalculator::getMIDDistance(MIDDistanceCalculator::nw(v1, v2, gapPenalty), v1.size(), v2.size()); + } + // std::cerr<<"Finished "< +std::pair, std::vector > MIDDistanceCalculator::nw(std::vector v1, std::vector v2, double gapPenalty) { + // j 0 1 2 3 4 + // i 0 V2[0] V2[1] V2[2] V2[3] + // 0 0 0 gp 2gp 3gp 4gp + // 1 V1[0] gp + // 2 V1[1] 2gp + // 3 V1[2] 3gp + + // the lower the score the better + + std::vector > scoreMat; + std::vector > tracebackMat; + initNWMatrices(v1.size(), v2.size(), gapPenalty, scoreMat, tracebackMat); + + double curGapPenalty = gapPenalty; + + // do actual stuff + for(int i = 1; i <= v1.size(); ++i) { // row + for(int j = 1; j <= v2.size(); ++j) { // col + double sright, sdown, sdiag; // scores + + // had gap before? make consecutive gaps less expensive + //if((j > 1 && scoreMat[i][j-2] < scoreMat[i-1][j-1]) || (scoreMat[i-1][j-1] < scoreMat[i-1][j-1])) curGapPenalty = gapPenalty / 10; + //else curGapPenalty = gapPenalty; + // go right? + sright = scoreMat[i][j - 1] + curGapPenalty; + + // make tailing gaps less expensive: + if(i == v1.size()) sright = scoreMat[i][j - 1]; + + // had gap before? make consecutive gaps less expensive + //if((scoreMat[i-1][j-1] < scoreMat[i-1][j-1]) || (i > 1 && scoreMat[i-2][j-1] < scoreMat[i-1][j-1])) curGapPenalty = gapPenalty / 10; + //else curGapPenalty = gapPenalty; + // go down? + sdown = scoreMat[i - 1][j] + curGapPenalty; + // make tailing gaps less expensive: + if(j == v2.size()) sdown = scoreMat[i - 1][j]; + + // go diagonal? + sdiag = scoreMat[i - 1][j - 1] + nwScoreMID(v1[i - 1], v2[j - 1]); // -1 because of initial 0 in matrix + + // least expensive path? + if(sdown < sright) { + if(sdown <= sdiag) { + scoreMat[i][j] = sdown; + tracebackMat[i][j] = '|'; + } else { + scoreMat[i][j] = sdiag; + tracebackMat[i][j] = '\\'; + } + } else { + if(sright <= sdiag) { + scoreMat[i][j] = sright; + tracebackMat[i][j] = '-'; + } else { + scoreMat[i][j] = sdiag; + tracebackMat[i][j] = '\\'; + } + } + //printMat(scoreMat); + //printMat(tracebackMat); + //std::cerr< alV1, alV2; + int i = v1.size(); // matrix is v1.size + 1 + int j = v2.size(); + int gaps = 0; + while(i > 0 || j > 0) { // i: row, v1 ; j: col, v2 + switch(tracebackMat[i][j]) { + case '\\': + alV1.push_back(v1[--i]); + alV2.push_back(v2[--j]); + break; + case '|': + alV1.push_back(v1[--i]); + alV2.push_back(0); + ++gaps; + break; + case '-': + alV1.push_back(0); + alV2.push_back(v2[--j]); + ++gaps; + break; + default: + std::cerr<<"MIDDistanceCalculator::nw: severe problem.\n"; + abort(); + } + } + std::reverse(alV1.begin(), alV1.end()); + std::reverse(alV2.begin(), alV2.end()); + + return std::pair, std::vector >(alV1, alV2); +} + +template +void MIDDistanceCalculator::initNWMatrices(int size1, int size2, double gapPenalty, std::vector > &scoreMat, std::vector > &tracebackMat) +{ + // resize, fill left and top with gap penalty + scoreMat.resize(size1 + 1); // need 0 + tracebackMat.resize(scoreMat.size()); + for(int i = 0; i <= size1; ++i) { + scoreMat[i].resize(size2 + 1); + scoreMat[i][0] = gapPenalty * i; + + tracebackMat[i].resize(scoreMat[i].size()); + tracebackMat[i][0] = '|'; + } + for(int j = 1; j <= size2; ++j) { + scoreMat[0][j] = gapPenalty * j; + tracebackMat[0][j] = '-'; + } + tracebackMat[0][0] = 'N'; +} + +template +void MIDDistanceCalculator::printAlignedVectors(const std::vector &v1, const std::vector &v2) +{ + assert(v1.size() == v2.size()); + std::cout< + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef MIDDISTANCECALCULATOR_H +#define MIDDISTANCECALCULATOR_H + +#include +#include + +#include + +#include "alg/ap.h" + +namespace mia { + +class MIDDistanceCalculator; +class MonteCarloHelper; + +/** + * @brief The MIDDistanceCalculator class does MID alignment and calculates the difference score. + */ +class MIDDistanceCalculator +{ +public: + + enum DISTANCE_MEASURE { + D_EUCLIDEAN, + D_CANBERRA, + D_MANHATTAN, + D_COSINE, + D_CUSTOM, + }; + + enum DISTANCE_NORMALIZATION{ + DN_ONE, + DN_SUM, + DN_PROD, + DN_MAX, + DN_MIN + }; + + static DISTANCE_MEASURE distanceMeasure; + static DISTANCE_NORMALIZATION distanceNormalization; + + MIDDistanceCalculator(double gapPenalty); + + void setDistanceMeasure(DISTANCE_MEASURE d); + + double getMIDDistance(std::vector mid1, std::vector mid2); + static double getMIDDistance(std::vector mid1, std::vector mid2, double gapPenalty); + + static double getMIDDistance(const std::pair, std::vector > &aligned, size_t origSize1 = 0, size_t origSize2 = 0); + + // z-score functions need checking! + static std::pair createMonteCarloModel(int len1, int len2, int size = MCMsize); + static double getMonteCarloZScore(double distance, int size1, int size2); + + static void normalize(std::vector::iterator itBegin, std::vector::iterator itEnd, double sum = 1); + static double sum(std::vector::iterator itBegin, std::vector::iterator itEnd); + static std::vector getNormalizedRandomVector(int size, int sum = 1); + + // Needleman-Wunsch + template static std::pair, std::vector > nw(std::vector v1, std::vector v2, double gapPenalty); + std::pair, std::vector > nw(std::vector v1, std::vector v2); + + template static void initNWMatrices(int size1, int size2, double gapPenalty, std::vector > &scoreMat, std::vector > &tracebackMat); + template static void printAlignedVectors(std::vector const &v1, std::vector const &v2); + +private: + static const int MCMsize = 1000; /**< Number of MID pairs to generate. */ + static double gapPenalty; /**< Gap penalty for Needleman-Wunsch-alignment. */ + static std::map, std::pair > MCModels; /**< Monte-Carlo models by MID size. (size1, size2) -> (mean, standard deviation); size1 <= size2. */ +}; + +/** + * @brief The MonteCarloHelper class creates random mass isotopomer distrubutions for Monte-Carlo-based distance cutoff. Needed for multi-threading. + */ +class MonteCarloHelper : public QThread { + + Q_OBJECT + +public: + MonteCarloHelper(double *arr, int number, int len1, int len2, double gapPenalty) + : arr(arr), number(number), len1(len1), len2(len2), gapPenalty(gapPenalty) {} + +private: + void run(); + + MIDDistanceCalculator *parent; /**< The instanciating object. */ + double *arr; /**< Pointer to double array to put the @b number MIDs into. */ + int number; /**< Number of MID pairs to generate. */ + int len1; /**< Length of first MID vector. */ + int len2; /**< Length of second MID vector. */ + double gapPenalty; /**< Gap penalty for Needleman-Wunsch-alignment. */ +}; + +} +#endif // MIDDISTANCECALCULATOR_H diff --git a/src/misc.cpp b/src/misc.cpp new file mode 100644 index 0000000..329546d --- /dev/null +++ b/src/misc.cpp @@ -0,0 +1,322 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "misc.h" +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#include "librarysearch.h" +#include "labelidentificator.h" +#include "compound.h" +#include "library.h" +#include "librarycompound.h" + +std::vector* > compoundsFromFiles(std::vector files) { + std::vector* > comps; // list with compounds from all files + for(std::vector::iterator it = files.begin(); it < files.end(); ++it) { + std::vector* > tmp = gcms::Compound::fromDisk(it->c_str()); + for(int i = 0; i < tmp.size(); ++i) { + comps.push_back(tmp.at(i)); + } + } + return comps; +} + +double getEuclideanDistance(const std::vector &v, const std::vector &w) { + assert(v.size() == w.size()); + double d = 0; // distance + for(int i = 0; i < v.size(); ++i) { + d += (v[i] - w[i]) * (v[i] - w[i]); + } + return sqrt(d); +} + + +gcms::LibrarySearch *libraryFromCompoundFiles(std::vector files) { + gcms::LibrarySearch *lib; + for(std::vector::iterator it = files.begin(); it < files.end(); ++it) { + std::vector* > tmp = gcms::Compound::fromDisk(it->c_str()); + lib->addCompoundSpectra(tmp); + } + return lib; +} + + +std::vector* > libraryCompoundsFromFiles(std::vector files) { + std::vector* > comps; // list with compounds from all files + for(std::vector::iterator it = files.begin(); it < files.end(); ++it) { + std::vector* > tmp = gcms::LibraryCompound::fromDisk(it->c_str()); + for(int i = 0; i < tmp.size(); ++i) { + comps.push_back(tmp.at(i)); + } + } + return comps; +} + + +/** + * @brief Write simple Dot-format file for graphviz visualization. + * + * @param mat Network matrix. Values > 0 represent nodes + * @param fname Output filename + * @param labs Node labels + */ +void matToDot(const std::vector > &mat, std::string fname, std::vector labs) { + std::ofstream ofs; + std::cout<<"writing " << fname<(mat) - 1 / min(mat)); + + ofs << "graph G {" << std::endl; + for(int i = 0; i < mat[0].size(); ++i) { // row + for(int j = 0; j < mat.size(); ++j) { // col + if(mat[i][j] > 0 && j > i) { + // i--j [weight=..]; + double weight = 1 / mat[i][j]; + //double penwidth = log(1 / mat[i][j]) * 4 / distRange; // maxwidth 4 + //ofs << i << " -- " << j << " [weight=" << weight << ",penwidth=" << "1" <<"];" << std::endl; + ofs << i << " -- " << j << " [penwidth=" << "1" <<",label="<
"<
>,style=filled,fillcolor=\"#ACD9FF\","; + ofs << "];" << std::endl; + } + ofs << "}" << std::endl; + ofs.close(); +} + + +/** + * @brief Write matrix to comma separated value file. + * + * @param mat Data matrix + * @param fname Output filename + * @param colnames Column labels + * @param rownames Row labels + */ +void matToCsv(const std::vector > &mat, std::string fname, std::vector colnames, std::vector rownames) { + std::ofstream ofs; + std::cout<<"writing " << fname; + ofs.open(fname.c_str()); + if(colnames.size()) { + ofs << ","; + for(int i = 0; i < colnames.size(); ++i) ofs << "\"" << colnames[i] << "\","; + ofs << std::endl; + } + for(int i = 0; i < mat[0].size(); ++i) { // row + if(rownames.size()) ofs << "\"" << rownames[i] << "\","; + for(int j = 0; j < mat.size(); ++j) { // col + ofs << "\"" << mat[i][j] << "\","; + } + ofs << std::endl; + } + ofs.close(); +} + +/** + * @brief (Dis-)similarity score for two mass-isotopomer abundances used for Needleman-Wunsch-scoring. + * + * @param v1 Value 1 + * @param v2 Value 2 + * @return float The score + */ +float nwScoreMID(float v1, float v2) { + return std::fabs(v1 - v2); +} + + +/** + * @brief Output matrix to ostream + * + * @param mat The matrix + * @param os The ostream (defaults to std::cerr) + */ +void printMat(const std::vector > &mat, std::ostream &os) { + os< > &mat, std::ostream &os) { + for(int i = 0; i < mat.size(); ++i) { // row + for(int j = 0; j < mat[i].size(); ++j) { // col + os< > &mat, std::ostream &os) { + for(int i = 0; i < mat.size(); ++i) { // row + for(int j = 0; j < mat[i].size(); ++j) { // col + os<<(mat[i][j]?"1":"0")<<" "; + } + os< &v, const std::vector &w) +{ + assert(v.size() == w.size()); + double dot = 0; + for(int i = 0; i < v.size(); ++i) + dot += v[i] * w[i]; + return dot; +} + + +double getCanberraDistance(const std::vector &v, const std::vector &w) +{ + assert(v.size() == w.size()); + double d = 0; // distance + for(int i = 0; i < v.size(); ++i) { + d += fabs(v[i] - w[i]) / (fabs(v[i]) + fabs(w[i])); + } + return d; +} + + +double getManhattanDistance(const std::vector &v, const std::vector &w) +{ + assert(v.size() == w.size()); + double d = 0; // distance + for(int i = 0; i < v.size(); ++i) { + d += fabs(v[i] - w[i]); + } + return d; +} + + +double getCustomDistance(const std::vector &v, const std::vector &w, const std::vector &vCI, const std::vector &wCI) +{ + assert(v.size() == w.size()); + double d = 0; // distance + /* + for(int i = 0; i < v.size(); ++i) { + d += fabs(v[i] - w[i]) * vCI[i] * wCI[i]; + } + */ + /*for(int i = 0; i < v.size(); ++i) { + d += sqrt(v[i] * w[i]); + }*/ + + //d = -log(d); + +/* + for(int i = 0; i < v.size(); ++i) { + if(v[i] < 0.01 || w[i] < 0.01) // i.e. not present (-> summand would become one) + continue; + d += fabs(v[i] - w[i]) / (fabs(v[i]) + fabs(w[i])); + } + */ +/* + double m; + for(int i = 0; i < v.size(); ++i) { + m = std::min(v[i], w[i]); + d += m < 0 ? 0 : m; + } + + d = 1/d; + if(d > std::numeric_limits::max()) + d = 5; + */ + + // pearson: + // means + double m_v = 0, m_w = 0; + for(int i = 0; i < v.size(); ++i) { + m_v += v[i]; + m_w += w[i]; + } + m_v /= v.size(); + m_w /= w.size(); + // sds + double sd_v = 0, sd_w = 0; + for(int i = 0; i < v.size(); ++i) { + sd_v += (m_v - v[i]) * (m_v - v[i]); + sd_w += (m_w - w[i]) * (m_w - w[i]); + } + sd_v = sqrt(sd_v / v.size()); + sd_w = sqrt(sd_w / w.size()); + + for(int i = 0; i < v.size(); ++i) { + d += (v[i] - m_v ) / sd_v * (w[i] - m_w ) / sd_w; + } + + d = 1 - d / v.size(); + + return d; +} + + +std::vector basePeakNormalization(const std::vector &v) +{ + std::vector res(v.size()); + if(v.size()) { + // find max + double max = v[0]; + for(int i = 0; i < v.size(); ++i) { + max = std::max(max, v[i]); + } + // normalize + for(int i = 0; i < v.size(); ++i) { + res[i] = v[i] / max; + } + } + return res; +} + +std::vector sumNormalization(const std::vector &v) +{ + std::vector res(v.size()); + if(v.size()) { + // find sum + double sum = 0; + for(int i = 0; i < v.size(); ++i) { + sum += v[i]; + } + // normalize + for(int i = 0; i < v.size(); ++i) { + res[i] = v[i] / sum; + } + } + return res; +} diff --git a/src/misc.h b/src/misc.h new file mode 100644 index 0000000..fd2db00 --- /dev/null +++ b/src/misc.h @@ -0,0 +1,418 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef MISC_H +#define MISC_H +#define MISC_H_DEBUG 1 + +#include +#include +#include +#include +#include +#include +#include +#include + +#include "librarysearch.h" +#include "labelidentificator.h" +#include "compound.h" +#include "library.h" +#include "librarycompound.h" + +std::vector* > compoundsFromFiles(std::vector files); + +gcms::LibrarySearch *libraryFromCompoundFiles(std::vector files); + +std::vector* > libraryCompoundsFromFiles(std::vector files); + +//double getCustomDistance(const std::vector &v, const std::vector &w); +double getCustomDistance(const std::vector &v, const std::vector &w, const std::vector &vCI = std::vector(), const std::vector &wCI = std::vector()); +double getCanberraDistance(const std::vector &v, const std::vector &w); +double getManhattanDistance(const std::vector &v, const std::vector &w); +double getEuclideanDistance(const std::vector &v, const std::vector &w); +double getCosineCorrelation(const std::vector &v, const std::vector &w); + +std::vector basePeakNormalization(std::vector const &v); +std::vector sumNormalization(std::vector const &v); + +template void printVec(std::vector v, std::ostream &os = std::cerr) { + os< T max(std::vector > vv) { + T max = vv[0][0]; + for(int i = 0; i < vv[0].size(); ++i) { // row + for(int j = 0; j < vv.size(); ++j) { // col + T m = vv[i][j]; + if(m > max) max = m; + } + } + return max; +} + +template T min(std::vector > vv) { + T min = INFINITY; + for(int i = 0; i < vv[0].size(); ++i) { // row + for(int j = 0; j < vv.size(); ++j) { // col + T m = vv[i][j]; + if(m < min) min = m; + } + } + return min; +} + +template T minAboveZero(std::vector > vv) { + T min = 0; + for(int i = 0; i < vv[0].size(); ++i) { // row + for(int j = 0; j < vv.size(); ++j) { // col + T m = vv[i][j]; + if(m && m < min) min = m; + } + } + return min; +} + +/** + * @brief Write simple Dot-format file for graphviz visualization. + * + * @param mat Network matrix. Values > 0 represent nodes + * @param fname Output filename + * @param labs Node labels + */ +void matToDot(const std::vector > &mat, std::string fname, std::vector labs); + +/** + * @brief Write matrix to comma separated value file. + * + * @param mat Data matrix + * @param fname Output filename + * @param colnames Column labels + * @param rownames Row labels + */ +void matToCsv(const std::vector > &mat, std::string fname, std::vector colnames, std::vector rownames); + +/** + * @brief Get the maximum of 3 values. + * + * @param v1 Value 1 + * @param v2 Value 2 + * @param v3 Value 3 + * @return T The maximum value of v1, v2, v3. + */ +template T max(T v1, T v2, T v3) { + return (v1 >= v2)?((v1 >= v3)?v1:v3):((v2 >= v3)?v2:v3); +} + +/** + * @brief Get the minimum of 3 values. + * + * @param v1 Value 1 + * @param v2 Value 2 + * @param v3 Value 3 + * @return T The minimum value of v1, v2, v3. + */ +template T min(T v1, T v2, T v3) { + return (v1 <= v2)?((v1 <= v3)?v1:v3):((v2 <= v3)?v2:v3); +} + +/** + * @brief (Dis-)similarity score for two mass-isotopomer abundances used for Needleman-Wunsch-scoring. + * + * @param v1 Value 1 + * @param v2 Value 2 + * @return float The score + */ +float nwScoreMID(float v1, float v2); + +/** + * @brief Output matrix to ostream + * + * @param mat The matrix + * @param os The ostream (defaults to std::cerr) + */ +void printMat(const std::vector > &mat, std::ostream &os = std::cerr); +void printMat(const std::vector > &mat, std::ostream &os = std::cerr); + +/** + * @brief Print aligned sequences. + * + * @param mat Needleman-Wunsch-matrix + * @param v1 Sequence 1 + * @param v2 Sequence 1 + */ +template +void printAlign(const std::vector > mat, std::vector v1, std::vector v2) { + // retrace best alignment, start at bottom right + std::vector alV1, alV2; + int i = v1.size(); // matrix is v1.size + 1 + int j = v2.size(); + int gaps = 0; + while(i > 0 || j > 0) { // i: row, v1 ; j: col, v2 + double sright, sdown, sdiag; // scores (go left, right, diag) + sright = j > 0?mat[i][j - 1]:1000; // if border set 1000: hilariously big score, cant go this way + sdown = i > 0?mat[i - 1][j]:1000; + sdiag = i*j > 0?mat[i - 1][j - 1]:1000; + double mn = min(sright, sdown, sdiag); + if(mn == sdiag) { + alV1.push_back(v1[--i]); + alV2.push_back(v2[--j]); + } else if (mn == sdown) { + alV1.push_back(v1[--i]); + alV2.push_back(0); + ++gaps; + } else if (mn == sright) { + alV1.push_back(0); + alV2.push_back(v2[--j]); + ++gaps; + } else { + std::cerr<<"severe nw() problem"; + } + } + + // output in reverse + std::stringstream al; + al << std::setw(6) << std::setprecision(2) << std::resetiosflags(std::ios::right); + std::vector::reverse_iterator it = alV1.rbegin(); + while(it < alV1.rend()) al << *(it++) << "\t\t"; + al << std::endl; + it = alV2.rbegin(); + while(it < alV2.rend()) al << *(it++) << "\t\t"; + al << std::endl; + std::cerr< +void printAlignHTML(const std::vector > mat, std::vector v1, std::vector v2, std::ofstream &ofs) { + // retrace best alignment, start at bottom right + std::vector alV1, alV2; + int i = v1.size(); // matrix is v1.size + 1 + int j = v2.size(); + int gaps = 0; + while(i > 0 || j > 0) { // i: row, v1 ; j: col, v2 + double sright, sdown, sdiag; // scores (go left, right, diag) + sright = j > 0?mat[i][j - 1]:1000; // if border set 1000: hilariously big score, cant go this way + sdown = i > 0?mat[i - 1][j]:1000; + sdiag = i*j > 0?mat[i - 1][j - 1]:1000; + double mn = min(sright, sdown, sdiag); + if(mn == sdiag) { + alV1.push_back(v1[--i]); + alV2.push_back(v2[--j]); + } else if (mn == sdown) { + alV1.push_back(v1[--i]); + alV2.push_back(-999); + ++gaps; + } else if (mn == sright) { + alV1.push_back(-999); + alV2.push_back(v2[--j]); + ++gaps; + } else { + std::cerr<<"prob printAlignHTML"; + } + } + + // output in reverse + ofs <<"
"; + ofs << std::setw(6) << std::setprecision(4) << std::resetiosflags(std::ios::right); + std::vector::reverse_iterator it = alV1.rbegin(); + while(it < alV1.rend()) ofs << ""; + ofs << ""<"<<*(it++) << ""; + ofs <<"
"<<*(it++) << "
"< T nw(std::vector v1, std::vector v2, double gapPenalty) { + // j 0 1 2 3 4 + // i 0 V2[0] V2[1] V2[2] V2[3] + // 0 0 0 gp 2gp 3gp 4gp + // 1 V1[0] gp + // 2 V1[1] 2gp + // 3 V1[2] 3gp + + // the lower the score the better + std::vector > mat; + + // resize, fill left and top with gap penalty + mat.resize(v1.size() + 1); // need 0 + for(int i = 0; i <= v1.size(); ++i) { + mat[i].resize(v2.size() + 1); + mat[i][0] = gapPenalty * i; + } + for(int j = 1; j <= v2.size(); ++j) { + mat[0][j] = gapPenalty * j; + } + + double curGapPenalty = gapPenalty; + + // do actual stuff + for(int i = 1; i <= v1.size(); ++i) { // row + for(int j = 1; j <= v2.size(); ++j) { // col + double sright, sdown, sdiag; // scores + + // had gap before? make consecutive gaps less expensive + if((j > 1 && mat[i][j-2] < mat[i-1][j-1]) || (mat[i-1][j-1] < mat[i-1][j-1])) curGapPenalty = gapPenalty / 10; + else curGapPenalty = gapPenalty; + // go right? + sright = mat[i][j - 1] + curGapPenalty; + + // had gap before? make consecutive gaps less expensive + if((mat[i-1][j-1] < mat[i-1][j-1]) || (i > 1 && mat[i-2][j-1] < mat[i-1][j-1])) curGapPenalty = gapPenalty / 10; + else curGapPenalty = gapPenalty; + // go down? + sdown = mat[i - 1][j] + curGapPenalty; + + // go diagonal? + sdiag = mat[i - 1][j - 1] + nwScoreMID(v1[i - 1], v2[j - 1]); // + 1 because of initial 0 in matrix + mat[i][j] = min(sright, sdown, sdiag); + + // remember last action + } + } + +#if MISC_H_DEBUG > 1 + // Debug + std::cerr<<"vecs"<::const_iterator it = v1.begin();//template?? + std::cerr< alV1, alV2; + int i = v1.size(); // matrix is v1.size + 1 + int j = v2.size(); + int gaps = 0; + while(i > 0 || j > 0) { // i: row, v1 ; j: col, v2 + double sright, sdown, sdiag; // scores (go left, right, diag) + sright = j > 0?mat[i][j - 1]:1000; // if border set 1000: hilariously big score, cant go this way + sdown = i > 0?mat[i - 1][j]:1000; + sdiag = i*j > 0?mat[i - 1][j - 1]:1000; + double mn = min(sright, sdown, sdiag); + if(mn == sdiag) { + alV1.push_back(v1[--i]); + alV2.push_back(v2[--j]); + } else if (mn == sdown) { + alV1.push_back(v1[--i]); + alV2.push_back(0); + ++gaps; + } else if (mn == sright) { + alV1.push_back(0); + alV2.push_back(v2[--j]); + ++gaps; + } else { + std::cerr<<"severe nw() problem"; + } + } + //return getEuclideanDistance(alV1, alV2); + return getCosineCorrelation(alV1, alV2) / (alV1.size() * alV2.size()); +// return mat[v1.size()][v2.size()] / std::max(v1.size(), v2.size()); +} + + +template T nwHTML(std::vector v1, std::vector v2, double gapPenalty, std::ofstream &ofs) { + // the lower the score the better + std::vector > mat; + + // resize, fill left and top with gap penalty + mat.resize(v1.size() + 1); // need 0 + for(int i = 0; i <= v1.size(); ++i) { + mat[i].resize(v2.size() + 1); + mat[i][0] = gapPenalty * i; + } + for(int j = 1; j <= v2.size(); ++j) { + mat[0][j] = gapPenalty * j; + } + + + // v2 header + ofs<<""<::const_iterator it = v2.begin(); + while(it < v2.end()) ofs<<""; + ofs<<""<"; + for(int j = 0; j <= v2.size(); ++j) { // col + if(i*j > 0) { // i,j== 0; only for printing + + double sright, sdown, sdiag; // scores + + // had gap before? make consecutive gaps less expensive + if((j > 1 && mat[i][j-2] < mat[i-1][j-1]) || (mat[i-1][j-1] < mat[i-1][j-1])) curGapPenalty = gapPenalty / 10; + else curGapPenalty = gapPenalty; + // go right? + sright = mat[i][j - 1] + curGapPenalty; + + // had gap before? make consecutive gaps less expensive + if((mat[i-1][j-1] < mat[i-1][j-1]) || (i > 1 && mat[i-2][j-1] < mat[i-1][j-1])) curGapPenalty = gapPenalty / 10; + else curGapPenalty = gapPenalty; + // go down? + sdown = mat[i - 1][j] + curGapPenalty; + + // go diagonal? + sdiag = mat[i - 1][j - 1] + nwScoreMID(v1[i - 1], v2[j - 1]); // - 1 because of initial 0 in matrix + mat[i][j] = min(sright, sdown, sdiag); + + } + ofs<<"\n"; + } + ofs<<"
0"<<*(it++)<<"
"<<(i==0?0:v1[i - 1])<<""<"; + } + ofs << "
\n"; + + printAlignHTML(mat, v1, v2, ofs); + // use bottom right as similarity score; normalize by mid length + //return mat[v1.size() - 1][v2.size() - 1] / std::max(v1.size(), v2.size()); + return mat[v1.size()][v2.size()]; +} +#endif // MISC_H diff --git a/src/networklayer.cpp b/src/networklayer.cpp new file mode 100644 index 0000000..899454d --- /dev/null +++ b/src/networklayer.cpp @@ -0,0 +1,59 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "networklayer.h" + +namespace mia { + +NetworkLayer::NetworkLayer() : LabelingDataset() +{ + visible = true; +} + +NetworkLayer::NetworkLayer(LabelingDataset *ds) : LabelingDataset(*ds) +{ + visible = true; +} + +NetworkLayer::NetworkLayer(Settings s): LabelingDataset(s) +{ + visible = true; +} + +bool NetworkLayer::isVisible() const +{ + return visible; +} + +void NetworkLayer::setVisible(bool visibility) +{ + visible = visibility; +} + +std::vector NetworkLayer::fromXMLFile(std::string file) +{ + std::vector l; + std::vector datasets = LabelingDataset::fromXMLFile(file); + for(int i = 0; i < datasets.size(); ++i) + l.push_back(new NetworkLayer(datasets[i])); + return l; +} + +} diff --git a/src/networklayer.h b/src/networklayer.h new file mode 100644 index 0000000..08d6c39 --- /dev/null +++ b/src/networklayer.h @@ -0,0 +1,49 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef NETWORKLAYER_H +#define NETWORKLAYER_H + +#include "labelingdataset.h" +#include "config.h" + +namespace mia { +class NetworkLayer; + +class NetworkLayer : public LabelingDataset +{ +public: + NetworkLayer(); + NetworkLayer(LabelingDataset *ds); + NetworkLayer(Settings s); + + bool isVisible() const; + void setVisible(bool visibility); + + friend QDataStream &operator << (QDataStream &out, const NetworkLayer*); + friend QDataStream &operator >> (QDataStream &in, NetworkLayer*&) throw(DeserializationException); + + static std::vector fromXMLFile(std::string file); + +private: + bool visible; +}; + +} +#endif // NETWORKLAYER_H diff --git a/src/nodecompound.cpp b/src/nodecompound.cpp new file mode 100644 index 0000000..a357056 --- /dev/null +++ b/src/nodecompound.cpp @@ -0,0 +1,797 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include +#include +#include + +#include "nodecompound.h" +#include "labeledcompound.h" +#include "labelingdataset.h" +#include "misc.h" +#include "midsolver.h" +#include "labidexception.h" +#include "serializationqt.h" + +namespace mia { + +NodeCompound::NodeCompound() +{ + compoundName = ""; + maxSD = -1; + + largestCommonIon = -1; + selectedIon = -1; +} + +NodeCompound::NodeCompound(std::string name) +{ + compoundName = QString::fromStdString(name); + maxSD = -1; + + largestCommonIon = -1; + selectedIon = -1; +} + +void NodeCompound::addLabeledCompound(std::string experiment, labid::LabeledCompound *lc) +{ + //std::cerr<<"addLabeledCompound: "<getRetentionIndices()[0]< fts = lc->getFeatures(); + for(std::map::const_iterator it = fts.begin(); it != fts.end(); ++it) { + features[QString::fromStdString(it->first)] = QString::fromStdString(it->second); + } + + maxSD = -1; + largestCommonIon = -1; + selectedIon = -1; +} + +labid::LabeledCompound *NodeCompound::getLabeledCompound(std::string experiment) +{ + int idx = experimentsLab.indexOf(QString::fromStdString(experiment)); + return lcs[idx]; +} + +void NodeCompound::removeLabeledCompound(labid::LabeledCompound *lc) +{ + int idx = lcs.indexOf(lc); + lcs.removeAt(idx); + experimentsLab.removeAt(idx); + + maxSD = -1; + largestCommonIon = -1; + selectedIon = -1; +} + +void NodeCompound::addUnlabeledCompound(std::string experiment, labid::LISpectrum *ls) +{ + lis.push_back(ls); + experimentsUnlab.push_back(QString::fromStdString(experiment)); + + maxSD = -1; + selectedIon = -1; +} + +labid::LISpectrum *NodeCompound::getUnlabeledCompound(std::string experiment) +{ + int idx = experimentsUnlab.indexOf(QString::fromStdString(experiment)); + return lis[idx]; +} + +labid::LabeledCompound *NodeCompound::getCompound(std::string experiment) +{ + int idx = experimentsLab.indexOf(QString::fromStdString(experiment)); + + if(idx > -1) + return lcs[idx]; + + idx = experimentsUnlab.indexOf(QString::fromStdString(experiment)); + + return dynamic_cast(lis[idx]); +} + +std::vector NodeCompound::getSelectedMID(std::string t) +{ + labid::LabeledCompound* lc = getCompound(t); + // TODO mia::pickMIDs + + // find best ion // TODO: consider intensity and R2 + int idx = getSelectedIndex(t); + return lc->getIsotopomers().at(idx); + //return lc->getMIDOfLargestFragment(0.95); +} + +double NodeCompound::getSelectedIon(std::string t) +{ + labid::LabeledCompound* lc = getCompound(t); + return lc->getLabeledIons().at(getSelectedIndex(t)); + //return lc->getLabeledIons().at(lc->getLargestSignificantIonIndex(0.95)); +} + +const std::vector NodeCompound::getSelectedCI(std::string t) +{ + labid::LabeledCompound* lc = getCompound(t); + return lc->getConfidenceIntervals().at(getSelectedIndex(t)); +} + +double NodeCompound::getSelectedR2(std::string t) +{ + labid::LabeledCompound* lc = getCompound(t); + return lc->getR2s().at(getSelectedIndex(t)); +// return lc->getR2s().at(lc->getLargestSignificantIonIndex(0.95)); +} + +/** + * @brief NodeCompound::getLargestCommonIon + * @return highest common m/z + */ +float NodeCompound::getLargestCommonIon() +{ + if(largestCommonIon > 0) { + return largestCommonIon; + } + + std::vector oldIons = lcs[0]->getLabeledIons(); // ions already sorted + std::vector commonIons(oldIons.size()); + foreach (labid::LabeledCompound* lc, lcs) { + std::vector curIons = lc->getLabeledIons(); + std::vector::iterator isit = std::set_intersection(oldIons.begin(), oldIons.end(), curIons.begin(), curIons.end(), commonIons.begin()); + commonIons.resize(isit - commonIons.begin()); + if(!commonIons.size()) + break; + oldIons = commonIons; + } + + // average r^2 + std::vector meanR2(commonIons.size(), 0); + foreach (labid::LabeledCompound* lc, lcs) { + std::vector curIons = lc->getLabeledIons(); + + for(int i = 0; i < commonIons.size(); ++i) { + int curIdx = std::find(curIons.begin(), curIons.end(), commonIons[i]) - curIons.begin(); + meanR2[i] += lc->getR2s()[curIdx] / lcs.size(); + } + } + + // choose largest > 0.95 + int idx = commonIons.size() - 1; + for(; idx > 0; --idx) { + if(meanR2[idx] >= 0.95) + break; + } + + if(idx == -1) { + return commonIons[commonIons.size() - 1]; + } + + largestCommonIon = commonIons[idx]; + + return largestCommonIon; +} + +int NodeCompound::getSelectedIndex(std::string t) +{ + labid::LabeledCompound* lc = getCompound(t); + + if(selectedIon < 0) { + if(useLargestCommonIon) { + selectedIon = getLargestCommonIon(); + } else { + try{ + //selectedIon = lc->getLargestSignificantIon(0.95); + selectedIon = lc->getLabeledIons().size() - 1; + } catch(labid::LabIDException e) { + // bug in ntfd where R2 can be < 0, which will + // throw and exception in getLargestSignificantIon + } + } + } + + std::vector ions = lc->getLabeledIons(); + for(int i = 0; i < ions.size(); ++i) { + if(ions[i] == selectedIon) { + return i; + } + } + + return ions.size() - 1; +} + +/** + * @brief Get the m/z of the [M-n] ion if exists, otherwise 0 + * @param t Experiment + * @param loss n + * @return + */ +int NodeCompound::getMMinusNIon(std::string t, int loss) +{ + labid::LabeledCompound* lc = getCompound(t); + + std::list > > dummy; + std::list fragments = lc->getSpectrumFragments(dummy); + + float largestFragment; + + // check isotope clusters + + for(std::list::reverse_iterator it = fragments.rbegin(); it != fragments.rend(); ++it) { + + if(it == fragments.rbegin()) { + largestFragment = it->getIon(); + } else { + float curFrag = it->getIon(); + + if(curFrag == largestFragment - loss) + return curFrag; + else if(curFrag < largestFragment - loss) + break; + } + } + + // or see if at least M0 for higher mass peak is present + if(lc->getIntensity(largestFragment + loss, 0.2)) + return largestFragment; + + return 0; +} + +double NodeCompound::getMaxIsotopomerSD() +{ + if(maxSD >= 0) + return maxSD; + + std::vector exps = getExperiments(); + if(exps.size() == 1) + return 0; + + // to adjust color to labeling variation + int expCount = 1; + int isoCount = 0; + + while(expCount) { + expCount = 0; + int i; + double sum = 0; + + // calc mean M_n + for(i = 0; i < exps.size(); ++i) { + const std::vector &mid = getSelectedMID(exps[i]); + if(mid.size() > isoCount) { + sum += mid[isoCount]; + ++expCount; + } + } + + double mean = sum / expCount; + + // calc SD M_n + sum = 0; + expCount = 0; + for(i = 0; i < exps.size(); ++i) { + const std::vector &mid = getSelectedMID(exps[i]); + double mi = 0; + if(mid.size() > isoCount) { + mi = mid[isoCount]; + ++expCount; + } + sum += (mi - mean) * (mi - mean); + } + + double sd = sqrt(sum / i); + + //maxSD = std::max(maxSD, sd / mean); + maxSD = std::max(maxSD, sd); + ++isoCount; + } + + return maxSD; +} + +double NodeCompound::getMinANOVAPvalue() +{ + std::vector exps = getExperiments(); + if(exps.size() == 1) + return 1; + + // max MID length + int maxLen = 0; + for(int i = 0; i < exps.size(); ++i) { + int curSize = getSelectedMID(exps[i]).size() + 1; + maxLen = std::max(maxLen, curSize); + } + + int minP = 1; + + for(int m = 0; m < maxLen; ++m) { + minP = minP < getANOVAPvalueForMassIsotopomer(m) ? minP : getANOVAPvalueForMassIsotopomer(m); + } + + return minP; +} + +double NodeCompound::getANOVAPvalueForMassIsotopomer(int m) +{ + // experiment means and standard deviations + std::vector means; + std::vector sds; + + std::vector exps = getExperiments(); + + //int oldN = 0; + int minNumFiles = 999999; + + for(int i = 0; i < exps.size(); ++i) { + + int midSize = getSelectedMID(exps[i]).size(); + if(midSize < m + 1) + continue; + + // current group number of observations + int N = getLabeledCompound(exps[i])->getLabeledSpecCount() + * getLabeledCompound(exps[i])->getUnLabeledSpecCount(); + + int curMinNumFiles = std::max(getLabeledCompound(exps[i])->getLabeledSpecCount(), + getLabeledCompound(exps[i])->getUnLabeledSpecCount()); + minNumFiles = std::min(curMinNumFiles, minNumFiles); + + //if(oldN > 0 && N != oldN) { + //std::cerr<<"Cannot perform ANOVA for different numbers of replicates."< means, std::vector sds, int n) +{ + if(n < 2) + return 1; + + int k = means.size(); + + if(k < 2) + return 1; + + assert(k == sds.size()); + + int df1 = n - 1; + int df2 = n * k - df1 - 1; + + double meanMean = 0; + double sumVar = 0; + for(int i = 0; i < k; ++i) { + meanMean += means[i]; + sumVar += sds[i] * sds[i]; + } + meanMean /= k; + + double s_x = 0; + for(int i = 0; i < k; ++i) { + s_x += (means[i] - meanMean) * (means[i] - meanMean); + } + s_x /= k - 1; + + double f = n * s_x / (sumVar / k); + + double p = gsl_cdf_fdist_Q(f, df1, df2); + + return p; +} + +std::vector NodeCompound::getExperiments() +{ + std::vector v; + + foreach(QString key, experimentsLab){ + v.push_back(key.toStdString()); + } + // include unlabeled + foreach(QString key, experimentsUnlab){ + v.push_back(key.toStdString()); + } + return v; +} + +bool NodeCompound::hasDataForExperiment(std::string s) +{ + return experimentsLab.contains(QString::fromStdString(s)); +} + +std::string NodeCompound::getCompoundName() +{ + return compoundName.toStdString(); +} + +void NodeCompound::setCompoundName(std::string name) +{ + compoundName = QString::fromStdString(name); +} + +void NodeCompound::addFeature(std::string name, std::string value) +{ + features[QString::fromStdString(name)] = QString::fromStdString(value); +} + +std::string NodeCompound::getFeature(std::string name) +{ + return features[QString::fromStdString(name)].toStdString(); +} + +std::string NodeCompound::toString() +{ + std::stringstream ss; + ss << "**********"<getName()<<"\t"<<*(lc->getRetentionIndices().begin())<getTotalSignal()<(lc->getLabeledIons(), ss); + } + ss << "Features:"<::Iterator it = features.begin(); it != features.end(); ++it) { + ss<<"\t"< > frags; + foreach(labid::LabeledCompound *lc, lcs) { + const std::vector ions = lc->getLabeledIons(); + const std::vector > mids = lc->getIsotopomers(); + for(int i = 0; i < ions.size(); ++i) { + size_t lower = ions[i]; + size_t upper = lower + mids[i].size(); + + // if not exists, add to list (?or alter range) + std::list >::iterator it; + for(it = frags.begin(); it != frags.end(); ++it) { + if(it->first == lower) { + it->second = std::max(upper, it->second); + break; + } + } + if(it == frags.end()) { + frags.push_back(std::pair(lower, upper)); + } + } + } + + frags.sort(sortByFirstPairValue); + + // if not present redetect + for(QList::iterator it = lcs.begin(); it != lcs.end(); ++it){ + //std::cout<<"Redetect "<setFeatures(lc.getFeatures()); + } + + // TODO: also in "unlabeled" compounds + for(QList::iterator it = lis.begin(); it != lis.end(); ++it){ + //std::cout<<"Redetect "<(*it))); + labid::LISpectrum lis = labid::LISpectrum(*lc.getLabeledReferenceCompound()); + *it = detectFragments(lc, lis, frags); // delete old lc? + + // copy features + (*it)->setFeatures(lc.getFeatures()); + } + +} + +labid::LabeledCompound* NodeCompound::detectFragments(labid::LISpectrum &ul_comp, labid::LISpectrum &l_comp, const std::list > &fragments) +{ + // Code from labid::LabelIdentificator::analyseFragments + //*it = labid::LabelIdentificator::analyseFragments(**it, *((*it)->getLabeledReferenceCompound()), frags, 0); // can make static?? no, notwork + + //init specs + std::list > ul_specs = ul_comp.getNormalizedSourceSpectra(); + std::list > l_specs = l_comp.getNormalizedSourceSpectra(); + + //init result containers + std::vector labeled_ions; + std::vector > isotopomers; + std::vector > confidence; + std::vector scores; + std::vector r2s; + + //iterate over all fragments + for ( std::list >::const_iterator it=fragments.begin();it!=fragments.end();++it ) + { + + + size_t start=it->first; + size_t end=it->second; + + //create fragment vectors for MID calculation + std::vector > frags_unlab; + for(std::list >::const_iterator it2=ul_specs.begin();it2!=ul_specs.end();++it2) + { + const std::vector& spec=*it2; + + if(spec.size() <= end) + continue; + + std::vector rc_frag(end-start+1, 0.0); + for(size_t i=start;i<=end && i > frags_lab; + for(std::list >::const_iterator it2=l_specs.begin();it2!=l_specs.end();++it2) + { + const std::vector& spec=*it2; + + if(spec.size() <= end) + continue; + + std::vector rc_frag(end-start+1, 0.0); + for(size_t i=start;i<=end && i cis=mid_solv.getCIs(); + + //calculate sum and create result list + std::vector mids=mid_solv.getMIDs(); + double sum=0.0; + double label_amount=0.0; + double m0=mids.at(0); + for ( size_t n=0;n0 && value>0 ) + { + label_amount+=value; + } + } + + bool conf_ok=false; + std::vector::const_iterator it_c=cis.begin(); + for ( std::vector::const_iterator it_s=mids.begin();it_s!=mids.end();++it_s, it_c++ ) + { + const double& rc_val=*it_s; + const double& rc_conf=*it_c; + + if ( it_c==cis.begin() ) + { + continue; //skip M0 isotopomer + } + if ( rc_val>=0 && ( rc_conf==-1 || rc_val-rc_conf>0 || rc_val+rc_conf<0 ) ) + { + conf_ok=true; + } + } + + double max_label = 0.55; // DW + max_label = 1; + //if ( r2>=min_r2 && sum>=1.0-sum_thr && sum<=1.0+sum_thr && label_amount>=min_label && m0<=1.0-min_label && conf_ok && m0 >= 1 - max_label) + { + l_comp.addFragment(start, end); + ul_comp.addFragment(start, end); + labeled_ions.push_back ( start ); + isotopomers.push_back ( mids ); + confidence.push_back ( cis ); + scores.push_back ( sum ); + r2s.push_back (r2 ); + } + } + + labid::LabeledCompound* result=new labid::LabeledCompound( &l_comp, &ul_comp ); + result->setLabeledIons ( labeled_ions ); + result->setIsotopomers ( isotopomers ); + result->setConfidenceIntervals ( confidence ); + result->setScores ( scores ); + result->setR2s ( r2s ); + return result; +} + +std::set NodeCompound::getAllLabeledIons() +{ + std::set s; + + for(int i = 0; i < lcs.size(); ++i) { + labid::LabeledCompound* lc = lcs[i]; + const std::vector< float > ions = lc->getLabeledIons(); + for(int j = 0; j < ions.size(); ++j) { + s.insert(ions[j]); + } + } + + return s; +} + +void NodeCompound::filterMIDs(labid::LabeledCompound &lc, Settings s) +{ + // Remove ions with too high mass isotopomers + std::vector ions = lc.getLabeledIons(); + std::vector > mids = lc.getIsotopomers(); + std::vector r2s = lc.getR2s(); + std::vector > cis = lc.getConfidenceIntervals(); + + std::vector ions2; + std::vector > mids2; + std::vector r2s2; + std::vector > cis2; + for(int i = 0; i < ions.size(); ++i) { + // filter r2 + if(r2s[i] < s.lid_req_r2) + continue; + + // remove if max(mid) * tracer mass increment > m/z + if(mids[i][mids[i].size() - 1] * s.tracer_atom_mass > ions[i] + && fabs(mids[i][mids[i].size() - 1]) > cis[i][cis[i].size() - 1]) + continue; + + // Filter compounds with less M0 than the tracer + if(mids[i].size() <= s.lid_max_mass_isotopomer + 1 + && mids[i][0] >= s.lid_min_m0 + && mids[i].size() * s.tracer_atom_mass <= ions[i] ) { // mass filter: make sure m/z < M_max * tracer_isotope_mass + ions2.push_back(ions[i]); + + // remove tailing values with abundance < 0.01 + mids2.push_back(removeTailingAbundances(mids[i], 0.01)); // TODO add to settings + //mids2.push_back(mids[i]); + r2s2.push_back(r2s[i]); + cis2.push_back(cis[i]); + cis2[cis2.size() - 1].resize(mids2[mids2.size() - 1].size()); + } + + // filter sum + double absSum = 0; + for(std::vector::iterator miIt = mids[i].begin(); miIt != mids[i].end(); ++miIt) + absSum += std::fabs(*miIt); + if(absSum - 1 > s.lid_maximal_frag_dev) + continue; + } + lc.setLabeledIons(ions2); + lc.setIsotopomers(mids2); + lc.setConfidenceIntervals(cis2); + lc.setR2s(r2s2); +} + +std::vector NodeCompound::removeTailingAbundances(const std::vector &mid, double threshold) +{ + bool tail = 1; // still in tail (nothing > threshold yet) + std::vector res; + for(std::vector::const_reverse_iterator it = mid.rbegin(); it < mid.rend(); ++it) { + if(!tail || *it > threshold) { + tail = 0; + res.push_back(*it); + } + } + std::reverse(res.begin(), res.end()); + + return res; +} +bool NodeCompound::getUseLargestCommonIon() const +{ + return useLargestCommonIon; +} + +void NodeCompound::setUseLargestCommonIon(bool value) +{ + useLargestCommonIon = value; + + selectedIon = -1; +} + +QDataStream &operator <<(QDataStream &out, const NodeCompound &nc) +{ + out<>(QDataStream &in, NodeCompound &nc) +{ + QString magic; + in >> magic; + Q_ASSERT(magic == "NodeCompound"); + + in >> nc.compoundName; + in >> nc.features; + + int size; + in >> size; + for(int i = 0; i < size; ++i) { + QString s; + in >> s; + nc.experimentsLab.push_back(s); + + labid::LabeledCompound *lc; + in >> lc; + nc.lcs.push_back(lc); + } + + return in; +} + +QDataStream &operator <<(QDataStream &out, const NodeCompound *nc) +{ + out << *nc; + return out; + +} + +QDataStream &operator >>(QDataStream &in, NodeCompound *&nc) +{ + nc = new NodeCompound; + in >> *nc; + return in; +} + +} diff --git a/src/nodecompound.h b/src/nodecompound.h new file mode 100644 index 0000000..cfa1747 --- /dev/null +++ b/src/nodecompound.h @@ -0,0 +1,113 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef NODECOMPOUND_H +#define NODECOMPOUND_H +#include +#include +#include +#include"labeledcompound.h" +#include"lispectrum.h" +#include +#include +#include "settings.h" +#include "config.h" + +namespace mia { + +class NodeCompound; + +/** + * @class NodeCompound + * @brief The NodeCompound class represent one specific compound and holds LabeledCompounds from different LabelingDatasets from different tracers/conditions. + * + */ +class NodeCompound +{ + +public: + + NodeCompound(); + NodeCompound(std::string name); + + void addLabeledCompound(std::string experiment, labid::LabeledCompound *lc); + labid::LabeledCompound *getLabeledCompound(std::string experiment); + void removeLabeledCompound(labid::LabeledCompound *); + void addUnlabeledCompound(std::string experiment, labid::LISpectrum *ls); + labid::LISpectrum* getUnlabeledCompound(std::string experiment); + labid::LabeledCompound *getCompound(std::string experiment); + + std::vector getSelectedMID(std::string t); + double getSelectedIon(std::string t); + const std::vector getSelectedCI(std::string t); + double getSelectedR2(std::string t); + float getLargestCommonIon(); + int getSelectedIndex(std::string t); + int getMMinusNIon(std::string t, int loss); + double getMaxIsotopomerSD(); + double getMinANOVAPvalue(); + double getANOVAPvalueForMassIsotopomer(int m); + double getANOVAPvalue(std::vector means, std::vector sds, int n); + + std::vector getExperiments(); // The different tracer names // unique! + bool hasDataForExperiment(std::string); + std::string getCompoundName(); + void setCompoundName(std::string name); + void addFeature(std::string name, std::string value); + std::string getFeature(std::string name); + std::string toString(); + void redetectFragments(); + labid::LabeledCompound *detectFragments(labid::LISpectrum &ul_comp, labid::LISpectrum &l_comp, const std::list< std::pair < size_t , size_t > > & fragments); + + std::set getAllLabeledIons(); + + static void filterMIDs(labid::LabeledCompound &lc, Settings s); + static std::vector removeTailingAbundances(const std::vector &mid, double threshold); + + // Serialization + friend QDataStream &operator<<(QDataStream &out, const NodeCompound &nc); + friend QDataStream &operator>>(QDataStream &in, NodeCompound &nc); + friend QDataStream &operator<<(QDataStream &out, const NodeCompound *nc); + friend QDataStream &operator>>(QDataStream &in, NodeCompound *&nc); + + template static bool sortByFirstPairValue(const std::pair& i, const std::pair& j){ + return i.first < j.first; + } + + bool getUseLargestCommonIon() const; + void setUseLargestCommonIon(bool value); + +private: + float largestCommonIon; + int selectedIon; + bool useLargestCommonIon; + double maxSD; + QString compoundName; /**< Compound label. */ + QList experimentsLab; /**< List of the tracers/conditions in which this compound was identified as labeled. */ + QList lcs; /**< The label information from all LabelingDatasets where the compound was identified as labeled. */ + QList experimentsUnlab; /**< List of the tracers/conditions in which this compound was identified as NOT labeled. */ + QList lis; /**< The compound from the not-label-detected LabelingDatasets. */ + QMap features; /**< Holds additional (key->value) pairs. */ + + //QList lcs2; +}; + +} + +#endif // NODECOMPOUND_H diff --git a/src/serializationqt.cpp b/src/serializationqt.cpp new file mode 100644 index 0000000..5e5a51f --- /dev/null +++ b/src/serializationqt.cpp @@ -0,0 +1,377 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "serializationqt.h" + +#include + +namespace mia { + +QDataStream &operator <<(QDataStream &out, const mia::NetworkLayer *layer) +{ + out << QString("Layer"); + + out << layer->settings << layer->cmpLab << layer->cmpUnlab << layer->dists << layer->distsCut; + out << layer->mids << layer->midsAll << layer->nodeLabs << layer->nodeLabsAll; + + out << QString("LID"); + + // serialize labid::Labelidentificator + std::ostringstream ss; + layer->lid->toStream(ss); + std::string str = ss.str(); + uint strlen = str.length(); + out << strlen; + out.writeRawData(str.c_str(), strlen); + + out << QString("/Layer"); + + return out; +} + +QDataStream &operator >>(QDataStream &in, mia::NetworkLayer *&layer) throw(DeserializationException) +{ + QString magic; + in >> magic; + if(magic != "Layer") + throw(DeserializationException("NetworkLayer -- Layer")); + + mia::Settings s; + in >> s; + layer = new mia::NetworkLayer(s); + + in >> layer->cmpLab >> layer->cmpUnlab >> layer->dists >> layer->distsCut; + in >> layer->mids >> layer->midsAll >> layer->nodeLabs >> layer->nodeLabsAll; + + // read labid::Labelidentificator + in >> magic; + if(magic != "LID") + throw(DeserializationException("NetworkLayer -- LID")); + uint size; + in >> size; + + char *buf = (char*)malloc(size*sizeof(char)); + in.readRawData(buf, size); + + std::stringstream ss; + ss.write(buf, size); + free(buf); + layer->lid = labid::LabelIdentificator::fromStream(ss, SERIALIZATIONQT_H_MD_VERSION); + + in >> magic; + if(magic != "/Layer") + throw(DeserializationException("NetworkLayer -- /Layer")); + + return in; +} + +QDataStream &operator <<(QDataStream &out, const labid::LabeledCompound * lc) +{ + out<toStream(ss); + std::string str = ss.str(); + out << (uint)(str.length()); + out.writeRawData(str.c_str(), str.length()); + + out<>(QDataStream &in, labid::LabeledCompound *&lc) throw(DeserializationException) +{ + QString magic; + in >> magic; + if(magic != "LabeledCompound") + throw(DeserializationException("LabeledCompound -- LabeledCompound")); + + uint bufsize; + in >> bufsize; + char buf[bufsize]; + in.readRawData(buf, bufsize); + std::stringstream ss; + ss.write(buf, bufsize); + lc = labid::LabeledCompound::fromStream(ss, SERIALIZATIONQT_H_MD_VERSION); + + in >> magic; + if(magic != "/LabeledCompound") + throw(DeserializationException("LabeledCompound -- LabeledCompound")); + + return in; +} + + +QDataStream &operator <<(QDataStream &out, const std::vector lcs) +{ + uint size = lcs.size(); + out << size; + for(std::vector::const_iterator it = lcs.begin(); it != lcs.end(); ++it) { + out << *it; + } + + return out; +} + +QDataStream &operator >>(QDataStream &in, std::vector &lcs) throw(DeserializationException) +{ + lcs.clear(); + + uint size1; + in >> size1; + + lcs.reserve(size1); + + while(size1--) { + labid::LabeledCompound *lc; + in >> lc; + lcs.push_back(lc); + } + + return in; +} + +QDataStream &operator <<(QDataStream &out, const std::vector lis) +{ + uint size = lis.size(); + out << size; + + for(std::vector::const_iterator it = lis.begin(); it != lis.end(); ++it) { + out << *it; + } + + return out; +} + +QDataStream &operator >>(QDataStream &in, std::vector &lis) throw(DeserializationException) +{ + lis.clear(); + + uint size1; + in >> size1; + lis.reserve(size1); + + while(size1--) { + labid::LISpectrum *li; + in>>li; + lis.push_back(li); + } + + return in; +} + + +QDataStream &operator <<(QDataStream &out, labid::LISpectrum const* lis) +{ + out << QString("LISpectrum"); + + std::ostringstream ss; + lis->toStream(ss); + std::string str = ss.str(); + uint strlen = str.length(); + out << strlen; + out.writeRawData(str.c_str(), strlen); + + return out; +} + +QDataStream &operator >>(QDataStream &in, labid::LISpectrum* &lis) throw(DeserializationException) +{ + QString magic; + in >> magic; + if(magic != "LISpectrum") + throw(DeserializationException("LISpectrum -- LISpectrum")); + + uint bufsize; + in >> bufsize; + + char *buf = (char*)malloc(bufsize*sizeof(char)); + in.readRawData(buf, bufsize); + std::stringstream ss; + ss.write(buf, bufsize); + free(buf); + + lis = labid::LISpectrum::fromStream(ss, SERIALIZATIONQT_H_MD_VERSION); + + return in; +} + +QDataStream &operator <<(QDataStream &out, const std::vector > v) +{ + uint size1 = v.size(); + out << size1; + for(std::vector >::const_iterator it1 = v.begin(); it1 != v.end(); ++it1){ + QVector v1 = QVector::fromStdVector(*it1); + out << v1; + } + return out; +} + +QDataStream &operator >>(QDataStream &in, std::vector > &v) throw(DeserializationException) +{ + v.clear(); + + uint size1; + in >> size1; + v.reserve(size1); + while(size1--) { + QVector v1; + in >> v1; + v.push_back(v1.toStdVector()); + } + return in; +} + +QDataStream &operator <<(QDataStream &out, const std::vector v) +{ + uint size = v.size(); + out << size; + for(std::vector::const_iterator it = v.begin(); it != v.end(); ++it){ + out << QString::fromStdString(*it); + } + return out; +} + +QDataStream &operator >>(QDataStream &in, std::vector &v) throw(DeserializationException) +{ + v.clear(); + + uint size; + in >> size; + while(size--) { + QString qs; + in>>qs; + v.push_back(qs.toStdString()); + } + return in; +} + +QDataStream &operator <<(QDataStream &out, const gcms::Compound *c) +{ + out<toStream(ss); + + std::string str = ss.str(); + uint strlen = str.length(); + out << strlen; + out.writeRawData(str.c_str(), strlen); + + return out; +} + +QDataStream &operator >>(QDataStream &in, gcms::Compound *c) throw(DeserializationException) +{ + QString magic; + in >> magic; + if(magic != "Compound") + throw(DeserializationException("Compound -- Compound")); + + uint bufsize; + in >> bufsize; + char *buf = (char*)malloc(bufsize*sizeof(char)); + in.readRawData(buf, bufsize); + std::stringstream ss; + ss.write(buf, bufsize); + free(buf); + + c = gcms::Compound::fromStream(ss, SERIALIZATIONQT_H_MD_VERSION); + + return in; +} + +QDataStream &operator <<(QDataStream &out, const gcms::LibraryCompound *c) +{ + out<toStream(ss); + + std::string str = ss.str(); + uint strlen = str.length(); + out << strlen; + out.writeRawData(str.c_str(), strlen); + + return out; +} + +QDataStream &operator >>(QDataStream &in, gcms::LibraryCompound *c) throw(DeserializationException) +{ + QString magic; + in >> magic; + if(magic != "LibraryCompound") + throw(DeserializationException("LibraryCompound -- LibraryCompound")); + + uint bufsize; + in >> bufsize; + char *buf = (char*)malloc(bufsize*sizeof(char)); + in.readRawData(buf, bufsize); + std::stringstream ss; + ss.write(buf, bufsize); + free(buf); + + c = gcms::LibraryCompound::fromStream(ss, SERIALIZATIONQT_H_MD_VERSION); + + return in; +} + +QDataStream &operator <<(QDataStream &out, const mia::Settings s) +{ + out< > cmp_id_mass_filter; + << s.cmp_matching_ri_tol << s.cmp_matching_score_cutoff + << QString::fromStdString(s.cmp_id_library) << s.unlabFiles << s.labFiles << s.lid_filter_by_conf_interval + << s.lid_min_signal_to_noise << s.lid_required_spec_freq << s.lid_req_label_amount + << s.lid_req_r2 << s.lid_min_frag_num << s.lid_sensitivity << s.lid_maximal_frag_dev + << s.lid_correction_ratio << s.nw_gap_penalty<< s.nw_exclude_m0 + << s.mid_distance_cutoff; + return out; +} + +QDataStream &operator >>(QDataStream &in, mia::Settings &s) throw(DeserializationException) +{ + QString magic; + in >> magic; + if(magic != "Settings") + throw(DeserializationException("Settings -- Settings")); + + QString t, lib; + in >> t >> s.cmp_id_use_ri >> s.cmp_id_ri_tol >> s.cmp_id_score_cutoff; + in >> s.labels_max_hits >> s.gcms_pure_factor >> s.gcms_impure_factor; + //>> std::set > cmp_id_mass_filter; + in >> s.cmp_matching_ri_tol >> s.cmp_matching_score_cutoff; + in >> lib >> s.unlabFiles; + in >> s.labFiles; + in >> s.lid_filter_by_conf_interval >> s.lid_min_signal_to_noise >> + s.lid_required_spec_freq >> s.lid_req_label_amount + >> s.lid_req_r2 >> s.lid_min_frag_num >> s.lid_sensitivity >> s.lid_maximal_frag_dev + >> s.lid_correction_ratio >> s.nw_gap_penalty>> s.nw_exclude_m0 + >> s.mid_distance_cutoff; + s.experiment = t.toStdString(); + s.cmp_id_library = lib.toStdString(); + + return in; +} +} diff --git a/src/serializationqt.h b/src/serializationqt.h new file mode 100644 index 0000000..9772510 --- /dev/null +++ b/src/serializationqt.h @@ -0,0 +1,70 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef SERIALIZATIONQT_H +#define SERIALIZATIONQT_H + +#include +#include + +#include + +#include "labeledcompound.h" +#include "compound.h" + +#include "settings.h" +#include "miaexception.h" +#include "labelingdataset.h" +#include "networklayer.h" + +namespace mia { + +#define SERIALIZATIONQT_H_MD_VERSION 4 + +/** Serialization functions to use with QDataStreams */ + +QDataStream &operator << (QDataStream &out, const std::vector); +QDataStream &operator >> (QDataStream &in, std::vector&) throw(DeserializationException); + +QDataStream &operator << (QDataStream &out, const labid::LabeledCompound*); +QDataStream &operator >> (QDataStream &in, labid::LabeledCompound*&) throw(DeserializationException); + +QDataStream &operator << (QDataStream &out, const std::vector); +QDataStream &operator >> (QDataStream &in, std::vector&) throw(DeserializationException); + +QDataStream &operator << (QDataStream &out, const labid::LISpectrum*); +QDataStream &operator >> (QDataStream &in, labid::LISpectrum*&) throw(DeserializationException); + +QDataStream &operator << (QDataStream &out, const std::vector >); +QDataStream &operator >> (QDataStream &in, std::vector >&) throw(DeserializationException); + +QDataStream &operator << (QDataStream &out, const std::vector); +QDataStream &operator >> (QDataStream &in, std::vector&) throw(DeserializationException); + +QDataStream &operator << (QDataStream &out, const gcms::Compound*); +QDataStream &operator >> (QDataStream &in, gcms::Compound*) throw(DeserializationException); + +QDataStream &operator << (QDataStream &out, const gcms::LibraryCompound*); +QDataStream &operator >> (QDataStream &in, gcms::LibraryCompound*) throw(DeserializationException); + +QDataStream &operator << (QDataStream &out, const mia::Settings); +QDataStream &operator >> (QDataStream &in, mia::Settings&) throw(DeserializationException); + +} +#endif // SERIALIZATIONQT_H diff --git a/src/settings.cpp b/src/settings.cpp new file mode 100644 index 0000000..cae8ce5 --- /dev/null +++ b/src/settings.cpp @@ -0,0 +1,247 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include +#include + +#include "settings.h" +#include "config.h" + +namespace mia { + +/** + * @brief Default constructor setting default parameter values. + */ +Settings::Settings() +{ + cmp_id_use_ri = true; + cmp_id_ri_tol = 100; + cmp_id_score_cutoff = 0.75; + cmp_id_library = ""; + + cmp_matching_ri_tol = 10; + cmp_matching_score_cutoff = 0.95; + + tracer_atom_mass = 13.0; + gcms_pure_factor = 0.5; + gcms_impure_factor = 0.5; + + lid_filter_by_conf_interval = true; // NTFD: hardcoded + lid_min_signal_to_noise = 5; // NTFD: hardcoded + lid_required_spec_freq = 0.75; // NTFD: hardcoded + + std::list > filter; + filter.push_back(std::make_pair(0,100)); // TODO used yet? + + lid_min_m0 = 0.45; + lid_req_label_amount = 0.05; + lid_req_r2 = 0.95; + lid_min_frag_num = 2; + lid_sensitivity = 1/10000.0; // .0 !! + lid_maximal_frag_dev = 0.2; + lid_correction_ratio = 0.010934; // C tracer + lid_max_mass_isotopomer = 20; + + nw_gap_penalty = 0.2; + nw_exclude_m0 = false; + mid_distance_cutoff = 0.0; + labels_max_hits = 2; +} + +/** + * @brief Copy constructor. + * @param s Instance to copy from. + */ +Settings::Settings(const Settings &s) +{ + experiment = s.experiment; + cmp_id_use_ri = s.cmp_id_use_ri; + cmp_id_ri_tol = s.cmp_id_ri_tol; + cmp_id_score_cutoff = s.cmp_id_score_cutoff; + cmp_matching_ri_tol = s.cmp_matching_ri_tol; + cmp_matching_score_cutoff = s.cmp_matching_score_cutoff; + tracer_atom_mass = s.tracer_atom_mass; + labels_max_hits = s.labels_max_hits; + gcms_pure_factor = s.gcms_pure_factor; + gcms_impure_factor = s.gcms_impure_factor; + cmp_id_library = s.cmp_id_library; + cmp_id_mass_filter = s.cmp_id_mass_filter; + unlabFiles = s.unlabFiles; + labFiles = s.labFiles; + lid_filter_by_conf_interval = s.lid_filter_by_conf_interval; + lid_min_signal_to_noise = s.lid_min_signal_to_noise; + lid_required_spec_freq = s.lid_required_spec_freq; + lid_req_label_amount = s.lid_req_label_amount; + lid_req_r2 = s.lid_req_r2; + lid_min_frag_num = s.lid_min_frag_num; + lid_sensitivity = s.lid_sensitivity; + lid_maximal_frag_dev = s.lid_maximal_frag_dev; + lid_correction_ratio = s.lid_correction_ratio; + lid_max_mass_isotopomer = s.lid_max_mass_isotopomer; + lid_min_m0 = s.lid_min_m0; + nw_gap_penalty = s.nw_gap_penalty; + nw_exclude_m0 = s.nw_exclude_m0; + mid_distance_cutoff = s.mid_distance_cutoff; +} + +/** + * @brief Check if certain parameter groups' settings are different from another instance. + * @param other The other instance. + * @param which Parameter group to be checked. + * @return True if parameters differ. + */ +bool Settings::settingsChanged(const Settings &other, Settings::SettingsGroup which) const +{ + bool unchanged = true; + + if(which & CmpIdSettings) { + unchanged = (unlabFiles == other.unlabFiles) + && (labFiles == other.labFiles) + && (cmp_id_use_ri == other.cmp_id_use_ri) + && (cmp_id_ri_tol == other.cmp_id_ri_tol) + && (cmp_id_score_cutoff == other.cmp_id_score_cutoff) + && (labels_max_hits == other.labels_max_hits) + && (cmp_id_library == other.cmp_id_library) + && (cmp_matching_ri_tol == other.cmp_matching_ri_tol) + && (cmp_matching_score_cutoff == other.cmp_matching_score_cutoff) + && (cmp_id_mass_filter == other.cmp_id_mass_filter); + } + if(which & GCMSSettings) { + unchanged = (gcms_pure_factor == other.gcms_pure_factor) + && (gcms_impure_factor == other.gcms_impure_factor); + } + if(which & LidSettings) { + unchanged = (lid_filter_by_conf_interval == other.lid_filter_by_conf_interval) + && (lid_min_signal_to_noise == other.lid_min_signal_to_noise) + && (lid_required_spec_freq == other.lid_required_spec_freq) + && (lid_req_label_amount == other.lid_req_label_amount) + && (lid_req_r2 == other.lid_req_r2) + && (lid_min_frag_num == other.lid_min_frag_num) + && (lid_sensitivity == other.lid_sensitivity) + && (lid_maximal_frag_dev == other.lid_maximal_frag_dev) + && (lid_correction_ratio == other.lid_correction_ratio) + && (lid_min_m0 == other.lid_min_m0) + && (tracer_atom_mass == other.tracer_atom_mass) + && (lid_max_mass_isotopomer == other.lid_max_mass_isotopomer); + } + if(which & NWSettings) { + unchanged = (nw_gap_penalty == other.nw_gap_penalty) + && (nw_exclude_m0 == other.nw_exclude_m0) + && (mid_distance_cutoff == other.mid_distance_cutoff); + } + if(which & AllSettings) { + unchanged = (experiment == other.experiment); + } + return !unchanged; +} + +/** + * @brief Human-readable string of settings parameters. + * @return Parameter string. + */ +std::string Settings::toString() const +{ + std::stringstream ss; + ss << "experiment = " << experiment << std::endl; + ss << "cmp_id_use_ri = " << cmp_id_use_ri << std::endl; + ss << "cmp_id_ri_tol = " << cmp_id_ri_tol << std::endl; + ss << "cmp_id_score_cutoff = " << cmp_id_score_cutoff << std::endl; + ss << "tracer_atom_mass = " << tracer_atom_mass << std::endl; + ss << "labels_max_hits = " << labels_max_hits << std::endl; + ss << "gcms_pure_factor = " << gcms_pure_factor << std::endl; + ss << "gcms_impure_factor = " << gcms_impure_factor << std::endl; + ss << "cmp_id_library = " << cmp_id_library << std::endl; + ss << "cmp_matching_ri_tol = " << cmp_matching_ri_tol << std::endl; + ss << "cmp_matching_score_cutoff = " << cmp_matching_score_cutoff << std::endl; + + // TODO ss << "cmp_id_mass_filter = " << cmp_id_mass_filter << std::endl; + for(std::vector::const_iterator it = unlabFiles.begin(); it != unlabFiles.end(); ++it) + ss << "unlabFiles = " << *it << std::endl; + for(std::vector::const_iterator it = labFiles.begin(); it != labFiles.end(); ++it) + ss << "labFiles = " << *it << std::endl; + ss << "lid_filter_by_conf_interval = " << lid_filter_by_conf_interval << std::endl; + ss << "lid_min_signal_to_noise = " << lid_min_signal_to_noise << std::endl; + ss << "lid_required_spec_freq = "<< lid_required_spec_freq << std::endl; + ss << "lid_req_label_amount = " << lid_req_label_amount << std::endl; + ss << "lid_req_r2 = " << lid_req_r2 << std::endl; + ss << "lid_min_frag_num = " << lid_min_frag_num << std::endl; + ss << "lid_sensitivity = " << lid_sensitivity << std::endl; + ss << "lid_maximal_frag_dev = " << lid_maximal_frag_dev << std::endl; + ss << "lid_correction_ratio = " << lid_correction_ratio << std::endl; + ss << "lid_min_m0 = " << lid_min_m0 << std::endl; + ss << "lid_max_mass_isotopomer = " << lid_max_mass_isotopomer << std::endl; + ss << "nw_gap_penalty = " << nw_gap_penalty << std::endl; + ss << "nw_exclude_m0 = " << nw_exclude_m0 << std::endl; + ss << "mid_distance_cutoff = " << mid_distance_cutoff << std::endl; + return ss.str(); +} + +std::string Settings::toXML() const +{ + std::stringstream ss; + ss << "" << std::endl; + + // settings + ss << ""<" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + // TODO cmp_id_mass_filter + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + ss << "" << std::endl; + + ss << ""<"<::const_iterator it = labFiles.begin(); it != labFiles.end(); ++it) + ss << "" << std::endl; + ss<<""<"<::const_iterator it = unlabFiles.begin(); it != unlabFiles.end(); ++it) + ss << "" << std::endl; + ss<<""<" << std::endl; + return ss.str(); +} + +} diff --git a/src/settings.h b/src/settings.h new file mode 100644 index 0000000..5d3460f --- /dev/null +++ b/src/settings.h @@ -0,0 +1,97 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef SETTINGS_H +#define SETTINGS_H + +#include +#include +#include + +namespace mia { + +/** + * @class Settings + * @brief The Settings class holds all parameters for labeled compound detection, + * identification, distance calculation and network generation. + * @author Daniel Weindl + */ +class Settings +{ +public: + /** + * @brief The SettingsGroup enum. Groups parameters into settings for gcms-lib, labid-lib, + * compound identification and network generation. + */ + enum SettingsGroup { + GCMSSettings = 1, + LidSettings = 2, + CmpIdSettings = 4, + NWSettings = 8, + AllSettings = 0xFF + }; + + Settings(); + Settings(const Settings&); + + bool settingsChanged(const Settings& other, SettingsGroup which = AllSettings) const; + std::string toString() const; + std::string toXML() const; + + std::string experiment; /**< Name of the dataset. */ + + // Compound identification settings + bool cmp_id_use_ri; /**< Use retention index. */ + double cmp_id_ri_tol; /**< Tolerance for retention index difference. */ + double cmp_id_score_cutoff; /**< Cutoff for spectrum matching score for identification. */ + double cmp_matching_ri_tol; /**< RI tolerance for peak matching different chromatograms */ + double cmp_matching_score_cutoff; /**< Spec score for peak matching different chromatograms */ + + int labels_max_hits; /**< Maximum number of labels to include in the name. -1: show all. */ + double gcms_pure_factor; /**< See labid. */ + double gcms_impure_factor; /**< See labid. */ + std::set > cmp_id_mass_filter; /** m/z range to exclude from library matching. */ + std::string cmp_id_library; /**< MD library file. */ + double tracer_atom_mass; /**< Mass of the tracer isotope. To be used for filtering. */ + + std::vector unlabFiles; /**< Unlabeled files for NTFD. */ + std::vector labFiles; /**< Labeled files for NTFD. */ + + // LabelIdentificator Settings + bool lid_filter_by_conf_interval; /**< NTFD: hardcoded */ + int lid_min_signal_to_noise; /**< NTFD: hardcoded */ + double lid_required_spec_freq; /**< NTFD: hardcoded */ + double lid_req_label_amount; /**< Minimum sum of mass isotopomer abundances to keep ion in results list. */ + double lid_req_r2; /**< Filter by R^2 < lid_req_r2. */ + int lid_min_frag_num; /**< Minimum number of labeled fragments a spectrum needs to hold. */ + double lid_sensitivity; /**< Specificity for label detection. */ + double lid_maximal_frag_dev; /**< Filter fragments where sum of absolute mass isotopomer abundances is > 1 + lid_maximal_frag_dev. */ + double lid_correction_ratio; /**< M+1 correction. Use 0.010934 for C tracer. M+1/M+0. See Jennings et al. */ + int lid_max_mass_isotopomer; /**< Filter ions with M+n | n > lid_max_mass_isotopomer. Defaults to 20. */ + double lid_min_m0; /**< Minimum M0 abundance (use little less than tracer percentage). Defaults to 0.45 (for 50:50 tracer:non-tracer). */ + /* TODO lid_mass_filter * m/z range to exclude from labeled ion detection. */ + + // Network construction settings + double nw_gap_penalty; /**< Gap penalty for needleman wunsch scoring. */ + bool nw_exclude_m0; /**< Exclude M+0 abundance for distance calculation & scoring? */ + double mid_distance_cutoff; /**< Distance threshold for network edges (lower/upper?). */ +}; + +} +#endif // SETTINGS_H diff --git a/src/utilities.cpp b/src/utilities.cpp new file mode 100644 index 0000000..4467db1 --- /dev/null +++ b/src/utilities.cpp @@ -0,0 +1,39 @@ +// +// MIA - Mass Isotopolome Analyzer +// Copyright (C) 2013-15 Daniel Weindl +// +// This file is part of MIA. +// +// MIA is free software: you can redistribute it and/or modify +// it under the terms of the GNU Affero General Public License as +// published by the Free Software Foundation, either version 3 of the +// License, or (at your option) any later version. +// +// MIA 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 Affero General Public License for more details. +// +// You should have received a copy of the GNU Affero General Public License +// along with MIA. If not, see . +// + +#include "utilities.h" + +#include + +namespace mia { + +bool Utilities::fileExists(std::string file) +{ + std::ifstream ifs(file.c_str()); + return ifs.good(); +} + +bool Utilities::fileExists(const char *file) +{ + std::ifstream ifs(file); + return ifs.good(); +} + +} diff --git a/src/utilities.h b/src/utilities.h new file mode 100644 index 0000000..3982ee5 --- /dev/null +++ b/src/utilities.h @@ -0,0 +1,35 @@ +/* * MIA - Mass Isotopolome Analyzer + * Copyright (C) 2013-15 Daniel Weindl + * + * This file is part of MIA. + * + * MIA is free software: you can redistribute it and/or modify + * it under the terms of the GNU Affero General Public License as + * published by the Free Software Foundation, either version 3 of the + * License, or (at your option) any later version. + * + * MIA 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 Affero General Public License for more details. + * + * You should have received a copy of the GNU Affero General Public License + * along with MIA. If not, see . + */ + +#ifndef UTILITIES_H +#define UTILITIES_H + +#include + +namespace mia { + +class Utilities +{ +public: + static bool fileExists(std::string file); + static bool fileExists(const char *file); +}; + +} +#endif // UTILITIES_H diff --git a/win32/msvcr100.dll b/win32/msvcr100.dll new file mode 100644 index 0000000..fd91c89 Binary files /dev/null and b/win32/msvcr100.dll differ