Ejemplo n.º 1
0
void diffusion2(gsl_vector *mean_cand, gsl_vector *param1, double ddeltat, gsl_matrix *disp_mat)
{
  double v1,v2,v12,k1,k2,k3,k4,k5,r1,r2;
  k1=VGET(param1, 0);
  k2=VGET(param1, 1);
  k3=VGET(param1, 2);
  k4=VGET(param1, 3);
  k5=VGET(param1, 4);
  r1=VGET(mean_cand, 0);
  r2=VGET(mean_cand, 1);

  v1 = ddeltat*(k1 + k3*r1 + k5*r1*r2);
  v2 = ddeltat*(k2 + k4*r2 + 400*k5*r1*r2);/*Change: 20^2*k5...*/
  v12 = -ddeltat*(20*k5*r1*r2);/*20*k5*...*/
  if((k1+k2+k3+k4) < 0.00000001) {
      postive_definite = 0;
      /*printf("#######################\n");*/
    }
  else
    postive_definite = 1;
  MSET(disp_mat,0,0,v1);
  MSET(disp_mat,1,1,v2);
  MSET(disp_mat,0,1,v12);
  MSET(disp_mat,1,0,v12);
}
Ejemplo n.º 2
0
void mvn_sample(gsl_vector *mean_cand, gsl_matrix *var)
{
  /* Takes a mean vec, mean and var matrix, 
   * var and gives vector of MVN(mean,var) realisations, x 
   */
  int i, j;
  int dimen = var -> size1;
  double value;
  gsl_matrix *disp;
  gsl_vector *ran;
  gsl_matrix *fast_species;
  
  fast_species = gsl_matrix_alloc(2, 2);
  gsl_matrix_set_identity(fast_species);
  
  for(i=0;i<dimen; i++) {
    if(MGET(var, i, i) <0.00000000001) {
      MSET(var, i, i, 1.0);
      MSET(fast_species, i, i, 0.0);
    }
  }
  
  disp = gsl_matrix_alloc(2, 2);
  ran = gsl_vector_alloc(2);
  gsl_matrix_memcpy(disp, var);
  if(postive_definite == 1) {
    gsl_linalg_cholesky_decomp(disp);
    for(i=0;i<dimen;i++) {
      for (j=i+1;j<dimen;j++) {
        MSET(disp,i,j,0.0);
      }
    }
  }else{
    value = pow(MGET(disp, 0 ,0), 0.5);
    gsl_matrix_set_identity(disp);
    MSET(disp, 0,0, value);
    MSET(disp, 1,1, value);       
  }

  for (j=0;j<dimen;j++) {
    VSET(ran,j,gsl_ran_gaussian(r,1.0));
  }

  /*remove update from slow species*/
  gsl_matrix_mul_elements(disp, fast_species);
    
  /*Add noise to mean cand*/
  gsl_blas_dgemv(CblasNoTrans,1.0, disp, ran, 1.0, mean_cand);
  for(i=0; i<2; i++)  {
    if(VGET(mean_cand,i)<=0.0001 && MGET(fast_species, i, i) > 0.000001)
      VSET(mean_cand,i,0.0001);
  }
  gsl_vector_free(ran);
  gsl_matrix_free(disp);
  gsl_matrix_free(fast_species);
}
Ejemplo n.º 3
0
/**
 * Get a summary statistic for the orbital elements; for instance,
 * the median value calculated over all the elements of the list.
 * @param kl List
 * @param what Can be one of: STAT_MEAN, STAT_MEDIAN, STAT_STDDEV, STAT_MAD. 
 *      Summary statistic is calculated correctly for angle parameters.
 * @return A matrix whose entries are the summary statistic for the 
 * corresponding orbital element.
 */
