Example #1
0
File: rnd.cpp Project: cran/mvabund
double dmvt(const unsigned int n, const gsl_vector *x, const gsl_vector *location, const gsl_matrix *scale, const unsigned int dof)
{
    int s;
    double ax,ay,az=0.5*(dof + n);
    gsl_vector *ym, *xm;
    gsl_matrix *work = gsl_matrix_alloc(n,n), 
               *winv = gsl_matrix_alloc(n,n);
    gsl_permutation *p = gsl_permutation_alloc(n);

    gsl_matrix_memcpy( work, scale );
    gsl_linalg_LU_decomp( work, p, &s );
    gsl_linalg_LU_invert( work, p, winv );
    ax = gsl_linalg_LU_det( work, s );
    gsl_matrix_free( work );
    gsl_permutation_free( p );

    xm = gsl_vector_alloc(n);
    gsl_vector_memcpy( xm, x);
    gsl_vector_sub( xm, location );
    ym = gsl_vector_alloc(n);
    gsl_blas_dsymv(CblasUpper,1.0,winv,xm,0.0,ym);
    gsl_matrix_free( winv );
    gsl_blas_ddot( xm, ym, &ay);
    gsl_vector_free(xm);
    gsl_vector_free(ym);

    ay = pow((1+ay/dof),-az)*gsl_sf_gamma(az)/(gsl_sf_gamma(0.5*dof)*sqrt( pow((dof*M_PI),double(n))*ax ));

    return ay;
}
Example #2
0
/// Subtract a vector
/// @param v :: The other vector
GSLVector &GSLVector::operator-=(const GSLVector &v) {
  if (size() != v.size()) {
    throw std::runtime_error("GSLVectors have different sizes.");
  }
  gsl_vector_sub(gsl(), v.gsl());
  return *this;
}
Example #3
0
double ran_mv_normal_pdf(const gsl_vector *x, const gsl_vector *mu,
			 const gsl_matrix *Sigma)
{
  const int k = x->size;
  int s;
  double det, den;

  gsl_vector *y = gsl_vector_alloc(k);
  gsl_vector *work_k = gsl_vector_alloc(k);
  
  gsl_matrix *work_k_k = gsl_matrix_alloc(k, k);
  gsl_matrix *Sigmainv = gsl_matrix_alloc(k, k);
  gsl_permutation *p = gsl_permutation_alloc(k);
  
  gsl_vector_memcpy(y, x);
  gsl_vector_sub(y, mu);
  
  gsl_matrix_memcpy(work_k_k, Sigma);
  gsl_linalg_LU_decomp(work_k_k, p, &s);
  gsl_linalg_LU_invert(work_k_k, p, Sigmainv);
  det = gsl_linalg_LU_det(work_k_k, s);

  gsl_blas_dgemv(CblasNoTrans, 1.0, Sigmainv, y, 0.0, work_k);
  gsl_blas_ddot(y, work_k, &den);
  den = exp(-0.5*den) / sqrt(pow((2*M_PI), k)*det);

  gsl_vector_free(y);
  gsl_vector_free(work_k);
  gsl_matrix_free(work_k_k);
  gsl_matrix_free(Sigmainv);
  gsl_permutation_free(p);
  
  return den;
}
Example #4
0
File: mvn.c Project: IlariaD/ssm
/**
 * Adapted from: Multivariate Normal density function and random
 * number generator Using GSL from Ralph dos Santos Silva
 * Copyright (C) 2006
 *
 * multivariate normal density function
 *
 * @param n	dimension of the random vetor
 * @param mean	vector of means of size n
 * @param var	variance matrix of dimension n x n
 */
