/** * Integrate SDDE one step forward for a given vector field * and state using the Euler Maruyama scheme. * \param[in] field Delayed vector fields to evaluate. * \param[in] stocField stochastic vector field to evaluate. * \param[in/out] currentState Current state to update by one time step. */ void EulerMaruyamaSDDE::stepForward(vectorFieldDelay *delayedField, vectorFieldStochastic *stocField, gsl_matrix *currentState) { // Assign pointers to workspace vectors gsl_vector_view tmp = gsl_matrix_row(work, 0); gsl_vector_view tmp1 = gsl_matrix_row(work, 1); gsl_vector_view presentState; /** Evaluate drift */ delayedField->evalField(currentState, &tmp.vector); // Scale by time step gsl_vector_scale(&tmp.vector, dt); /** Update historic */ updateHistoric(currentState); // Assign pointer to present state presentState = gsl_matrix_row(currentState, 0); // Evaluate stochastic field at present state stocField->evalField(&presentState.vector, &tmp1.vector); // Scale by time step gsl_vector_scale(&tmp1.vector, sqrt(dt)); // Add drift to present state gsl_vector_add(&presentState.vector, &tmp.vector); /** Add diffusion at present state */ gsl_vector_add(&presentState.vector, &tmp1.vector); return; }
static int robust_covariance(const double sigma, gsl_matrix *cov, gsl_multifit_robust_workspace *w) { int s = 0; const size_t p = w->p; const double s2 = sigma * sigma; size_t i, j; gsl_matrix *QSI = w->QSI; gsl_vector *D = w->D; /* Form variance-covariance matrix cov = s2 * (Q S^-1) (Q S^-1)^T */ for (i = 0; i < p; i++) { gsl_vector_view row_i = gsl_matrix_row (QSI, i); double d_i = gsl_vector_get (D, i); for (j = i; j < p; j++) { gsl_vector_view row_j = gsl_matrix_row (QSI, j); double d_j = gsl_vector_get (D, j); double s; gsl_blas_ddot (&row_i.vector, &row_j.vector, &s); gsl_matrix_set (cov, i, j, s * s2 / (d_i * d_j)); gsl_matrix_set (cov, j, i, s * s2 / (d_i * d_j)); } } return s; } /* robust_covariance() */
void update_phi(int doc_number, int time, lda_post* p, lda_seq* var, gsl_matrix* g) { int i, k, n, K = p->model->ntopics, N = p->doc->nterms; double dig[p->model->ntopics]; for (k = 0; k < K; k++) { dig[k] = gsl_sf_psi(vget(p->gamma, k)); } for (n = 0; n < N; n++) { // compute log phi up to a constant int w = p->doc->word[n]; for (k = 0; k < K; k++) { mset(p->log_phi, n, k, dig[k] + mget(p->model->topics, w, k)); } // normalize in log space gsl_vector log_phi_row = gsl_matrix_row(p->log_phi, n).vector; gsl_vector phi_row = gsl_matrix_row(p->phi, n).vector; log_normalize(&log_phi_row); for (i = 0; i < K; i++) { vset(&phi_row, i, exp(vget(&log_phi_row, i))); } } }
static int secs2d_eval_B(const double r, const double theta, const double phi, double B[3], void * vstate) { secs2d_state_t *state = (secs2d_state_t *) vstate; gsl_vector_view vx = gsl_matrix_row(state->X, 0); gsl_vector_view vy = gsl_matrix_row(state->X, 1); gsl_vector_view vz = gsl_matrix_row(state->X, 2); (void) phi; /* unused parameter */ B[0] = 0.0; B[1] = 0.0; B[2] = 0.0; if (state->flags & MAGFIT_SECS_FLG_FIT_DF) { secs2d_matrix_row_df(r, theta, phi, &vx.vector, &vy.vector, &vz.vector, state); gsl_blas_ddot(&vx.vector, state->c, &B[0]); gsl_blas_ddot(&vy.vector, state->c, &B[1]); gsl_blas_ddot(&vz.vector, state->c, &B[2]); } if (state->flags & MAGFIT_SECS_FLG_FIT_CF) { secs2d_matrix_row_cf(r, theta, &vy.vector, state); gsl_blas_ddot(&vy.vector, state->c, &B[1]); } return 0; }
int gsl_multifit_wlinear (const gsl_matrix * X, const gsl_vector * w, const gsl_vector * y, gsl_vector * c, gsl_matrix * cov, double *chisq, gsl_multifit_linear_workspace * work) { int status; size_t rank = 0; double rnorm, snorm; gsl_vector_view b = gsl_vector_subvector(work->t, 0, y->size); /* compute A = sqrt(W) X, b = sqrt(W) y */ status = gsl_multifit_linear_applyW(X, w, y, work->A, &b.vector); if (status) return status; /* compute SVD of A */ status = gsl_multifit_linear_bsvd(work->A, work); if (status) return status; status = multifit_linear_solve(X, &b.vector, GSL_DBL_EPSILON, 0.0, &rank, c, &rnorm, &snorm, work); if (status) return status; *chisq = rnorm * rnorm; /* variance-covariance matrix cov = s2 * (Q S^-1) (Q S^-1)^T */ { const size_t p = X->size2; size_t i, j; gsl_matrix_view QSI = gsl_matrix_submatrix(work->QSI, 0, 0, p, p); gsl_vector_view D = gsl_vector_subvector(work->D, 0, p); for (i = 0; i < p; i++) { gsl_vector_view row_i = gsl_matrix_row (&QSI.matrix, i); double d_i = gsl_vector_get (&D.vector, i); for (j = i; j < p; j++) { gsl_vector_view row_j = gsl_matrix_row (&QSI.matrix, j); double d_j = gsl_vector_get (&D.vector, j); double s; gsl_blas_ddot (&row_i.vector, &row_j.vector, &s); gsl_matrix_set (cov, i, j, s / (d_i * d_j)); gsl_matrix_set (cov, j, i, s / (d_i * d_j)); } } } return GSL_SUCCESS; }
/** * Integrate one step forward for a given vector field and state * using the Runge-Kutta 4 scheme. * \param[in] field Vector field to evaluate. * \param[in,out] currentState Current state to update by one time step. */ void RungeKutta4::stepForward(vectorField *field, gsl_vector *currentState) { /** Use views on a working matrix not to allocate memory * at each time step */ gsl_vector_view k1, k2, k3, k4, tmp; // Assign views tmp = gsl_matrix_row(work, 0); k1 = gsl_matrix_row(work, 1); k2 = gsl_matrix_row(work, 2); k3 = gsl_matrix_row(work, 3); k4 = gsl_matrix_row(work, 4); // First increament field->evalField(currentState, &k1.vector); gsl_vector_scale(&k1.vector, dt); gsl_vector_memcpy(&tmp.vector, &k1.vector); gsl_vector_scale(&tmp.vector, 0.5); gsl_vector_add(&tmp.vector, currentState); // Second increment field->evalField(&tmp.vector, &k2.vector); gsl_vector_scale(&k2.vector, dt); gsl_vector_memcpy(&tmp.vector, &k2.vector); gsl_vector_scale(&tmp.vector, 0.5); gsl_vector_add(&tmp.vector, currentState); // Third increment field->evalField(&tmp.vector, &k3.vector); gsl_vector_scale(&k3.vector, dt); gsl_vector_memcpy(&tmp.vector, &k3.vector); gsl_vector_add(&tmp.vector, currentState); // Fourth increment field->evalField(&tmp.vector, &k4.vector); gsl_vector_scale(&k4.vector, dt); gsl_vector_scale(&k2.vector, 2); gsl_vector_scale(&k3.vector, 2); gsl_vector_memcpy(&tmp.vector, &k1.vector); gsl_vector_add(&tmp.vector, &k2.vector); gsl_vector_add(&tmp.vector, &k3.vector); gsl_vector_add(&tmp.vector, &k4.vector); gsl_vector_scale(&tmp.vector, 1. / 6); // Update state gsl_vector_add(currentState, &tmp.vector); return; }
void Compute_Forces(gsl_matrix * Positions, gsl_matrix * Velocities, gsl_matrix * Neighbors, gsl_vector * ListHead, gsl_vector * List, int type1, int type2, gsl_matrix * Forces, gsl_vector * Energy, gsl_vector * Kinetic ) { // RESET MATRICES AND VECTORS // TODO: Redundant? gsl_matrix_set_zero(Forces); gsl_vector_set_zero(Energy); gsl_vector_set_zero(Kinetic); // Begin of parallel region int omp_get_max_threads(); int chunks = NParticles / omp_get_max_threads(); #pragma omp parallel { #pragma omp for schedule (dynamic,chunks) for (int i=0;i<NParticles;i++) { gsl_vector_view vi = gsl_matrix_row(Velocities, i); double * fij = malloc(3*sizeof(double)); // Compute the kinetic energy of particle i (0.5 mi vi^2) double ei = KineticEnergy(&vi.vector, (int) gsl_matrix_get(Positions,i,0)); gsl_vector_set(Kinetic,i,ei); // Obtain the list of neighboring cells to iCell (the cell i belongs to) int iCell = FindParticle(Positions,i); gsl_vector_view NeighboringCells = gsl_matrix_row(Neighbors, iCell); // Obtain the list of neighboring particles that interacts with i // i interacts with all Verlet[j] particles (j = 0 .. NNeighbors-1) int * Verlet = malloc(27 * NParticles * sizeof(int) / (Mx*My*Mz)); int NNeighbors = Compute_VerletList(Positions, i, &NeighboringCells.vector, iCell, ListHead, List, Verlet); // Loop over all the j-neighbors of i-particle for (int j=0;j<NNeighbors;j++) { ei = Compute_Force_ij(Positions, i, Verlet[j], type1, type2, fij); Forces->data[i*Forces->tda + 0] += fij[0]; Forces->data[i*Forces->tda + 1] += fij[1]; Forces->data[i*Forces->tda + 2] += fij[2]; Energy->data[i*Energy->stride] += ei; } free(Verlet); free(fij); } } // End of parallel region }
double fit_lda_post(int doc_number, int time, lda_post* p, lda_seq* var, gsl_matrix* g, gsl_matrix* g3_matrix, gsl_matrix* g4_matrix, gsl_matrix* g5_matrix) { init_lda_post(p); gsl_vector_view topic_view; gsl_vector_view renormalized_topic_view; if (FLAGS_model == "fixed" && var && var->influence) { // Make sure this stays in scope while the posterior is in // use! topic_view = gsl_matrix_row( var->influence->doc_weights[time], doc_number); renormalized_topic_view = gsl_matrix_row( var->influence->renormalized_doc_weights[time], doc_number); p->doc_weight = &topic_view.vector; p->renormalized_doc_weight = &renormalized_topic_view.vector; } double lhood = compute_lda_lhood(p); double lhood_old = 0; double converged = 0; int iter = 0; do { iter++; lhood_old = lhood; update_gamma(p); if (FLAGS_model == "fixed" && var != NULL) { update_phi_fixed(doc_number, time, p, var, g3_matrix, g4_matrix, g5_matrix); } else if (FLAGS_model == "dtm" || var == NULL) { update_phi(doc_number, time, p, var, g); } else { printf("Error. Unhandled model.\n"); exit(1); } // TODO(sgerrish): Remove this. // output_phi(p); lhood = compute_lda_lhood(p); converged = fabs((lhood_old - lhood) / (lhood_old * p->doc->total)); } while ((converged > LDA_INFERENCE_CONVERGED) && (iter <= LDA_INFERENCE_MAX_ITER)); return(lhood); }
void ica_match_gt(gsl_matrix *true_a, gsl_matrix *true_s, gsl_matrix *esti_a, gsl_matrix *esti_s){ /* Sort estimated loading and source matrices to match ground truth*/ const size_t NCOMP = true_s->size1; const size_t NVOX = true_s->size2; const size_t NSUB = true_a->size1; gsl_matrix *cs = gsl_matrix_alloc(NCOMP, NCOMP); // cs <- CORR(S, S') matrix_cross_corr_row(cs, true_s, esti_s); matrix_apply_all(cs, absolute); // index <- cs.max(axis = 1 ); size_t i; gsl_vector_view a_row, b_row; gsl_vector *index = gsl_vector_alloc(NCOMP); for (i = 0; i < NCOMP; i++) { a_row = gsl_matrix_row(cs, i); gsl_vector_set(index, i, gsl_stats_max_index(a_row.vector.data, a_row.vector.stride, a_row.vector.size)); } // Sort estimated sources // S' <- S'[index,:] gsl_matrix *temp = gsl_matrix_alloc(NCOMP, NVOX); gsl_matrix_memcpy(temp, esti_s); #pragma omp parallel for private(i,a_row,b_row) for (i = 0; i < NCOMP; i++) { a_row = gsl_matrix_row(esti_s, i); b_row = gsl_matrix_row(temp, gsl_vector_get(index, i)); gsl_vector_memcpy(&a_row.vector, &b_row.vector); } gsl_matrix_free(temp); // Sort estimated loadings // A' <- A'[:,index] temp = gsl_matrix_alloc(NSUB, NCOMP); gsl_matrix_memcpy(temp, esti_a); #pragma omp parallel for private(i,a_row,b_row) for (i = 0; i < NCOMP; i++) { a_row = gsl_matrix_column(esti_a, i); b_row = gsl_matrix_column(temp, gsl_vector_get(index, i)); gsl_vector_memcpy(&a_row.vector, &b_row.vector); } gsl_matrix_free(temp); gsl_matrix_free(cs); gsl_vector_free(index); }
void gsl_matrix_normalize_rows(gsl_matrix * mat, struct scaling * scales){ if(scales == NULL){ for(unsigned i =0; i<mat->size2; i++){ gsl_vector_view row = gsl_matrix_row(mat, i); gsl_vector_normalize(&row.vector); } } else { for(unsigned i =0; i<mat->size2; i++){ gsl_vector_view row = gsl_matrix_row(mat, i); scales[i] = gsl_vector_normalize(&row.vector); } } }
/** * Update past states of historic by one time step. * \param[in/out] currentState Historic to update. */ void numericalSchemeSDDE::updateHistoric(gsl_matrix *currentState) { gsl_vector_view delayedState, afterState; size_t delayMax = currentState->size1 - 1; for (size_t d = 0; d < delayMax; d++) { delayedState = gsl_matrix_row(currentState, delayMax - d); afterState = gsl_matrix_row(currentState, delayMax - d - 1); gsl_vector_memcpy(&delayedState.vector, &afterState.vector); } return; }
void matrix_cross_corr_row(gsl_matrix *C, gsl_matrix *A, gsl_matrix *B){ size_t i,j; gsl_vector_view a, b; double c; #pragma omp parallel for private(i,j,a,b,c) for (i = 0; i < A->size1; i++) { for (j = 0; j < B->size1; j++) { a = gsl_matrix_row(A, i); b = gsl_matrix_row(B, j); c = gsl_stats_correlation(a.vector.data, a.vector.stride, b.vector.data, b.vector.stride, a.vector.size); gsl_matrix_set(C, i,j, c); } } }
// simplex reduction void reduction(double f(gsl_vector* x), simplex_workspace* W) { int i,k, m = W->n+1; double ki, loi; gsl_vector_view v; // reduce vertices for(i=0; i < W->n; i++) { loi = gsl_matrix_get(W->simplex,W->lo,i); for(k = 0; k < m; k++) { if(k != W->lo) { ki = gsl_matrix_get(W->simplex,k,i); gsl_matrix_set(W->simplex,k,i,0.5*(loi+ki)); } } } // recalculate function values in affected vertices for(i=0; i < m; i++) { if (i != W->lo) { v = gsl_matrix_row(W->simplex,i); gsl_vector_set(W->fp,i,f(&v.vector)); } } return; }
void mcmclib_matrix_printf(gsl_matrix* A) { size_t n = A->size1; for(size_t i=0; i<n; i++) { gsl_vector_view row = gsl_matrix_row(A, i); mcmclib_vector_printf(&row.vector); } }
/** * emulate the model at the ith entry in results->new_x */ void emulate_ith_location(modelstruct *the_model, optstruct *options, resultstruct *results,int i, gsl_matrix* h_matrix, gsl_matrix* cinverse, gsl_vector *beta_vector){ double kappa; double temp_mean, temp_var; gsl_vector_view new_x_row; gsl_vector *kplus = gsl_vector_alloc(options->nmodel_points); gsl_vector *h_vector = gsl_vector_alloc(options->nregression_fns); // read the new x location new_x_row = gsl_matrix_row(results->new_x, i); //fprintf(stderr, "i(%d) new_x_row: ", i); //print_vector_quiet(&new_x_row.vector, options->nparams); makeKVector(kplus, the_model->xmodel, &new_x_row.vector, the_model->thetas, options->nmodel_points, options->nthetas, options->nparams); makeHVector(h_vector, &new_x_row.vector, options->nparams); temp_mean = makeEmulatedMean(cinverse, the_model->training_vector, kplus, h_vector, h_matrix, beta_vector, options->nmodel_points); kappa = covariance_fn(&new_x_row.vector, &new_x_row.vector, the_model->thetas, options->nthetas, options->nparams); temp_var = makeEmulatedVariance(cinverse, kplus, h_vector, h_matrix, kappa, options->nmodel_points, options->nregression_fns); //fprintf(stderr, "temp_mean %lf\ttemp_var %lf\n", temp_mean, temp_var); gsl_vector_set(results->emulated_mean, i, temp_mean); gsl_vector_set(results->emulated_var, i, temp_var); gsl_vector_free(kplus); gsl_vector_free(h_vector); }
int wrap_gsl_linalg_SV_decomp(gsl_matrix* A, gsl_matrix* V, gsl_matrix* S, gsl_matrix* work) { gsl_vector_view _S = gsl_matrix_diagonal(S); gsl_vector_view _work = gsl_matrix_row(work, 0); return gsl_linalg_SV_decomp(A, V, &_S.vector, &_work.vector); }
/** * Integrate the SDDE model forward for a given period. * \param[in] length Duration of the integration. * \param[in] Spinup Initial integration period to remove. * \param[in] sampling Time step at which to save states. * \return Matrix to record the states. */ gsl_matrix * modelSDDE::integrateForward(const double length, const double spinup, const size_t sampling) { size_t nt = length / scheme->getTimeStep(); size_t ntSpinup = spinup / scheme->getTimeStep(); gsl_matrix *data = gsl_matrix_alloc((size_t) ((nt - ntSpinup) / sampling), dim); gsl_vector_view presentState; // Get spinup for (size_t i = 1; i <= ntSpinup; i++) { // Integrate one step forward stepForward(); } // Get record for (size_t i = ntSpinup+1; i <= nt; i++) { // Integrate one step forward stepForward(); // Save present state if (i%sampling == 0) { presentState = gsl_matrix_row(currentState, 0); gsl_matrix_set_row(data, (i - ntSpinup) / sampling - 1, &presentState.vector); } } return data; }
int PoissonGlm::update(gsl_vector *bj, unsigned int id) { int isValid=TRUE; unsigned int i; double eij, mij; gsl_vector_view xi; for (i=0; i<nRows; i++) { xi = gsl_matrix_row (Xref, i); gsl_blas_ddot (&xi.vector, bj, &eij); if (Oref!=NULL) eij = eij+gsl_matrix_get(Oref, i, id); if (eij>link(maxtol)) { // to avoid nan; eij = link(maxtol); isValid=FALSE; } if (eij<link(mintol)){ eij = link(mintol); isValid=FALSE; } mij = invLink(eij); gsl_matrix_set(Eta, i, id, eij); gsl_matrix_set(Mu, i, id, mij); } return isValid; }
static int wnlin_df (CBLAS_TRANSPOSE_t TransJ, const gsl_vector * x, const gsl_vector * u, void * params, gsl_vector * v, gsl_matrix * JTJ) { gsl_matrix_view J = gsl_matrix_view_array(wnlin_J, wnlin_N, wnlin_P); double A = gsl_vector_get (x, 0); double lambda = gsl_vector_get (x, 1); size_t i; for (i = 0; i < wnlin_N; i++) { gsl_vector_view v = gsl_matrix_row(&J.matrix, i); double ti = i; double swi = sqrt(wnlin_W[i]); double e = exp(-lambda * ti); gsl_vector_set(&v.vector, 0, e); gsl_vector_set(&v.vector, 1, -ti * A * e); gsl_vector_set(&v.vector, 2, 1.0); gsl_vector_scale(&v.vector, swi); } if (v) gsl_blas_dgemv(TransJ, 1.0, &J.matrix, u, 0.0, v); if (JTJ) gsl_blas_dsyrk(CblasLower, CblasTrans, 1.0, &J.matrix, 0.0, JTJ); return GSL_SUCCESS; }
int gsl_linalg_balance_accum(gsl_matrix *A, gsl_vector *D) { const size_t N = A->size1; if (N != D->size) { GSL_ERROR ("vector must match matrix size", GSL_EBADLEN); } else { size_t i; double s; gsl_vector_view r; for (i = 0; i < N; ++i) { s = gsl_vector_get(D, i); r = gsl_matrix_row(A, i); gsl_blas_dscal(s, &r.vector); } return GSL_SUCCESS; } } /* gsl_linalg_balance_accum() */
/** * Evaluate the delayed vector field from fields for each delay. * \param[in] state State at which to evaluate the vector field. * \param[out] field Vector resulting from the evaluation of the vector field. */ void vectorFieldDelay::evalField(gsl_matrix *state, gsl_vector *field) { gsl_vector_view delayedState; unsigned int delay; // Set field evaluation to 0 gsl_vector_set_zero(field); /** Add delayed drifts */ for (size_t d = 0; d < nDelays; d++) { delay = gsl_vector_uint_get(delays, nDelays - d - 1); // Assign pointer to delayed state delayedState = gsl_matrix_row(state, delay); // Evaluate vector field at delayed state fields->at(nDelays - d - 1)->evalField(&delayedState.vector, work); // Add to newState in workspace gsl_vector_add(field, work); } return; }
void expectation(corpus* corpus, llna_model* model, llna_ss* ss, double* avg_niter, double* total_lhood, gsl_matrix* corpus_lambda, gsl_matrix* corpus_nu, gsl_matrix* corpus_phi_sum, short reset_var, double* converged_pct) { int i; llna_var_param* var; doc doc; double lhood, total; gsl_vector lambda, nu; gsl_vector* phi_sum; *avg_niter = 0.0; *converged_pct = 0; phi_sum = gsl_vector_alloc(model->k); total = 0; for (i = 0; i < corpus->ndocs; i++) { printf("doc %5d ", i); doc = corpus->docs[i]; var = new_llna_var_param(doc.nterms, model->k); if (reset_var) init_var_unif(var, &doc, model); else { lambda = gsl_matrix_row(corpus_lambda, i).vector; nu= gsl_matrix_row(corpus_nu, i).vector; init_var(var, &doc, model, &lambda, &nu); } lhood = var_inference(var, &doc, model); update_expected_ss(var, &doc, ss); total += lhood; printf("lhood %5.5e niter %5d\n", lhood, var->niter); *avg_niter += var->niter; *converged_pct += var->converged; gsl_matrix_set_row(corpus_lambda, i, var->lambda); gsl_matrix_set_row(corpus_nu, i, var->nu); col_sum(var->phi, phi_sum); gsl_matrix_set_row(corpus_phi_sum, i, phi_sum); free_llna_var_param(var); } gsl_vector_free(phi_sum); *avg_niter = *avg_niter / corpus->ndocs; *converged_pct = *converged_pct / corpus->ndocs; *total_lhood = total; }
inline static void apply_givens_lq (size_t M, size_t N, gsl_matrix * Q, gsl_matrix * L, size_t i, size_t j, double c, double s) { size_t k; /* Apply rotation to matrix Q, Q' = G Q */ #if USE_BLAS { gsl_matrix_view Q0M = gsl_matrix_submatrix(Q,0,0,j+1,M); gsl_vector_view Qi = gsl_matrix_row(&Q0M.matrix,i); gsl_vector_view Qj = gsl_matrix_row(&Q0M.matrix,j); gsl_blas_drot(&Qi.vector, &Qj.vector, c, -s); } #else for (k = 0; k < M; k++) { double qik = gsl_matrix_get (Q, i, k); double qjk = gsl_matrix_get (Q, j, k); gsl_matrix_set (Q, i, k, qik * c - qjk * s); gsl_matrix_set (Q, j, k, qik * s + qjk * c); } #endif /* Apply rotation to matrix L, L' = L G^T (note: lower triangular so zero for column > row) */ #if USE_BLAS { k = GSL_MIN(i,j); gsl_matrix_view L0 = gsl_matrix_submatrix(L, k, 0, N-k, j+1); gsl_vector_view Li = gsl_matrix_column(&L0.matrix,i); gsl_vector_view Lj = gsl_matrix_column(&L0.matrix,j); gsl_blas_drot(&Li.vector, &Lj.vector, c, -s); } #else for (k = GSL_MIN (i, j); k < N; k++) { double lki = gsl_matrix_get (L, k, i); double lkj = gsl_matrix_get (L, k, j); gsl_matrix_set (L, k, i, c * lki - s * lkj); gsl_matrix_set (L, k, j, s * lki + c * lkj); } #endif }
inline static void apply_givens_qr (size_t M, size_t N, gsl_matrix * Q, gsl_matrix * R, size_t i, size_t j, double c, double s) { size_t k; /* Apply rotation to matrix Q, Q' = Q G */ #if USE_BLAS { gsl_matrix_view Q0M = gsl_matrix_submatrix(Q,0,0,M,j+1); gsl_vector_view Qi = gsl_matrix_column(&Q0M.matrix,i); gsl_vector_view Qj = gsl_matrix_column(&Q0M.matrix,j); gsl_blas_drot(&Qi.vector, &Qj.vector, c, -s); } #else for (k = 0; k < M; k++) { double qki = gsl_matrix_get (Q, k, i); double qkj = gsl_matrix_get (Q, k, j); gsl_matrix_set (Q, k, i, qki * c - qkj * s); gsl_matrix_set (Q, k, j, qki * s + qkj * c); } #endif /* Apply rotation to matrix R, R' = G^T R (note: upper triangular so zero for column < row) */ #if USE_BLAS { k = GSL_MIN(i,j); gsl_matrix_view R0 = gsl_matrix_submatrix(R, 0, k, j+1, N-k); gsl_vector_view Ri = gsl_matrix_row(&R0.matrix,i); gsl_vector_view Rj = gsl_matrix_row(&R0.matrix,j); gsl_blas_drot(&Ri.vector, &Rj.vector, c, -s); } #else for (k = GSL_MIN (i, j); k < N; k++) { double rik = gsl_matrix_get (R, i, k); double rjk = gsl_matrix_get (R, j, k); gsl_matrix_set (R, i, k, c * rik - s * rjk); gsl_matrix_set (R, j, k, s * rik + c * rjk); } #endif }
int gsl_multifit_linear_applyW(const gsl_matrix * X, const gsl_vector * w, const gsl_vector * y, gsl_matrix * WX, gsl_vector * Wy) { const size_t n = X->size1; const size_t p = X->size2; if (n != y->size) { GSL_ERROR("y vector does not match X", GSL_EBADLEN); } else if (w != NULL && n != w->size) { GSL_ERROR("weight vector does not match X", GSL_EBADLEN); } else if (n != WX->size1 || p != WX->size2) { GSL_ERROR("WX matrix dimensions do not match X", GSL_EBADLEN); } else if (n != Wy->size) { GSL_ERROR("Wy vector must be length n", GSL_EBADLEN); } else { size_t i; /* copy WX = X; Wy = y if distinct pointers */ if (WX != X) gsl_matrix_memcpy(WX, X); if (Wy != y) gsl_vector_memcpy(Wy, y); if (w != NULL) { /* construct WX = sqrt(W) X and Wy = sqrt(W) y */ for (i = 0; i < n; ++i) { double wi = gsl_vector_get(w, i); double swi; gsl_vector_view row = gsl_matrix_row(WX, i); double *yi = gsl_vector_ptr(Wy, i); if (wi < 0.0) wi = 0.0; swi = sqrt(wi); gsl_vector_scale(&row.vector, swi); *yi *= swi; } } return GSL_SUCCESS; } }
int GlmTest::resampSmryCase(glm *model, gsl_matrix *bT, GrpMat *GrpXs, gsl_matrix *bO, unsigned int i) { gsl_set_error_handler_off(); int status, isValid = TRUE; unsigned int j, k, id; gsl_vector_view yj, oj, xj; unsigned int nRows = tm->nRows, nParam = tm->nParam; gsl_matrix *tXX = gsl_matrix_alloc(nParam, nParam); while (isValid == TRUE) { // if all isSingular==TRUE for (j = 0; j < nRows; j++) { // resample Y, X, offsets accordingly if (bootID != NULL) { id = (unsigned int)gsl_matrix_get(bootID, i, j); } else { if (tm->reprand == TRUE) { id = (unsigned int)gsl_rng_uniform_int(rnd, nRows); } else { id = (unsigned int)nRows * Rf_runif(0, 1); } } xj = gsl_matrix_row(model->Xref, id); gsl_matrix_set_row(GrpXs[0].matrix, j, &xj.vector); yj = gsl_matrix_row(model->Yref, id); gsl_matrix_set_row(bT, j, &yj.vector); oj = gsl_matrix_row(model->Eta, id); gsl_matrix_set_row(bO, j, &oj.vector); } gsl_matrix_set_identity(tXX); gsl_blas_dsyrk(CblasLower, CblasTrans, 1.0, GrpXs[0].matrix, 0.0, tXX); status = gsl_linalg_cholesky_decomp(tXX); if (status != GSL_EDOM) break; } for (k = 2; k < nParam + 2; k++) { subX2(GrpXs[0].matrix, k - 2, GrpXs[k].matrix); } gsl_matrix_free(tXX); return SUCCESS; }
void pca_whiten( gsl_matrix *input,// NOBS x NVOX size_t const NCOMP, // gsl_matrix *x_white, // NCOMP x NVOX gsl_matrix *white, // NCOMP x NSUB gsl_matrix *dewhite, //NSUB x NCOMP int demean){ // get input reference size_t NSUB = input->size1; // demean input matrix if (demean){ matrix_demean(input); } // Convariance Matrix gsl_matrix *cov = gsl_matrix_alloc(NSUB, NSUB); matrix_cov(input, cov); // Set up eigen decomposition gsl_vector *eval = gsl_vector_alloc(NCOMP); //eigen values gsl_matrix *evec = gsl_matrix_alloc(NSUB, NCOMP); rr_eig(cov, eval, evec, NCOMP ); //Computing whitening matrix gsl_matrix_transpose_memcpy(white, evec); gsl_vector_view v; double e; size_t i; // white = eval^{-1/2} evec^T #pragma omp parallel for private(i,e,v) for (i = 0; i < NCOMP; i++) { e = gsl_vector_get(eval,i); v = gsl_matrix_row(white,i); gsl_blas_dscal(1/sqrt(e), &v.vector); } // Computing dewhitening matrix gsl_matrix_memcpy(dewhite, evec); // dewhite = evec eval^{1/2} #pragma omp parallel for private(i,e,v) for (i = 0; i < NCOMP; i++) { e = gsl_vector_get(eval,i); v = gsl_matrix_column(dewhite,i); gsl_blas_dscal(sqrt(e), &v.vector); } // whitening data (white x Input) gsl_blas_dgemm(CblasNoTrans,CblasNoTrans,1.0, white, input, 0.0, x_white); gsl_matrix_free(cov); gsl_matrix_free(evec); gsl_vector_free(eval); }
int gsl_linalg_cholesky_invert(gsl_matrix * LLT) { if (LLT->size1 != LLT->size2) { GSL_ERROR ("cholesky matrix must be square", GSL_ENOTSQR); } else { const size_t N = LLT->size1; size_t i; gsl_vector_view v1, v2; /* invert the lower triangle of LLT */ gsl_linalg_tri_lower_invert(LLT); /* * The lower triangle of LLT now contains L^{-1}. Now compute * A^{-1} = L^{-T} L^{-1} */ for (i = 0; i < N; ++i) { double aii = gsl_matrix_get(LLT, i, i); if (i < N - 1) { double tmp; v1 = gsl_matrix_subcolumn(LLT, i, i, N - i); gsl_blas_ddot(&v1.vector, &v1.vector, &tmp); gsl_matrix_set(LLT, i, i, tmp); if (i > 0) { gsl_matrix_view m = gsl_matrix_submatrix(LLT, i + 1, 0, N - i - 1, i); v1 = gsl_matrix_subcolumn(LLT, i, i + 1, N - i - 1); v2 = gsl_matrix_subrow(LLT, i, 0, i); gsl_blas_dgemv(CblasTrans, 1.0, &m.matrix, &v1.vector, aii, &v2.vector); } } else { v1 = gsl_matrix_row(LLT, N - 1); gsl_blas_dscal(aii, &v1.vector); } } /* copy lower triangle to upper */ gsl_matrix_transpose_tricpy('L', 0, LLT, LLT); return GSL_SUCCESS; } } /* gsl_linalg_cholesky_invert() */
// initial calculation of function values at all vertices void simplex_initialize(double f(gsl_vector* x), simplex_workspace* W) { int i, m= W->n+1; gsl_vector_view v; for(i=0; i < m; i++) { v = gsl_matrix_row(W->simplex,i); gsl_vector_set(W->fp,i,f(&v.vector)); } }
int lls_fold(gsl_matrix *A, gsl_vector *b, gsl_vector *wts, lls_workspace *w) { const size_t n = A->size1; if (A->size2 != w->p) { GSL_ERROR("A has wrong size2", GSL_EBADLEN); } else if (n != b->size) { GSL_ERROR("b has wrong size", GSL_EBADLEN); } else if (n != wts->size) { GSL_ERROR("wts has wrong size", GSL_EBADLEN); } else { int s = 0; size_t i; double bnorm; for (i = 0; i < n; ++i) { gsl_vector_view rv = gsl_matrix_row(A, i); double *bi = gsl_vector_ptr(b, i); double wi = gsl_vector_get(wts, i); double swi = sqrt(wi); /* A <- sqrt(W) A */ gsl_vector_scale(&rv.vector, swi); /* b <- sqrt(W) b */ *bi *= swi; } /* ATA += A^T W A, using only the upper half of the matrix */ s = gsl_blas_dsyrk(CblasUpper, CblasTrans, 1.0, A, 1.0, w->ATA); if (s) return s; /* ATb += A^T W b */ s = gsl_blas_dgemv(CblasTrans, 1.0, A, b, 1.0, w->ATb); if (s) return s; /* bTb += b^T W b */ bnorm = gsl_blas_dnrm2(b); w->bTb += bnorm * bnorm; return s; } } /* lls_fold() */