gsl_matrix* KL_getElementsStats(const ok_list* kl, const int what) {
    
    int npl = MROWS(kl->kernels[0]->elements);
    if (npl == 0)
        return NULL;
    
    gsl_vector* v = gsl_vector_alloc(kl->size);
    
    gsl_matrix* m = gsl_matrix_alloc(npl, ALL_ELEMENTS_SIZE);
    gsl_matrix_set_all(m, 0.);
    
    
    for (int i = 0; i < npl; i++)
            for (int j = 0; j < ALL_ELEMENTS_SIZE; j++) {
                for (int n = 0; n < kl->size; n++) {
                    VSET(v, n, MGET(kl->kernels[n]->elements, i, j));
                }
                
                switch (what) {
                    case STAT_MEAN:
                        if (j == MA || j == LOP || j == INC || j == NODE || j == TRUEANOMALY)
                            MSET(m, i, j, ok_average_angle(v->data, v->size, false));
                        else
                            MSET(m, i, j, gsl_stats_mean(v->data, 1, v->size));
                        break;
                    case STAT_STDDEV:
                        if (j == MA || j == LOP || j == INC || j == NODE || j == TRUEANOMALY) {
                            MSET(m, i, j, ok_stddev_angle(v->data, v->size, false));
                        }
                        else
                            MSET(m, i, j, gsl_stats_sd(v->data, 1, v->size));
                        break;
                    case STAT_MEDIAN:
                        if (j == MA || j == LOP || j == INC || j == NODE || j == TRUEANOMALY)
                            MSET(m, i, j, ok_median_angle(v->data, v->size, false));
                        else {
                            gsl_sort_vector(v);
                            MSET(m, i, j, gsl_stats_median_from_sorted_data(v->data, 1, v->size));
                        }
                        break;
                    case STAT_MAD:
                        if (j == MA || j == LOP || j == INC || j == NODE || j == TRUEANOMALY) {
                            double med = ok_median_angle(v->data, v->size, false);
                            MSET(m, i, j, 1.4826 * ok_mad_angle(v->data, v->size, med, false));
                        } else {
                            gsl_sort_vector(v);
                            double med = gsl_stats_median_from_sorted_data(v->data, 1, v->size);
                            
                            MSET(m, i, j, 1.4826 * ok_mad(v->data, v->size, med));
                        }
                        break;
                    default:
                        // percentiles
                        gsl_sort_vector(v);
                        MSET(m, i, j, gsl_stats_quantile_from_sorted_data(v->data, 1, v->size, (double)(what)/100.));
                };
            }
    gsl_vector_free(v);
    return m;
}
Ejemplo n.º 4
0
Archivo: Mgcd.c Proyecto: 8l/csolve
FN minvert(MINT *a, MINT *b, MINT *c)
{	MINT x, y, z, w, Anew, Aold;
	int i = 0;
	static MINT one;
	static int oneinit = 1;

	if (oneinit) {
		oneinit = 0;
		MSET(1,&one);
	}
	MINIT(&x);
	MINIT(&y);
	MINIT(&z);
	MINIT(&w);
	MINIT(&Aold);
	MSET (1,&Anew);

	mcopy(b, &x);
	mcopy(a, &y);
	/*
	 * Loop invariant:
	 *
	 * y = -1^i * Anew * a  mod b
	 */
	while(mtest(&y) != 0)
	{	mdiv(&x, &y, &w, &z);
		mcopy(&Anew, &x);
		mmult(&w, &Anew, &Anew);
		madd(&Anew, &Aold, &Anew);
		mmove(&x, &Aold);
		mmove(&y, &x);
		mmove(&z, &y);
		i++;
	}
	if (mcmp(&one,&x)) {
		mcopy(&one,c);
	} else {
		mmove(&Aold, c);
		if( (i&01) == 0) msub(b, c, c);
	}

	MFREE(&x);
	MFREE(&y);
	MFREE(&z);
	MFREE(&w);
	MFREE(&Aold);
	MFREE(&Anew);
}
Ejemplo n.º 5
0
Archivo: Mstrtoul.c Proyecto: 8l/csolve
mstrtoul(MINT *a, char *s, char **p, short int b)
{
	MINT	y, base;
	int	c, dectop, alphatop;
	short	qy;
	int	i;

	mset(0,a);
	MSET(b,&base);
	y.len	= 1;
	y.val	= &qy;
	dectop = (b <= 10) ? '0' + b - 1 : '9';
	if (b > 10) alphatop = 'a' + b - 10;

	i=0;
	while (isxdigit(c=s[i++])) {
		if (isupper(c)) c = c - 'A' + 'a';
		if (c >= '0' && c <= dectop) {
			qy = c - '0';
			mmult(a,&base,a);
			if (qy != 0) madd(a,&y,a);
			continue;
		} if (b > 10 && (c >= 'a' && c <= alphatop)) {
			qy = c - 'a' + 10;
			mmult(a,&base,a);
			madd(a,&y,a);
			continue;
		}
	};
	if (p!=NULL) (*p)=(char *)s+i-1;
}
Ejemplo n.º 6
0
void move(struct mat * ro, struct mat * RO_r, struct mat * RO_n, struct mat * r,
          struct mat * u, struct mat * n)
{
    double a = MGET(r, 2, 0);
    double dx = MGET(u, 0, 0) + MGET(n, 0, 0);
    double da = MGET(u, 1, 0) + MGET(n, 1, 0);

    double ao = a + da;

    //printf("ao = %f\n", ao);
    if (ao > M_PI)
    {
        ao = ao - 2.0 * M_PI;
    }
    if (ao < -M_PI)
    {
        ao = ao + 2.0 * M_PI;
    }

    struct mat * dp = mat(2, 1);

    MSET(dp, 0, 0, dx);
    //MSET(dp, 1, 0, da);

    struct mat * to = mat(2, 1);
    struct mat * TO_r = mat(2, 3);
    struct mat * TO_dt = mat(2, 2);

    from_frame(to, TO_r, TO_dt, r, dp);

    float AO_a = 1;
    float AO_da = 1;

    copy_into(RO_r, TO_r, 0, 0);
    MSET(RO_r, 2, 0, 0);
    MSET(RO_r, 2, 1, 0);
    MSET(RO_r, 2, 2, AO_a);

    copy_into(RO_n, TO_dt, 0, 0);
    MSET(RO_n, 0, 1, 0);
    MSET(RO_n, 1, 1, 0);
    MSET(RO_n, 2, 1, AO_da);

    //print_mat(to);
    //printf("%f\n", ao);

    copy_into(ro, to, 0, 0);
    MSET(ro, 2, 0, ao);