double ssm_dmvnorm(const int n, const gsl_vector *x, const gsl_vector *mean, const gsl_matrix *var, double sd_fac)
{
    int s;
    double ax,ay;
    gsl_vector *ym, *xm;
    gsl_matrix *work = gsl_matrix_alloc(n,n),
        *winv = gsl_matrix_alloc(n,n);
    gsl_permutation *p = gsl_permutation_alloc(n);

    gsl_matrix_memcpy( work, var );
    //scale var with sd_fac^2
    gsl_matrix_scale(work, sd_fac*sd_fac);

    gsl_linalg_LU_decomp( work, p, &s );
    gsl_linalg_LU_invert( work, p, winv );
    ax = gsl_linalg_LU_det( work, s );
    gsl_matrix_free( work );
    gsl_permutation_free( p );

    xm = gsl_vector_alloc(n);
    gsl_vector_memcpy( xm, x);
    gsl_vector_sub( xm, mean );
    ym = gsl_vector_alloc(n);
    gsl_blas_dsymv(CblasUpper,1.0,winv,xm,0.0,ym);
    gsl_matrix_free( winv );
    gsl_blas_ddot( xm, ym, &ay);
    gsl_vector_free(xm);
    gsl_vector_free(ym);
    ay = exp(-0.5*ay)/sqrt( pow((2*M_PI),n)*ax );

    return ay;
}
Example #5
0
double overlap_gto(const GTO* g1, const gsl_vector* A, const GTO* g2, const gsl_vector* B, int debug)
{
    double K, gamma, Ix, Iy, Iz, result = 0;
    double normal1, normal2;
    double coeff1, coeff2;
    gsl_vector *PA, *PB, *P;

    PA = gsl_vector_alloc(3);
    PB = gsl_vector_alloc(3);

    normal1 = g1->norm;
    normal2 = g2->norm;
    coeff1 = g1->coeff;
    coeff2 = g2->coeff;

    // compute the coordination of P. 《量子化学》中册, P77
    P = gaussian_product_center(g1->alpha, A, g2->alpha, B, debug);
    gsl_vector_memcpy(PA, P);
    gsl_vector_memcpy(PB, P);

    gsl_vector_sub(PA, A);
    gsl_vector_sub(PB, B);

    gamma = g1->alpha + g2->alpha;

    Ix = I_xyz(g1->l, PA->data[0], g2->l, PB->data[0], gamma, debug);
    Iy = I_xyz(g1->m, PA->data[1], g2->m, PB->data[1], gamma, debug);
    Iz = I_xyz(g1->n, PA->data[2], g2->n, PB->data[2], gamma, debug);

    K = gauss_K(g1->alpha, A, g2->alpha, B);

    result = pow(M_PI/gamma, 1.5) * K * Ix * Iy * Iz * normal1 * normal2 * coeff1 * coeff2;
    if (debug == 2) {
                printf("--------------------------------------------\n");
                vector_output(PA, 3, "PA:");
                vector_output(PB, 3, "PB:");
                gto_output(g1, 1, "g1:");
                gto_output(g2, 1, "g2:");
                printf("%14.8lf%14.8lf%14.8lf%14.8lf%14.8lf\n", 
                                                        K, Ix, Iy, Iz, result);
    }
    gsl_vector_free(P);
    gsl_vector_free(PA);
    gsl_vector_free(PB);
    return result;
}
Example #6
0
GslVector&
GslVector::operator-=(const GslVector& rhs)
{
  int iRC;
  iRC = gsl_vector_sub(m_vec,rhs.m_vec);
  queso_require_msg(!(iRC), "failed");

  return *this;
}
Example #7
0
 /** Subtraction operator (vector) */
 vector<double> vector<double>::operator-(const vector<double>& v)
 {
   vector<double> v1(_vector);
   if (gsl_vector_sub(v1.as_gsl_type_ptr(), v.as_gsl_type_ptr()))
     {
       std::cout << "\n Error in vector<double> -" << std::endl;
       exit(EXIT_FAILURE);
     }
   return v1;
 }
