void ssm_pipe_theta(FILE *stream, json_t *jparameters, ssm_theta_t *theta, ssm_var_t *var, ssm_fitness_t *fitness, ssm_nav_t *nav, ssm_options_t *opts) { int i, j, index; double x; json_t *jresources = json_object_get(jparameters, "resources"); json_t *jcovariance = NULL; json_t *jsummary = NULL; for(index=0; index< json_array_size(jresources); index++){ json_t *el = json_array_get(jresources, index); const char* name = json_string_value(json_object_get(el, "name")); if (strcmp(name, "values") == 0) { json_t *values = json_object_get(el, "data"); for(i=0; i<nav->theta_all->length; i++){ x = nav->theta_all->p[i]->f_inv(gsl_vector_get(theta, nav->theta_all->p[i]->offset_theta)); json_object_set_new(values, nav->theta_all->p[i]->name, json_real(x)); } } else if ((strcmp(name, "covariance") == 0)) { jcovariance = el; } else if ((strcmp(name, "summary") == 0)) { jsummary = el; } } json_t *jsummarydata = json_object(); json_object_set_new(jsummarydata, "id", json_integer(opts->id)); json_object_set_new(jsummarydata, "AIC", isnan(fitness->AIC) ? json_null(): json_real(fitness->AIC)); json_object_set_new(jsummarydata, "AICc", isnan(fitness->AICc) ? json_null(): json_real(fitness->AICc)); json_object_set_new(jsummarydata, "DIC", isnan(fitness->DIC) ? json_null(): json_real(fitness->DIC)); json_object_set_new(jsummarydata, "log_likelihood", isnan(fitness->summary_log_likelihood) ? json_null(): json_real(fitness->summary_log_likelihood)); json_object_set_new(jsummarydata, "log_ltp", isnan(fitness->summary_log_ltp) ? json_null(): json_real(fitness->summary_log_ltp)); json_object_set_new(jsummarydata, "sum_squares", isnan(fitness->summary_sum_squares) ? json_null(): json_real(fitness->summary_sum_squares)); json_object_set_new(jsummarydata, "n_parameters", json_integer(nav->theta_all->length)); json_object_set_new(jsummarydata, "n_data", json_integer(fitness->n)); if(!jsummary){ json_array_append_new(jresources, json_pack("{s,s,s,s,s,o}", "name", "summary", "format", "json", "data", jsummarydata)); } else{ json_object_set_new(jsummary, "data", jsummarydata); } if(var){ json_t *jdata = json_object(); for(i=0; i<nav->theta_all->length; i++){ json_t *jrow = json_object(); for(j=0; j<nav->theta_all->length; j++){ x = gsl_matrix_get(var, nav->theta_all->p[i]->offset_theta, nav->theta_all->p[j]->offset_theta); if(x){ json_object_set_new(jrow, nav->theta_all->p[j]->name, json_real(x)); } } if(json_object_size(jrow)){ json_object_set_new(jdata, nav->theta_all->p[i]->name, jrow); } else { json_decref(jrow); } } if(json_object_size(jdata)){ if(!jcovariance){ json_array_append_new(jresources, json_pack("{s,s,s,s,s,o}", "name", "covariance", "format", "json", "data", jdata)); } else{ json_object_set_new(jcovariance, "data", jdata); } } else { json_decref(jdata); } } if(strcmp(opts->next, "") != 0){ char path[SSM_STR_BUFFSIZE]; snprintf(path, SSM_STR_BUFFSIZE, "%s/%s%d.json", opts->root, opts->next, opts->id); json_dump_file(jparameters, path, JSON_INDENT(2)); } else { json_dumpf(jparameters, stdout, JSON_COMPACT); printf("\n"); fflush(stdout); } }
/* * gamma_df - * * return a vector of the derivative of f (the sum of the * squares) with respect to each optimisation variable. */ void gamma_df(const gsl_vector * vary, void *params, gsl_vector * df) { FUNC_REC *func_rec; double t0, Cmax, alpha, beta; double dt0, dCmax, dalpha, dbeta; double dt02, dCmax2, dalpha2, dbeta2; double t, fit_i, v_i; int i; func_rec = (FUNC_REC *) params; double local_df[GAMMA_NVARY]; double gparm[GAMMA_NVARY]; /* init the input df vector */ gsl_vector_set_zero(df); /* convert from nasty to nice */ gamma_nasty_to_nice((gsl_vector *) vary, gparm); t0 = gparm[0]; Cmax = gparm[1]; alpha = gparm[2]; beta = gparm[3]; /* init variables */ dt0 = dCmax = dalpha = dbeta = 0.0; for(i = 0; i < func_rec->v->size; i++){ /* retrieve the value of fit_i (set previously in gamma_f) */ fit_i = gsl_vector_get(func_rec->v_fit, i); v_i = gsl_vector_get(func_rec->v, i); t = gsl_vector_get(func_rec->x_values, i) - t0; if(t > 0){ dCmax += 2 * (fit_i - v_i) * fit_i / Cmax; if(t != 0.0){ dt0 += 2 * (fit_i - v_i) * fit_i * ((1 / beta) - (alpha / t)); dalpha += 2 * (fit_i - v_i) * fit_i * log(t); dbeta += 2 * (fit_i - v_i) * fit_i * t / (beta * beta); } } } gsl_vector_set(df, 0, dt0 + (dCmax * Cmax / beta) - (dbeta / alpha)); dalpha2 = 1.0 / (gsl_vector_get(vary, 1) * (1.0 - log(2.0))); dbeta2 = -dalpha2 * beta / alpha; dCmax2 = pow(alpha * beta, -alpha) * exp(alpha); dCmax2 = dCmax2 * (1.0 + gsl_vector_get(vary, 1) * (-log(alpha * beta) * dalpha2 - (alpha / beta) * dbeta2)); gsl_vector_set(df, 1, dCmax * dCmax2 + dalpha * dalpha2 + dbeta * dbeta2); dCmax2 = pow(alpha * beta, -alpha) * exp(alpha); dCmax2 = -dCmax2 * gsl_vector_get(vary, 1) / beta; gsl_vector_set(df, 2, dCmax * dCmax2 + dbeta / alpha); dalpha2 = 1.0 / (gsl_vector_get(vary, 3) * (log(2.0) - 1.0)); dbeta2 = -dalpha2 * beta / alpha; dCmax2 = pow(alpha * beta, -alpha) * exp(alpha); dCmax2 = dCmax2 * gsl_vector_get(vary, 1) * (-log(alpha * beta) * dalpha2 - (alpha / beta) * dbeta2); gsl_vector_set(df, 3, dCmax * dCmax2 + dalpha * dalpha2 + dbeta * dbeta2); }
int main(void) { int n; //dimension of matrix int i, j; printf("Enter the number of rows and columns n:"); scanf("%d", &n); gsl_matrix * A = gsl_matrix_alloc(n, n); gsl_matrix * V = gsl_matrix_alloc(n, n); gsl_matrix * Sm = gsl_matrix_alloc(n, n); gsl_matrix * X = gsl_matrix_alloc(n, n); gsl_matrix * Y = gsl_matrix_alloc(n, n); gsl_vector * S = gsl_vector_alloc(n); //only the diagonal elements of S gsl_vector * work = gsl_vector_alloc(n); //workspace for GSL decomp for (i = 0; i < n; i++) for (j = 0; j < n; j++) { gsl_matrix_set(A, i, j, (20 * rand()) / (double) RAND_MAX); } for (i = 0; i < n; i++) for (j = 0; j < n; j++) printf("A(%d,%d) = %g\n", i, j, gsl_matrix_get(A, i, j)); printf("\n\n"); gsl_linalg_SV_decomp(A, V, S, work); // A decomposed into: A = U S V // A now replaced by U // V NOT TRANSPOSED by GSL yet // find Pseudo inverse of S, then calculate: A(PI) = V S(PI) U^T for (i = 0; i < n; i++) { if (gsl_vector_get(S, i) != 0) { gsl_matrix_set(Sm, i, i, (1 / gsl_vector_get(S, i))); } else { gsl_matrix_set(Sm, i, i, (gsl_vector_get(S, i))); } } //now Sm is matrix with 1/S elements on diagonal //V * S * U^T is now the aim //FIND: A(Ps.Inv) = V Sm(Ps.Inv) U^T // X = Sm*U // Y = V*X = V*Sm*U gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, Sm, A, 0.0, X); //multiply Sm.A, put in X gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, V, X, 0.0, Y); //multiply V.X, put in Y //Y now stores the inverse for (i = 0; i < n; i++) { for (j = 0; j < n; j++) { printf("Inv(%d,%d) = %g\n", i, j, gsl_matrix_get(Y, i, j)); } } }
/* * Main function */ int main(int argc, char* argv[]) { GError *parse_error = NULL; GOptionContext *context; context = g_option_context_new ("- generate non uniform grid of cartesian points in the robot workspace"); g_option_context_add_main_entries (context, entries, NULL); if (!g_option_context_parse(context, &argc, &argv, &parse_error)) { g_print("Options parsing failed: %s\n", parse_error->message); g_option_context_free(context); exit(1); } g_option_context_free(context); g_print("Using values interval [ %f , %f ], increment: %f \n", t_min, t_max, t_increment); DGeometry *geometry = d_geometry_new (a, b, h, r); g_print ( "Current geometry [ %f, %f, %f, %f ] \n", a, b, h, r ); gsl_vector *pos = gsl_vector_alloc(3); gsl_vector *axes = gsl_vector_alloc(3); GError *err = NULL; GFile *out_file = g_file_new_for_path ("workspace.asc"); GFileOutputStream *out_stream = g_file_replace(out_file, NULL, FALSE, G_FILE_CREATE_NONE, NULL, NULL); GString *buffer = g_string_new(NULL); gdouble t1 = t_min; gdouble t2 = t_min; gdouble t3 = t_min; while(t3 <= t_max) { while (t2 <= t_max) { while (t1 <= t_max) { if (verbose) { g_print ( "Current axes [ %f, %f, %f ] \n", t1, t2, t3 ); } gsl_vector_set(axes, 0, t1 / 180.0 * G_PI); gsl_vector_set(axes, 1, t2 / 180.0 * G_PI); gsl_vector_set(axes, 2, t3 / 180.0 * G_PI); d_solver_solve_direct (geometry, axes, pos, &err); if (err) { g_clear_error(&err); } else { if (verbose) { g_print ( "Point [ %f, %f, %f ] \n", gsl_vector_get(pos, 0), gsl_vector_get(pos, 1), gsl_vector_get(pos, 2)); } g_string_printf(buffer, "%f %f %f\n", gsl_vector_get(pos, 0), gsl_vector_get(pos, 1), gsl_vector_get(pos, 2)); g_output_stream_write (G_OUTPUT_STREAM (out_stream), buffer->str, buffer->len, NULL, NULL); } t1 += t_increment; } t1 = t_min; t2 += t_increment; } t1 = t_min; t2 = t_min; t3 += t_increment; } g_output_stream_close(out_stream, NULL, NULL); gsl_vector_free(axes); g_clear_object(&geometry); g_string_free(buffer, TRUE); return 0; }
void vector_gsl2R(SEXP* vr, gsl_vector* v) { PROTECT((*vr) = allocVector(REALSXP, v->size)); for (unsigned int i = 0; i < v->size; i++) { REAL((*vr))[i] = gsl_vector_get(v, i); } }
int main(int argc, char *argv[]) { int i,j; char eigen_name[100] = "eigen.dat"; char pca_name[100] = "pca_eigen.dat"; int atom[2]; int mode = 6; int nm = 10; char filename[100] = "undefined"; int verbose =1 ; int lig = 0; for (i = 1;i < argc;i++) { if (strcmp("-i",argv[i]) == 0) {strcpy(filename,argv[i+1]);} if (strcmp("-lig",argv[i]) == 0) {++lig;} if (strcmp("-ieig1",argv[i]) == 0) {strcpy(eigen_name,argv[i+1]);} if (strcmp("-ieig2",argv[i]) == 0) {strcpy(pca_name,argv[i+1]);} if (strcmp("-m",argv[i]) == 0) {sscanf(argv[i+1],"%d",&mode);} if (strcmp("-nm",argv[i]) == 0) {sscanf(argv[i+1],"%d",&nm);} } printf("-ieig1 %s -ieig2 %s -i %s\n",eigen_name,pca_name,filename); if (strcmp("undefined",filename) == 0) { printf("You need to give the WT form pdb\n"); return(0); } int all = count_atom(filename); int nconn = count_connect(filename); if (verbose == 1) {printf("Connect:%d\n",nconn);} if (verbose == 1) {printf("Assigning Structure\n\tAll Atom\n");} // Array qui comprend tous les connects int **connect_h=(int **)malloc(nconn*sizeof(int *)); for(i=0;i<nconn;i++) { connect_h[i]=(int *)malloc(7*sizeof(int));} assign_connect(filename,connect_h); // Assign tous les atoms struct pdb_atom strc_all[all]; int atom_strc = build_all_strc(filename,strc_all); // Retourne le nombre de Node if (verbose == 1) {printf(" Node:%d\n Atom:%d\n",atom_strc,all);} check_lig(strc_all,connect_h,nconn,all); // Assign les Nodes if (verbose == 1) {printf(" CA Structure\n");} //atom = count_atom_CA_n(strc_all,all,super_node,lig); if (verbose == 1) {printf(" Node:%d\n",atom_strc);} struct pdb_atom strc_node[atom_strc]; atom_strc = build_cord_CA(strc_all, strc_node,all,lig,connect_h,nconn); if (verbose == 1) {printf(" Assign Node:%d\n",atom_strc);} if (verbose == 1) {printf("Open eigen 1:%s\n",eigen_name);} atom[0] = count_eigen(eigen_name); gsl_vector *eval = gsl_vector_alloc(atom[0]); gsl_matrix *evec = gsl_matrix_alloc (atom[0],atom[0]); load_eigen(eval,evec,eigen_name,atom[0]); if (verbose == 1) {printf("Open eigen 2:%s\n",pca_name);} atom[1] = count_eigen(pca_name); gsl_vector *evalpca = gsl_vector_alloc(atom[1]); gsl_matrix *evecpca = gsl_matrix_alloc (atom[1],atom[1]); load_eigen(evalpca,evecpca,pca_name,atom[1]); printf("Atom: %d::%d\n",atom[0],atom[1]); if (atom[0] != atom[1]) {printf("I exited, car pas même nombre de Ca entre les eigenvecoctors.... la première structure de build_pca, est la strc de référence pour comparer\n");return(1);} float corr; int k; printf("J:NMA I:PCA\n"); //float overlap; for(i=mode-1;i<nm+mode-1;++i) { for(j=mode-1;j<nm+mode-1;++j) { corr = over_eigen(evec,evecpca,atom[0],i,j, strc_node); printf("I:%3d J:%3d %8.5f Val %8.5f :: %8.5f\n",i,j,corr*corr,gsl_vector_get(eval,i),gsl_vector_get(evalpca,j)); } } return(1); }
static VALUE rb_gsl_cheb_eval(VALUE obj, VALUE xx) { gsl_cheb_series *p = NULL; VALUE x, ary; size_t i, j, n; gsl_vector *v = NULL, *vnew = NULL; gsl_matrix *m = NULL, *mnew = NULL; #ifdef HAVE_NARRAY_H struct NARRAY *na; double *ptr1, *ptr2; #endif Data_Get_Struct(obj, gsl_cheb_series, p); if (CLASS_OF(xx) == rb_cRange) xx = rb_gsl_range2ary(xx); switch (TYPE(xx)) { case T_FIXNUM: case T_BIGNUM: case T_FLOAT: return rb_float_new(gsl_cheb_eval(p, NUM2DBL(xx))); break; case T_ARRAY: n = RARRAY(xx)->len; ary = rb_ary_new2(n); for (i = 0; i < n; i++) { x = rb_ary_entry(xx, i); Need_Float(xx); rb_ary_store(ary, i, rb_float_new(gsl_cheb_eval(p, NUM2DBL(x)))); } return ary; break; default: #ifdef HAVE_NARRAY_H if (NA_IsNArray(xx)) { GetNArray(xx, na); ptr1 = (double*) na->ptr; n = na->total; ary = na_make_object(NA_DFLOAT, na->rank, na->shape, CLASS_OF(xx)); ptr2 = NA_PTR_TYPE(ary,double*); for (i = 0; i < n; i++) ptr2[i] = gsl_cheb_eval(p, ptr1[i]); return ary; } #endif if (VECTOR_P(xx)) { Data_Get_Struct(xx, gsl_vector, v); vnew = gsl_vector_alloc(v->size); for (i = 0; i < v->size; i++) { gsl_vector_set(vnew, i, gsl_cheb_eval(p, gsl_vector_get(v, i))); } return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vnew); } else if (MATRIX_P(xx)) { Data_Get_Struct(xx, gsl_matrix, m); mnew = gsl_matrix_alloc(m->size1, m->size2); for (i = 0; i < m->size1; i++) { for (j = 0; j < m->size2; j++) { gsl_matrix_set(mnew, i, j, gsl_cheb_eval(p, gsl_matrix_get(m, i, j))); } } return Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, mnew); } else { rb_raise(rb_eTypeError, "wrong argument type"); } break; } return Qnil; /* never reach here */ }
/* ** goal function 2, mutual information */ double func2(const gsl_vector *vec, void *params) { struct my_params *par = params; VDouble reject = VRepnMaxValue(VFloatRepn); int i, j, n, m; float nx1, nx2; int u, v; int b = 0, r, c, bb, rr, cc; float bx, rx, cx; float bx1, bx2, bx3, rx1, rx2, rx3; float phi, psi, theta, sb, sr, sc; int step; float nn[N][N]; float sumi[N], sumj[N]; float hxy, hx, hy, ixy, px, sum; float tiny = 1.0e-30; m = 16; m = 8; n = 256 / m; if(n > N) VError(" MI arrays too large"); step = 2 + nbands2; if(step > 8) step = 8; sb = gsl_vector_get(vec, 0); sr = gsl_vector_get(vec, 1); sc = gsl_vector_get(vec, 2); psi = gsl_vector_get(vec, 3); phi = gsl_vector_get(vec, 4); theta = gsl_vector_get(vec, 5); rotation_matrix(psi, phi, theta); for(i = 0; i < n; i++) for(j = 0; j < n; j++) nn[i][j] = 0; nx1 = nx2 = 0; for(b = 0; b < nbands2; b++) { bx = (float) b * slicedist; bx -= center[0]; bx1 = rot[0][0] * bx; bx2 = rot[1][0] * bx; bx3 = rot[2][0] * bx; for(r = rmin; r < rmax; r += step) { rx = (float) r; rx -= center[1]; rx1 = rot[0][1] * rx; rx2 = rot[1][1] * rx; rx3 = rot[2][1] * rx; for(c = cmin; c < cmax; c += step) { cx = (float) c; cx -= center[2]; nx2++; bb = (int) VRint(bx1 + rx1 + rot[0][2] * cx + sb); if(bb < 0 || bb >= nbands1) continue; rr = (int) VRint(bx2 + rx2 + rot[1][2] * cx + sr); if(rr < 0 || rr >= nrows1) continue; cc = (int) VRint(bx3 + rx3 + rot[2][2] * cx + sc); if(cc < 0 || cc >= ncols1) continue; u = (int) VPixel(s1, bb, rr, cc, VUByte); i = u / m; v = (int) VPixel(s2, b, r, c, VUByte); j = v / m; nn[i][j]++; nx1++; } } } if(nx1 < nx2 * 0.33) return reject; sum = 0; for(i = 0; i < n; i++) { sumi[i] = 0; for(j = 0; j < n; j++) { sumi[i] += nn[i][j]; sum += nn[i][j]; } } if(sum < tiny) return reject; for(j = 0; j < n; j++) { sumj[j] = 0; for(i = 0; i < n; i++) sumj[j] += nn[i][j]; } hx = hy = 0; for(i = 0; i < n; i++) { if(sumi[i] > 0) { px = sumi[i] / sum; hx -= px * log(px); } if(sumj[i] > 0) { px = sumj[i] / sum; hy -= px * log(px); } } hxy = 0; for(i = 0; i < n; i++) { for(j = 0; j < n; j++) { if(nn[i][j] > 0) { px = nn[i][j] / sum; hxy -= px * log(px); } } } ixy = hx + hy - hxy; return (double)(-ixy); }
/* ** goal function 1, linear correlation */ double func1(const gsl_vector *vec, void *params) { struct my_params *par = params; float u, v, nx1, nx2; float sum1, sum2, sum3; int b = 0, r, c, bb, rr, cc; float bx, rx, cx; float bx1, bx2, bx3, rx1, rx2, rx3; float phi, psi, theta, sb, sr, sc; int step; double corr; VDouble reject = VRepnMaxValue(VFloatRepn); step = 2 + nbands2; if(step > 8) step = 8; sb = gsl_vector_get(vec, 0); sr = gsl_vector_get(vec, 1); sc = gsl_vector_get(vec, 2); psi = gsl_vector_get(vec, 3); phi = gsl_vector_get(vec, 4); theta = gsl_vector_get(vec, 5); rotation_matrix(psi, phi, theta); corr = 0; sum1 = sum2 = sum3 = 0; nx1 = nx2 = 0; for(b = 0; b < nbands2; b++) { bx = (float) b * slicedist; bx -= center[0]; bx1 = rot[0][0] * bx; bx2 = rot[1][0] * bx; bx3 = rot[2][0] * bx; for(r = rmin; r < rmax; r += step) { rx = (float) r; rx -= center[1]; rx1 = rot[0][1] * rx; rx2 = rot[1][1] * rx; rx3 = rot[2][1] * rx; for(c = cmin; c < cmax; c += step) { cx = (float) c; cx -= center[2]; nx2++; bb = (int) VRint(bx1 + rx1 + rot[0][2] * cx + sb); if(bb < 0 || bb >= nbands1) continue; rr = (int) VRint(bx2 + rx2 + rot[1][2] * cx + sr); if(rr < 0 || rr >= nrows1) continue; cc = (int) VRint(bx3 + rx3 + rot[2][2] * cx + sc); if(cc < 0 || cc >= ncols1) continue; u = VPixel(s1, bb, rr, cc, VUByte); if(u < xminval || u > xmaxval) continue; u -= ave1; v = (float) VPixel(s2, b, r, c, VUByte) - ave2; sum1 += u * v; sum2 += u * u; sum3 += v * v; nx1++; } } } if(nx1 < nx2 * 0.33) return reject; if(sum2 *sum3 != 0) corr = (sum1 * sum1) / (sum2 * sum3); else corr = 1.0; return -corr; }
void updateR(gsl_matrix* R,double* factor,gsl_vector* p,gsl_vector* z, double* tau) { *factor = (*factor) / (1.0 - (*tau)); My_dscal(p,sqrt(GSL_MAX(*tau,- *tau)*(*factor))); My_dscal(z,sqrt(GSL_MAX(*tau,- *tau)*(*factor))); gsl_vector* w = gsl_vector_alloc(z->size); gsl_vector_memcpy(w, z); gsl_vector* s = gsl_vector_calloc(w->size+1); int n = w->size; gsl_vector_set(s, n-1, gsl_vector_get(p, n-1)*gsl_vector_get(p, n-1)); for (int i=n-2; i>=0; i--) { gsl_vector_set(s, i, gsl_vector_get(s, i+1)+gsl_vector_get(p, i)*gsl_vector_get(p, i)); } double a = 1.0; if (*tau < 0.0) { a = -1.0; } double sigma = a/(1.0+sqrt(1.0+a*gsl_vector_get(s, 0))); double q; double theta; double sigma1; double beta; double rho; gsl_vector* d2 = gsl_vector_alloc(n); gsl_vector_view d22 = gsl_matrix_diagonal(R); gsl_vector_memcpy(d2, &d22.vector); for (int j=0; j<n; j++) { q = gsl_pow_2(gsl_vector_get(p, j)); theta = 1.0 + sigma * q; gsl_vector_set(s, j+1, gsl_vector_get(s, j)-q); rho = sqrt(theta*theta+sigma*sigma*q*gsl_vector_get(s, j+1)); beta = a * gsl_vector_get(p, j) * gsl_matrix_get(R, j, j); gsl_matrix_set(R, j, j, rho * gsl_matrix_get(R, j, j)); beta = beta/gsl_matrix_get(R, j, j)/gsl_matrix_get(R, j, j); a = a / rho/rho; sigma1 = sigma* (1.0 + rho)/(rho*(theta + rho)); sigma = sigma1; //for (int r = j+1; r<n; r++) { // gsl_vector_set(w, r, gsl_vector_get(w, r)-gsl_vector_get(p, j)*gsl_matrix_get(R, r, j)); // gsl_matrix_set(R, r, j, gsl_matrix_get(R, r, j)/gsl_vector_get(d2, j)+beta*gsl_vector_get(w, r)); // gsl_matrix_set(R, r, j, gsl_matrix_get(R, r, j)*gsl_matrix_get(R, j, j)); //} if (j<n-1) { gsl_vector_view wr = gsl_vector_subvector(w, j+1, n-j-1); gsl_vector_view Rr = gsl_matrix_subcolumn(R, j, j+1, n-j-1); My_daxpy(&wr.vector, &Rr.vector, -gsl_vector_get(p, j)); My_dscal(&Rr.vector, 1.0/gsl_vector_get(d2, j)); My_daxpy(&Rr.vector, &wr.vector, beta); My_dscal(&Rr.vector, gsl_matrix_get(R, j, j)); } } //clean up gsl_vector_free(w); gsl_vector_free(s); gsl_vector_free(d2); }
gboolean RawBound01Thread ( gpointer gdata ) { GuiData *gd = GetGuiData (); if ( gd->gauss == NULL ) return TRUE; if ( gd->raw == NULL ) { gint width = cairo_image_surface_get_width ( gd->gauss ); gint height = cairo_image_surface_get_height ( gd->gauss ); gsl_matrix *pic = gsl_matrix_alloc ( height, width ); unsigned char *data = cairo_image_surface_get_data ( gd->gauss ); for ( gint row=0; row<height; row++ ) { for ( gint col=0; col<width; col++ ) { gsl_matrix_set ( pic, row, col, data[row*width+col] ); } } gsl_matrix *h = gsl_matrix_alloc ( 3, 3 ); gsl_matrix_set_all ( h, 0 ); gsl_matrix_set ( h, 0, 0, 1 ); gsl_matrix_set ( h, 0, 1, 2 ); gsl_matrix_set ( h, 0, 2, 1 ); gsl_matrix_set ( h, 2, 0, -1 ); gsl_matrix_set ( h, 2, 1, -2 ); gsl_matrix_set ( h, 2, 2, -1 ); gsl_matrix *gx = Convolution ( pic, h ); gsl_matrix_set_all ( h, 0 ); gsl_matrix_set ( h, 0, 0, 1 ); gsl_matrix_set ( h, 1, 0, 2 ); gsl_matrix_set ( h, 2, 0, 1 ); gsl_matrix_set ( h, 0, 2, -1 ); gsl_matrix_set ( h, 1, 2, -2 ); gsl_matrix_set ( h, 2, 2, -1 ); gsl_matrix *gy = Convolution ( pic, h ); gsl_matrix *raw = gsl_matrix_alloc ( height, width ); ignore -= 10; for ( gint row=0; row<height; row++ ) { for ( gint col=0; col<width; col++ ) { if ( row < ignore || col < ignore || row > height - ignore || col > width - ignore ) { gsl_matrix_set ( raw, row, col, 0 ); } else { gsl_matrix_set ( raw, row, col, pow ( gsl_matrix_get ( gx, row, col ), 2 ) + pow ( gsl_matrix_get ( gy, row, col ), 2 ) ); } } } ignore += 10; gfloat val = 0; gint start1 = 0; /* // 从右到左 for ( gint row=height/2; row<height; row++ ) { if ( gsl_matrix_get ( raw, row, width-ignore ) > val ) { val = gsl_matrix_get ( raw, row, width-ignore ); start1 = row; } } gint start2 = start1 - 1; val = gsl_matrix_get ( raw, start1-1, width-ignore-1 ); if ( val < gsl_matrix_get ( raw, start1, width-ignore-1 ) ) { val = gsl_matrix_get ( raw, start1, width-ignore-1 ); start2++; } if ( val < gsl_matrix_get ( raw, start1+1, width-ignore-1 ) ) { val = gsl_matrix_get ( raw, start1+1, width-ignore-1 ); start2++; } gsl_vector *v = gsl_vector_alloc (3); gsl_vector_set ( v, 0, start1 ); gsl_vector_set ( v, 1, width-ignore ); gsl_vector_set ( v, 2, gsl_matrix_get ( raw, start1, width-ignore ) ); gd->rawlist = g_slist_append ( gd->rawlist, v ); gsl_vector *v1 = gsl_vector_alloc (3); gsl_vector_set ( v1, 0, start2 ); gsl_vector_set ( v1, 1, width-ignore-1 ); gsl_vector_set ( v1, 2, gsl_matrix_get ( raw, start2, width-ignore-1 ) ); gd->rawlist = g_slist_append ( gd->rawlist, v1 ); */ // 从左到右 for ( gint row=height/2; row<height; row++ ) { if ( gsl_matrix_get ( raw, row, ignore ) > val ) { val = gsl_matrix_get ( raw, row, ignore ); start1 = row; } } gint start2 = start1 - 1; val = gsl_matrix_get ( raw, start1-1, ignore+1 ); if ( val < gsl_matrix_get ( raw, start1, ignore+1 ) ) { val = gsl_matrix_get ( raw, start1, ignore+1 ); start2++; } if ( val < gsl_matrix_get ( raw, start1+1, ignore+1 ) ) { val = gsl_matrix_get ( raw, start1+1, ignore+1 ); start2++; } gsl_vector *v = gsl_vector_alloc (3); gsl_vector_set ( v, 0, start1 ); gsl_vector_set ( v, 1, ignore ); gsl_vector_set ( v, 2, gsl_matrix_get ( raw, start1, ignore ) ); gd->rawlist = g_slist_append ( gd->rawlist, v ); gsl_vector *v1 = gsl_vector_alloc (3); gsl_vector_set ( v1, 0, start2 ); gsl_vector_set ( v1, 1, ignore+1 ); gsl_vector_set ( v1, 2, gsl_matrix_get ( raw, start2, ignore+1 ) ); gd->rawlist = g_slist_append ( gd->rawlist, v1 ); for ( gint w=0; w<weightlen; w++ ) { weight = weights[w]; while ( FindSinglePoint( pic, raw, width, height, &v, &v1, gd ) ); gint length = g_slist_length ( gd->rawlist ); if ( gsl_vector_get ( v1, 1 ) > width - 2*ignore ) break; for ( int i=length-1; i>1; i-- ) { gsl_vector *vv = g_slist_nth_data ( gd->rawlist, i ); gd->rawlist = g_slist_remove ( gd->rawlist, vv ); gsl_vector_free ( vv ); } v = g_slist_nth_data ( gd->rawlist, 0 ); v1 = g_slist_nth_data ( gd->rawlist, 1 ); } /* printf ( "value:%f\n", gsl_matrix_get ( raw, 1660, 51 ) ); gsl_matrix_view vview = gsl_matrix_submatrix ( raw, 1660, 45, 10, 10 ); DispMatrix ( (gsl_matrix*)&vview ); */ gd->raw = cairo_image_surface_create ( CAIRO_FORMAT_A8, width, height ); cairo_surface_flush ( gd->raw ); data = cairo_image_surface_get_data ( gd->raw ); guint len = g_slist_length ( gd->rawlist ); for ( int i=0; i<len; i++ ) { gsl_vector *v = g_slist_nth_data ( gd->rawlist, i ); data[(int)(gsl_vector_get(v,0)*width+gsl_vector_get(v,1))] = 255; } cairo_surface_mark_dirty ( gd->raw ); gsl_matrix_free ( pic ); gsl_matrix_free ( gx ); gsl_matrix_free ( gy ); gsl_matrix_free ( h ); gsl_matrix_free ( raw ); } gd->sCur = "粗边界后图片"; gd->sRaw = "已粗边界"; gd->cur = gd->raw; UpdateStatusbar (); return TRUE; }
int weightless(apop_data *onerow, void *extra_param){ return gsl_vector_get(onerow->weights, 0)==0; }
void init_gbpCosmo2gbpCosmo(cosmo_info **cosmo_source, cosmo_info **cosmo_target, double z_min, double M_min, double M_max, gbpCosmo2gbpCosmo_info *gbpCosmo2gbpCosmo){ SID_log("Initializing cosmology scaling...",SID_LOG_OPEN|SID_LOG_TIMER); SID_set_verbosity(SID_SET_VERBOSITY_RELATIVE,-1); // Store some infor in the gbpCosmo2gbpCosmo_info structure gbpCosmo2gbpCosmo->M_min =M_min; gbpCosmo2gbpCosmo->M_max =M_max; gbpCosmo2gbpCosmo->z_min =z_min; gbpCosmo2gbpCosmo->cosmo_source=(*cosmo_source); gbpCosmo2gbpCosmo->cosmo_target=(*cosmo_target); // Perform minimization //const gsl_multimin_fminimizer_type *T=gsl_multimin_fminimizer_nmsimplex2; const gsl_multimin_fminimizer_type *T=gsl_multimin_fminimizer_nmsimplex; gsl_multimin_fminimizer *s = NULL; gsl_vector *ss, *x; gsl_multimin_function minex_func; // Starting point x = gsl_vector_alloc (2); gsl_vector_set (x, 0, 1.); // inv_s gsl_vector_set (x, 1, z_min); // z_scaled // Set initial step sizes to 1 ss = gsl_vector_alloc (2); gsl_vector_set_all (ss, 1.0); // Set parameters init_gbpCosmo2gbpCosmo_integrand_params params; params.cosmo_source=cosmo_source; params.cosmo_target=cosmo_target; params.z_source =z_min; params.R_1 =R_of_M(M_min,*cosmo_source); params.R_2 =R_of_M(M_max,*cosmo_source); params.inv_s =gsl_vector_get(x,0); params.z_target =gsl_vector_get(x,1); params.n_int =100; params.wspace =gsl_integration_workspace_alloc(params.n_int); // Initialize method minex_func.n = 2; minex_func.f = init_gbpCosmo2gbpCosmo_minimize_function; minex_func.params = (void *)(¶ms); s = gsl_multimin_fminimizer_alloc (T, 2); gsl_multimin_fminimizer_set(s,&minex_func,x,ss); // Perform minimization double size; int status; size_t iter = 0; size_t iter_max=200; do{ iter++; status=gsl_multimin_fminimizer_iterate(s); if(status) SID_trap_error("Error encountered during minimisation in init_gbpCosmo2gbpCosmo() (status=%d).",ERROR_LOGIC,status); size = gsl_multimin_fminimizer_size(s); status = gsl_multimin_test_size(size,1e-2); } while(status==GSL_CONTINUE && iter<=iter_max); if(status!=GSL_SUCCESS) SID_trap_error("Failed to converge during minimisation in init_gbpCosmo2gbpCosmo() (status=%d,iter=%d).",ERROR_LOGIC,status,iter); // Finalize results double Omega_M_source = ((double *)ADaPS_fetch(*cosmo_source,"Omega_M") )[0]; double H_Hubble_source=1e2*((double *)ADaPS_fetch(*cosmo_source,"h_Hubble"))[0]; double Omega_M_target = ((double *)ADaPS_fetch(*cosmo_target,"Omega_M") )[0]; double H_Hubble_target=1e2*((double *)ADaPS_fetch(*cosmo_target,"h_Hubble"))[0]; gbpCosmo2gbpCosmo->s_L =1./gsl_vector_get(s->x,0); gbpCosmo2gbpCosmo->s_M =(Omega_M_target*H_Hubble_target)/(Omega_M_source*H_Hubble_source)*pow((gbpCosmo2gbpCosmo->s_L),3.); gbpCosmo2gbpCosmo->z_min_scaled=gsl_vector_get(s->x,1);; // Calculate growth factors needed for // determining redshift mappings gbpCosmo2gbpCosmo->D_prime_z_min=linear_growth_factor(z_min, *cosmo_target); gbpCosmo2gbpCosmo->D_z_scaled =linear_growth_factor(gbpCosmo2gbpCosmo->z_min_scaled,*cosmo_source); gbpCosmo2gbpCosmo->D_ratio =gbpCosmo2gbpCosmo->D_prime_z_min/gbpCosmo2gbpCosmo->D_z_scaled; // Clean-up gsl_vector_free(x); gsl_vector_free(ss); gsl_multimin_fminimizer_free(s); gsl_integration_workspace_free(params.wspace); SID_set_verbosity(SID_SET_VERBOSITY_DEFAULT); SID_log("Done.",SID_LOG_CLOSE); }
void gsl_vector_print(gsl_vector* A, int N) { int i; for (i=0; i<N; i++) printf("%g ", gsl_vector_get(A, i)); printf("\n"); }
static void Print_State_Mass_Fit_Helper_1(int iter, gsl_multifit_fdfsolver *solver) { fprintf(stderr, "iter = %4d: p1 = %+9.6lf, p2 = %+9.6lf, m = %+9.6lf (chi_square = %13.6lf).\n", iter, gsl_vector_get(solver->x, 0), gsl_vector_get(solver->x, 1), gsl_vector_get(solver->x, 2), pow(gsl_blas_dnrm2(solver->f), 2.0)); }
static int multifit_linear_svd (const gsl_matrix * X, const gsl_vector * y, double tol, int balance, size_t * rank, gsl_vector * c, gsl_matrix * cov, double *chisq, gsl_multifit_linear_workspace * work) { if (X->size1 != y->size) { GSL_ERROR ("number of observations in y does not match rows of matrix X", GSL_EBADLEN); } else if (X->size2 != c->size) { GSL_ERROR ("number of parameters c does not match columns of matrix X", GSL_EBADLEN); } else if (cov->size1 != cov->size2) { GSL_ERROR ("covariance matrix is not square", GSL_ENOTSQR); } else if (c->size != cov->size1) { GSL_ERROR ("number of parameters does not match size of covariance matrix", GSL_EBADLEN); } else if (X->size1 != work->n || X->size2 != work->p) { GSL_ERROR ("size of workspace does not match size of observation matrix", GSL_EBADLEN); } else if (tol <= 0) { GSL_ERROR ("tolerance must be positive", GSL_EINVAL); } else { const size_t n = X->size1; const size_t p = X->size2; size_t i, j, p_eff; gsl_matrix *A = work->A; gsl_matrix *Q = work->Q; gsl_matrix *QSI = work->QSI; gsl_vector *S = work->S; gsl_vector *xt = work->xt; gsl_vector *D = work->D; /* Copy X to workspace, A <= X */ gsl_matrix_memcpy (A, X); /* Balance the columns of the matrix A if requested */ if (balance) { gsl_linalg_balance_columns (A, D); } else { gsl_vector_set_all (D, 1.0); } /* Decompose A into U S Q^T */ gsl_linalg_SV_decomp_mod (A, QSI, Q, S, xt); /* Solve y = A c for c */ gsl_blas_dgemv (CblasTrans, 1.0, A, y, 0.0, xt); /* Scale the matrix Q, Q' = Q S^-1 */ gsl_matrix_memcpy (QSI, Q); { double alpha0 = gsl_vector_get (S, 0); p_eff = 0; for (j = 0; j < p; j++) { gsl_vector_view column = gsl_matrix_column (QSI, j); double alpha = gsl_vector_get (S, j); if (alpha <= tol * alpha0) { alpha = 0.0; } else { alpha = 1.0 / alpha; p_eff++; } gsl_vector_scale (&column.vector, alpha); } *rank = p_eff; } gsl_vector_set_zero (c); gsl_blas_dgemv (CblasNoTrans, 1.0, QSI, xt, 0.0, c); /* Unscale the balancing factors */ gsl_vector_div (c, D); /* Compute chisq, from residual r = y - X c */ { double s2 = 0, r2 = 0; for (i = 0; i < n; i++) { double yi = gsl_vector_get (y, i); gsl_vector_const_view row = gsl_matrix_const_row (X, i); double y_est, ri; gsl_blas_ddot (&row.vector, c, &y_est); ri = yi - y_est; r2 += ri * ri; } s2 = r2 / (n - p_eff); /* p_eff == rank */ *chisq = r2; /* 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 GSL_SUCCESS; } }
SEXP multifit_cor(SEXP par, SEXP Thalf, SEXP x, SEXP y, SEXP err, SEXP tr, SEXP prec, SEXP N, SEXP max_iter, SEXP no_masses) { int npar, nx, ny, i, iter_max; double p1, p2, m; double *yp, *errp, *parp, *precp, *statep; double chi_square, red_chi_square; int dof; int * xp, *Thalfp, *trp, *Np, *mip, *nmp; SEXP state; const gsl_multifit_fdfsolver_type *solver_type = gsl_multifit_fdfsolver_lmsder; /* Allocate the solver. */ gsl_multifit_fdfsolver *solver; /* Initialize the data structure. */ struct data data_struct; gsl_multifit_function_fdf function_fdf; gsl_matrix *covar; double * para_initial, c=1.; gsl_vector_view para_initial_; int status, iter=0, no_points=0; PROTECT(par = AS_NUMERIC(par)); PROTECT(Thalf = AS_INTEGER(Thalf)); PROTECT(x = AS_INTEGER(x)); PROTECT(y = AS_NUMERIC(y)); PROTECT(err = AS_NUMERIC(err)); PROTECT(tr = AS_INTEGER(tr)); PROTECT(prec = AS_NUMERIC(prec)); PROTECT(N = AS_INTEGER(N)); PROTECT(max_iter = AS_INTEGER(max_iter)); PROTECT(no_masses = AS_INTEGER(no_masses)); xp = INTEGER_POINTER(x); Thalfp = INTEGER_POINTER(Thalf); trp = INTEGER_POINTER(tr); Np = INTEGER_POINTER(N); yp = NUMERIC_POINTER(y); errp = NUMERIC_POINTER(err); parp = NUMERIC_POINTER(par); precp = NUMERIC_POINTER(prec); mip = INTEGER_POINTER(max_iter); nmp = INTEGER_POINTER(no_masses); iter_max = mip[0]; npar = LENGTH(par); nx = LENGTH(x); ny = LENGTH(y); assert(npar == nmp[0]*(Np[0]+1)); PROTECT(state = NEW_NUMERIC(5+npar)); statep = NUMERIC_POINTER(state); /* PROTECT(gradient = allocMatrix(REALSXP, npar, npar)); */ if(Np[0] == 2) no_points = 3*trp[0]; if(Np[0] == 4) no_points = 10*trp[0]; if(Np[0] == 6) no_points = 21*trp[0]; solver = gsl_multifit_fdfsolver_alloc(solver_type, ny, npar); data_struct.x = (double*) malloc(nx*sizeof(double)); data_struct.y = (double*) malloc(ny*sizeof(double)); data_struct.err = (double*) malloc(ny*sizeof(double)); para_initial = (double*) malloc(npar*sizeof(double)); for(i = 0; i < nx; i++) { data_struct.x[i] = (double)xp[i]; } for(i = 0; i < ny; i++) { data_struct.y[i] = yp[i]; data_struct.err[i] = errp[i]; } data_struct.Thalf = Thalfp[0]; data_struct.tr = trp[0]; data_struct.N = Np[0]; data_struct.no_masses = nmp[0]; // The ansatz. function_fdf.f = &exp_f; function_fdf.df = &exp_df; function_fdf.fdf = &exp_fdf; function_fdf.n = ny; function_fdf.p = npar; function_fdf.params = &data_struct; for(i = 0; i < npar; i++) { para_initial[i] = parp[i]; } para_initial_ = gsl_vector_view_array(para_initial, npar); gsl_multifit_fdfsolver_set(solver, &function_fdf, ¶_initial_.vector); // Perform the fit. // Print the initial state. #ifdef _DEBUG Print_State_Mass_Fit_Helper_1(iter, solver); #endif do { iter++; /* Do a solver iteration. */ status = gsl_multifit_fdfsolver_iterate(solver); #ifdef _DEBUG fprintf(stderr, "status = %s.\n", gsl_strerror(status)); Print_State_Mass_Fit_Helper_1(iter, solver); #endif if(status) { break; } status = gsl_multifit_test_delta(solver->dx, solver->x, precp[0], precp[1]); } while(status == GSL_CONTINUE && iter < iter_max); #ifdef _DEBUG fprintf(stderr, "\n"); #endif // ***** // Compute the covariance matrix. covar = gsl_matrix_alloc(npar, npar); gsl_multifit_covar(solver->J, 0.0, covar); // Output. chi_square = pow(gsl_blas_dnrm2(solver->f), 2.0); #ifdef _DEBUG fprintf(stderr, "chi_square = %13.6lf.\n", chi_square); #endif dof = no_points - npar; #ifdef _DEBUG fprintf(stderr, "dof = %d\n", dof); #endif red_chi_square = chi_square / (double)dof; #ifdef _DEBUG fprintf(stderr, "red_chi_square = %13.6lf.\n", red_chi_square); fprintf(stderr, "\n"); #endif p1 = gsl_vector_get(solver->x, 0); p2 = gsl_vector_get(solver->x, 1); m = gsl_vector_get(solver->x, npar-1); if(red_chi_square > 1.0) c = sqrt(red_chi_square); #ifdef _DEBUG fprintf(stderr, "p1 = %+9.6lf +/- %9.6lf.\n", p1, c * sqrt(gsl_matrix_get(covar, 0, 0))); fprintf(stderr, "p2 = %+9.6lf +/- %9.6lf.\n", p2, c * sqrt(gsl_matrix_get(covar, 1, 1))); fprintf(stderr, "m = %+9.6lf +/- %9.6lf.\n", m, c * sqrt(gsl_matrix_get(covar, npar-1, npar-1))); fprintf(stderr, "\n"); fprintf(stderr, "status = %s.\n", gsl_strerror(status)); fprintf(stderr, "\n"); #endif for(i = 0; i < npar; i++) { statep[5+i] = gsl_vector_get(solver->x, i); } statep[0] = chi_square; statep[1] = gsl_blas_dnrm2(solver->f); statep[2] = (double)iter; statep[3] = (double)dof; statep[4] = (double)status; gsl_multifit_fdfsolver_free(solver); #ifdef _DEBUG gsl_matrix_free(covar); #endif free(data_struct.x); free(data_struct.y); free(data_struct.err); free(para_initial); UNPROTECT(11); return(state); }
int main(int argc, char** args) { int ext = 0,c; double ra,dec; double sol[2]; const gsl_multiroot_fsolver_type *T; gsl_multiroot_fsolver *s; int status; size_t iter=0; const size_t n=2; gsl_multiroot_function f={&fvec,n,NULL}; gsl_vector *x = gsl_vector_alloc(n); char *wcsfn1=NULL, *wcsfn2=NULL; while ((c = getopt(argc, args, OPTIONS)) != -1) { switch(c) { case 'v': loglvl++; break; case 'h': print_help(args[0]); exit(0); case '1': wcsfn1 = optarg; break; case '2': wcsfn2 = optarg; break; } } log_init(loglvl); if (optind != argc) { print_help(args[0]); exit(-1); } if (!(wcsfn1) || !(wcsfn2)) { print_help(args[0]); exit(-1); } /* open the two wcs systems */ wcs1 = anwcs_open(wcsfn1, ext); if (!wcs1) { ERROR("Failed to read WCS file"); exit(-1); } logverb("Read WCS:\n"); if (log_get_level() >= LOG_VERB) { anwcs_print(wcs1, log_get_fid()); } wcs2 = anwcs_open(wcsfn2, ext); if (!wcs2) { ERROR("Failed to read WCS file"); exit(-1); } logverb("Read WCS:\n"); if (log_get_level() >= LOG_VERB) { anwcs_print(wcs2, log_get_fid()); } /* setup the solver, start in the middle */ gsl_vector_set(x,0,anwcs_imagew(wcs1)/2.0); gsl_vector_set(x,1,anwcs_imageh(wcs1)/2.0); T = gsl_multiroot_fsolver_hybrids; s = gsl_multiroot_fsolver_alloc (T,2); gsl_multiroot_fsolver_set(s,&f,x); print_state(iter,s); do { iter++; status = gsl_multiroot_fsolver_iterate(s); print_state(iter,s); if (status) break; status = gsl_multiroot_test_residual(s->f,1e-7); } while (status == GSL_CONTINUE && iter < 1000); sol[0]=gsl_vector_get(s->x,0); sol[1]=gsl_vector_get(s->x,1); /* write some diagnostics on stderr */ /* transform to ra/dec */ anwcs_pixelxy2radec(wcs1, sol[0], sol[1], &ra, &dec); if (loglvl > LOG_MSG) fprintf(stderr,"Pixel (%.10f, %.10f) -> RA,Dec (%.10f, %.10f)\n", sol[0], sol[1], ra, dec); /* transform to x/y with second wcs center of rotation should stay the same x/y */ anwcs_radec2pixelxy(wcs2, ra, dec, &sol[0], &sol[1]); if (loglvl > LOG_MSG) fprintf(stderr,"RA,Dec (%.10f, %.10f) -> Pixel (%.10f, %.10f) \n", ra, dec, sol[0], sol[1]); /* write the solution */ fprintf(stdout,"%f\n",sol[0]); fprintf(stdout,"%f\n",sol[1]); return(0); }
static VALUE rb_gsl_cheb_eval_n_err(VALUE obj, VALUE nn, VALUE xx) { gsl_cheb_series *p = NULL; double result, err; VALUE x, ary, aerr; size_t n, order, i, j; gsl_vector *v, *vnew, *verr; gsl_matrix *m, *mnew, *merr; #ifdef HAVE_NARRAY_H struct NARRAY *na; double *ptr1, *ptr2, *ptr3; #endif CHECK_FIXNUM(nn); order = FIX2INT(nn); Data_Get_Struct(obj, gsl_cheb_series, p); if (CLASS_OF(xx) == rb_cRange) xx = rb_gsl_range2ary(xx); switch (TYPE(xx)) { case T_FIXNUM: case T_BIGNUM: case T_FLOAT: gsl_cheb_eval_n_err(p, order, NUM2DBL(xx), &result, &err); return rb_ary_new3(2, rb_float_new(result), rb_float_new(err)); break; case T_ARRAY: n = RARRAY(xx)->len; ary = rb_ary_new2(n); aerr = rb_ary_new2(n); for (i = 0; i < n; i++) { x = rb_ary_entry(xx, i); Need_Float(xx); gsl_cheb_eval_n_err(p, order, NUM2DBL(x), &result, &err); rb_ary_store(ary, i, rb_float_new(result)); rb_ary_store(aerr, i, rb_float_new(err)); } return rb_ary_new3(2, ary, aerr); break; default: #ifdef HAVE_NARRAY_H if (NA_IsNArray(xx)) { GetNArray(xx, na); ptr1 = (double*) na->ptr; n = na->total; ary = na_make_object(NA_DFLOAT, na->rank, na->shape, CLASS_OF(xx)); aerr = na_make_object(NA_DFLOAT, na->rank, na->shape, CLASS_OF(xx)); ptr2 = NA_PTR_TYPE(ary,double*); ptr3 = NA_PTR_TYPE(aerr,double*); for (i = 0; i < n; i++) { gsl_cheb_eval_n_err(p, order, ptr1[i], &result, &err); ptr2[i] = result; ptr3[i] = err; } return rb_ary_new3(2, ary, aerr); } #endif if (VECTOR_P(xx)) { Data_Get_Struct(xx, gsl_vector, v); vnew = gsl_vector_alloc(v->size); verr = gsl_vector_alloc(v->size); for (i = 0; i < v->size; i++) { gsl_cheb_eval_n_err(p, order, gsl_vector_get(v, i), &result, &err); gsl_vector_set(vnew, i, result); gsl_vector_set(verr, i, err); } return rb_ary_new3(2, Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, vnew), Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, verr)); } else if (MATRIX_P(xx)) { Data_Get_Struct(xx, gsl_matrix, m); mnew = gsl_matrix_alloc(m->size1, m->size2); merr = gsl_matrix_alloc(m->size1, m->size2); for (i = 0; i < m->size1; i++) { for (j = 0; j < m->size2; j++) { gsl_cheb_eval_n_err(p, order, gsl_matrix_get(m, i, j), &result, &err); gsl_matrix_set(mnew, i, j, result); gsl_matrix_set(merr, i, j, err); } } return rb_ary_new3(2, Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, mnew), Data_Wrap_Struct(cgsl_matrix, 0, gsl_matrix_free, merr)); } else { rb_raise(rb_eTypeError, "wrong argument type"); } break; } return Qnil; /* never reach here */ }
int main (int argc, char **argv) { if(argc != 2) { printf("Faltan parámetros para correr el programa\n"); exit(1); } char archivo[256]; strcpy(archivo,argv[1]); double *tiempo, *posicion; int n_filas = 0; int n_columnas = 2; int nc = 3; int t = 0; int p = 1; int i,j,a; double x,y,z; tiempo = load_data(archivo, &n_filas, t); posicion = load_data(archivo, &n_filas, p); //Creación de las matrices y vectores empleados en la regresión gsl_matrix *G = gsl_matrix_calloc(n_filas,nc); gsl_vector *d = gsl_vector_calloc(n_filas); gsl_matrix *G_T = gsl_matrix_calloc(nc,n_filas); for (i=0;i<n_filas;i++) { gsl_matrix_set(G,i,0,1); gsl_matrix_set(G,i,1,tiempo[i]); gsl_matrix_set(G,i,2,0.5*tiempo[i]*tiempo[i]); gsl_vector_set(d,i,posicion[i]); gsl_matrix_set(G_T,0,i,1); gsl_matrix_set(G_T,1,i,tiempo[i]); gsl_matrix_set(G_T,2,i,0.5*tiempo[i]*tiempo[i]); } //Cálculo del producto de G_T*G gsl_matrix *prod = gsl_matrix_calloc(nc,nc); for (i=0;i<nc;i++) { for (j=0;j<nc;j++) { z = 0; for (a=0;a<n_filas;a++) { x = gsl_matrix_get(G_T,i,a); y = gsl_matrix_get(G,a,j); z += x*y; } gsl_matrix_set(prod,i,j,z); } } //Cálculo de la inversa de (G_T*G) gsl_permutation *perm = gsl_permutation_alloc(nc); gsl_matrix *invProd = gsl_matrix_calloc(nc,nc); int signo; gsl_linalg_LU_decomp(prod,perm,&signo); gsl_linalg_LU_invert(prod,perm,invProd); //Cálculo del producto (G_T*G)-¹*G_T gsl_matrix *prod2 = gsl_matrix_calloc(nc,n_filas); for (i=0;i<nc;i++) { for (j=0;j<n_filas;j++) { z = 0; for (a=0;a<nc;a++) { x = gsl_matrix_get(invProd,i,a); y = gsl_matrix_get(G_T,a,j); z += x*y; } gsl_matrix_set(prod2,i,j,z); } } //Cálculo del vector de parámetros m = (G_T*G)-¹*G_T*d gsl_vector *m = gsl_vector_calloc(nc); for (i=0;i<nc;i++) { z = 0; for (j=0;j<n_filas;j++) { x = gsl_matrix_get(prod2,i,j); y = gsl_vector_get(d,j); z += x*y; } gsl_vector_set(m,i,z); } //Generación del archivo de salida FILE *out; out = fopen("parametros_movimiento.dat","w"); fprintf(out, "%f %f %f\n", gsl_vector_get(m,0), gsl_vector_get(m,1), gsl_vector_get(m,2)); fclose(out); return 0; }
/** Solves A*x = B using SVD * @param A :: [input] The matrix A * @param B :: [input] The vector B * @return :: The solution x */ std::vector<double> MaxEnt::solveSVD(const DblMatrix &A, const DblMatrix &B) { size_t dim = A.size().first; gsl_matrix *a = gsl_matrix_alloc(dim, dim); gsl_matrix *v = gsl_matrix_alloc(dim, dim); gsl_vector *s = gsl_vector_alloc(dim); gsl_vector *w = gsl_vector_alloc(dim); gsl_vector *x = gsl_vector_alloc(dim); gsl_vector *b = gsl_vector_alloc(dim); // Need to copy from DblMatrix to gsl matrix for (size_t k = 0; k < dim; k++) for (size_t l = 0; l < dim; l++) gsl_matrix_set(a, k, l, A[k][l]); for (size_t k = 0; k < dim; k++) gsl_vector_set(b, k, B[k][0]); // Singular value decomposition gsl_linalg_SV_decomp(a, v, s, w); // A could be singular or ill-conditioned. We can use SVD to obtain a least // squares // solution by setting the small (compared to the maximum) singular values to // zero // Find largest sing value double max = gsl_vector_get(s, 0); for (size_t i = 0; i < dim; i++) { if (max < gsl_vector_get(s, i)) max = gsl_vector_get(s, i); } // Apply a threshold to small singular values const double THRESHOLD = 1E-6; double threshold = THRESHOLD * max; for (size_t i = 0; i < dim; i++) if (gsl_vector_get(s, i) > threshold) gsl_vector_set(s, i, gsl_vector_get(s, i)); else gsl_vector_set(s, i, 0); // Solve A*x = B gsl_linalg_SV_solve(a, v, s, b, x); // From gsl_vector to vector std::vector<double> delta(dim); for (size_t k = 0; k < dim; k++) delta[k] = gsl_vector_get(x, k); gsl_matrix_free(a); gsl_matrix_free(v); gsl_vector_free(s); gsl_vector_free(w); gsl_vector_free(x); gsl_vector_free(b); return delta; }
//spline locations held fixed in Mpc^-1; CMB basically fixed P(k) in these units void dopksmoothbspline_(double *kvals, double *lnpklinear, double *lnpksmooth, int *npts) { double kmaxsuppress = 0.01*0.7; size_t n, ncoeffs, nbreak; gsl_bspline_workspace *bw; gsl_vector *B; gsl_vector *c, *w, *x, *y; gsl_matrix *X, *cov; gsl_multifit_linear_workspace *mw; double deltak,lastk; int i,j,countkeep; nbreak = 9; gsl_vector *mybreaks = gsl_vector_alloc(nbreak); gsl_vector_set(mybreaks,0,(0.001*0.7)); gsl_vector_set(mybreaks,1,(0.025*0.7)); gsl_vector_set(mybreaks,2,(0.075*0.7)); gsl_vector_set(mybreaks,3,(0.125*0.7)); gsl_vector_set(mybreaks,4,(0.175*0.7)); gsl_vector_set(mybreaks,5,(0.225*0.7)); gsl_vector_set(mybreaks,6,(0.275*0.7)); gsl_vector_set(mybreaks,7,(0.325*0.7)); gsl_vector_set(mybreaks,8,(0.375*0.7)); countkeep = 0; for(i=0;i<(*npts);i++) { if((kvals[i]) >= gsl_vector_get(mybreaks,0) && (kvals[i]) <= gsl_vector_get(mybreaks,nbreak-1)) { countkeep += 1; } } n = countkeep; ncoeffs = nbreak + 2; /* allocate a cubic bspline workspace (k = 4) */ bw = gsl_bspline_alloc(4, nbreak); B = gsl_vector_alloc(ncoeffs); x = gsl_vector_alloc(n); y = gsl_vector_alloc(n); X = gsl_matrix_alloc(n, ncoeffs); c = gsl_vector_alloc(ncoeffs); w = gsl_vector_alloc(n); cov = gsl_matrix_alloc(ncoeffs, ncoeffs); mw = gsl_multifit_linear_alloc(n, ncoeffs); i=0; for(j=0;j<(*npts);j++) { if((kvals[j]) >= gsl_vector_get(mybreaks,0) && (kvals[j]) <= gsl_vector_get(mybreaks,nbreak-1)) { gsl_vector_set(x,i,(kvals[j])); gsl_vector_set(y,i,exp(lnpklinear[j])*pow(kvals[j],1.5)); if(j>0) { deltak = kvals[j] - kvals[j-1]; } else { deltak = kvals[0]; if(kvals[1] - kvals[0] < deltak) { deltak = kvals[1]-kvals[0]; } } gsl_vector_set(w,i,deltak); i+=1; } } gsl_bspline_knots(mybreaks,bw); for(i=0;i<n;i++) { double xi = gsl_vector_get(x,i); gsl_bspline_eval(xi,B,bw); for(j=0;j<ncoeffs;j++) { double Bj = gsl_vector_get(B,j); gsl_matrix_set(X,i,j,Bj); } } //do fit double yi,yierr,chisq; gsl_multifit_wlinear(X,w,y,c,cov,&chisq,mw); i = 0; for(j=0;j<(*npts);j++) { if((kvals[j]) >= gsl_vector_get(mybreaks,0) && (kvals[j]) <= gsl_vector_get(mybreaks,nbreak-1)) { gsl_bspline_eval(gsl_vector_get(x,i),B,bw); gsl_multifit_linear_est(B,c,cov,&yi,&yierr); lnpksmooth[j] = log(yi*pow(kvals[j],-1.5)); i += 1; } else { lnpksmooth[j] = lnpklinear[j]; } //spline is wacky at small k -- suppress difference at k < 0.01 if(kvals[j] < kmaxsuppress) { lnpksmooth[j] = lnpklinear[j]; } } assert(i==n); gsl_bspline_free(bw); gsl_vector_free(B); gsl_vector_free(x); gsl_vector_free(y); gsl_vector_free(mybreaks); gsl_matrix_free(X); gsl_vector_free(c); gsl_vector_free(w); gsl_matrix_free(cov); gsl_multifit_linear_free(mw); }
void print_vector(gsl_vector* v) { for (unsigned int i = 0; i < v->size; i++) { cerr << fixed << showpos << setprecision(3) << gsl_vector_get(v,i) << "\t"; } cerr << endl; }
/* Function loading the noise data from a directory */ int LLVSimFD_Noise_Init(const char dir[]) { if(!__LLVSimFD_Noise_setup) { printf("Error: LLVSimFD noise was already set up!"); exit(1); } /* Loading noise data in gsl_vectors */ int ret = SUCCESS; gsl_matrix* noise_LHO = gsl_matrix_alloc(noisedata_pts, 2); gsl_matrix* noise_LLO = gsl_matrix_alloc(noisedata_pts, 2); gsl_matrix* noise_VIRGO = gsl_matrix_alloc(noisedata_pts, 2); char* file_LIGO = malloc(strlen(dir)+64); char* file_VIRGO = malloc(strlen(dir)+64); //sprintf(file_LIGO, "%s", "LIGO-P1200087-v18-aLIGO_DESIGN.txt"); //sprintf(file_VIRGO, "%s", "LIGO-P1200087-v18-AdV_DESIGN.txt"); sprintf(file_LIGO, "%s", "aLIGO_sensitivity.dat"); sprintf(file_VIRGO, "%s", "aVirgo_sensitivity.dat"); ret |= Read_Text_Matrix(dir, file_LIGO, noise_LHO); ret |= Read_Text_Matrix(dir, file_LIGO, noise_LLO); ret |= Read_Text_Matrix(dir, file_VIRGO, noise_VIRGO); if(ret==FAILURE) { printf("Error: problem reading LLV noise data."); exit(1); } /* Linear interpolation of the data, after setting the gsl_spline structures */ else if(ret==SUCCESS) { /* Extracting te vectors for the frequencies and data */ gsl_vector* noise_LHO_freq = gsl_vector_alloc(noisedata_pts); gsl_vector* noise_LLO_freq = gsl_vector_alloc(noisedata_pts); gsl_vector* noise_VIRGO_freq = gsl_vector_alloc(noisedata_pts); gsl_vector* noise_LHO_data = gsl_vector_alloc(noisedata_pts); gsl_vector* noise_LLO_data = gsl_vector_alloc(noisedata_pts); gsl_vector* noise_VIRGO_data = gsl_vector_alloc(noisedata_pts); gsl_matrix_get_col(noise_LHO_freq, noise_LHO, 0); gsl_matrix_get_col(noise_LLO_freq, noise_LLO, 0); gsl_matrix_get_col(noise_VIRGO_freq, noise_VIRGO, 0); gsl_matrix_get_col(noise_LHO_data, noise_LHO, 1); gsl_matrix_get_col(noise_LLO_data, noise_LLO, 1); gsl_matrix_get_col(noise_VIRGO_data, noise_VIRGO, 1); /* Setting the global variables that indicate the range in frequency of these splines */ __LLVSimFD_LHONoise_fLow = gsl_vector_get(noise_LHO_freq, 0); __LLVSimFD_LHONoise_fHigh = gsl_vector_get(noise_LHO_freq, noise_LHO_freq->size - 1); __LLVSimFD_LLONoise_fLow = gsl_vector_get(noise_LLO_freq, 0); __LLVSimFD_LLONoise_fHigh = gsl_vector_get(noise_LLO_freq, noise_LLO_freq->size - 1); __LLVSimFD_VIRGONoise_fLow = gsl_vector_get(noise_VIRGO_freq, 0); __LLVSimFD_VIRGONoise_fHigh = gsl_vector_get(noise_VIRGO_freq, noise_VIRGO_freq->size - 1); /* Initializing the splines and accelerators */ *__LLVSimFD_LHONoiseSpline = gsl_spline_alloc(gsl_interp_linear, noisedata_pts); *__LLVSimFD_LLONoiseSpline = gsl_spline_alloc(gsl_interp_linear, noisedata_pts); *__LLVSimFD_VIRGONoiseSpline = gsl_spline_alloc(gsl_interp_linear, noisedata_pts); *__LLVSimFD_LHONoiseAccel = gsl_interp_accel_alloc(); *__LLVSimFD_LLONoiseAccel = gsl_interp_accel_alloc(); *__LLVSimFD_VIRGONoiseAccel = gsl_interp_accel_alloc(); gsl_spline_init(*__LLVSimFD_LHONoiseSpline, gsl_vector_const_ptr(noise_LHO_freq, 0), gsl_vector_const_ptr(noise_LHO_data, 0), noisedata_pts); gsl_spline_init(*__LLVSimFD_LLONoiseSpline, gsl_vector_const_ptr(noise_LLO_freq, 0), gsl_vector_const_ptr(noise_LLO_data, 0), noisedata_pts); gsl_spline_init(*__LLVSimFD_VIRGONoiseSpline, gsl_vector_const_ptr(noise_VIRGO_freq, 0), gsl_vector_const_ptr(noise_VIRGO_data, 0), noisedata_pts); /* Setting the global tag to success and clean up */ gsl_matrix_free(noise_LHO); gsl_matrix_free(noise_LLO); gsl_matrix_free(noise_VIRGO); gsl_vector_free(noise_LHO_freq); gsl_vector_free(noise_LLO_freq); gsl_vector_free(noise_VIRGO_freq); gsl_vector_free(noise_LHO_data); gsl_vector_free(noise_LLO_data); gsl_vector_free(noise_VIRGO_data); __LLVSimFD_Noise_setup = SUCCESS; } /* Cleaning and output */ free(file_LIGO); free(file_VIRGO); return(ret); }
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); }
inline static int exp_df (const gsl_vector * x, void *data, gsl_matrix * J) { int no_masses = ((struct data *)data)->no_masses; int tr = ((struct data *)data)->tr; int N = ((struct data *)data)->N; double Time = 2.*((struct data *)data)->Thalf; double *t = ((struct data *)data)->x; double *err = ((struct data *) data)->err; double p[6][6], m[6]; size_t i, j, k=0, kludge = 0; double Y = 0., dY=0.; for(i = 0; i < no_masses; i++) { for(j = 0; j < N; j++) { p[j][i] = gsl_vector_get (x, j + i*(N+1)); } m[i] = gsl_vector_get (x, N + i*(N+1)); } j = 0; for (i = 0; i < tr; i++) { for(k = 0; k < no_masses; k++) { Y = 0.5*(exp(-m[k]*(Time-t[i])) + exp(-m[k]*t[i])); dY = -0.5*((Time-t[i])*exp(-m[k]*(Time-t[i])) + t[i]*exp(-m[k]*t[i])); j = 0; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 2.*p[0][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[0][k]*p[0][k]*dY/err[i+j*tr]); j = 1; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), p[1][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), p[0][k]*Y/err[i+j*tr]); if(k == 1 && kludge == 1) { printf("kludge df\n"); gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), gsl_matrix_get(J, i+j*tr, 0 + k*(N+1)) + 1000000.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), gsl_matrix_get(J, i+j*tr, 1 + k*(N+1)) + 1000000.); } gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[0][k]*p[1][k]*dY/err[i+j*tr]); j = 2; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 2.*p[1][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[0][k]*p[0][k]*dY/err[i+j*tr]); } } if (N > 2) { for (i = 0; i < tr; i++) { for(j = 0; j < 3; j++) { for(k = 0; k < no_masses; k++) { gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); } } } for (i = 0; i < tr; i++) { for (k = 0; k < no_masses; k++) { Y = 0.5*(exp(-m[k]*(Time-t[i])) - exp(-m[k]*t[i])); dY = -0.5*((Time-t[i])*exp(-m[k]*(Time-t[i])) - t[i]*exp(-m[k]*t[i])); j = 3; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), p[2][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), p[0][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[0][k]*p[2][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), p[3][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), p[0][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[0][k]*p[3][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), p[2][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), p[1][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[1][k]*p[2][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), p[3][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), p[1][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[1][k]*p[3][k]*dY/err[i+j*tr]); } } for (i = 0; i < tr; i++) { for (k = 0; k < no_masses; k++) { Y = 0.5*(exp(-m[k]*(Time-t[i])) + exp(-m[k]*t[i])); dY = -0.5*((Time-t[i])*exp(-m[k]*(Time-t[i])) + t[i]*exp(-m[k]*t[i])); j = 7; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 2.*p[2][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[2][k]*p[2][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), p[3][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), p[2][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[2][k]*p[3][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 2.*p[3][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[3][k]*p[3][k]*dY/err[i+j*tr]); } } } if (N > 4) { for (i = 0; i < tr; i++) { for(j = 0; j < 10; j++) { for(k = 0; k < no_masses; k++) { gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), 0.); } } } for (i = 0; i < tr; i++) { for(k = 0; k < no_masses; k++) { Y = 0.5*(exp(-m[k]*(Time-t[i])) + exp(-m[k]*t[i])); dY = -0.5*((Time-t[i])*exp(-m[k]*(Time-t[i])) + t[i]*exp(-m[k]*t[i])); j = 10; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), 2.*p[4][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[4][k]*p[4][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), p[5][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), p[4][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[4][k]*p[5][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), 2.*p[5][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[5][k]*p[5][k]*dY/err[i+j*tr]); } } for (i = 0; i < tr; i++) { for(k = 0; k < no_masses; k++) { Y = 0.5*(exp(-m[k]*(Time-t[i])) - exp(-m[k]*t[i])); dY = -0.5*((Time-t[i])*exp(-m[k]*(Time-t[i])) - t[i]*exp(-m[k]*t[i])); j = 13; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), p[4][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), p[0][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[0][k]*p[4][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), p[5][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), p[0][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[0][k]*p[5][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), p[4][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), p[1][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[1][k]*p[4][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), p[5][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), p[1][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[1][k]*p[5][k]*dY/err[i+j*tr]); } } for (i = 0; i < tr; i++) { for(k = 0; k < no_masses; k++) { Y = 0.5*(exp(-m[k]*(Time-t[i])) + exp(-m[k]*t[i])); dY = -0.5*((Time-t[i])*exp(-m[k]*(Time-t[i])) + t[i]*exp(-m[k]*t[i])); j = 17; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), p[4][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), p[2][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[2][k]*p[4][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), p[5][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), p[2][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[2][k]*p[5][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), p[4][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), p[3][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[3][k]*p[4][k]*dY/err[i+j*tr]); j++; gsl_matrix_set(J, i+j*tr, 0 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 1 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 2 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 3 + k*(N+1), p[5][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, 4 + k*(N+1), 0.); gsl_matrix_set(J, i+j*tr, 5 + k*(N+1), p[3][k]*Y/err[i+j*tr]); gsl_matrix_set(J, i+j*tr, N + k*(N+1), p[3][k]*p[5][k]*dY/err[i+j*tr]); } } } return GSL_SUCCESS; }
static int mc_eigen(lua_State *L) /* (-1,+2,e) */ { mMatComplex *m = qlua_checkMatComplex(L, 1); gsl_matrix_complex_view mx; gsl_eigen_hermv_workspace *w; gsl_vector *ev; mVecReal *lambda; mMatComplex *trans; mMatComplex *tmp; int n; int i; int lo, hi; switch (lua_gettop(L)) { case 1: if (m->l_size != m->r_size) return luaL_error(L, "matrix:eigen() expects square matrix"); lo = 0; hi = m->l_size; break; case 2: lo = 0; hi = luaL_checkint(L, 2); if ((hi > m->l_size) || (hi > m->r_size)) return slice_out(L); break; case 3: lo = luaL_checkint(L, 2); hi = luaL_checkint(L, 3); if ((lo >= hi) || (lo > m->l_size) || (lo > m->r_size) || (hi > m->l_size) || (hi > m->r_size)) return slice_out(L); break; default: return luaL_error(L, "matrix:eigen(): illegal arguments"); } n = hi - lo; mx = gsl_matrix_complex_submatrix(m->m, lo, lo, n, n); tmp = qlua_newMatComplex(L, n, n); gsl_matrix_complex_memcpy(tmp->m, &mx.matrix); lambda = qlua_newVecReal(L, n); trans = qlua_newMatComplex(L, n, n); ev = new_gsl_vector(L, n); w = gsl_eigen_hermv_alloc(n); if (w == 0) { lua_gc(L, LUA_GCCOLLECT, 0); w = gsl_eigen_hermv_alloc(n); if (w == 0) luaL_error(L, "not enough memory"); } if (gsl_eigen_hermv(tmp->m, ev, trans->m, w)) luaL_error(L, "matrix:eigen() failed"); if (gsl_eigen_hermv_sort(ev, trans->m, GSL_EIGEN_SORT_VAL_ASC)) luaL_error(L, "matrix:eigen() eigenvalue ordering failed"); for (i = 0; i < n; i++) lambda->val[i] = gsl_vector_get(ev, i); gsl_vector_free(ev); gsl_eigen_hermv_free(w); return 2; }
inline static int exp_f(const gsl_vector * x, void *data, gsl_vector * f) { int no_masses = ((struct data *)data)->no_masses; int N = ((struct data *)data)->N; int tr = ((struct data *)data)->tr; double Time = 2.*((struct data *)data)->Thalf; double *t = ((struct data *)data)->x; double *y = ((struct data *)data)->y; double *err = ((struct data *) data)->err; double p[6][6], m[6]; size_t i, j, k=0, id0 = 0, id1 = 0, kludge = 0; double Y = 0., sign = 1., c = 0.; for(i = 0; i < no_masses; i++) { for(j = 0; j < N; j++) { p[j][i] = gsl_vector_get (x, j + i*(N+1)); } m[i] = gsl_vector_get (x, N + i*(N+1)); } /* PP */ for(j = 0; j < 3; j++) { if(j == 0) { id0 = 0; id1 = 0; } if(j == 1) { id0 = 0; id1 = 1; } if(j == 2) { id0 = 1; id1 = 1; } for (i = 0; i < tr; i++) { Y = 0.; for(k = 0; k < no_masses; k++) { c = p[id0][k]*p[id1][k]; Y += c*0.5*(exp(-m[k]*(Time-t[i])) + sign*exp(-m[k]*t[i])); } if(kludge==1 && j == 1 && no_masses > 1) { Y += 1000000.*p[id0][1] + 1000000.*p[id1][1]; printf("kludge\n"); } gsl_vector_set (f, i+j*tr, (Y - y[i+j*tr])/err[i+j*tr]); } } if(N > 2) { /* PA, AP */ sign = -1.; for(j = 0; j < 4; j++) { if(j == 0) { id0 = 0; id1 = 2; } if(j == 1) { id0 = 0; id1 = 3; } if(j == 2) { id0 = 1; id1 = 2; } if(j == 3) { id0 = 1; id1 = 3; } for (i = 0; i < tr; i++) { Y = 0.; for(k = 0; k < no_masses; k++) { c = p[id0][k]*p[id1][k]; Y += c*0.5*(exp(-m[k]*(Time-t[i])) + sign*exp(-m[k]*t[i])); } gsl_vector_set (f, i+(3+j)*tr, (Y - y[i+(3+j)*tr])/err[i+(3+j)*tr]); } } /* AA */ sign = 1.; for(j = 0; j < 3; j++) { if(j == 0) { id0 = 2; id1 = 2; } if(j == 1) { id0 = 2; id1 = 3; } if(j == 2) { id0 = 3; id1 = 3; } for (i = 0; i < tr; i++) { Y = 0.; for(k = 0; k < no_masses; k++) { c = p[id0][k]*p[id1][k]; Y += c*0.5*(exp(-m[k]*(Time-t[i])) + sign*exp(-m[k]*t[i])); } gsl_vector_set (f, i+(7+j)*tr, (Y - y[i+(7+j)*tr])/err[i+(7+j)*tr]); } } } if(N > 4) { /* 44 */ sign = 1.; for(j = 0; j < 3; j++) { if(j == 0) { id0 = 4; id1 = 4; } if(j == 1) { id0 = 4; id1 = 5; } if(j == 2) { id0 = 5; id1 = 5; } for (i = 0; i < tr; i++) { Y = 0.; for(k = 0; k < no_masses; k++) { c = p[id0][k]*p[id1][k]; Y += c*0.5*(exp(-m[k]*(Time-t[i])) + sign*exp(-m[k]*t[i])); } gsl_vector_set (f, i+(10+j)*tr, (Y - y[i+(10+j)*tr])/err[i+(10+j)*tr]); } } /* P[3] */ sign = -1.; for(j = 0; j < 4; j++) { if(j == 0) { id0 = 0; id1 = 4; } if(j == 1) { id0 = 0; id1 = 5; } if(j == 2) { id0 = 1; id1 = 4; } if(j == 3) { id0 = 1; id1 = 5; } for (i = 0; i < tr; i++) { Y = 0.; for(k = 0; k < no_masses; k++) { c = p[id0][k]*p[id1][k]; Y += c*0.5*(exp(-m[k]*(Time-t[i])) + sign*exp(-m[k]*t[i])); } gsl_vector_set (f, i+(13+j)*tr, (Y - y[i+(13+j)*tr])/err[i+(13+j)*tr]); } } /* 4A */ sign = 1.; for(j = 0; j < 4; j++) { if(j == 0) { id0 = 2; id1 = 4; } if(j == 1) { id0 = 2; id1 = 5; } if(j == 2) { id0 = 3; id1 = 4; } if(j == 3) { id0 = 3; id1 = 5; } for (i = 0; i < tr; i++) { Y = 0.; for(k = 0; k < no_masses; k++) { c = p[id0][k]*p[id1][k]; Y += c*0.5*(exp(-m[k]*(Time-t[i])) + sign*exp(-m[k]*t[i])); } gsl_vector_set(f, i+(17+j)*tr, (Y - y[i+(17+j)*tr])/err[i+(17+j)*tr]); } } } 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 int i, j,l = 0; // Hilfsvariablen double rowsum = 0; double colsum = 0; //-- 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 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); 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_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); gsl_vector_set(nicheweb->migrPara,5,ydotmigr); //printf("ydotmigr ist %f\n",gsl_vector_get(nicheweb->migrPara,5)); // 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; }
void Testrapt(CuTest* tc) { gsl_vector* x = gsl_vector_alloc(DIM); gsl_vector_set_all(x, 0.0); gsl_rng* rng = gsl_rng_alloc(gsl_rng_default); gsl_matrix* sigma_whole = gsl_matrix_alloc(DIM, DIM); gsl_matrix_set_identity(sigma_whole); gsl_matrix* sigma_local[K]; for(int k=0; k<K; k++) { sigma_local[k] = gsl_matrix_alloc(DIM, DIM); gsl_matrix_set_identity(sigma_local[k]); } double means[K]; double variances[K]; double nk[K]; for(int k=0; k<K; k++) { means[k] = 0.0; variances[k] = 0.0; nk[k] = 0.0; } double mean = 0.0; double variance = 0.0; mcmclib_amh* s = mcmclib_rapt_alloc(rng, dunif, NULL, /*target distrib.*/ x, T0, sigma_whole, K, sigma_local, which_region, NULL, NULL); rapt_suff* suff = (rapt_suff*) s->suff; /*Main MCMC loop*/ gsl_matrix* X = gsl_matrix_alloc(N, DIM); gsl_vector* which_region_n = gsl_vector_alloc(N); for(size_t n=0; n<N; n++) { mcmclib_amh_update(s); gsl_vector_view Xn = gsl_matrix_row(X, n); gsl_vector_memcpy(&(Xn.vector), x); gsl_vector_set(which_region_n, n, (double) which_region(NULL, x)); means[which_region(NULL, x)] += x0; variances[which_region(NULL, x)] += x0 * x0; nk[which_region(NULL, x)] += 1.0; mean += x0; variance += x0 * x0; } /*compute means and variances*/ mean /= (double) N; variance = variance / ((double) N) - (mean * mean); for(size_t k=0; k<K; k++) { means[k] /= nk[k]; variances[k] = (variances[k] / nk[k]) - (means[k] * means[k]); } /*check results*/ CuAssertDblEquals(tc, mean, v0(suff->global_mean), TOL); CuAssertDblEquals(tc, variance, m00(suff->global_variance), TOL); static char kmsg[3]; for(size_t k=0; k<K; k++) { sprintf(kmsg, "%zd", k); CuAssertDblEquals_Msg(tc, kmsg, nk[k], gsl_vector_get(suff->n, k), TOL); CuAssertDblEquals_Msg(tc, kmsg, means[k], v0(suff->means[k]), TOL); CuAssertDblEquals_Msg(tc, kmsg, variances[k], m00(suff->variances[k]), TOL); } /*free memory*/ gsl_matrix_free(X); for(int k=0; k<K; k++) gsl_matrix_free(sigma_local[k]); gsl_matrix_free(sigma_whole); gsl_vector_free(x); mcmclib_amh_free(s); gsl_rng_free(rng); gsl_vector_free(which_region_n); }