    free(to);
    free(TO_r);
    free(TO_dt);
    free(dp);
}
Ejemplo n.º 7
0
double K_getPhasedDataForPlanet(ok_kernel* k, int planet, int row, int column) {
    static gsl_matrix* phased_data = NULL;

    if (planet >= 1) {
        if (phased_data != NULL) {
            gsl_matrix_free(phased_data);
            phased_data = NULL;
        }
        double chi2 = k->chi2;
        double rms = k->rms;
        double jitter = k->jitter;
        double chi2_rvs = k->chi2_rvs;

        planet = MIN(planet, K_getNplanets(k));
        double mass = K_getElement(k, planet, MASS);
        double period = K_getElement(k, planet, PER);
        K_setElement(k, planet, MASS, 0);
        K_calculate(k);

        phased_data = K_getCompiledDataMatrix(k);
        double mint = MGET(phased_data, 0, T_TIME);
        for (int i = 0; i < MROWS(phased_data); i++) {
            double t = fmod((MGET(phased_data, i, T_TIME) - mint), period);
            double v = MGET(phased_data, i, T_SVAL) - MGET(phased_data, i, T_PRED);
            MSET(phased_data, i, T_TIME, t);
            MSET(phased_data, i, T_VAL, v);
        }

        ok_sort_matrix(phased_data, T_TIME);
        K_setElement(k, planet, MASS, mass);
        K_calculate(k);
        k->chi2 = chi2;
        k->rms = rms;
        k->jitter = jitter;
        k->chi2_rvs = chi2_rvs;
        return 1;
    } else {
        return MGET(phased_data, row, column);
    }
}
Ejemplo n.º 8
0
/* 
   C code for reading in a csv file
 */
gsl_matrix *readMatrix(char *filename)
{
  int line_length = 500;    
  int nrows, ncols;
       
  FILE* f;  
  char *pch;
  char line[line_length];
  gsl_matrix *particles;
    
  f = fopen(filename, "r");
  if(NULL==f) {
    fprintf(stderr, "Cannot open file %s\n", filename);
    exit(1);
  }
  nrows = 0; ncols = 0;
  /*Scan once to get the dimensions
    there doesn't seem to be a realloc matrix function
  */

  while(fgets(line, line_length, f) != NULL){
    pch = strtok(line,",");
    while(nrows == 0 && pch != NULL ) {
      ncols++;
      pch = strtok(NULL,",");
    }
    nrows++;
  }
  
  fclose(f);
        
  /*Create matrix and fill up*/
  particles = gsl_matrix_alloc(nrows, ncols);
  nrows = 0; ncols = 0;
  f=fopen(filename, "r");
      
  while(fgets(line, line_length, f) != NULL){
    pch = strtok(line,",");
    while(pch != NULL ) {
      MSET(particles, nrows, ncols, atof(pch));
      ncols++;
      pch = strtok(NULL,",");
    }
    ncols = 0;
    nrows++;
  }
  fclose(f);
    
  return(particles);    
}  
Ejemplo n.º 9
0
double K_getPhasedRVLine(ok_kernel* k, int planet, int row, int column) {
    static gsl_matrix* phasedRVLine = NULL;
    if (planet >= 1) {
        if (k->ndata == 0)
            return -1;

        int np = K_getNplanets(k);
        double masses[np + 1];
        double periods[np + 1];
        for (int i = 1; i <= np; i++) {
            masses[i] = K_getElement(k, i, MASS);
            periods[i] = K_getElement(k, i, PER);
            if (i != planet) {
                K_setElement(k, i, MASS, 0.);
                K_setElement(k, i, PER, 10000.);
            }
        };

        double period = K_getElement(k, planet, PER);
        int samples = -row;
        if (phasedRVLine != NULL) {
            gsl_matrix_free(phasedRVLine);
            phasedRVLine = NULL;
        }
        double** comp = K_getCompiled(k);

        phasedRVLine = K_integrateStellarVelocity(k, comp[0][0],
                       comp[k->ndata - 1][0],
                       samples,
                       NULL, NULL);

        double mint = MGET(phasedRVLine, 0, T_TIME);
        for (int i = 0; i < MROWS(phasedRVLine); i++) {
            double t = fmod((MGET(phasedRVLine, i, 0) - mint), period);
            MSET(phasedRVLine, i, 0, t);
        }
        ok_sort_matrix(phasedRVLine, 0);

        for (int i = 1; i <= np; i++) {
            K_setElement(k, i, MASS, masses[i]);
            K_setElement(k, i, PER, periods[i]);
        }

        return 1;
    } else {
        return MGET(phasedRVLine, row, column);
    }
}
Ejemplo n.º 10
0
void *heap_allocate(u4 size, bool references, methodinfo *finalizer)
{
	void *m;

	mmapptr = (void *) MEMORY_ALIGN((ptrint) mmapptr, ALIGNSIZE);
	
	m = mmapptr;
	mmapptr = (void *) ((ptrint) mmapptr + size);

	if (mmapptr > mmaptop)
		vm_abort("heap_allocate: out of memory");

	MSET(m, 0, u1, size);

	return m;
}
Ejemplo n.º 11
0
void from_frame(struct mat * pw, struct mat * PW_f, struct mat * PW_pf,
                struct mat * F, struct mat * pf)
{
  struct mat * t = mat(2, 1);

  double a = MGET(F, 2, 0);

  sub_mat(t, F, 0, 0);