Example #8
0
double objective(gsl_matrix *A, gsl_vector *b, double lambda, gsl_vector *z) {
	double obj = 0;
	gsl_vector *Azb = gsl_vector_calloc(A->size1);
	gsl_blas_dgemv(CblasNoTrans, 1, A, z, 0, Azb);
	gsl_vector_sub(Azb, b);
	double Azb_nrm2;
	gsl_blas_ddot(Azb, Azb, &Azb_nrm2);
	obj = 0.5 * Azb_nrm2 + lambda * gsl_blas_dasum(z);
	gsl_vector_free(Azb);
	return obj;
}
Example #9
0
void SimplexFltr::pivot(int jj, int ii) {
    gsl_vector_scale(gjs[jj],1.0/gsl_vector_get(gjs[jj],ii));
    for(int j=0; j<d+1; j++) {
        if(j==jj) j++;
        double scale = gsl_vector_get(gjs[j],ii);
        if(std::abs(scale)>=signtol) { //need to subtract off this row
            gsl_vector_scale(gjs[jj],scale);
            gsl_vector_sub(gjs[j],gjs[jj]);
            gsl_vector_scale(gjs[jj],1.0/scale);
        }
    }
}
Example #10
0
GslVector&
GslVector::operator-=(const GslVector& rhs)
{
  int iRC;
  iRC = gsl_vector_sub(m_vec,rhs.m_vec);
  UQ_FATAL_RC_MACRO(iRC,
                    m_env.worldRank(),
                    "GslVector::operator-=()",
                    "failed");

  return *this;
}
Example #11
0
File: utils.c Project: hwp/notGHMM
double gaussian_pdf_log(const gaussian_t* dist,
    const gsl_vector* x) {
  double r = 0.0;
  double logdet = 0.0;

  if (gaussian_isdiagonal(dist)) {
    size_t i;
    double dx, dd;
    for (i = 0; i < dist->dim; i++) {
      dx = gsl_vector_get(x, i) - gsl_vector_get(dist->mean, i);
      dd = gsl_vector_get(dist->diag, i);
      r += dx * dx / dd;
      logdet += DEBUG_LOG(dd);
    }
  }
  else {
    int signum;
    gsl_vector* w1 = gsl_vector_alloc(dist->dim);
    gsl_vector* w2 = gsl_vector_alloc(dist->dim);
    gsl_vector_memcpy(w1, x);
    gsl_vector_sub(w1, dist->mean);

    gsl_matrix* v = gsl_matrix_alloc(dist->dim, dist->dim);
    gsl_matrix_memcpy(v, dist->cov);
    gsl_permutation* p = gsl_permutation_alloc(dist->dim);

    gsl_linalg_LU_decomp(v, p, &signum);
    gsl_linalg_LU_solve(v, p, w1, w2);
    gsl_blas_ddot(w1, w2, &r);
    logdet = gsl_linalg_LU_lndet(v);
    assert(gsl_linalg_LU_sgndet(v, signum) == 1.0);

    gsl_vector_free(w1);
    gsl_vector_free(w2);
    gsl_matrix_free(v);
    gsl_permutation_free(p);
  }

  /* Use log to avoid underflow !
     here
     r = (x - mean)^T * cov^-1 * (x - mean)
     logdet = log(det(cov))
     then
     logpdf = -.5 * (k * log(2*pi) + logdet + r);
   */
  r = r + dist->dim * DEBUG_LOG(2 * M_PI) + logdet;
  r = -0.5 * r;

  assert(!isnan(r));

  return r;
}
Example #12
0
double ldmvnorm(const int n, const gsl_vector *x, const gsl_vector *mean, const gsl_matrix *var){
    /* log-multivariate normal density function    */
    /*
     *	n	dimension of the random vetor
     *	mean	vector of means of size n
     *	var	variance matrix of dimension n x n
     */
    int s;
    double ax,ay;
    gsl_vector *ym, *xm;
    gsl_matrix *work = gsl_matrix_alloc(n,n), 
	                  *winv = gsl_matrix_alloc(n,n);
#ifdef PRINTSTIFF
    /* Print Stiffness indicator S=max(eigen)/min(eigen)*/
    gsl_vector *eval = gsl_vector_alloc (n);
    gsl_matrix *evec = gsl_matrix_alloc (n, n);
    gsl_matrix_memcpy(work,var);
    gsl_eigen_symmv_workspace * w = gsl_eigen_symmv_alloc(n);
    gsl_eigen_symmv (work, eval, evec, w);
    gsl_eigen_symmv_free (w);
    gsl_eigen_symmv_sort (eval, evec, 
	    GSL_EIGEN_SORT_ABS_ASC);
    printf("%f ",
	    gsl_vector_get(eval,n-1) / gsl_vector_get(eval,0));
    gsl_vector_free(eval);
    gsl_matrix_free(evec);
#endif

    gsl_permutation *p = gsl_permutation_alloc(n);
    gsl_matrix_memcpy( work, var );
    gsl_linalg_LU_decomp( work, p, &s );
    gsl_linalg_LU_invert( work, p, winv );
    ax = gsl_linalg_LU_det( work, s );
    gsl_matrix_free( work );
    gsl_permutation_free( p );

    xm = gsl_vector_alloc(n);
    gsl_vector_memcpy( xm, x);
    gsl_vector_sub( xm, mean );
    ym = gsl_vector_alloc(n);
    gsl_blas_dsymv(CblasUpper,1.0,winv,xm,0.0,ym);
    gsl_matrix_free( winv );
    gsl_blas_ddot( xm, ym, &ay);
    gsl_vector_free(xm);
    gsl_vector_free(ym);
    /* 
     * ay = exp(-0.5*ay)/sqrt( pow((2*M_PI),n)*ax );
     */
    ay = -0.5*( ay + n*log(2*M_PI) + log(ax) );
    return ay;
}
Example #13
0
int resudial_itegral_k(const gsl_vector *in, void * p, gsl_vector *out){
    struct mu_data_fit * mu = (struct mu_data_fit *)p;
    struct fit_params fp = {in->data[0], in->data[1], in->data[2], \
                            in->data[3], in->data[4], in->data[5]} ;
    gsl_vector_set_zero(out);
    compute_itegral(mu->k, &fp, out);
    /*
    for (int i =0; i< in->size; i++){
        printf("%10.5f", gsl_vector_get (out, i)) ;
    }
    printf("\n") ;*/
    gsl_vector_set (out, 0, 0.0) ;
    gsl_vector_sub(out, mu->mu);
    return GSL_SUCCESS;}
