Exemplo n.º 1
0
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);	
    }
}
Exemplo n.º 2
0
/*
 *  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);
   }
Exemplo n.º 3
0
Arquivo: SVD.c Projeto: s-low/physics
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));
		}
	}

}
Exemplo n.º 4
0
/*
 * 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;
}
Exemplo n.º 5
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);
    }
}
Exemplo n.º 6
0
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);
}
Exemplo n.º 7
0
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 */
}
Exemplo n.º 8
0
/*
**  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);
}
Exemplo n.º 9
0
/*
**  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);

}
Exemplo n.º 11
0
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;
}
Exemplo n.º 12
0
Arquivo: em_weight.c Projeto: b-k/tea
int weightless(apop_data *onerow, void *extra_param){ return gsl_vector_get(onerow->weights, 0)==0; }
Exemplo n.º 13
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 *)(&params);
   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);
}
Exemplo n.º 14
0
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");
}
Exemplo n.º 15
0
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));
}
Exemplo n.º 16
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;
    }
}
Exemplo n.º 17
0
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, &para_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);
}
Exemplo n.º 18
0
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);
}
Exemplo n.º 19
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 */
}
Exemplo n.º 20
0
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;
}
Exemplo n.º 21
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;
}
Exemplo n.º 22
0
//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);
	}
Exemplo n.º 23
0
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;
}
Exemplo n.º 24
0
/* 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);
}
Exemplo n.º 25
0
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);
}
Exemplo n.º 26
0
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;
}
Exemplo n.º 27
0
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;
}
Exemplo n.º 28
0
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;
}
Exemplo n.º 29
0
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;

}
Exemplo n.º 30
0
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);
}