  struct mat * R = mat(2, 2);

  MSET(R, 0, 0, cos(a));
  MSET(R, 0, 1, -sin(a));
  MSET(R, 1, 0, sin(a));
  MSET(R, 1, 1, cos(a));

  struct mat * temp = mat(2, 1);

  prodMat(temp, R, pf);

  addMat(pw, temp, t);

  free(temp);

  double px = MGET(pf, 0, 0);
  double py = MGET(pf, 1, 0);

  MSET(PW_f, 0, 0, 1);
  MSET(PW_f, 0, 2, -py*cos(a) - px * sin(a));
  MSET(PW_f, 1, 1, 1);
  MSET(PW_f, 1, 2, px * cos(a) - py * sin(a));

  memcpy(&PW_pf->values[0], &R->values[0], sizeof(double) * (R->rows * R->columns));

  free(R);
}
Ejemplo n.º 12
0
void K_setDataAt(ok_kernel* k, int subset, int row, int column, double val) {
    if (subset == ALL)
        K_getCompiled(k)[row][column] = val;
    else
        MSET(K_getData(k, subset), row, column, val);
}
Ejemplo n.º 13
0
/**
 * Computes the Lomb-Scargle periodogram of the matrix "data". "data" should contain at least three
 * columns: time, measurement and measurement error. The periodogram is calculated in "samples" intervals
 * between "Pmin" and "Pmax", spaced logarithmically. 
 * 
 * The function returns a matrix of "samples" rows and several columns, including period, power (z) and 
 * an estimation of the upper bound for the false alarm probability. The estimation is calculated using 
 * the method of Baluev, 2008 (Baluev08). The column PS_Z_LS contains the unnormalized LS periodogram 
 * (z = 1/2 * (Chi^2_0 - Chi^2_SC)), while the column PS_Z contains z_1 = 1/2 * N_H * z / Chi^2_0 (z_1 in Baluev08). 
 * The FAP upper bound is estimated as ~ tau(z_1). (Another estimate of the FAP can be calculated by 
 * estimating the indep. frequencies through your own algorithm, or using the ok_periodogram_boot routine.)
 * 
 * @param data Input data containing the data; each row containing (t_i, x_i, sigma_i)
 * @param samples Number of frequencies sampled
 * @param Pmin Minimum period sampled
 * @param Pmax Maximum period sampled
 * @param method Method to compute periodogram (ignored)
 * @param timecol Time column (e.g. 0) in the matrix data
 * @param valcol Value column (e.g. 1) in the matrix data
 * @param sigmacol Sigma column (e.g. 2) in the matrix data
 * @param p If not NULL, it is used to return additional info for the periodogram and reuse matrices to save space/speed. If you pass
 * a value different than NULL, you are responsible for deallocating the workspace and its fields. p->buf is an array of
 * gsl_matrix*, sized the same as the value of omp_get_max_threads().
 * @return A matrix containing: {PS_TIME, PS_Z, PS_FAP, PS_Z_LS} (period, power, FAP upper limit, unnormalized
 * LS power). You are responsible for deallocating it.
 */