Example #14
0
bool move_unit_towards(unit *subj, gsl_vector *dest, PLAYERS *players) {
  // set the z coordinate because it gets set incorrectly when
  // placing the unit in the beginning 
  gsl_vector_set(subj->position, 2, height_at(x(subj->position), y(subj->position)));

  gsl_vector *go_to = gsl_vector_alloc(3);
  gsl_vector_memcpy(go_to, dest);
  gsl_vector_sub(go_to, subj->position);

  // check if we're already there
  bool there = abs(lround(x(go_to))) < subj->attributes.speed && abs(lround(y(go_to))) < subj->attributes.speed;
  if(there) {
    gsl_vector_free(go_to);
    return true;
  }

  double norm = gsl_blas_dnrm2(go_to);
  gsl_vector_scale(go_to, 1 / norm);

  //delta_height_scale(go_to, subj->position);
  gsl_vector_add(subj->velocity, go_to);

  //bool unit_at = check_for_unit_near(go_to, players, subj, false, false) != NULL;
  //if(!unit_at) {
    // XXX find a way around?
  //gsl_vector_memcpy(subj->position, go_to);
  //}

  // re-check if we're there yet
  gsl_vector_memcpy(go_to, dest);
  gsl_vector_sub(go_to, subj->position);
  there = abs(lround(x(go_to))) < subj->attributes.speed && abs(lround(y(go_to))) < subj->attributes.speed;

  gsl_vector_free(go_to);

  return there;
}
Example #15
0
gsl_vector* gaussian_product_center(const double a, const gsl_vector *A, 
                            const double b, const gsl_vector *B, int flags)
{
// Gaussian函数乘积定理计算双中心
// 关于此部分不甚明白
    int i;
    double gamma = a + b;
    //double x1, x2, tmp;

    gsl_vector *center = gsl_vector_alloc(3);
    
    for (i = 0; i < 3; i++)
        center->data[i] = (a * A->data[i] + b * B->data[i]) / gamma;

    // FOR DEBUG
    if (flags == 1) {
        gsl_vector * test = gsl_vector_alloc(3);
        gsl_vector * test2 = gsl_vector_alloc(3);
        gsl_vector_set(test, 0, 0);
        gsl_vector_set(test, 1, 0);
        gsl_vector_set(test, 2, 2.175);
        gsl_vector_memcpy(test2, test);
        gsl_vector_sub(test, B);
        gsl_vector_sub(test2, A);
        if (gsl_vector_max(test) < 1.0E-10 || gsl_vector_max(test2) < 1.0E-10) {
        //printf("----------------------------------------\n");
        vector_output(A, 3, "用于计算中心的第一个坐标:");
        vector_output(B, 3, "用于计算中心的第二个坐标:");
        printf("alpha1 =%10.6lf\talpha2 =%10.6lf\n", a, b);
        vector_output(center, 3, "中心为:");
        }
        gsl_vector_free(test);
        gsl_vector_free(test2);
    }

    return center;
}
Example #16
0
static inline double mean_distance(const mtrx* in, int n){
  double out = 0.0;
  vect* wrk = gsl_vector_alloc(n);
  for(int i = 0; i< in->size1; i++){
    gsl_vector_view v1 = gsl_vector_view_array(in->data+i*in->tda,n);
    for(int j = i; j < in->size1; j++){
      gsl_vector_view v2 = gsl_vector_view_array(in->data+j*in->tda,n);
      gsl_vector_memcpy(wrk, &v2.vector);
      gsl_vector_sub(wrk, &v1.vector);
      out += gsl_blas_dnrm2(wrk);
    }
  }
  gsl_vector_free(wrk);
  return out/(in->size1*in->size1-1);
}
Example #17
0
double gauss_K(double a, const gsl_vector *A, double b, const gsl_vector *B)
{
// 归一化系数 《量子化学》中册 P58 (10.4.1b)
// A, B 为坐标

    double result, norm_2;
    gsl_vector* v = gsl_vector_alloc(3);

    gsl_vector_memcpy(v, A);
    gsl_vector_sub(v, B);
    norm_2 = gsl_pow_2(gsl_blas_dnrm2(v));

    result = exp(-a * b * norm_2 / (a + b));
    return result;
}
Example #18
0
static CVECTOR *_sub(CVECTOR *a, CVECTOR *b, bool invert)
{
	CVECTOR *v = VECTOR_make(a);
	
	if (COMPLEX(v) || COMPLEX(b))
	{
		VECTOR_ensure_complex(v);
		VECTOR_ensure_complex(b);
		gsl_vector_complex_sub(CVEC(v), CVEC(b));
	}
	else
		gsl_vector_sub(VEC(v), VEC(b));
	
	return v;
}
Example #19
0
double uniformPdf(gsl_vector *alpha,gsl_vector *beta,const double *x){
	double r=1.0;
	int i;
	for(i=0;i<alpha->size;i++){
		if(x[i] > gsl_vector_get(alpha,i)) return 0;
		if(x[i] < gsl_vector_get(beta,i)) return 0;
	}
	gsl_vector *rages=gsl_vector_clone(alpha);
	gsl_vector_sub(rages,beta);
	for(i=0;i<rages->size;i++){
		r*=gsl_vector_get(rages,i);
	}
	
	return 1.0/r;
}
Example #20
0
/** Rotates point b around point a using the rotation matrix R. */
void rotate(bool transpose, const gsl_matrix *R, const gsl_vector *a, gsl_vector *b)
{
        declare_stack_allocated_vector(v, 3);
        gsl_vector_memcpy(v, b);
        gsl_vector_sub(v, a);

        /* Rotate end vector. */
        declare_stack_allocated_vector(w, 3);
        gsl_blas_dgemv(transpose == false ? CblasNoTrans : CblasTrans, 1.0, R, v, 0.0, w);

        /* Update position. */
        gsl_vector_memcpy(b, a);
        gsl_vector_add(b, w);

        assert(gsl_fcmp(gsl_blas_dnrm2(v), gsl_blas_dnrm2(w), 1e-15) == 0);
}
Example #21
0
double gsl_vector_minkowski_dist(const gsl_vector* v1,
                                 const gsl_vector* v2, const double p)
{
  gsl_vector* diff = gsl_vector_alloc(v1->size);
  gsl_vector_memcpy(diff, v1);
  gsl_vector_sub(diff, v2);

  double retval = 0.;
  for (size_t i = 0; i < diff->size; ++i)
  {
    retval += pow(abs(gsl_vector_get(diff, i)), p);
  }
  retval = pow(retval, 1./p);

  gsl_vector_free(diff);
  return retval;
}
Example #22
0
void GbA::compute_likelihood(double *data, int nstats, int nbands, int nsim,
						double mean[2], double cov[2][2]){
	int i, j, k, l, idx;
	gsl_vector *lsq = gsl_vector_alloc (_td->get_noftraces());
	gsl_vector *input = gsl_vector_alloc (nbands);
	gsl_vector *trace = gsl_vector_alloc (nbands);
	double *mags, *dists;
	double misfit_l2;
	size_t *indices = new size_t[nsim];
	mags = new double[nsim];
	dists = new double[nsim];

	for (i=0; i<nstats; i++){
		for (j=0; j<nbands; j++){
			gsl_vector_set(input, j, std::log10(data[i*nbands+j]));
		}
		for (k=0; k<_td->get_noftraces(); k++){
			gsl_matrix_get_row(trace, _td->_tdata_gsl, k);
			gsl_vector_sub(trace,input);
			misfit_l2 = gsl_blas_dnrm2(trace);
			gsl_vector_set(lsq, k, misfit_l2*misfit_l2);
		}
		gsl_sort_vector_smallest_index(indices, nsim,lsq);
		mean[0] = 0;
		mean[1] = 0;
		for(l=0; l<nsim; l++){
			dists[l] = std::log10(gsl_vector_get(_td->_r_gsl, indices[l]));
			mags[l] = gsl_vector_get(_td->_m_gsl, indices[l]);
			//std::cout << gsl_vector_get(_td->_m_gsl,indices[l]) << std::endl;
		}
		mean[0] = gsl_stats_mean(dists,1,nsim);
		mean[1] = gsl_stats_mean(mags,1,nsim);
		cov[0][0] = gsl_stats_variance(dists, 1, nsim);
		cov[1][1] = gsl_stats_variance(mags, 1, nsim);
		cov[0][1] = gsl_stats_covariance_m(dists,1,mags,1,nsim,mean[0],mean[1]);
		cov[1][0] = cov[0][1];
		std::cout << "Distance: " << mean[0] << "; Magnitude: " << mean[1] << std::endl;
		std::cout << "Covariance matrix:" << std::endl;
		for(i=0; i<2; i++){
			for(j=0;j<2;j++){
				printf("%d, %d, %g\n",i,j,cov[i][j]);
			}
		}
	}
}
Example #23
0
double execute_chi2_t(chi2_t *chichi)
{
  //-- Let Delta X = X_model - X_obs,
  //-- L = 1 / sqrt[(2 pi)^d * det(Cov)] * exp[-0.5 *(Delta X)^T * Cov^-1 * (Delta X)]
  //-- -2 ln L = -2 * [ -0.5 * ln (2 pi)^d - 0.5 * ln det(Cov) - 0.5 * (Delta X)^T * Cov^-1 * (Delta X) ]
  //--         = cst + ln det(Cov) + (Delta X)^T * Cov^-1 * (Delta X)
  //-- We set chi2 = ln det(Cov) + (Delta X)^T * Cov^-1 * (Delta X)
  
  //-- data should be N*d matrix
  int N = chichi->N;
  int d = chichi->d;
  gsl_vector *X_model = chichi->X_model;
  double value;
  
  gsl_vector_sub(X_model, chichi->X_obs); //-- X_model -= X_obs
  gsl_blas_dsymv(CblasUpper, 1.0, chichi->invCov, X_model, 0.0, chichi->intermediate); //-- intermediate = invCov * (X_model - X_obs)
  gsl_blas_ddot(X_model, chichi->intermediate, &value);
  value += gsl_linalg_LU_lndet(chichi->cov);
  return value;
}
Example #24
0
void gatherErrors(gsl_vector *x_bar, gsl_vector *x, gsl_vector **x_error,
    double *max_error)
{
    double elem;
    size_t i;
    
    *x_error = gsl_vector_alloc(x_bar->size);
    gsl_vector_memcpy(*x_error, x);
    gsl_vector_sub(*x_error, x_bar);

    *max_error = fabs(gsl_vector_get(*x_error, 0));
    
    for (i = 1; i < (*x_error)->size; ++i) {
        elem = fabs(gsl_vector_get(*x_error, i));

        if (*max_error < elem) {
            *max_error = elem;
        }
    }
}
Example #25
0
/** Give me a data set and a model, and I'll give you the jackknifed covariance matrix of the model parameters.

The basic algorithm for the jackknife (glossing over the details): create a sequence of data
sets, each with exactly one observation removed, and then produce a new set of parameter estimates 
using that slightly shortened data set. Then, find the covariance matrix of the derived parameters.

\li Jackknife or bootstrap? As a broad rule of thumb, the jackknife works best on models
    that are closer to linear. The worse a linear approximation does (at the given data),
    the worse the jackknife approximates the variance.

\param in	    The data set. An \ref apop_data set where each row is a single data point.
\param model    An \ref apop_model, that will be used internally by \ref apop_estimate.
            
\exception out->error=='n'   \c NULL input data.
\return         An \c apop_data set whose matrix element is the estimated covariance matrix of the parameters.
\see apop_bootstrap_cov

For example:
\include jack.c
*/
apop_data * apop_jackknife_cov(apop_data *in, apop_model *model){
    Apop_stopif(!in, apop_return_data_error(n), 0, "The data input can't be NULL.");
    Get_vmsizes(in); //msize1, msize2, vsize
    apop_model *e = apop_model_copy(model);
    int i, n = GSL_MAX(msize1, GSL_MAX(vsize, in->textsize[0]));
    apop_model *overall_est = e->parameters ? e : apop_estimate(in, e);//if not estimated, do so
    gsl_vector *overall_params = apop_data_pack(overall_est->parameters);
    gsl_vector_scale(overall_params, n); //do it just once.
    gsl_vector *pseudoval = gsl_vector_alloc(overall_params->size);

    //Copy the original, minus the first row.
    apop_data *subset = apop_data_copy(Apop_rs(in, 1, n-1));
    apop_name *tmpnames = in->names; 
    in->names = NULL;  //save on some copying below.

    apop_data *array_of_boots = apop_data_alloc(n, overall_params->size);

    for(i = -1; i< n-1; i++){
        //Get a view of row i, and copy it to position i-1 in the short matrix.
        if (i >= 0) apop_data_memcpy(Apop_r(subset, i), Apop_r(in, i));
        apop_model *est = apop_estimate(subset, e);
        gsl_vector *estp = apop_data_pack(est->parameters);
        gsl_vector_memcpy(pseudoval, overall_params);// *n above.
        gsl_vector_scale(estp, n-1);
        gsl_vector_sub(pseudoval, estp);
        gsl_matrix_set_row(array_of_boots->matrix, i+1, pseudoval);
        apop_model_free(est);
        gsl_vector_free(estp);
    }
    in->names = tmpnames;
    apop_data *out = apop_data_covariance(array_of_boots);
    gsl_matrix_scale(out->matrix, 1./(n-1.));
    apop_data_free(subset);
    gsl_vector_free(pseudoval);
    apop_data_free(array_of_boots);
    if (e!=overall_est)
        apop_model_free(overall_est);
    apop_model_free(e);
    gsl_vector_free(overall_params);
    return out;
}
Example #26
0
double ran_mv_t_pdf(const gsl_vector *x, const gsl_vector *mu,
		    const gsl_matrix *Sigma, const double nu)
{
  const int k = x->size;
  int s;
  double det,temp, den;

  gsl_vector *y = gsl_vector_alloc(k);
  gsl_vector *work_k = gsl_vector_alloc(k);

  gsl_matrix *work_k_k = gsl_matrix_alloc(k, k);
  gsl_matrix *Sigmainv = gsl_matrix_alloc(k, k);
  gsl_permutation *p = gsl_permutation_alloc(k);

  gsl_vector_memcpy(y, x);
  gsl_vector_sub(y, mu);

  gsl_matrix_memcpy(work_k_k, Sigma);
  gsl_linalg_LU_decomp(work_k_k, p, &s);
  gsl_linalg_LU_invert(work_k_k, p, Sigmainv);
  det = gsl_linalg_LU_det(work_k_k, s);

  gsl_blas_dgemv(CblasNoTrans, 1.0/k, Sigmainv, y, 0.0, work_k);
  gsl_blas_ddot(y, work_k, &temp);
  temp = pow((1+temp), (nu+ (double) k)/2 );
  temp *= gsl_sf_gamma(nu/2) * pow(nu, k/2) * pow(M_PI, k/2) * sqrt(det);

  den = gsl_sf_gamma((nu+ (double) k)/2);
  den /= temp;

  gsl_vector_free(y);
  gsl_vector_free(work_k);
  gsl_matrix_free(work_k_k);
  gsl_matrix_free(Sigmainv);
  gsl_permutation_free(p);

  return den;
}
Example #27
0
void GetMVNpdf(const gsl_matrix * mat, const double * mu, const gsl_matrix * sigmaInv, const gsl_matrix * sigmaChol, const size_t nPoints, const size_t nDim, double * returnVal)
{

  double normConst = - log(2*M_PI)*nDim/2.0;
  for(size_t j = 0; j < nDim; j++)
    normConst -= log(gsl_matrix_get(sigmaChol, j, j));

  gsl_vector_const_view vecMu = gsl_vector_const_view_array(mu, nDim);

  #pragma omp parallel for
  for(size_t i = 0; i < nPoints; i++){
    gsl_vector * x1 = gsl_vector_alloc(nDim);  // Note: allocating and freeing these every loop is not ideal, but needed for threadsafe. There might be a better way.
    gsl_vector * x2 = gsl_vector_alloc(nDim);
    gsl_matrix_get_row(x1, mat, i);
    gsl_vector_sub(x1, &vecMu.vector);
    gsl_blas_dsymv(CblasUpper, 1.0, sigmaInv, x1, 0.0, x2);
    gsl_blas_ddot(x1, x2, &returnVal[i]);
    returnVal[i] = exp(normConst - 0.5*returnVal[i]);
    gsl_vector_free(x1);
    gsl_vector_free(x2);
  }

  return;
}
/* build orthonormal basis matrix
Q = Y;
for j=1:k
    vj = Q(:,j);
    for i=1:(j-1)
        vi = Q(:,i);
        vj = vj - project_vec(vj,vi);
    end
    vj = vj/norm(vj);
    Q(:,j) = vj;
end
*/
void build_orthonormal_basis_from_mat(gsl_matrix *A, gsl_matrix *Q){
    int m,n,i,j,ind,num_ortos=2;
    double vec_norm;
    gsl_vector *vi,*vj,*p;
    m = A->size1;
    n = A->size2;
    vi = gsl_vector_calloc(m);
    vj = gsl_vector_calloc(m);
    p = gsl_vector_calloc(m);
    gsl_matrix_memcpy(Q, A);
    for(ind=0; ind<num_ortos; ind++){
        for(j=0; j<n; j++){
            gsl_matrix_get_col(vj, Q, j);
            for(i=0; i<j; i++){
                gsl_matrix_get_col(vi, Q, i);
                project_vector(vj, vi, p);
                gsl_vector_sub(vj, p);
            }
            vec_norm = gsl_blas_dnrm2(vj);
            gsl_vector_scale(vj, 1.0/vec_norm);
            gsl_matrix_set_col (Q, j, vj);
        }
    }
}
Example #29
0
void GbA::process(double *data, int nbands, float time, int cmpnt){

	assert(nbands == _nbands);
	pthread_mutex_lock(&_process_lock);
	int i, j, k, timeidx=0;
	double timemin=std::numeric_limits<double>::max();
	gsl_vector *lsq = gsl_vector_alloc (_td->get_noftraces());
	gsl_vector *input = gsl_vector_alloc (nbands);
	gsl_vector *trace = gsl_vector_alloc (nbands);
	gsl_matrix *tdata;
	double misfit_l2, terror;
	size_t *indices = new size_t[_nsim];
	TData::Component _c = static_cast<TData::Component>(cmpnt);
	_status[_c] = true;
	// Find time index
	for(i=0;i<_td->get_noftimes();i++){
		terror = gsl_vector_get(_td->get_times(),i) - time;
		if(abs(terror)< timemin){
			timeidx = i;
			timemin = abs(terror);
		}
	}

	tdata = _td->get_amps(timeidx,_c);

	for (i=0; i<nbands; i++){
			gsl_vector_set(input, i, std::log10(data[i]));
	}
	for (j=0; j<_td->get_noftraces(); j++){
		gsl_matrix_get_row(trace, tdata, j);
		gsl_vector_sub(trace,input);
		misfit_l2 = gsl_blas_dnrm2(trace);
		gsl_vector_set(lsq, j, misfit_l2*misfit_l2);
	}

	gsl_sort_vector_smallest_index(indices, _nsim,lsq);

	for(k=0; k<_nsim; k++){
		gsl_vector_set(&_r[_c].vector,k, std::log10(gsl_vector_get(_td->get_dist(), indices[k])));
		gsl_vector_set(&_m[_c].vector,k, gsl_vector_get(_td->get_mag(), indices[k]));
	}

	if (_status[TData::vertical] && _status[TData::horizontal]){
		_mv = gsl_vector_subvector(_mags,0,_mags->size);
		_rv = gsl_vector_subvector(_dists,0,_dists->size);
	} else if(_status[TData::vertical]){
		_mv = gsl_vector_subvector(_mags,0,_nsim);
		_rv = gsl_vector_subvector(_dists,0,_nsim);
	} else if(_status[TData::horizontal]){
		_mv = gsl_vector_subvector(_mags,_nsim,_nsim);
		_rv = gsl_vector_subvector(_dists,_nsim,_nsim);
	}

	_mn[0] = gsl_stats_mean(_rv.vector.data,1,_rv.vector.size);
	_mn[1] = gsl_stats_mean(_mv.vector.data,1,_mv.vector.size);
	_cov[0][0] = gsl_stats_variance(_rv.vector.data, 1, _rv.vector.size);
	_cov[1][1] = gsl_stats_variance(_mv.vector.data, 1, _mv.vector.size);
	_cov[0][1] = gsl_stats_covariance_m(_rv.vector.data,1,_mv.vector.data,1,
			                            _rv.vector.size,_mn[0],_mn[1]);
	_cov[1][0] = _cov[0][1];
	delete[] indices;
	pthread_mutex_unlock(&_process_lock);
}
// measurement update (correction)
bool DiscreteKalmanFilter::updateMeasurement(const size_t step, const gsl_vector *actualMeasurement, const gsl_vector *Du)  // Du(k) = Dd(k) * u(k)
{
	if (!x_hat_ || /*!y_hat_ ||*/ !P_ || !K_) return false;

	const gsl_matrix *Cd = system_.getOutputMatrix(step, x_hat_);
#if 0
	const gsl_matrix *V = system_.getMeasurementNoiseCouplingMatrix(step);
	const gsl_matrix *R = system_.getMeasurementNoiseCovarianceMatrix(step);  // R(k)
#else
	const gsl_matrix *Rd = system_.getMeasurementNoiseCovarianceMatrix(step);  // Rd(k) = V(k) * R(k) * V(k)^T
#endif
	//const gsl_vector *Du = system_.getMeasurementInput(step, x_hat_);  // Du(k) = Dd(k) * u(k)
	//const gsl_vector *actualMeasurement = system_.getMeasurement(step, x_hat_);  // actual measurement

	if (!Cd || !Rd || !Du || !actualMeasurement) return false;

	// 1. calculate Kalman gain: K(k) = P-(k) * Cd(k)^T * (Cd(k) * P-(k) * Cd(k)^T + Rd(k))^-1 where Rd(k) = V(k) * R(k) * V(k)^T
	// inverse of matrix using LU decomposition
	gsl_matrix_memcpy(RR_, Rd);
	if (GSL_SUCCESS != gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, P_, Cd, 0.0, PCt_) ||
		GSL_SUCCESS != gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Cd, PCt_, 1.0, RR_))
		return false;

	int signum;
	if (GSL_SUCCESS != gsl_linalg_LU_decomp(RR_, permutation_, &signum) ||
		GSL_SUCCESS != gsl_linalg_LU_invert(RR_, permutation_, invRR_))
		return false;

	if (GSL_SUCCESS != gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, PCt_, invRR_, 0.0, K_))  // calculate Kalman gain
		return false;

	// 2. update measurement: x(k) = x-(k) + K(k) * (y_tilde(k) - y_hat(k)) where y_hat(k) = Cd(k) * x-(k) + Dd(k) * u(k)
