// Scale each row in a matrix to have values in a given range [a,b] // f(x) = a + (b-a)(x-min)/(max-min) void shapeAlign::scaleMatrix(gsl_matrix *M, double min, double max){ for (size_t i = 0; i < M->size1; i++){ double rmin,rmax; // row max and min gsl_vector_view row = gsl_matrix_row(M,i); gsl_vector_minmax(&row.vector,&rmin,&rmax); gsl_vector_add_constant(&row.vector,-1*rmin); gsl_vector_scale(&row.vector,(max-min)/(rmax-rmin)); gsl_vector_add_constant(&row.vector,min); } return; }
gsl_matrix* GaussianMatrix ( gsl_vector *v, float sigma ) { gsl_vector_add_constant ( v, -1 ); gsl_vector_scale ( v, 0.5 ); int siz1 = gsl_vector_get ( v, 0 ); int siz2 = gsl_vector_get ( v, 1 ); gsl_matrix *x = gsl_matrix_alloc ( siz1*2+1, siz2*2+1 ); gsl_matrix *y = gsl_matrix_alloc ( siz1*2+1, siz2*2+1 ); for ( int i=-siz2; i<=siz2; i++ ) { for ( int j=-siz1; j<=siz1; j++ ) { gsl_matrix_set ( x, i+siz2, j+siz1, j ); gsl_matrix_set ( y, i+siz2, j+siz1, i ); } } gsl_matrix_mul_elements ( x, x ); gsl_matrix_mul_elements ( y, y ); gsl_matrix_add ( x, y ); gsl_matrix_scale ( x, -1/(2*sigma*sigma) ); float sum = 0; for ( int i=0; i<x->size1; i++ ) { for ( int j=0; j<x->size2; j++ ) { gsl_matrix_set ( x, i, j, exp(gsl_matrix_get ( x, i, j )) ); sum += gsl_matrix_get ( x, i, j ); } } if ( sum != 0 ) gsl_matrix_scale ( x, 1/sum ); gsl_matrix_free ( y ); return x; }
inline void model::zero_out_mat(gsl_matrix *mat) { size_t ncol = mat->size2; for (size_t j = 0; j < ncol; ++j) { gsl_vector_view cv = gsl_matrix_column(mat, j); gsl_vector_add_constant(&cv.vector, -gsl_vector_get(_col_mean, j)); } }
int lls_regularize(const double lambda, gsl_matrix *ATA) { int s; gsl_vector_view d = gsl_matrix_diagonal(ATA); s = gsl_vector_add_constant(&d.vector, lambda * lambda); return s; } /* lls_regularize() */
/** Subtraction operator (double) */ vector<double> vector<double>::operator-(const double& a) { vector<double> v1(_vector); if (gsl_vector_add_constant(v1.as_gsl_type_ptr(), -a)) { std::cout << "\n Error in vector<double> - (double)" << std::endl; exit(EXIT_FAILURE); } return v1; }
void shapeAlign::scaleMatrixZscore(gsl_matrix *M){ for (size_t i = 0; i < M->size1; i++){ gsl_vector_view row = gsl_matrix_row(M,i); double mu = gsl_stats_mean(row.vector.data, row.vector.stride, row.vector.size); double sigma = gsl_stats_sd_m(row.vector.data, row.vector.stride, row.vector.size, mu); gsl_vector_add_constant(&row.vector,-mu); gsl_vector_scale(&row.vector,1.0/sigma); } return; }
void StationaryCholesky::computeGammak( const gsl_matrix *Rt, double reg ) { gsl_matrix_view submat; for (size_t k = 0; k < getMu(); k++) { submat = gsl_matrix_submatrix(myGammaK, 0, k * getD(), getD(), getD()); myStStruct->AtVkB(&submat.matrix, k, Rt, Rt, myTempVijtRt); if (reg > 0) { gsl_vector diag = gsl_matrix_diagonal(&submat.matrix).vector; gsl_vector_add_constant(&diag, reg); } } submat = gsl_matrix_submatrix(myGammaK, 0, getMu() * getD(), getD(), getD()); gsl_matrix_set_zero(&submat.matrix); }
void matrix_demean(gsl_matrix *input){ gsl_vector *mean = gsl_vector_alloc(input->size2); matrix_mean(mean, input); size_t NCOL = input->size2; size_t i; gsl_vector_view column; #pragma omp parallel for private(column) for (i = 0; i < NCOL; i++) { column = gsl_matrix_column(input, i); gsl_vector_add_constant( &column.vector, -gsl_vector_get(mean, i)); } }
/** * Empirical Orthogonal Functions analysis (or Principal Component Analysis) * of a multivariate time series. * \param[in] data Multivariate time series on which to perform the analysis. * \param[out] w Eigenvalues of the covariance matrix giving the explained variance. * \param[out] E Matrix with an Empirical Orthogonal Function for each column. * \param[out] A Matrix with a principal component for each column. */ void getEOF(const gsl_matrix *data, gsl_vector *w, gsl_matrix *E, gsl_matrix *A) { size_t nt = data->size1; size_t N = data->size2; gsl_vector *mean; gsl_matrix *C = gsl_matrix_alloc(N, N); gsl_eigen_symmv_workspace *work = gsl_eigen_symmv_alloc(N); gsl_matrix *X = gsl_matrix_alloc(data->size1, data->size2); gsl_matrix_memcpy(X, data); gsl_vector_view col; // Get anomalies A = gsl_matrix_alloc(nt, N); gsl_matrix_memcpy(A, X); mean = gsl_vector_alloc(N); gsl_matrix_get_mean(mean, A, 0); for (size_t j = 0; j < X->size2; j++) { col = gsl_matrix_column(X, j); gsl_vector_add_constant(&col.vector, - gsl_vector_get(mean, j)); } // Get correlation matrix gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1., A, A, 0., C); gsl_matrix_scale(C, 1. / nt); // Solve eigen problem and sort by descending magnitude gsl_eigen_symmv(C, w, E, work); gsl_eigen_symmv_sort(w, E, GSL_EIGEN_SORT_VAL_DESC); // Get principal components gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1., X, E, 0., A); // Free gsl_eigen_symmv_free(work); gsl_matrix_free(C); return; }
double log_sum_exp(const gsl_vector* v) { double m = -gsl_vector_max(v); assert(!isnan(m)); if (isinf(m)) { // m = +inf OR -inf // both cases the result should be equal to m return m; } gsl_vector* w = gsl_vector_alloc(v->size); gsl_vector_memcpy(w, v); gsl_vector_add_constant(w, m); double s = 0.0; size_t i; for (i = 0; i < w->size; i++) { s += DEBUG_EXP(gsl_vector_get(w, i)); } gsl_vector_free(w); return -m + DEBUG_LOG(s); }
gsl_matrix* reconstructData (gsl_matrix* t_data, gsl_matrix* rot, gsl_vector* means) { // rec_data = rot * t_data gsl_matrix* rec_data_t = gsl_matrix_alloc(rot->size1, t_data->size2); gsl_blas_dgemm( CblasNoTrans, CblasNoTrans, 1.0, rot, t_data, 0.0, rec_data_t); gsl_matrix* rec_data = gsl_matrix_alloc(rec_data_t->size2, rec_data_t->size1); transposeMatrix(rec_data_t, rec_data); gsl_matrix_free(rec_data_t); // rec_data + means for (unsigned int j = 0; j < (rec_data->size2); j++) { gsl_vector_view vv = gsl_matrix_column(rec_data,j); gsl_vector* v = &vv.vector; gsl_vector_add_constant(v, gsl_vector_get(means,j)); } return(rec_data); }
int penalty_df (CBLAS_TRANSPOSE_t TransJ, const gsl_vector * x, const gsl_vector * u, void * params, gsl_vector * v, gsl_matrix * JTJ) { struct model_params *par = (struct model_params *) params; const size_t p = x->size; size_t j; /* store 2*x in last row of J */ for (j = 0; j < p; ++j) { double xj = gsl_vector_get(x, j); gsl_spmatrix_set(par->J, p, j, 2.0 * xj); } /* compute v = op(J) u */ if (v) gsl_spblas_dgemv(TransJ, 1.0, par->J, u, 0.0, v); if (JTJ) { gsl_vector_view diag = gsl_matrix_diagonal(JTJ); /* compute J^T J = [ alpha*I_p + 4 x x^T ] */ gsl_matrix_set_zero(JTJ); /* store 4 x x^T in lower half of JTJ */ gsl_blas_dsyr(CblasLower, 4.0, x, JTJ); /* add alpha to diag(JTJ) */ gsl_vector_add_constant(&diag.vector, par->alpha); } return GSL_SUCCESS; }
int compute_itegral_r(const mu_data_fit *mu, const fit_params fp, gsl_vector *fftR_abs){ size_t vsize= mu->k->size; gsl_vector *mu_tmp=gsl_vector_alloc(vsize); gsl_vector_set_zero(mu_tmp); size_t ikmin=search_min(mu->k, mu->kmin - 0.5*mu->dwk); size_t ikmax=search_min(mu->k, mu->kmax + 0.5*mu->dwk); gsl_vector_view kw = gsl_vector_subvector(mu->k, ikmin-1, ikmax-ikmin-1); gsl_vector_view muw = gsl_vector_subvector(mu_tmp, ikmin-1, ikmax-ikmin-1); gsl_vector *ktmp=gsl_vector_alloc((&kw.vector)->size); gsl_vector_memcpy(ktmp, &kw.vector); gsl_vector_add_constant(ktmp, fp.kshift); compute_itegral(ktmp, &fp, &muw.vector); hanning(mu_tmp, mu->k, mu->kmin, mu->kmax, mu->dwk); //FFT transform double *data = (double *) malloc(vsize*sizeof(double)); memcpy(data, mu_tmp->data, vsize*sizeof(double)); gsl_fft_real_radix2_transform(data, 1, vsize); //Unpack complex vector gsl_vector_complex *fourier_data = gsl_vector_complex_alloc (vsize); gsl_fft_halfcomplex_radix2_unpack(data, fourier_data->data, 1, vsize); gsl_vector *fftR_real = gsl_vector_alloc(vsize/2); gsl_vector *fftR_imag = gsl_vector_alloc(vsize/2); //gsl_vector *fftR_abs = gsl_vector_alloc(vsize/2); complex_vector_parts(fourier_data, fftR_real, fftR_imag); complex_vector_abs(fftR_abs, fftR_real, fftR_imag); hanning(fftR_abs, mu->r, mu->rmin, mu->rmax, mu->dwr); gsl_vector_free(fftR_real); gsl_vector_free(fftR_imag); gsl_vector_complex_free(fourier_data); gsl_vector_free(mu_tmp); free(data); }
void KFKSDS_steady (int *dim, double *sy, double *sZ, double *sT, double *sH, double *sR, double *sV, double *sQ, double *sa0, double *sP0, double *tol, int *maxiter, double *ksconvfactor, double *mll, double *epshat, double *vareps, double *etahat, double *vareta, double *sumepsmisc, double *sumetamisc) { int i, ip1, n = dim[0], m = dim[2], ir = dim[3], convref, nmconvref, nm1 = n-1; int irsod = ir * sizeof(double); //double v[n], f[n], invf[n], vof[n]; std::vector<double> v(n), f(n), invf(n), vof(n); sumepsmisc[0] = 0.0; gsl_vector * sum_eta_misc = gsl_vector_calloc(ir); gsl_vector * etahat_sq = gsl_vector_alloc(ir); gsl_vector_view Z = gsl_vector_view_array(sZ, m); gsl_vector * Z_cp = gsl_vector_alloc(m); gsl_matrix * K = gsl_matrix_alloc(n, m); gsl_vector_view K_irow; gsl_matrix_view Q = gsl_matrix_view_array(sQ, m, m); gsl_matrix_view V = gsl_matrix_view_array(sV, ir, ir); gsl_matrix_view R = gsl_matrix_view_array(sR, m, ir); gsl_matrix * r = gsl_matrix_alloc(n + 1, m); gsl_vector_view r_row_t; gsl_vector_view r_row_tp1 = gsl_matrix_row(r, n); gsl_vector_set_zero(&r_row_tp1.vector); std::vector<gsl_matrix*> L(n); std::vector<gsl_matrix*> N(n+1); N.at(n) = gsl_matrix_calloc(m, m); gsl_vector_view Ndiag; gsl_vector_view Qdiag = gsl_matrix_diagonal(&Q.matrix); gsl_vector * Qdiag_msq = gsl_vector_alloc(m); gsl_vector_memcpy(Qdiag_msq, &Qdiag.vector); gsl_vector_mul(Qdiag_msq, &Qdiag.vector); gsl_vector_scale(Qdiag_msq, -1.0); gsl_vector * sum_vareta = gsl_vector_calloc(m); KF_steady(dim, sy, sZ, sT, sH, sR, sV, sQ, sa0, sP0, mll, &v, &f, &invf, &vof, K, &L, tol, maxiter); convref = dim[5]; if (convref == -1) { convref = n; } else convref = ceil(convref * ksconvfactor[0]); nmconvref = n - convref; gsl_vector_view vaux; gsl_matrix * Mmm = gsl_matrix_alloc(m, m); gsl_matrix * ZtZ = gsl_matrix_alloc(m, m); gsl_matrix_view maux1, maux2; maux1 = gsl_matrix_view_array(gsl_vector_ptr(&Z.vector, 0), m, 1); gsl_vector_memcpy(Z_cp, &Z.vector); maux2 = gsl_matrix_view_array(gsl_vector_ptr(Z_cp, 0), 1, m); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix, &maux2.matrix, 0.0, ZtZ); gsl_vector * var_eps = gsl_vector_alloc(n); double msHsq = -1.0 * pow(*sH, 2); vaux = gsl_vector_view_array(&f[0], n); gsl_vector_set_all(var_eps, msHsq); gsl_vector_div(var_eps, &vaux.vector); gsl_vector_add_constant(var_eps, *sH); gsl_matrix * eta_hat = gsl_matrix_alloc(n, ir); gsl_matrix * Mrm = gsl_matrix_alloc(ir, m); gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, &V.matrix, &R.matrix, 0.0, Mrm); for (i = n-1; i > -1; i--) { ip1 = i + 1; if (i != n-1) //the case i=n-1 was initialized above r_row_tp1 = gsl_matrix_row(r, ip1); r_row_t = gsl_matrix_row(r, i); gsl_blas_dgemv(CblasTrans, 1.0, L.at(i), &r_row_tp1.vector, 0.0, &r_row_t.vector); gsl_vector_memcpy(Z_cp, &Z.vector); gsl_vector_scale(Z_cp, vof[i]); gsl_vector_add(&r_row_t.vector, Z_cp); N.at(i) = gsl_matrix_alloc(m, m); if (i < convref || i > nmconvref) { gsl_matrix_memcpy(N.at(i), ZtZ); gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L.at(i), N.at(ip1), 0.0, Mmm); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, L.at(i), invf[i], N.at(i)); } else { gsl_matrix_memcpy(N.at(i), N.at(ip1)); } if (dim[6] == 0 || dim[6] == 1) { if (i < convref || i == nm1) { K_irow = gsl_matrix_row(K, i); } gsl_blas_ddot(&K_irow.vector, &r_row_tp1.vector, &epshat[i]); epshat[i] -= vof[i]; epshat[i] *= -*sH; if (i < convref || i > nmconvref) { maux1 = gsl_matrix_view_array(gsl_vector_ptr(&K_irow.vector, 0), 1, m); maux2 = gsl_matrix_view_array(gsl_vector_ptr(Z_cp, 0), 1, m); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix, N.at(ip1), 0.0, &maux2.matrix); vaux = gsl_vector_view_array(gsl_vector_ptr(var_eps, i), 1); gsl_blas_dgemv(CblasNoTrans, msHsq, &maux2.matrix, &K_irow.vector, 1.0, &vaux.vector); vareps[i] = gsl_vector_get(&vaux.vector, 0); } else { vareps[i] = vareps[ip1]; } sumepsmisc[0] += epshat[i] * epshat[i] + vareps[i]; } if (dim[6] == 0 || dim[6] == 2) { vaux = gsl_matrix_row(eta_hat, i); gsl_blas_dgemv(CblasNoTrans, 1.0, Mrm, &r_row_tp1.vector, 0.0, &vaux.vector); memcpy(&etahat[i*ir], (&vaux.vector)->data, irsod); if (i != n-1) { gsl_vector_memcpy(etahat_sq, &vaux.vector); gsl_vector_mul(etahat_sq, etahat_sq); gsl_vector_add(sum_eta_misc, etahat_sq); } if (i != n-1) { if (i < convref || i > nmconvref) { Ndiag = gsl_matrix_diagonal(N.at(ip1)); gsl_vector_memcpy(Z_cp, &Ndiag.vector); gsl_vector_mul(Z_cp, Qdiag_msq); gsl_vector_add(Z_cp, &Qdiag.vector); gsl_vector_set_zero(sum_vareta); gsl_vector_add(sum_vareta, Z_cp); } gsl_blas_dgemv(CblasTrans, 1.0, &R.matrix, sum_vareta, 1.0, sum_eta_misc); } } gsl_matrix_free(L.at(i)); gsl_matrix_free(N.at(ip1)); } gsl_matrix_free(N.at(0)); if (dim[6] == 0 || dim[6] == 2) { memcpy(&sumetamisc[0], sum_eta_misc->data, irsod); } gsl_vector_free(Z_cp); gsl_vector_free(var_eps); gsl_vector_free(Qdiag_msq); gsl_vector_free(sum_vareta); gsl_vector_free(sum_eta_misc); gsl_vector_free(etahat_sq); gsl_matrix_free(eta_hat); gsl_matrix_free(Mrm); gsl_matrix_free(r); gsl_matrix_free(K); gsl_matrix_free(ZtZ); gsl_matrix_free(Mmm); }
int model::predict(const dataset &tds, gsl_matrix **pp) { int ret = -1; gsl_matrix *mat = NULL; gsl_matrix *ptv = NULL; gsl_matrix *km1 = NULL; gsl_matrix *km2 = NULL; gsl_matrix *res = NULL; gsl_matrix *stm = NULL; gsl_vector_view avg_col; gsl_vector_view dv; if (tds.ins_num() <= 0 || tds.fea_num() != (int)_col_mean->size) { ULIB_FATAL("invalid test dimensions, (ins_num=%d,fea_num=%d)", tds.ins_num(), tds.fea_num()); goto done; } mat = gsl_matrix_alloc(tds.ins_num(), tds.fea_num()); if (mat == NULL) { ULIB_FATAL("couldn't allocate test feature matrix"); goto done; } ptv = gsl_matrix_alloc(tds.ins_num(), 2); if (ptv == NULL) { ULIB_FATAL("couldn't allocate prediction matrix"); goto done; } if (tds.get_matrix(mat)) { ULIB_FATAL("couldn't get test matrix"); goto done; } dbg_print_mat(mat, "Test Matrix:"); zero_out_mat(mat); norm_mat(mat); dbg_print_mat(mat, "Normalized Test Matrix:"); km1 = comp_kern_mat(mat, _fm, _kern); if (km1 == NULL) { ULIB_FATAL("couldn't compute test1 kernel matrix"); goto done; } dbg_print_mat(km1, "Test Kernel Matrix:"); km2 = comp_kern_mat(mat, mat, _kern); if (km2 == NULL) { ULIB_FATAL("couldn't compute test2 kernel matrix"); goto done; } dbg_print_mat(km1, "Test Kernel Matrix:"); dv = gsl_matrix_diagonal(km2); res = gsl_matrix_alloc(km1->size1, _ikm->size2); if (res == NULL) { ULIB_FATAL("couldn't allocate temporary matrix"); goto done; } stm = gsl_matrix_alloc(km2->size1, km2->size2); if (stm == NULL) { ULIB_FATAL("couldn't allocate std matrix"); goto done; } gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, km1, _ikm, 0.0, res); gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, res, km1, 0.0, stm); gsl_matrix_sub(km2, stm); dbg_print_mat(res, "Predictive Matrix:"); avg_col = gsl_matrix_column(ptv, 0); gsl_blas_dgemv(CblasNoTrans, 1.0, res, _tv, 0.0, &avg_col.vector); gsl_vector_add_constant(&avg_col.vector, _t_avg); gsl_matrix_scale(km2, _t_std*_t_std); gsl_vector_add_constant(&dv.vector, _noise_var); for (size_t i = 0; i < km2->size1; ++i) gsl_matrix_set(ptv, i, 1, sqrt(gsl_vector_get(&dv.vector, i))); *pp = ptv; ptv = NULL; ret = 0; done: gsl_matrix_free(mat); gsl_matrix_free(ptv); gsl_matrix_free(km1); gsl_matrix_free(km2); gsl_matrix_free(res); gsl_matrix_free(stm); return ret; }
int main(int argc, char **argv){ int row = atoi(argv[2]); int col = atoi(argv[3]); printf("%d %d\n", row, col); gsl_matrix* data = gsl_matrix_alloc(row, col); //gsl_matrix* data = gsl_matrix_alloc(col, row); FILE* f = fopen(argv[1], "r"); gsl_matrix_fscanf(f, data); //gsl_matrix_fread(f, data); //gsl_matrix_transpose_memcpy(data, data_raw); fclose(f); //printf("%f %f", gsl_matrix_get(data,0,0), gsl_matrix_get(data,0,1)); //f = fopen("test.dat", "w"); //gsl_matrix_fprintf(f, data, "%f"); //fclose(f); // data centering, subtract the mean in each dimension (col.-wise) int i, j; double mean, sum, std; gsl_vector_view col_vector; for (i = 0; i < col; ++i){ col_vector = gsl_matrix_column(data, i); mean = gsl_stats_mean((&col_vector.vector)->data, 1, (&col_vector.vector)->size); gsl_vector_add_constant(&col_vector.vector, -mean); gsl_matrix_set_col(data, i, &col_vector.vector); } char filename[50]; //sprintf(filename, "%s.zscore", argv[1]); //print2file(filename, data); gsl_matrix* u; if (col > row) { u = gsl_matrix_alloc(data->size2, data->size1); gsl_matrix_transpose_memcpy(u, data); } else { u = gsl_matrix_alloc(data->size1, data->size2); gsl_matrix_memcpy(u, data); } // svd gsl_matrix* X = gsl_matrix_alloc(col, col); gsl_matrix* V = gsl_matrix_alloc(u->size2, u->size2); gsl_vector* S = gsl_vector_alloc(u->size2); gsl_vector* work = gsl_vector_alloc(u->size2); gsl_linalg_SV_decomp(u, V, S, work); //gsl_linalg_SV_decomp_jacobi(u, V, S); // mode coefficient //print2file("u.dat", u); /* // characteristic mode gsl_matrix* diag = diag_alloc(S); gsl_matrix* mode = gsl_matrix_alloc(diag->size1, V->size1); gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, diag, V, 0.0, mode); gsl_matrix_transpose(mode); print2file("mode.dat", mode); gsl_matrix_transpose(mode); */ // reconstruction gsl_matrix *recons = gsl_matrix_alloc(u->size2, data->size1); if (col > row) { gsl_matrix_view data_sub = gsl_matrix_submatrix(data, 0, 0, u->size2, u->size2); gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, V, &data_sub.matrix, 0.0, recons); } else gsl_blas_dgemm(CblasTrans, CblasTrans, 1.0, V, data, 0.0, recons); //gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, u, mode, 0.0, // recons); gsl_matrix *recons_trans = gsl_matrix_alloc(recons->size2, recons->size1); gsl_matrix_transpose_memcpy(recons_trans, recons); // take the first two eigenvectors gsl_matrix_view final = gsl_matrix_submatrix(recons_trans, 0, 0, recons_trans->size1, 2); print2file(argv[4], &final.matrix); // eigenvalue gsl_vector_mul(S, S); f = fopen("eigenvalue.dat", "w"); //gsl_vector_fprintf(f, S, "%f"); fclose(f); gsl_matrix_free(data); gsl_matrix_free(X); gsl_matrix_free(V); //gsl_matrix_free(diag); //gsl_matrix_free(mode); gsl_matrix_free(recons); gsl_matrix_free(recons_trans); gsl_matrix_free(u); gsl_vector_free(S); gsl_vector_free(work); //gsl_vector_free(zero); //gsl_vector_free(corrcoef); //gsl_vector_free(corrcoef_mean); return 0; }
/* solve standard form system with given lambda and test against * normal equations solution, L = I */ static void test_reg2(const double lambda, const gsl_matrix * X, const gsl_vector * y, const gsl_vector * wts, const double tol, gsl_multifit_linear_workspace * w, const char * desc) { const size_t n = X->size1; const size_t p = X->size2; double rnorm0, snorm0; double rnorm1, snorm1; gsl_vector *c0 = gsl_vector_alloc(p); gsl_vector *c1 = gsl_vector_alloc(p); gsl_matrix *XTX = gsl_matrix_alloc(p, p); /* X^T W X + lambda^2 I */ gsl_vector *XTy = gsl_vector_alloc(p); /* X^T W y */ gsl_matrix *Xs = gsl_matrix_alloc(n, p); gsl_vector *ys = gsl_vector_alloc(n); gsl_vector_view xtx_diag = gsl_matrix_diagonal(XTX); gsl_permutation *perm = gsl_permutation_alloc(p); gsl_vector *r = gsl_vector_alloc(n); int signum; size_t j; /* compute Xs = sqrt(W) X and ys = sqrt(W) y */ gsl_multifit_linear_wstdform1(NULL, X, wts, y, Xs, ys, w); /* construct XTy = X^T W y */ gsl_blas_dgemv(CblasTrans, 1.0, Xs, ys, 0.0, XTy); /* construct XTX = X^T W X + lambda^2 I */ gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, Xs, Xs, 0.0, XTX); gsl_vector_add_constant(&xtx_diag.vector, lambda*lambda); /* solve XTX c = XTy with LU decomp */ gsl_linalg_LU_decomp(XTX, perm, &signum); gsl_linalg_LU_solve(XTX, perm, XTy, c0); /* compute SVD of X */ gsl_multifit_linear_svd(Xs, w); /* solve regularized standard form system with lambda */ gsl_multifit_linear_solve(lambda, Xs, ys, c1, &rnorm0, &snorm0, w); /* test snorm = ||c1|| */ snorm1 = gsl_blas_dnrm2(c1); gsl_test_rel(snorm0, snorm1, tol, "test_reg2: %s, snorm lambda=%g n=%zu p=%zu", desc, lambda, n, p); /* test rnorm = ||y - X c1|| */ gsl_vector_memcpy(r, ys); gsl_blas_dgemv(CblasNoTrans, -1.0, Xs, c1, 1.0, r); rnorm1 = gsl_blas_dnrm2(r); gsl_test_rel(rnorm0, rnorm1, tol, "test_reg2: %s, rnorm lambda=%g n=%zu p=%zu", desc, lambda, n, p); /* test c0 = c1 */ for (j = 0; j < p; ++j) { double c0j = gsl_vector_get(c0, j); double c1j = gsl_vector_get(c1, j); gsl_test_rel(c1j, c0j, tol, "test_reg2: %s, c0/c1 lambda=%g n=%zu p=%zu", desc, lambda, n, p); } gsl_matrix_free(XTX); gsl_vector_free(XTy); gsl_matrix_free(Xs); gsl_vector_free(ys); gsl_vector_free(c0); gsl_vector_free(c1); gsl_vector_free(r); gsl_permutation_free(perm); }
void KFKSDS_deriv_C (int *dim, double *sy, double *sZ, double *sT, double *sH, double *sR, double *sV, double *sQ, double *sa0, double *sP0, double *dvof, double *epshat, double *vareps, double *etahat, double *vareta, double *r, double *N, double *dr, double *dN, double *dahat, double *dvareps) { //int s, p = dim[1], mp1 = m + 1; int i, ip1, j, k, n = dim[0], m = dim[2], ir = dim[3], rp1 = ir + 1, nrp1 = n * rp1, rp1m = rp1 * m, iaux, irp1m, irsod = ir * sizeof(double), msod = m * sizeof(double), nsod = n * sizeof(double), rp1msod = rp1 * msod; //double invf[n], vof[n], msHsq, dfinvfsq[nrp1]; double msHsq; std::vector<double> invf(n); std::vector<double> vof(n); std::vector<double> dfinvfsq(nrp1); gsl_matrix_view Q = gsl_matrix_view_array(sQ, m, m); gsl_vector_view Z = gsl_vector_view_array(sZ, m); gsl_vector * Z_cp = gsl_vector_alloc(m); gsl_matrix * ZtZ = gsl_matrix_alloc(m, m); gsl_matrix_view maux1, maux2; maux1 = gsl_matrix_view_array(gsl_vector_ptr(&Z.vector, 0), m, 1); gsl_vector_memcpy(Z_cp, &Z.vector); maux2 = gsl_matrix_view_array(gsl_vector_ptr(Z_cp, 0), 1, m); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix, &maux2.matrix, 0.0, ZtZ); gsl_matrix * a_pred = gsl_matrix_alloc(n, m); std::vector<gsl_matrix*> P_pred(n); gsl_matrix * K = gsl_matrix_alloc(n, m); gsl_vector_view K_irow; std::vector<gsl_matrix*> L(n); gsl_vector_view Qdiag = gsl_matrix_diagonal(&Q.matrix); gsl_vector * Qdiag_msq = gsl_vector_alloc(m); gsl_vector_memcpy(Qdiag_msq, &Qdiag.vector); gsl_vector_mul(Qdiag_msq, &Qdiag.vector); gsl_vector_scale(Qdiag_msq, -1.0); std::vector<gsl_matrix*> da_pred(rp1); std::vector< std::vector<gsl_matrix*> > dP_pred(n, std::vector<gsl_matrix*>(rp1)); std::vector<gsl_matrix*> dK(n); // filtering KF_deriv_aux_C(dim, sy, sZ, sT, sH, sR, sV, sQ, sa0, sP0, &invf, &vof, dvof, &dfinvfsq, a_pred, &P_pred, K, &L, &da_pred, &dP_pred, &dK); // state vector smoothing and disturbances smoothing gsl_matrix_view V = gsl_matrix_view_array(sV, ir, ir); gsl_matrix_view R = gsl_matrix_view_array(sR, m, ir); gsl_vector_view vaux; gsl_vector *vaux2 = gsl_vector_alloc(m); gsl_matrix *Mmm = gsl_matrix_alloc(m, m); gsl_matrix *Mmm2 = gsl_matrix_alloc(m, m); gsl_matrix *Mrm = gsl_matrix_alloc(ir, m); gsl_vector_memcpy(Z_cp, &Z.vector); gsl_matrix *r0 = gsl_matrix_alloc(n + 1, m); gsl_vector_view r_row_t; gsl_vector_view r_row_tp1 = gsl_matrix_row(r0, n); gsl_vector_set_zero(&r_row_tp1.vector); std::vector<gsl_matrix*> N0(n + 1); N0.at(n) = gsl_matrix_calloc(m, m); gsl_vector_view Ndiag; gsl_vector *var_eps = gsl_vector_alloc(n); msHsq = -1.0 * pow(*sH, 2); //vaux = gsl_vector_view_array(invf, n); vaux = gsl_vector_view_array(&invf[0], n); gsl_vector_set_all(var_eps, msHsq); gsl_vector_mul(var_eps, &vaux.vector); gsl_vector_add_constant(var_eps, *sH); gsl_vector *vr = gsl_vector_alloc(ir); gsl_matrix *dL = gsl_matrix_alloc(m, m); std::vector<gsl_matrix*> dr0(n + 1); dr0.at(n) = gsl_matrix_calloc(rp1, m); gsl_vector_view dr_row_t, dr_row_tp1; std::vector< std::vector<gsl_matrix*> > dN0(n + 1, std::vector<gsl_matrix*>(rp1)); for (j = 0; j < rp1; j++) { (dN0.at(n)).at(j) = gsl_matrix_calloc(m, m); } for (i = n-1; i > -1; i--) { ip1 = i + 1; iaux = (i-1) * rp1m; irp1m = i * rp1m; if (i != n-1) //the case i=n-1 was initialized above r_row_tp1 = gsl_matrix_row(r0, ip1); r_row_t = gsl_matrix_row(r0, i); gsl_blas_dgemv(CblasTrans, 1.0, L.at(i), &r_row_tp1.vector, 0.0, &r_row_t.vector); gsl_vector_memcpy(Z_cp, &Z.vector); gsl_vector_scale(Z_cp, vof.at(i)); gsl_vector_add(&r_row_t.vector, Z_cp); gsl_vector_memcpy(vaux2, &r_row_tp1.vector); memcpy(&r[i * m], vaux2->data, msod); N0.at(i) = gsl_matrix_alloc(m, m); gsl_matrix_memcpy(N0.at(i), ZtZ); gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L.at(i), N0.at(ip1), 0.0, Mmm); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, L.at(i), invf.at(i), N0.at(i)); vaux = gsl_matrix_diagonal(N0.at(ip1)); gsl_vector_memcpy(vaux2, &vaux.vector); memcpy(&N[i * m], vaux2->data, msod); K_irow = gsl_matrix_row(K, i); gsl_blas_ddot(&K_irow.vector, &r_row_tp1.vector, &epshat[i]); epshat[i] -= vof.at(i); epshat[i] *= -*sH; maux1 = gsl_matrix_view_array(gsl_vector_ptr(&K_irow.vector, 0), 1, m); maux2 = gsl_matrix_view_array(gsl_vector_ptr(Z_cp, 0), 1, m); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix, N0.at(ip1), 0.0, &maux2.matrix); vaux = gsl_vector_view_array(gsl_vector_ptr(var_eps, i), 1); gsl_blas_dgemv(CblasNoTrans, msHsq, &maux2.matrix, &K_irow.vector, 1.0, &vaux.vector); gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, &V.matrix, &R.matrix, 0.0, Mrm); gsl_blas_dgemv(CblasNoTrans, 1.0, Mrm, &r_row_tp1.vector, 0.0, vr); memcpy(&etahat[i*ir], vr->data, irsod); Ndiag = gsl_matrix_diagonal(N0.at(ip1)); gsl_vector_memcpy(Z_cp, &Ndiag.vector); gsl_vector_mul(Z_cp, Qdiag_msq); gsl_vector_add(Z_cp, &Qdiag.vector); gsl_blas_dgemv(CblasTrans, 1.0, &R.matrix, Z_cp, 0.0, vr); memcpy(&vareta[i*ir], vr->data, irsod); // derivatives dr0.at(i) = gsl_matrix_alloc(rp1, m); for (j = 0; j < rp1; j++) { k = i + j * n; gsl_vector_memcpy(Z_cp, &Z.vector); gsl_vector_scale(Z_cp, dvof[k]); vaux = gsl_matrix_row(dK.at(i), j); maux1 = gsl_matrix_view_array(gsl_vector_ptr(&vaux.vector, 0), m, 1); maux2 = gsl_matrix_view_array(gsl_vector_ptr(&Z.vector, 0), 1, m); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, &maux1.matrix, &maux2.matrix, 0.0, dL); dr_row_t = gsl_matrix_row(dr0.at(i), j); dr_row_tp1 = gsl_matrix_row(dr0.at(ip1), j); gsl_blas_dgemv(CblasTrans, 1.0, dL, &r_row_tp1.vector, 0.0, &dr_row_t.vector); gsl_vector_add(&dr_row_t.vector, Z_cp); gsl_blas_dgemv(CblasTrans, 1.0, L.at(i), &dr_row_tp1.vector, 1.0, &dr_row_t.vector); (dN0.at(i)).at(j) = gsl_matrix_alloc(m, m); gsl_matrix_memcpy((dN0.at(i)).at(j), ZtZ); gsl_matrix_scale((dN0.at(i)).at(j), -1.0 * dfinvfsq.at(k)); gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, dL, N0.at(ip1), 0.0, Mmm); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, L.at(i), 1.0, (dN0.at(i)).at(j)); gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L.at(i), (dN0.at(ip1)).at(j), 0.0, Mmm); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, L.at(i), 1.0, (dN0.at(i)).at(j)); gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L.at(i), N0.at(ip1), 0.0, Mmm); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, dL, 1.0, (dN0.at(i)).at(j)); if (i != 0) { vaux = gsl_matrix_diagonal((dN0.at(i)).at(j)); gsl_vector_memcpy(vaux2, &vaux.vector); memcpy(&dN[iaux + j * m], vaux2->data, msod); } vaux = gsl_matrix_row(da_pred.at(j), i); gsl_blas_dgemv(CblasNoTrans, 1.0, (dP_pred.at(i)).at(j) , &r_row_t.vector, 1.0, &vaux.vector); gsl_blas_dgemv(CblasNoTrans, 1.0, P_pred.at(i), &dr_row_t.vector, 1.0, &vaux.vector); gsl_vector_memcpy(vaux2, &vaux.vector); memcpy(&dahat[irp1m + j * m], vaux2->data, msod); gsl_matrix_memcpy(Mmm, (dP_pred.at(i)).at(j)); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, (dP_pred.at(i)).at(j), N0.at(i), 0.0, Mmm2); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm2, P_pred.at(i), 1.0, Mmm); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, P_pred.at(i), (dN0.at(i)).at(j), 0.0, Mmm2); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm2, P_pred.at(i), 1.0, Mmm); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, P_pred.at(i), N0.at(i), 0.0, Mmm2); gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm2, (dP_pred.at(i)).at(j), 1.0, Mmm); gsl_matrix_mul_elements(Mmm, ZtZ); std::vector<double> vmm(Mmm->data, Mmm->data + m*m); dvareps[i*rp1 + j] = std::accumulate(vmm.begin(), vmm.end(), 0.0); gsl_matrix_free((dN0.at(ip1)).at(j)); gsl_matrix_free((dP_pred.at(i)).at(j)); } if (i != 0) { memcpy(&dr[iaux], (dr0.at(i))->data, rp1msod); } gsl_matrix_free(dr0.at(ip1)); gsl_matrix_free(dK.at(i)); gsl_matrix_free(P_pred.at(i)); gsl_matrix_free(L.at(i)); gsl_matrix_free(N0.at(ip1)); } gsl_matrix_free(N0.at(0)); gsl_matrix_free(dr0.at(0)); for (j = 0; j < rp1; j++) { gsl_matrix_free((dN0.at(0)).at(j)); gsl_matrix_free(da_pred.at(j)); } memcpy(&vareps[0], var_eps->data, nsod); gsl_matrix_free(Mmm); gsl_matrix_free(Mmm2); gsl_matrix_free(Mrm); gsl_matrix_free(r0); gsl_matrix_free(K); gsl_matrix_free(dL); gsl_matrix_free(a_pred); gsl_vector_free(Z_cp); gsl_matrix_free(ZtZ); gsl_vector_free(var_eps); gsl_vector_free(vr); gsl_vector_free(Qdiag_msq); gsl_vector_free(vaux2); }}
gsl_matrix* pca(gsl_matrix* feature_matrix, gsl_vector* means, float sig_limit) { // subtract means of columns for (unsigned int j = 0; j < feature_matrix->size2; j++) { gsl_vector_view vv = gsl_matrix_column(feature_matrix,j); gsl_vector* v = &vv.vector; gsl_vector_set(means, j, getVectorMean(v)); gsl_vector_add_constant(v, (-1.0) * gsl_vector_get(means,j)); } // initialise matrix SEXP m; double* matrix; PROTECT(m = allocMatrix(REALSXP, feature_matrix->size1, feature_matrix->size2)); matrix = REAL(m); for (unsigned int i = 0; i < feature_matrix->size1; i++) { for (unsigned int j = 0; j < feature_matrix->size2; j++) { matrix[i+(feature_matrix->size1)*j] = gsl_matrix_get( feature_matrix, i, j); } } // do principal components analysis, using R //fprintf(stderr, "PCA\n"); fflush(stdout); SEXP pca; PROTECT(pca = R_exec("prcomp", m)); //R_exec("print", pca); SEXP summary; PROTECT(summary = R_exec("summary", pca)); //R_exec("print", summary); // get proportion of variance SEXP ev; PROTECT(ev = get_list_element(pca,(char*)"sdev")); //R_exec("print",ev); unsigned int dim = length(ev); //printf("dim: %i\n", dim); float sum_var = 0.0; float c_ev = 0.0; for (unsigned int i = 0; i < dim; i++) { c_ev = (REAL(ev)[i]) * (REAL(ev)[i]); sum_var += c_ev; } float cum_var = 0.0; unsigned int sig_cnt = 0; for (unsigned int i = 0; i < dim; i++) { c_ev = (REAL(ev)[i]) * (REAL(ev)[i]); cum_var += c_ev; //printf("ev%i: %.7g\n", i, REAL(ev)[i]); sig_cnt++; if ((cum_var/sum_var) > sig_limit) break; } //fprintf(stderr, "Cumulative variance of %g reached by using %i eigen vector(s).\n" , (cum_var/sum_var), sig_cnt); // get loads (eigenvectors) SEXP loads; PROTECT(loads = get_list_element(pca, (char*)"rotation")); //R_exec("print", loads); gsl_matrix* rot = gsl_matrix_alloc(dim, sig_cnt); for (unsigned int i = 0; i < dim; i++) { for (unsigned int j = 0; j < sig_cnt; j++) { gsl_matrix_set(rot, i, j, REAL(loads)[i+dim*j]); //printf("%g \n", REAL(loads)[i+dim*j]); } } // de-initialise R UNPROTECT(4); end_R(); return(rot); }
int DPMHC_xi_smplr(struct str_DPMHC *ptr_DPMHC_data, int i_J, struct str_firm_data *a_firm_data) { int j,i; int i_K = ptr_DPMHC_data->i_K; int i_n = ptr_DPMHC_data->v_y->size; // is this the same as i_J??? if (i_n != i_J){ fprintf(stderr,"Error in DPMN_xi_smplr(): DPMHC.v_y length does not equal i_J\n"); exit(1); } double d_sumT_si; gsl_vector_int *vi_S = ptr_DPMHC_data->vi_S; gsl_matrix *m_theta = ptr_DPMHC_data->m_DPtheta; double d_A = ptr_DPMHC_data->d_A; double d_mu_si, d_tau_si, d_ei; double d_mean_j, d_var_j; double d_xi_j; int i_Ti; int i_factors = (a_firm_data[0].v_beta)->size; gsl_vector *v_ret; gsl_matrix *m_factors; gsl_vector *v_betai; gsl_vector *v_rstar_i; gsl_matrix *m_Xi; gsl_matrix_view mv_Xi; double d_rstar_j; double d_s2i; for(j=0;j<i_K;j++){ d_mu_si = mget(m_theta,j,0); d_tau_si = mget(m_theta,j,2); d_rstar_j = 0.; d_sumT_si = 0; for(i=0;i<i_J;i++){ if( vget_int(vi_S,i) == j ){ d_ei = vget(ptr_DPMHC_data->v_e,i); m_factors = a_firm_data[i].m_factors; i_Ti = a_firm_data[i].i_ni; d_s2i = a_firm_data[i].d_s2; m_Xi = gsl_matrix_alloc(i_Ti,i_factors); mv_Xi = gsl_matrix_submatrix(m_factors,0,0,i_Ti,i_factors); gsl_matrix_memcpy(m_Xi,&mv_Xi.matrix); v_betai = a_firm_data[i].v_beta; v_ret = a_firm_data[i].v_ret; v_rstar_i = gsl_vector_alloc(i_Ti); gsl_vector_memcpy(v_rstar_i,v_ret); gsl_blas_dgemv(CblasNoTrans, -1.0, m_Xi, v_betai, 1.0, v_rstar_i); gsl_vector_add_constant(v_rstar_i, -d_mu_si); gsl_vector_scale(v_rstar_i, 1./(sqrt(d_tau_si) * d_ei) ); d_rstar_j += sum(v_rstar_i); d_sumT_si += i_Ti/(d_s2i/(d_tau_si * d_ei * d_ei) ); gsl_matrix_free(m_Xi); gsl_vector_free(v_rstar_i); } } d_var_j = 1./( 1./(d_A * d_A) + d_sumT_si); d_mean_j = d_rstar_j * d_var_j; d_xi_j = d_mean_j + gsl_ran_gaussian_ziggurat(rng, sqrt(d_var_j) ); mset(m_theta, j, 1, d_xi_j); // printf("%d: eta = %g lambda^2 = %g\n",j, mget(m_theta,j,0), mget(m_theta,j,1) ); } return 0; }
struct scaling gsl_vector_normalize(gsl_vector * v){ struct scaling scale = {gsl_vector_max(v) - gsl_vector_min(v), gsl_stats_mean(v->data, v->stride, v->size)}; gsl_vector_add_constant(v, -scale.center); if(scale.scale!=0){gsl_vector_scale(v,1/scale.scale);} return scale; }
int gsl_multifit_linear_Lsobolev(const size_t p, const size_t kmax, const gsl_vector *alpha, gsl_matrix *L, gsl_multifit_linear_workspace *work) { if (p > work->pmax) { GSL_ERROR("p is larger than workspace", GSL_EBADLEN); } else if (p <= kmax) { GSL_ERROR("p must be larger than derivative order", GSL_EBADLEN); } else if (kmax + 1 != alpha->size) { GSL_ERROR("alpha must be size kmax + 1", GSL_EBADLEN); } else if (p != L->size1) { GSL_ERROR("L matrix is wrong size", GSL_EBADLEN); } else if (L->size1 != L->size2) { GSL_ERROR("L matrix is not square", GSL_ENOTSQR); } else { int s; size_t j, k; gsl_vector_view d = gsl_matrix_diagonal(L); const double alpha0 = gsl_vector_get(alpha, 0); /* initialize L to alpha0^2 I */ gsl_matrix_set_zero(L); gsl_vector_add_constant(&d.vector, alpha0 * alpha0); for (k = 1; k <= kmax; ++k) { gsl_matrix_view Lk = gsl_matrix_submatrix(work->Q, 0, 0, p - k, p); double ak = gsl_vector_get(alpha, k); /* compute a_k L_k */ s = gsl_multifit_linear_Lk(p, k, &Lk.matrix); if (s) return s; gsl_matrix_scale(&Lk.matrix, ak); /* LTL += L_k^T L_k */ gsl_blas_dsyrk(CblasLower, CblasTrans, 1.0, &Lk.matrix, 1.0, L); } s = gsl_linalg_cholesky_decomp(L); if (s) return s; /* copy Cholesky factor to upper triangle and zero out bottom */ gsl_matrix_transpose_tricpy('L', 1, L, L); for (j = 0; j < p; ++j) { for (k = 0; k < j; ++k) gsl_matrix_set(L, j, k, 0.0); } return GSL_SUCCESS; } }
int Holling2(double t, const double y[], double ydot[], void *params){ double alpha = 0.3; // respiration double lambda = 0.65; // ecologic efficiency double hand = 0.35; // handling time double beta = 0.5; // intraspecific competition double aij = 6.0; // attack rate //double migratingPop = 0.01; int i, j,l = 0; // Hilfsvariablen double rowsum = 0; //double colsum = 0; // int test = 0; // // if(test<5) // { // printf("Richtiges Holling"); // } // test++; //-- Struktur zerlegen------------------------------------------------------------------------------------------------------------------------------- struct foodweb *nicheweb = (struct foodweb *)params; // pointer cast from (void*) to (struct foodweb*) //printf("t in Holling 2=%f\n", t); gsl_vector *network = (nicheweb->network); // Inhalt: A+linksA+Y+linksY+Massen+Trophische_Level = (Rnum+S)²+1+Y²+1+(Rnum+S)+S int S = nicheweb->S; int Y = nicheweb->Y; int Rnum = nicheweb->Rnum; //double d = nicheweb->d; int Z = nicheweb->Z; //double dij = pow(10, d); double Bmigr = gsl_vector_get(network, (Rnum+S)*(S+Rnum)+1+Y*Y+1+(Rnum+S)+S); //printf("Bmigr ist %f\n", Bmigr); double nu,mu, tau; int SpeciesNumber; tau = gsl_vector_get(nicheweb->migrPara,0); mu = gsl_vector_get(nicheweb->migrPara,1); // if((int)nu!=0) // { // printf("nu ist nicht null sondern %f\n",nu); // } nu = gsl_vector_get(nicheweb->migrPara,2); SpeciesNumber = gsl_vector_get(nicheweb->migrPara,3); double tlast = gsl_vector_get(nicheweb->migrPara,4); // if(SpeciesNumber!= 0) // { // //printf("SpeciesNumber %i\n", SpeciesNumber); // } //printf("t oben %f\n",t); //int len = (Rnum+S)*(Rnum+S)+2+Y*Y+(Rnum+S)+S; gsl_vector_view A_view = gsl_vector_subvector(network, 0, (Rnum+S)*(Rnum+S)); // Fressmatrix A als Vektor gsl_matrix_view EA_mat = gsl_matrix_view_vector(&A_view.vector, (Rnum+S), (Rnum+S)); // A als Matrix_view gsl_matrix *EAmat = &EA_mat.matrix; // A als Matrix gsl_vector_view D_view = gsl_vector_subvector(network, (Rnum+S)*(Rnum+S)+1, Y*Y); // Migrationsmatrix D als Vektor gsl_matrix_view ED_mat = gsl_matrix_view_vector(&D_view.vector, Y, Y); // D als Matrixview gsl_matrix *EDmat = &ED_mat.matrix; // D als Matrix gsl_vector_view M_vec = gsl_vector_subvector(network, ((Rnum+S)*(Rnum+S))+1+(Y*Y)+1, (Rnum+S)); // Massenvektor gsl_vector *Mvec = &M_vec.vector; //-- verändere zu dem gewünschten Zeitpunkt Migrationsmatrix if( (t > tau) && (tlast < tau)) { //printf("mu ist %f\n", gsl_vector_get(nicheweb->migrPara,1)); //printf("nu ist %f\n", nu); gsl_vector_set(nicheweb->migrPara,4,t); //printf("Setze Link für gewünschte Migration\n"); // printf("t oben %f\n",t); // printf("tlast oben %f\n",tlast); gsl_matrix_set(EDmat, nu, mu, 1.); //int m; // for(l = 0; l< Y;l++) // { // for(m=0;m<Y;m++) // { // printf("%f\t",gsl_matrix_get(EDmat,l,m)); // } // printf("\n"); // } } else { gsl_matrix_set_zero(EDmat); } // printf("\ncheckpoint Holling2 I\n"); // printf("\nS = %i\n", S); // printf("\nS + Rnum = %i\n", S+Rnum); // // printf("\nSize A_view = %i\n", (int)A_view.vector.size); // printf("\nSize D_view = %i\n", (int)D_view.vector.size); // printf("\nSize M_vec = %i\n", (int)M_vec.vector.size); // for(i=0; i<(Rnum+S)*Y; i++){ // printf("\ny = %f\n", y[i]); // } // for(i=0; i<(Rnum+S)*Y; i++){ // printf("\nydot = %f\n", ydot[i]); // } //--zusätzliche Variablen anlegen------------------------------------------------------------------------------------------------------------- double ytemp[(Rnum+S)*Y]; for(i=0; i<(Rnum+S)*Y; i++) ytemp[i] = y[i]; // temp array mit Kopie der Startwerte for(i=0; i<(Rnum+S)*Y; i++) ydot[i] = 0; // Ergebnis, in das evolve_apply schreibt gsl_vector_view yfddot_vec = gsl_vector_view_array(ydot, (Rnum+S)*Y); //Notiz: vector_view_array etc. arbeiten auf den original Daten der ihnen zugeordneten Arrays/Vektoren! gsl_vector *yfddotvec = &yfddot_vec.vector; // zum einfacheren Rechnen ydot über vector_view_array ansprechen gsl_vector_view yfd_vec = gsl_vector_view_array(ytemp, (Rnum+S)*Y); gsl_vector *yfdvec = &yfd_vec.vector; // Startwerte der Populationen //-- neue Objekte zum Rechnen anlegen-------------------------------------------------------------------------------------------------------- gsl_matrix *AFgsl = gsl_matrix_calloc(Rnum+S, Rnum+S); // matrix of foraging efforts // gsl_matrix *ADgsl = gsl_matrix_calloc(Y,Y); // matrix of migration efforts gsl_matrix *Emat = gsl_matrix_calloc(Rnum+S, Rnum+S); // gsl objects for calculations of populations gsl_vector *tvec = gsl_vector_calloc(Rnum+S); gsl_vector *rvec = gsl_vector_calloc(Rnum+S); gsl_vector *svec = gsl_vector_calloc(Rnum+S); // gsl_matrix *Dmat = gsl_matrix_calloc(Y,Y); // gsl objects for calculations of migration // gsl_vector *d1vec = gsl_vector_calloc(Y); gsl_vector *d2vec = gsl_vector_calloc(Y); gsl_vector *d3vec = gsl_vector_calloc(Y); // printf("\ncheckpoint Holling2 III\n"); //-- Einzelne Patches lösen------------------------------------------------------------------------------------------------------------ for(l=0; l<Y; l++) // start of patch solving { gsl_matrix_set_zero(AFgsl); // Objekte zum Rechnen vor jedem Patch nullen gsl_matrix_set_zero(Emat); gsl_vector_set_zero(tvec); gsl_vector_set_zero(rvec); gsl_vector_set_zero(svec); gsl_vector_view ydot_vec = gsl_vector_subvector(yfddotvec, (Rnum+S)*l, (Rnum+S)); // enthält ydot von Patch l gsl_vector *ydotvec = &ydot_vec.vector; gsl_vector_view y_vec = gsl_vector_subvector(yfdvec, (Rnum+S)*l, (Rnum+S)); // enthält Startwerte der Population in l gsl_vector *yvec = &y_vec.vector; gsl_matrix_memcpy(AFgsl, EAmat); for(i=0; i<Rnum+S; i++) { gsl_vector_view rowA = gsl_matrix_row(AFgsl,i); rowsum = gsl_blas_dasum(&rowA.vector); if(rowsum !=0 ) { for(j=0; j<Rnum+S; j++) gsl_matrix_set(AFgsl, i, j, (gsl_matrix_get(AFgsl,i,j)/rowsum)); // normiere Beute Afgsl = A(Beutelinks auf 1 normiert) = f(i,j) } } gsl_matrix_memcpy(Emat, EAmat); // Emat = A gsl_matrix_scale(Emat, aij); // Emat(i,j) = a(i,j) gsl_matrix_mul_elements(Emat, AFgsl); // Emat(i,j) = a(i,j)*f(i,j) gsl_vector_memcpy(svec, yvec); // s(i) = y(i) gsl_vector_scale(svec, hand); // s(i) = y(i)*h gsl_blas_dgemv(CblasNoTrans, 1, Emat, svec, 0, rvec); // r(i) = Sum_k h*a(i,k)*f(i,k)*y(k) gsl_vector_add_constant(rvec, 1); // r(i) = 1+Sum_k h*a(i,k)*f(i,k)*y(k) gsl_vector_memcpy(tvec, Mvec); // t(i) = masse(i)^(-0.25) gsl_vector_div(tvec, rvec); // t(i) = masse(i)^(-0.25)/(1+Sum_k h*a(i,k)*f(i,k)*y(k)) gsl_vector_mul(tvec, yvec); // t(i) = masse(i)^(-0.25)*y(i)/(1+Sum_k h*a(i,k)*f(i,k)*y(k)) gsl_blas_dgemv(CblasTrans, 1, Emat, tvec, 0, rvec); // r(i) = Sum_j a(j,i)*f(j,i)*t(j) gsl_vector_mul(rvec, yvec); // r(i) = Sum_j a(j,i)*f(j,i)*t(j)*y(i) [rvec: Praedation] gsl_blas_dgemv(CblasNoTrans, lambda, Emat, yvec, 0, ydotvec); // ydot(i) = Sum_j lambda*a(i,j)*f(i,j)*y(j) gsl_vector_mul(ydotvec, tvec); // ydot(i) = Sum_j lambda*a(i,j)*f(i,j)*y(j)*t(i) gsl_vector_memcpy(svec, Mvec); gsl_vector_scale(svec, alpha); // s(i) = alpha*masse^(-0.25) [svec=Respiration bzw. Mortalitaet] gsl_vector_memcpy(tvec, Mvec); gsl_vector_scale(tvec, beta); // t(i) = beta*masse^(-0.25) gsl_vector_mul(tvec, yvec); // t(i) = beta*y(i) gsl_vector_add(svec, tvec); // s(i) = alpha*masse^(-0.25)+beta*y(i) gsl_vector_mul(svec, yvec); // s(i) = alpha*masse^(-0.25)*y(i)+beta*y(i)*y(i) gsl_vector_add(svec, rvec); // [svec: Respiration, competition und Praedation] gsl_vector_sub(ydotvec, svec); // ydot(i) = Fressen-Respiration-Competition-Praedation for(i=0; i<Rnum; i++) gsl_vector_set(ydotvec, i, 0.0); // konstante Ressourcen }// Ende Einzelpatch, Ergebnis steht in ydotvec // printf("\ncheckpoint Holling2 IV\n"); //-- Migration lösen--------------------------------------------------------------------------------------------------------- gsl_vector *ydottest = gsl_vector_calloc(Y); double ydotmigr = gsl_vector_get(nicheweb->migrPara, 5); // int count=0,m; // for(l = 0; l< Y;l++) // { // for(m=0;m<Y;m++) // { // count += gsl_matrix_get(EDmat,l,m); // } // } // if(count!=0) // { // //printf("count %i\n",count); // //printf("t unten %f\n",t); // //printf("tau %f\n",tau); // for(l = 0; l< Y;l++) // { // for(m=0;m<Y;m++) // { // printf("%f\t",gsl_matrix_get(EDmat,l,m)); // } // printf("\n"); // } // } double max = gsl_matrix_max(EDmat); for(l = Rnum; l< Rnum+S; l++) // start of migration solving { if(l == SpeciesNumber+Rnum && max !=0 ) { //printf("max ist %f\n",max); //printf("l ist %i\n",l); // gsl_matrix_set_zero(ADgsl); // reset gsl objects for every patch // gsl_matrix_set_zero(Dmat); // gsl_vector_set_zero(d1vec); gsl_vector_set_zero(d2vec); gsl_vector_set_zero(d3vec); gsl_vector_set_zero(ydottest); // Untervektor von yfddot (enthält ydot[]) mit offset l (Rnum...Rnum+S) und Abstand zwischen den Elementen (stride) von Rnum+S. // Dies ergibt gerade die Größe einer Spezies in jedem Patch in einem Vektor gsl_vector_view dydot_vec = gsl_vector_subvector_with_stride(yfddotvec, l, (Rnum+S), Y); // ydot[] gsl_vector *dydotvec = &dydot_vec.vector; /* gsl_vector_view dy_vec = gsl_vector_subvector_with_stride(yfdvec, l, (Rnum+S), Y); // Startgrößen der Spezies pro Patch gsl_vector *dyvec = &dy_vec.vector; */ // gsl_matrix_memcpy(ADgsl, EDmat); // ADgsl = D // // if(nicheweb->M == 1) // umschalten w: patchwise (Abwanderung aus jedem Patch gleich), sonst linkwise (Abwanderung pro link gleich) // { // for(i=0; i<Y; i++) // { // gsl_vector_view colD = gsl_matrix_column(ADgsl, i); // Spalte i aus Migrationsmatrix // colsum = gsl_blas_dasum(&colD.vector); // if(colsum!=0) // { // for(j=0;j<Y;j++) // gsl_matrix_set(ADgsl,j,i,(gsl_matrix_get(ADgsl,j,i)/colsum)); // ADgsl: D mit normierten Links // } // } // } // // gsl_matrix_memcpy(Dmat, EDmat); // Dmat = D // gsl_matrix_scale(Dmat, dij); // Dmat(i,j) = d(i,j) (Migrationsstärke) // gsl_matrix_mul_elements(Dmat, ADgsl); // Dmat(i,j) = d(i,j)*xi(i,j) (skalierte und normierte Migrationsmatrix) // // gsl_vector_set_all(d1vec, 1/gsl_vector_get(Mvec, l)); // d1(i)= m(l)^0.25 // gsl_vector_mul(d1vec, dyvec); // d1(i)= m(l)^0.25*y(i) // gsl_blas_dgemv(CblasNoTrans, 1, Dmat, d1vec, 0, d2vec); // d2(i)= Sum_j d(i,j)*xi(i,j)*m(l)^0.25*y(j) // // gsl_vector_set_all(d1vec, 1); // d1(i)= 1 // gsl_blas_dgemv(CblasTrans, 1, Dmat, d1vec, 0, d3vec); // d3(i)= Sum_j d(i,j)*xi(i,j) // gsl_vector_scale(d3vec, 1/gsl_vector_get(Mvec,l)); // d3(i)= Sum_j d(i,j)*xi(i,j)*m(l)^0.25 // gsl_vector_mul(d3vec, dyvec); // d3(i)= Sum_j d(i,j)*xi(i,j)*m(l)^0.25*y(i) // gsl_vector_set(d2vec,nu,Bmigr); gsl_vector_set(d3vec,mu,Bmigr); gsl_vector_add(ydottest,d2vec); gsl_vector_sub(ydottest,d3vec); //printf("d2vec ist %f\n",gsl_vector_get(d2vec,0)); //printf("d3vec ist %f\n",gsl_vector_get(d3vec,0)); //if(gsl_vector_get(ydottest,mu)!=0) //{ ydotmigr += gsl_vector_get(ydottest,nu); // printf("ydotmigr ist %f\n",ydotmigr); gsl_vector_set(nicheweb->migrPara,5,ydotmigr); // if(ydotmigr !=0) // { // printf("ydottest aufaddiert ist %f\n",ydotmigr); // printf("ydottest aufaddiert ist %f\n",gsl_vector_get(nicheweb->migrPara,5)); // } gsl_vector_add(dydotvec, d2vec); // gsl_vector_sub(dydotvec, d3vec); // Ergebnis in dydotvec (also ydot[]) = Sum_j d(i,j)*xi(i,j)*m(l)^0.25*y(j) - Sum_j d(i,j)*xi(i,j)*m(l)^0.25*y(i) } }// Patch i gewinnt das was aus allen j Patches zuwandert und verliert was von i auswandert //printf("ydot ist %f\n",gsl_vector_get(ydottest,0)); //printf("\ncheckpoint Holling2 V\n"); /* for(i=0; i<(Rnum+S)*Y; i++){ printf("\ny = %f\tydot=%f\n", y[i], ydot[i]); } */ //--check for fixed point attractor----------------------------------------------------------------------------------- if(t>7800){ gsl_vector_set(nicheweb->fixpunkte, 0, 0); gsl_vector_set(nicheweb->fixpunkte, 1, 0); gsl_vector_set(nicheweb->fixpunkte, 2, 0); int fix0 = (int)gsl_vector_get(nicheweb->fixpunkte, 0); int fix1 = (int)gsl_vector_get(nicheweb->fixpunkte, 1); int fix2 = (int)gsl_vector_get(nicheweb->fixpunkte, 2); //printf("t unten = %f\n", t); for(i=0; i<(Rnum+S)*Y; i++) { if(y[i] <= 0) { fix0++; fix1++; fix2++; } else { if((ydot[i]/y[i]<0.0001) || (ydot[i]<0.0001)) fix0++; if(ydot[i]/y[i]<0.0001) fix1++; if(ydot[i]<0.0001) fix2++; } } if(fix0==(Rnum+S)*Y) gsl_vector_set(nicheweb->fixpunkte, 3, 1); if(fix1==(Rnum+S)*Y) gsl_vector_set(nicheweb->fixpunkte, 4, 1); if(fix2==(Rnum+S)*Y) gsl_vector_set(nicheweb->fixpunkte, 5, 1); } //--Speicher leeren----------------------------------------------------------------------------------------------------- gsl_matrix_free(Emat); // gsl_matrix_free(Dmat); gsl_matrix_free(AFgsl); // gsl_matrix_free(ADgsl); gsl_vector_free(tvec); gsl_vector_free(rvec); gsl_vector_free(svec); // gsl_vector_free(d1vec); gsl_vector_free(d2vec); gsl_vector_free(d3vec); gsl_vector_free(ydottest); // printf("\nCheckpoint Holling2 VI\n"); return GSL_SUCCESS; }
int model::train(const dataset &ds) { int ret = -1; gsl_matrix *km = NULL; gsl_matrix *ikm = NULL; gsl_permutation *perm = NULL; gsl_vector_view dv; gsl_matrix_free(_ikm); if (load_training_data(ds)) { ULIB_FATAL("couldn't load training data"); goto done; } dbg_print_mat(_fm, "Feature Matrix:"); if (get_col_mean()) { ULIB_FATAL("couldn't get feature column means"); goto done; } zero_out_mat(_fm); if (get_col_sd()) { ULIB_FATAL("couldn't get feature column standard deviations"); goto done; } norm_mat(_fm); dbg_print_mat(_fm, "Normalized Feature Matrix:"); km = comp_kern_mat(_fm, _kern); dbg_print_mat(km, "Kernel Matrix:"); if (km == NULL) { ULIB_FATAL("couldn't compute kernel matrix"); goto done; } dv = gsl_matrix_diagonal(km); gsl_vector_add_constant(&dv.vector, _noise_var); ikm = gsl_matrix_alloc(km->size1, km->size2); if (ikm == NULL) { ULIB_FATAL("couldn't allocate cost model"); goto done; } int signum; perm = gsl_permutation_alloc(ikm->size1); if (perm == NULL) { ULIB_FATAL("couldn't allocate cost model"); goto done; } gsl_linalg_LU_decomp(km, perm, &signum); gsl_linalg_LU_invert(km, perm, ikm); gsl_vector_add_constant(_tv, -_t_avg); _ikm = ikm; ikm = NULL; ret = 0; done: gsl_permutation_free(perm); gsl_matrix_free(km); gsl_matrix_free(ikm); return ret; }
void CNumVec::operator+=(double x) { assert(m_vec!=NULL); if(gsl_vector_add_constant(m_vec,x)) throw BPException("gsl_vector_add_constant"); }
double* intraguildPred(struct foodweb nicheweb, const double y[], double* intraPred) { int i,j,l; int S = nicheweb.S; int Y = nicheweb.Y; int Rnum = nicheweb.Rnum; gsl_vector *network = nicheweb.network; // Inhalt: A+linksA+Y+linksY+Massen+Trophische_Level = (Rnum+S)²+1+Y²+1+(Rnum+S)+S double lambda = nicheweb.lambda; double aij = nicheweb.aij; double hand = nicheweb.hand; /* Massen rausholen */ gsl_vector_view A_view = gsl_vector_subvector(network, 0, (Rnum+S)*(Rnum+S)); // Fressmatrix A als Vektor gsl_matrix_view EA_mat = gsl_matrix_view_vector(&A_view.vector, (Rnum+S), (Rnum+S)); // A als Matrix_view gsl_matrix *EAmat = &EA_mat.matrix; // A als Matrix gsl_vector_view M_vec = gsl_vector_subvector(network, ((Rnum+S)*(Rnum+S))+1+(Y*Y)+1, (Rnum+S)); // Massenvektor gsl_vector *Mvec = &M_vec.vector; // massvector: M(i)=m^(-0.25) double ytemp[(Rnum+S)*Y]; // tempvector for populations and efforts for(i=0;i<(Rnum+S)*Y;i++) ytemp[i]=y[i]; /* Alles view_array */ /* Auslesen von ytemp = y[]; sind Population */ gsl_vector_view yfd_vec=gsl_vector_view_array(ytemp,(Rnum+S)*Y); gsl_vector *yfdvec=&yfd_vec.vector; // populations and efforts for later use /* Initialisierungen */ gsl_matrix *AFgsl=gsl_matrix_calloc(Rnum+S, Rnum+S); // matrix of foraging efforts gsl_matrix *Emat=gsl_matrix_calloc(Rnum+S, Rnum+S); // gsl objects for calculations of populations gsl_vector *tvec=gsl_vector_calloc(Rnum+S); gsl_vector *rvec=gsl_vector_calloc(Rnum+S); gsl_vector *svec=gsl_vector_calloc(Rnum+S); gsl_vector *intraPredTemp=gsl_vector_calloc(Rnum+S); for(l=0;l<Y;l++) // start of patch solving { /* Initialisierungen */ gsl_matrix_set_zero(AFgsl); // reset gsl objects for every patch gsl_matrix_set_zero(Emat); gsl_vector_set_zero(tvec); gsl_vector_set_zero(rvec); gsl_vector_set_zero(svec); /* Je Vektoren von (Res+S) Elementen */ /* yfdvec enthält die Population */ gsl_vector_view y_vec=gsl_vector_subvector(yfdvec,(Rnum+S)*l,(Rnum+S)); gsl_vector *yvecint=&y_vec.vector; /* Kopie von EAmat erstellen */ gsl_matrix_memcpy(AFgsl,EAmat); for(i=0;i<Rnum+S;i++) { /* Nehme i-te Zeile aus A */ gsl_vector_view tempp=gsl_matrix_row(AFgsl,i); /* Summiere Absolutwerte der Zeile */ double temp1; temp1=gsl_blas_dasum(&tempp.vector); if(temp1!=0) { /* Teile die Einträge, die nicht- Null sind durch Anzahl an nicht-Nullen in dieser Zeile*/ /* und setzte diesen Wert dann an den entsprechenden Platz */ /* Man erhält also eine prozentuale Verbindung */ for(j=0;j<Rnum+S;j++) gsl_matrix_set(AFgsl,i,j,(gsl_matrix_get(AFgsl,i,j)/temp1)); } } /* aij ist Attackrate; AFgsl ist jetzt normiert- also fij */ gsl_matrix_memcpy(Emat,EAmat); gsl_matrix_scale(Emat,aij); // Emat(i,j) = a(i,j) gsl_matrix_mul_elements(Emat,AFgsl); // Emat(i,j) = a(i,j)*f(i,j) /* hand = handling time */ /* Berechnung wie aus Paper */ gsl_vector_set(yvecint,0,0); printf("y: %f\n",gsl_vector_get(yvecint,0)); gsl_vector_memcpy(svec,yvecint); // s(i)=y(i) gsl_vector_scale(svec, hand); // s(i)=y(i)*h gsl_blas_dgemv(CblasNoTrans,1,Emat,svec,0,rvec); // r(i)=Sum_k h*a(i,k)*f(i,k)*y(k) gsl_vector_add_constant(rvec,1); // r(i)=1+Sum_k h*a(i,k)*f(i,k)*y(k) gsl_vector_memcpy(tvec,Mvec); // t(i)=masse(i)^(-0.25) gsl_vector_div(tvec,rvec); // t(i)=masse(i)^(-0.25)/(1+Sum_k h*a(i,k)*f(i,k)*y(k)) gsl_vector_mul(tvec,yvecint); // t(i)=masse(i)^(-0.25)*y(i)/(1+Sum_k h*a(i,k)*f(i,k)*y(k)) gsl_blas_dgemv(CblasNoTrans,lambda,Emat,yvecint,0,intraPredTemp); // ydot(i)=Sum_j lambda*a(i,j)*f(i,j)*y(j) gsl_vector_mul(intraPredTemp,tvec); intraPred[l] = gsl_blas_dasum(intraPredTemp); } /* Speicher befreien */ gsl_matrix_free(Emat); gsl_matrix_free(AFgsl); gsl_vector_free(tvec); gsl_vector_free(rvec); gsl_vector_free(svec); gsl_vector_free(intraPredTemp); return 0; }