gsl_matrix* ok_periodogram_ls(const gsl_matrix* data, const unsigned int samples, const double Pmin, const double Pmax, const int method,
                              unsigned int timecol, unsigned int valcol, unsigned int sigcol, ok_periodogram_workspace* p) {

    gsl_matrix* ret = NULL;
    gsl_matrix* buf = NULL;
    gsl_vector* bufv = gsl_vector_alloc(data->size1);

    int ndata = data->size1;

    // If no pre-allocated buffers are passed through p, or p is null,
    // allocate those buffers.
    if (p != NULL) {
        if (p->per != NULL && MROWS(p->per) == samples && MCOLS(p->per) == PS_SIZE)
            ret = p->per;
        if (p->buf != NULL && MROWS(p->buf) == ndata && MCOLS(p->per) == 5)
            ret = p->buf;
    }

    ret = (ret != NULL ? ret : gsl_matrix_alloc(samples, PS_SIZE));
    buf = (buf != NULL ? buf : gsl_matrix_alloc(ndata, 5));

    double fmin = 1. / Pmax;
    double fmax = 1. / Pmin;
    double df = (fmax - fmin) / (double) samples;


    gsl_matrix_get_col(bufv, data, timecol);
    double W = 2. * M_PI * gsl_stats_sd(bufv->data, 1, ndata) / Pmin;
    gsl_matrix_get_col(bufv, data, valcol);
    double avg = gsl_stats_mean(bufv->data, 1, ndata);
    double z1_max = 0.;
    double xa[ndata];

    // pre-calculate cdf, sdf
    for (int i = 0; i < ndata; i++) {
        double t = MGET(data, i, timecol) - MGET(data, 0, timecol);
        MSET(buf, i, BUF_CDF, cos(2 * M_PI * df * t));
        MSET(buf, i, BUF_SDF, sin(2 * M_PI * df * t));
        MSET(buf, i, BUF_C, cos(2 * M_PI * fmin * t));
        MSET(buf, i, BUF_S, sin(2 * M_PI * fmin * t));
        MSET(buf, i, BUF_SIG, 1. / (MGET(data, i, sigcol) * MGET(data, i, sigcol)));
        xa[i] = MGET(data, i, valcol) - avg;
    }

    // Calculate periodogram by looping over all angular frequencies
    for (int i = 0; i < samples; i++) {
        // Current frequency
        double f = fmin + df * i;


        double w = 2 * M_PI*f;

        // Calculate tau(w)
        double s_2wt = 0.;
        double c_2wt = 0.;

        for (int j = 0; j < ndata; j++) {
            double cos_wt = C(j);
            double sin_wt = S(j);
            c_2wt += (1. - 2. * sin_wt * sin_wt) * SIG(j);
            s_2wt += (2. * sin_wt * cos_wt) * SIG(j);
        }

        double tau = atan2(s_2wt, c_2wt) / (2. * w);
        double numa = 0.;
        double numb = 0.;
        double dena = 0.;
        double denb = 0.;
        double numa_w = 0.;
        double numb_w = 0.;
        double dena_w = 0.;
        double denb_w = 0.;

        double coswtau = cos(w * tau);
        double sinwtau = sin(w * tau);
        double chi2_h = 0.;
        double chi2_h_w = 0;

        for (int j = 0; j < ndata; j++) {

            double sig = SIG(j);

            const double cos_wt = C(j);
            const double sin_wt = S(j);

            double cos_wdf = CDF(j);
            double sin_wdf = SDF(j);

            double c = cos_wt * coswtau + sin_wt * sinwtau;
            double s = sin_wt * coswtau - cos_wt * sinwtau;
            double x = xa[j];

            MSET(buf, j, BUF_C, cos_wt * cos_wdf - sin_wt * sin_wdf);
            MSET(buf, j, BUF_S, sin_wt * cos_wdf + cos_wt * sin_wdf);

            numa += x * c * sig;
            numb += x * s * sig;
            dena += c * c * sig;
            denb += s * s * sig;
            chi2_h += x * x * sig;

            numa_w += c;
            numb_w += s;
            dena_w += c*c;
            denb_w += s*s;

            chi2_h_w += 1;
        }


        double z = 0.5 * (numa * numa / dena + numb * numb / denb);
        double z_1 = z * ndata / chi2_h;

        double w_1 = 0.5 * (numa_w * numa_w / dena_w + numb_w * numb_w / denb_w) * ndata / chi2_h_w;

        double fap_single = pow(1. - 2. * z_1 / (double) ndata, 0.5 * (double) (ndata - 3.));
        double tau_z = W * fap_single * sqrt(z_1);

        MSET(ret, samples - i - 1, PS_TIME, 1. / f);
        MSET(ret, samples - i - 1, PS_Z, z_1);
        MSET(ret, samples - i - 1, PS_Z_LS, z);
        MSET(ret, samples - i - 1, PS_FAP, MIN(fap_single + tau_z, 1.));
        MSET(ret, samples - i - 1, PS_TAU, tau);
        MSET(ret, samples - i - 1, PS_WIN, w_1);

        z1_max = MAX(z1_max, z_1);
    }

    if (p != NULL && p->calc_z_fap) {
        gsl_root_fsolver * s = gsl_root_fsolver_alloc(gsl_root_fsolver_brent);
        double pars[3];
        pars[0] = ndata;
        pars[1] = W;
        pars[2] = 0.;

        gsl_function F;
        F.function = _baluev_tau;
        F.params = pars;

        double zz = z1_max;
        while (_baluev_tau(zz, pars) > 1e-3)
            zz *= 2;

        p->z_fap_3 = _find_z(s, &F, 1e-3, 0.1, zz);
        p->z_fap_2 = _find_z(s, &F, 1e-2, 0.1, p->z_fap_3);
        p->z_fap_1 = _find_z(s, &F, 1e-1, 0.1, p->z_fap_2);


        gsl_root_fsolver_free(s);
        p->calc_z_fap = false;
    }

    if (p == NULL) {
        gsl_matrix_free(buf);
    } else {
        p->per = ret;
        p->buf = buf;
        p->zmax = z1_max;
    };

    gsl_vector_free(bufv);

    return ret;
}
Ejemplo n.º 14
0
/**
 * Estimates the FAP by Monte Carlo bootstrapping of the original data. "trials" bootstrapped data sets are
 * generated using the random number generator "rng"; for each data set, the routine ok_periodogram_ls estimates
 * z_max, which is collected into an array and returned into "zmax". Bootstrapped datasets are built by selecting
 * with replacement from the input dataset, keeping times of observation fixed. 
 * @param data Input matrix containing the data; each row containing (t_i, x_i, sigma_i)
 * @param trials Number of bootstrap trials
 * @param samples Number of frequencies sampled
 * @param Pmin Minimum period sampled
 * @param Pmax Maximum period sampled
 * @param method Method used to compute periodogram (ignored)
 * @param timecol Time column (e.g. 0) in the matrix data
 * @param valcol Value column (e.g. 1) in the matrix data
 * @param sigmacol Sigma column (e.g. 2) in the matrix data
 * @param rng A pre-allocated random number generator
 * @param p If specified, returns additional info for the periodogram and reuses matrices to save space/speed. If you pass
 * a value different than NULL, you are responsible for deallocating the workspace and its fields. p->zm returns a sorted
 * vector of the maximum powers in each synthetic trial.
 * @param prog An ok_progress* callback; if different from NULL, can be used to stop or report progress.
 * @return A matrix containing: {PS_TIME, PS_Z, PS_FAP, PS_Z_LS} (period, power, bootstrapped FAP, unnormalized
 * LS power). You are responsible for deallocating it.

 */