#if 0
	// save an estimated measurement, y_hat
	gsl_vector_memcpy(y_hat_, Du);
	if (GSL_SUCCESS != gsl_blas_dgemv(CblasNoTrans, 1.0, Cd, x_hat_, 1.0, y_hat_))  // calcuate y_hat(k)
		return false;
	gsl_vector_memcpy(residual_, y_hat_);
	if (GSL_SUCCESS != gsl_vector_sub(residual_, actualMeasurement) ||  // calculate residual = y_tilde(k) - y_hat(k)
		GSL_SUCCESS != gsl_blas_dgemv(CblasNoTrans, -1.0, K_, residual_, 1.0, x_hat_))  // calculate x_hat(k)
		return false;
#else
	gsl_vector_memcpy(residual_, Du);
	if (GSL_SUCCESS != gsl_blas_dgemv(CblasNoTrans, 1.0, Cd, x_hat_, 1.0, residual_) ||  // calcuate y_hat(k)
		GSL_SUCCESS != gsl_vector_sub(residual_, actualMeasurement) ||  // calculate residual = y_tilde(k) - y_hat(k)
		GSL_SUCCESS != gsl_blas_dgemv(CblasNoTrans, -1.0, K_, residual_, 1.0, x_hat_))  // calculate x_hat(k)
		return false;
#endif

	// 3. update covariance: P(k) = (I - K(k) * Cd(k)) * P-(k)
#if 0
	// not working
	gsl_matrix_set_identity(M_);
	if (GSL_SUCCESS != gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, K_, Cd, 1.0, M_) ||
		GSL_SUCCESS != gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, M_, P_, 0.0, P_))
		return false;
#else
	gsl_matrix_set_identity(M_);
	if (GSL_SUCCESS != gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, K_, Cd, 1.0, M_) ||
		GSL_SUCCESS != gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, M_, P_, 0.0, M2_))
		return false;
	gsl_matrix_memcpy(P_, M2_);
#endif

	// preserve symmetry of P
	gsl_matrix_transpose_memcpy(M_, P_);
	gsl_matrix_add(P_, M_);
	gsl_matrix_scale(P_, 0.5);

	return true;
}