/************************************************************************* 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)<N!", _state); ae_assert(x->cnt>=m, "ODESolverRKCK: Length(X)<M!", _state); ae_assert(isfinitevector(y, n, _state), "ODESolverRKCK: Y contains infinite or NaN values!", _state); ae_assert(isfinitevector(x, m, _state), "ODESolverRKCK: Y contains infinite or NaN values!", _state); ae_assert(ae_isfinite(eps, _state), "ODESolverRKCK: Eps is not finite!", _state); ae_assert(ae_fp_neq(eps,(double)(0)), "ODESolverRKCK: Eps is zero!", _state); ae_assert(ae_isfinite(h, _state), "ODESolverRKCK: H is not finite!", _state); odesolver_odesolverinit(0, y, n, x, m, eps, h, 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) { 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)<N!", _state); ae_assert(y->cnt>=n, "Spline1DFitPenalized: Length(Y)<N!", _state); ae_assert(isfinitevector(x, n, _state), "Spline1DFitPenalized: X contains infinite or NAN values!", _state); ae_assert(isfinitevector(y, n, _state), "Spline1DFitPenalized: Y contains infinite or NAN values!", _state); ae_assert(ae_isfinite(rho, _state), "Spline1DFitPenalized: Rho is infinite!", _state); ae_vector_set_length(&w, n, _state); for(i=0; i<=n-1; i++) { w.ptr.p_double[i] = 1; } spline1dfitpenalizedw(x, y, &w, n, m, rho, info, s, rep, _state); ae_frame_leave(_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) { 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)<N!", _state); ae_assert(y->cnt>=n, "Spline1DFitPenalizedW: Length(Y)<N!", _state); ae_assert(w->cnt>=n, "Spline1DFitPenalizedW: Length(W)<N!", _state); ae_assert(isfinitevector(x, n, _state), "Spline1DFitPenalizedW: X contains infinite or NAN values!", _state); ae_assert(isfinitevector(y, n, _state), "Spline1DFitPenalizedW: Y contains infinite or NAN values!", _state); ae_assert(isfinitevector(w, n, _state), "Spline1DFitPenalizedW: Y contains infinite or NAN values!", _state); ae_assert(ae_isfinite(rho, _state), "Spline1DFitPenalizedW: Rho is infinite!", _state); /* * Prepare LambdaV */ v = -ae_log(ae_machineepsilon, _state)/ae_log(10, _state); if( ae_fp_less(rho,-v) ) { rho = -v; } if( ae_fp_greater(rho,v) ) { rho = v; } lambdav = ae_pow(10, rho, _state); /* * Sort X, Y, W */ heapsortdpoints(x, y, w, n, _state); /* * Scale X, Y, XC, YC */ lsfitscalexy(x, y, w, n, &xc, &yc, &dc, 0, &xa, &xb, &sa, &sb, &xoriginal, &yoriginal, _state); /* * Allocate space */ ae_matrix_set_length(&fmatrix, n, m, _state); ae_matrix_set_length(&amatrix, m, m, _state); ae_matrix_set_length(&d2matrix, m, m, _state); ae_vector_set_length(&bx, m, _state); ae_vector_set_length(&by, m, _state); ae_vector_set_length(&fcolumn, n, _state); ae_matrix_set_length(&nmatrix, m, m, _state); ae_vector_set_length(&rightpart, m, _state); ae_vector_set_length(&tmp0, ae_maxint(m, n, _state), _state); ae_vector_set_length(&c, m, _state); /* * Fill: * * FMatrix by values of basis functions * * TmpAMatrix by second derivatives of I-th function at J-th point * * CMatrix by constraints */ fdmax = 0; for (b=0; b<=m-1; b++) { /* * Prepare I-th basis function */ for(j=0; j<=m-1; j++) { bx.ptr.p_double[j] = (double)(2*j)/(double)(m-1)-1; by.ptr.p_double[j] = 0; } by.ptr.p_double[b] = 1; //spline1dgriddiff2cubic(&bx, &by, m, 2, 0.0, 2, 0.0, &bd1, &bd2, _state); test_gridDiff2Cubic(&bx, &by, m, &bd1, &bd2, _state); // spline1dbuildcubic(&bx, &by, m, 2, 0.0, 2, 0.0, &bs, _state); test_buildCubic(&bx, &by, m, &bs, _state); /* * Calculate B-th column of FMatrix * Update FDMax (maximum column norm) */ spline1dconvcubic(&bx, &by, m, 2, 0.0, 2, 0.0, x, n, &fcolumn, _state); ae_v_move(&fmatrix.ptr.pp_double[0][b], fmatrix.stride, &fcolumn.ptr.p_double[0], 1, ae_v_len(0,n-1)); v = 0; for(i=0; i<=n-1; i++) { //fprintf(stderr, "fcoll %d %f\n", i, fcolumn.ptr.p_double[i]); v = v+ae_sqr(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); }