gsl_matrix* ok_periodogram_boot(const gsl_matrix* data, const unsigned int trials, const unsigned int samples,
                                const double Pmin, const double Pmax, const int method,
                                const unsigned int timecol, const unsigned int valcol, const unsigned int sigcol,
                                const unsigned long int seed, ok_periodogram_workspace* p, ok_progress prog) {


    int nthreads = omp_get_max_threads();

    ok_periodogram_workspace * w[nthreads];
    gsl_matrix * mock[nthreads];
    gsl_rng * rng[nthreads];

    rng[0] = gsl_rng_alloc(gsl_rng_default);
    gsl_rng_set(rng[0], seed);

    for (int i = 0; i < nthreads; i++) {
        w[i] = (ok_periodogram_workspace*) malloc(sizeof (ok_periodogram_workspace));
        w[i]->per = NULL;
        w[i]->buf = NULL;
        w[i]->calc_z_fap = false;
        mock[i] = ok_matrix_copy(data);
        if (i > 0) {
            rng[i] = gsl_rng_alloc(gsl_rng_default);
            gsl_rng_set(rng[i], seed + i);
        }
    }

    gsl_matrix* ret = ok_matrix_copy(ok_periodogram_ls(data, samples, Pmin, Pmax, method, timecol, valcol, sigcol, NULL));

    gsl_vector* zmax = (p != NULL && p->zm != NULL ? p->zm : gsl_vector_alloc(trials));

    bool abort = false;
    #pragma omp parallel for
    for (int i = 0; i < trials; i++) {
        if (!abort) {
            int nt = omp_get_thread_num();

            ok_bootstrap_matrix_mean(data, T_TIME, T_VAL, mock[nt], rng[nt]);
            ok_periodogram_ls(mock[nt], samples, Pmin, Pmax, method, timecol, valcol, sigcol, w[nt]);
            zmax->data[i] = w[nt]->zmax;

            if (nt == 0 && prog != NULL) {
                int ret = prog(i * nthreads, trials, NULL,
                               "ok_periodogram_boot");
                if (ret == PROGRESS_STOP) {
                    abort = true;
                    #pragma omp flush (abort)
                }
            }
        }
    }

    gsl_sort(zmax->data, 1, trials);

    for (int i = 0; i < ret->size1; i++) {
        if (MGET(ret, i, PS_Z) > zmax->data[trials - 1])
            MSET(ret, i, PS_FAP, 1. / (double) trials);
        else if (MGET(ret, i, PS_Z) < zmax->data[0])
            MSET(ret, i, PS_FAP, 1.);
        else {
            int idx = ok_bsearch(zmax->data, MGET(ret, i, PS_Z), trials);
            MSET(ret, i, PS_FAP, (double) (trials - idx) / (double) trials);
        }
    }



    for (int i = 0; i < nthreads; i++) {
        gsl_matrix_free(w[i]->buf);
        gsl_matrix_free(w[i]->per);
        free(w[i]);
        gsl_matrix_free(mock[i]);
        gsl_rng_free(rng[i]);
    }

    if (p != NULL) {
        if (p->zm != NULL)
            gsl_vector_free(zmax);
    }
    return ret;
}
Ejemplo n.º 15
0
gsl_matrix* ok_periodogram_full(ok_kernel* k, int type, int algo, bool circular, unsigned int sample,
                                const unsigned int samples, const double Pmin, const double Pmax) {

    k = K_clone(k);
    K_calculate(k);

    // Input data for LS periodogram
    gsl_matrix* data = ok_buf_to_matrix(K_compileData(k), K_getNdata(k), DATA_SIZE);


    if (type == PS_TYPE_RESIDUALS) {
        // If residuals periodogram, subtract signal from data
        for (int i = 0; i < data->size1; i++)
            MSET(data, i, T_SVAL, MGET(data, i, T_SVAL) - MGET(data, i, T_PRED));
    } else if (type == PS_TYPE_DATA) {
        // If full periodogram, then start with no planets
        K_removePlanet(k, -1);
    }

    // Calculate LS periodogram
    gsl_matrix* ret = ok_periodogram_ls(data, samples, Pmin, Pmax, 0, T_TIME, T_SVAL, T_ERR, NULL);
    int np = K_getNplanets(k) + 1;

    // Number of minimizable offsets
    int no = 0;
    for (int i = 0; i < DATA_SETS_SIZE; i++)
        if (VIGET(k->parFlags, i) & MINIMIZE) {
            no++;
        }

    // Calculate baseline chi^2 (Chi^2_H)

    double Chi2_H = _kminimize(k, algo);

    // Normalizing factor for power
    double nd = 0.5 * (K_getNdata(k) - no);



    #pragma omp parallel for
    for (int r = 0; r < samples; r++) {
        double P = MGET(ret, r, PS_TIME);
        double K = sqrt(MGET(ret, r, PS_Z));

        ok_kernel* k2 = K_clone(k);
        K_calculate(k2);

        double args[] = {PER, P, DONE};
        K_addPlanet(k2, args);
        K_setElement(k2, np, SEMIAMP, K);

        K_setElementFlag(k2, np, PER, ACTIVE);

        if (circular) {
            K_setElementFlag(k2, np, ECC, ACTIVE);
            K_setElementFlag(k2, np, LOP, ACTIVE);
        }

        double Chi2_K = _kminimize(k2, algo);

        double z = nd * (Chi2_H - Chi2_K) / Chi2_H;
        MSET(ret, r, PS_Z, z);
        fflush(stdout);
    }

    return ret;

}
Ejemplo n.º 16
0
void hybridSim(st_part_at* prop_part,
               double maxtime, 
               void (*forwardsimulate)(gsl_vector *params, double maxtime, gsl_vector* sps)/*a pointer to the forward simulator method*/
               ) {
    
  double t,  tau=0;
  int zc=-1, i, mu=-1;
  double  deltat, Deltat=0.1;
  deltat = Deltat;
    
  gsl_vector *sps = prop_part->sps;
  gsl_vector *params = prop_part->params;
  gsl_vector *residuals = prop_part->res;        
    
  gsl_vector *fast_params;
  fast_params = gsl_vector_alloc(params->size);
  gsl_vector_memcpy(fast_params, params);
    
  gsl_matrix *PostPre;
  PostPre = gsl_matrix_alloc(5, 2);
  gsl_matrix_set_zero(PostPre);
  MSET(PostPre, 0, 0, 1);
  MSET(PostPre, 1, 1, 1);    
  MSET(PostPre, 2, 0, -1);        
  MSET(PostPre, 3, 1, -1);            
  MSET(PostPre, 4, 0, -1);                
  MSET(PostPre, 4, 1, 20);/*Change to 1-> 20*/               
    
  gsl_vector *haz;
  haz = gsl_vector_alloc(5);
  gsl_vector_set_zero(haz);
  double toutput = 0.0;
  t = 0.0;
  while (t<maxtime){
    deltat = min(deltat, maxtime - t );
    gsl_vector_memcpy(fast_params, params);
    //    printf("sps0=%f, sps1=%f\n", VGET(sps, 0),VGET(sps, 1));
    /*Update Hazard function*/
    updateHazard(haz, params, sps);
    checkReactions(haz, residuals, fast_params, deltat, sps, PostPre);
        
    /*Evaluate residuals of jump equations*/
    gsl_vector_scale(haz, deltat);
    gsl_vector_add(residuals, haz);
    zc = 0;
    for(i=0; i<5; i++) {
      if(VGET(residuals, i)>=0.0) {
        zc++;
        mu = i;
      }
    }
    if(zc == 0) {
      forwardsimulate(fast_params, deltat, sps);
      t += deltat;
      deltat = Deltat;
    }
        
    if(zc == 1) {
      /*Generate time to reaction*/
      tau = -(VGET(residuals, mu) - VGET(haz, mu))/(VGET(haz, mu)/deltat);
      gsl_vector_sub(residuals, haz);
      gsl_vector_scale(haz, tau/deltat);
      gsl_vector_add(residuals, haz);
      VSET(residuals, mu, log(gsl_ran_flat(r, 0.0, 1.0)));
      deltat = tau;
      forwardsimulate(fast_params, deltat, sps);
            
      /*Add on effect of reaction mu*/
      VSET(sps, 0, round(VGET(sps, 0) + MGET(PostPre, mu, 0)));
      VSET(sps, 1, round(VGET(sps, 1) + MGET(PostPre, mu, 1)));            
      t += deltat;
      deltat = Deltat;
    }
    
    if(zc > 1) {
      gsl_vector_sub(residuals, haz);
      deltat = deltat/5.0;
    }

    if(zc < 2 && t > toutput) {
      /* printf("%f,%f,%f,%f,%f,%f\n", 
       *        toutput, VGET(fast_params, 0),
       *        VGET(fast_params, 1), VGET(fast_params, 2),
       *        VGET(fast_params, 3),VGET(fast_params, 4)); */
        toutput += 1.0;
        }
  }

  gsl_vector_free(haz);
  gsl_vector_free(fast_params);
  gsl_matrix_free(PostPre);
}
Ejemplo n.º 17
0
/**
 * Loads a list previously saved to a file using KL_save.
 * 
 * @param fid opened file handle 
 * @param skip set to 0
 * @return a list containing the data read from the file
 */
ok_list* KL_load(FILE* fid, int skip) {
    char line[18192];
    int np = -1;

    int trials = -1;
    double Mstar = 0.;
    double epoch = 0.;
    
    for (int i = 0; i < skip; i++) {
        while (fgets(line, sizeof(line), fid)) 
            if (strcmp(line, "#End\n") == 0)
                break;
        if (feof(fid))
            return NULL;
    }
    
    bool found = false;
    char* ret = NULL;
    
    while (!found) {
       while ((ret = fgets(line, sizeof(line), fid)) != NULL) {
            if (strcmp(line, "#KernelList\n") == 0) {
                found = true;
                break;
            }
            if (feof(fid))
                return NULL;
       }

        if (ret == NULL) {
            return NULL;
        }
            
    }
    
    ok_list* kl = NULL;
    
    while (true) {
        //long int ft = ftell(fid);
        if ((fgets(line, sizeof(line), fid) == NULL) || feof(fid))
            break;
        
        if (line[0] == '#') {
            char tag[100] = {0};
            sscanf(line + 2, "%s = ", tag);
            
            if (strcmp(tag, "Planets") == 0) {
                sscanf(line + 2, "%*s = %d", &np);
            } else if (strcmp(tag, "Trials") == 0) {
                sscanf(line + 2, "%*s = %d", &trials);
                kl = KL_alloc(trials, NULL);
            } else if (strcmp(tag, "Epoch") == 0) {
                sscanf(line + 2, "%*s = %le", &epoch);
            } else if (strcmp(tag, "Mstar") == 0) {
                sscanf(line + 2, "%*s = %le", &Mstar);
            } else if (strcmp(tag, "Type") == 0) {
                sscanf(line + 2, "%*s = %d", &(kl->type));
            }
            
        } else {
            
            kl->prototype = K_alloc(np);
            K_setEpoch(kl->prototype, epoch);
            K_setMstar(kl->prototype, Mstar);
            
            
            for (int tr = 0; tr < trials; tr++) {
                gsl_matrix* elements = gsl_matrix_calloc(np+1, ALL_ELEMENTS_SIZE);
                gsl_vector* pars = gsl_vector_calloc(PARAMS_SIZE);
                
                
                   for (int i = 0; i < ALL_ELEMENTS_SIZE; i++) {
                       for (int j = 1; j <= np; j++) {
                            double v = 1e-10;
                            fscanf(fid, "%le", &v);
                            MSET(elements, j, i, v);
                        }
                    }
                
                
                for (int i = 0; i < PARAMS_SIZE; i++) {
                    double v;
                    fscanf(fid, "%le", &v);
                    VSET(pars, i, v);
                }

                double merit;
                fscanf(fid, "%le", &merit);
                
                ok_list_item* it = KL_set(kl, tr, elements, pars, merit, 0);
                fscanf(fid, "%le", &it->merit_li);
                fscanf(fid, "%le", &it->merit_pr);
                double tag;
                fscanf(fid, "%le", &tag);
                it->tag = (int) tag;
                
            }
            break;
        }
    }
    
    return kl;
}
Ejemplo n.º 18
0
double K_getPeriodogramAt(ok_kernel* k, int row, int col) {

    static int length;
    static int samples = 15000;
    static double Pmin = 1.;
    static double Pmax = 20000.;
    static ok_periodogram_workspace* p = NULL;
    static gsl_matrix* ps = NULL;
    static const int top_freqs = 10;
    static double* top = NULL;
    static double tolerance[1] = {1e-3};

    if (p == NULL) {
        p = (ok_periodogram_workspace*) malloc(sizeof (ok_periodogram_workspace));
        p->buf = NULL;
        p->per = NULL;
        p->calc_z_fap = true;
    }
    if (row == JS_PS_GET_TOP_PERIODS) {
        return top[col];
    } else if (row == JS_PS_GET_TOP_POWERS) {
        return top[col + top_freqs];
    } else if (row == JS_PS_GET_TOP_FAPS) {
        return top[col + 2 * top_freqs];
    } else if (row == JS_PS_SET_PMIN) {
        Pmin = (double) col;
        return 0;
    } else if (row == JS_PS_SET_PMAX) {
        Pmax = (double) col;
        return 0;
    } else if (row == JS_PS_SETUP) {
        if (ps != NULL) {
            gsl_matrix_free(ps);
            ps = NULL;
        }
        if (top == NULL)
            top = (double*) malloc(top_freqs * 3 * sizeof (double));
        gsl_matrix* data = K_getCompiledDataMatrix(k);
        for (int i = 0; i < MROWS(data); i++)
            MSET(data, i, T_SVAL, MGET(data, i, T_SVAL) - MGET(data, i, T_PRED));

        gsl_matrix* ret = ok_periodogram_ls(data, samples, Pmin, Pmax,
                                            0, T_TIME, T_SVAL, T_ERR, p);

        ps = ok_resample_curve(ret, 0, 1, 0.1, 800,
                               100, tolerance, 0, true);
        length = MROWS(ps);

        ok_sort_matrix(ret, PS_Z);
        double dt = 0.5;
        int idx = MROWS(ret);
        int i = 0;
        while (idx > 0 && i < top_freqs) {
            idx--;
            bool skip = false;
            for (int n = 0; n < i; n++)
                if (fabs(top[n] - MGET(ret, idx, PS_TIME)) < dt)
                    skip = true;

            if (!skip) {
                top[i] = MGET(ret, idx, PS_TIME);
                top[i + top_freqs] = MGET(ret, idx, PS_Z);
                top[i + 2 * top_freqs] = MGET(ret, idx, PS_FAP);
                i++;
            }
        }
        gsl_matrix_free(data);

        return (double) length;
    } else if (row == JS_PS_GET_FAPS_LEVELS) {
        if (p == NULL || ps == NULL)
            return 0;
        if (col == 1)
            return p->z_fap_1;
        else if (col == 2)
            return p->z_fap_2;
        else if (col == 3)
            return p->z_fap_3;
        else
            return 0.;
    } else {
        if (ps == NULL)
            return 0;
        return MGET(ps, row, col);
    }
}