void matrix_fscan(FILE* stream, gsl_matrix* m) {
size_t i, j;
for (i = 0; i < m->size1; i++) {
for (j = 0; j < m->size2 - 1; j++) {
fscanf(stream, "%lg ", gsl_matrix_ptr(m, i, j));
}
fscanf(stream, "%lg\n", gsl_matrix_ptr(m, i, j));
}
}
int
gsl_linalg_cholesky_scale_apply(gsl_matrix * A, const gsl_vector * S)
{
const size_t M = A->size1;
const size_t N = A->size2;
if (M != N)
{
GSL_ERROR("A is not a square matrix", GSL_ENOTSQR);
}
else if (N != S->size)
{
GSL_ERROR("S must have length N", GSL_EBADLEN);
}
else
{
size_t i, j;
/* compute: A <- diag(S) A diag(S) using lower triangle */
for (j = 0; j < N; ++j)
{
double sj = gsl_vector_get(S, j);
for (i = j; i < N; ++i)
{
double si = gsl_vector_get(S, i);
double *Aij = gsl_matrix_ptr(A, i, j);
*Aij *= si * sj;
}
}
return GSL_SUCCESS;
}
}
/* Applies the updates stored in 'db_e' to all membership functions inside 'net'
* 'new_err' must be the total learning error, ie: sum all over db_e values
*
* PRE: net != NULL
* db_e != NULL
* new_err >= 0.0
*
* POS: network parameters successfully updated
*/
static void
anfis_do_mf_up (anfis_t net, gsl_matrix *db_e, double new_err)
{
int i = 0, l = 0;
double etha = 0.0,
*db_e_ij = NULL;
assert (net != NULL);
assert (db_e != NULL);
assert (new_err >= 0.0);
etha = net->etha / ((new_err !=0) ? new_err : 2.0);
#pragma omp parallel for default(shared) private(i,l,db_e_ij)
for (i=0 ; i < net->t * net->n ; i++) {
/* Error gradients for the parameters of M[i/n][i%n] */
db_e_ij = gsl_matrix_ptr (db_e, i, 0);
for (l=0 ; l < MAX_PARAM ; l++) {
net-> b[i/net->n]. MF[i%net->n]. p[l] -= etha * db_e_ij[l];
}
}
return;
}
const double &CNumMat::operator()(unsigned row, unsigned col) const
{
assert(m_mat!=NULL);
assert(row<NumRows());
assert(col<NumCols());
return(*gsl_matrix_ptr(m_mat,row, col));
}
static gsl_matrix *
covariance_calculate_single_pass_unnormalized (struct covariance *cov)
{
size_t i, j;
for (i = 0 ; i < cov->dim; ++i)
{
for (j = 0 ; j < cov->dim; ++j)
{
double *x = gsl_matrix_ptr (cov->moments[MOMENT_VARIANCE], i, j);
*x -= pow2 (gsl_matrix_get (cov->moments[MOMENT_MEAN], i, j))
/ gsl_matrix_get (cov->moments[MOMENT_NONE], i, j);
}
}
for ( j = 0 ; j < cov->dim - 1; ++j)
{
for (i = j + 1 ; i < cov->dim; ++i)
{
double *x = &cov->cm [cm_idx (cov, i, j)];
*x -=
gsl_matrix_get (cov->moments[MOMENT_MEAN], i, j)
*
gsl_matrix_get (cov->moments[MOMENT_MEAN], j, i)
/ gsl_matrix_get (cov->moments[MOMENT_NONE], i, j);
}
}
return cm_to_gsl (cov);
}
int AnovaTest::anovaresi(gsl_matrix *bY, const unsigned int i)
{
unsigned int hid=i, aid = i-1;
// count the right-hand tails
calcSS(bY, &(Hats[aid]), mmRef);
calcSS(bY, &(Hats[hid]), mmRef);
testStatCalc(&(Hats[hid]), &(Hats[aid]), mmRef, TRUE, &(bMultStat), bStatj);
// count data related to P-values
if (bMultStat >= multstat[aid]) Pmultstat[aid]++;
// get result ptr corresponds to model i
double *sj = gsl_matrix_ptr (statj, aid, 0);
double *pj = gsl_matrix_ptr (Pstatj, aid, 0);
double *bj = gsl_vector_ptr (bStatj, 0);
calcAdjustP(mmRef->punit, nVars, bj, sj, pj, sortid[aid]);
return 0;
}
void step_function_internal (gsl_matrix *p, float var, gsl_rng* number_generator)
/* var stands for width of distribution
* var must be supplied so as to reflect the temperature.
*/
{
int i,j;
for (i = 0; i < p->size1; i++)
for (j = 0; j < p->size2; j++)
*gsl_matrix_ptr(p,i,j) += var * 2 * (gsl_rng_uniform(number_generator) - 0.5);
gsl_rng_uniform(number_generator);
}
int AnovaTest::anovacase(gsl_matrix *bY, gsl_matrix *bX)
{
unsigned int j;
// if Y col is all zeros
for ( j=0; j<nVars; j++ ){
gsl_vector_view colj = gsl_matrix_column(bY, j);
if ( gsl_vector_isnull(&colj.vector) == TRUE ) return GSL_ERANGE;
}
unsigned int i, hid, aid;
double *sj, *pj, *bj;
gsl_matrix *Z = gsl_matrix_alloc(nRows, nVars);
gsl_matrix_memcpy(Z, bY);
// Hats.X
for (i=0; i<nModels-1; i++){
hid = i+1; aid = i;
gsl_vector_view ref1 = gsl_matrix_row(inRef, aid);
subX(bX, &ref1.vector, Hats[aid].X);
gsl_vector_view ref0 = gsl_matrix_row(inRef, hid);
subX(bX, &ref0.vector, Hats[hid].X);
//Y = X*coef
gsl_blas_dgemm(CblasNoTrans,CblasNoTrans,-1.0,Hats[aid].X,Hats[aid].Coef,0.0,Z);
//Z = bY - Yhat;
gsl_matrix_add (Z, bY);
// calc teststats
calcSS(Z, &(Hats[hid]), mmRef);
calcSS(Z, &(Hats[aid]), mmRef);
testStatCalc(&(Hats[hid]), &(Hats[aid]), mmRef, TRUE, &(bMultStat), bStatj);
if (bMultStat >= multstat[i]) Pmultstat[i]++;
sj = gsl_matrix_ptr (statj, i, 0);
pj = gsl_matrix_ptr (Pstatj, i, 0);
bj = gsl_vector_ptr (bStatj, 0);
calcAdjustP(mmRef->punit, nVars, bj, sj, pj, sortid[i]);
}
gsl_matrix_free(Z);
return 0;
}
void egsl_add_to_col(val v1, size_t j, val v2) {
/* egsl_print("m1",v1);
egsl_print("m2",v2); */
gsl_matrix * m1 = egsl_gslm(v1);
gsl_matrix * m2 = egsl_gslm(v2);
/* printf("m1 size = %d,%d j = %d\n",m1->size1,m1->size2,j); */
egsl_expect_size(v2, m1->size1, 1);
size_t i;
for(i=0;i<m1->size1;i++) {
*gsl_matrix_ptr(m1, i, j) += gsl_matrix_get(m2,i,0);
}
}
/* pseudo graphical display of sample chunk statistical properties,
only useful with one MPI worker as it prints to terminal.
*/
void print_chunk_graph(gsl_matrix *X,/*sub-sample of CHUNK rows*/ gsl_vector *lP)/*log-Posterior values, unnormalized*/{
int width=100; // we assume that the display can show $width characters
int i,j,k,n,nc;
int tmp;
double *x;
gsl_vector_view x_view;
double Q[5];
int q[5];
double max,min,range;
char s[32],c[32];
n=X->size2;
max=gsl_matrix_max(X);
min=gsl_matrix_min(X);
range=max-min;
printf("range: [%g,%g] (%g)\n",min,max,range);
for (i=0;i<X->size1;i++){
//sort each row:
x_view=gsl_matrix_row(X,i);
gsl_sort_vector(&(x_view.vector));
//determine eachquantile
x=gsl_matrix_ptr(X,i,0);
Q[0]=gsl_stats_quantile_from_sorted_data(x,1,n,0.01);
Q[1]=gsl_stats_quantile_from_sorted_data(x,1,n,0.25);
Q[2]=gsl_stats_quantile_from_sorted_data(x,1,n,0.50);
Q[3]=gsl_stats_quantile_from_sorted_data(x,1,n,0.75);
Q[4]=gsl_stats_quantile_from_sorted_data(x,1,n,0.99);
//printf("quantiles: %g\t%g\t%g\t%g\t%g\n",Q[0],Q[1],Q[2],Q[3],Q[4]);
for (j=0;j<5;j++) {
q[j]=(int) ((Q[j]-min)*width/range);
}
sprintf(s," -LU- ");
sprintf(c,"+{|}+ ");
tmp=0;
for (k=0;k<5;k++){
nc=q[k]-tmp;
for (j=0;j<nc;j++) {
printf("%c",s[k]);
}
tmp=q[k];
printf("%c",c[k]);
}
printf("\n\n");
}
printf("|");
for (j=0;j<width-2;j++) printf("-");
printf("|\n");
printf("%+4.4g",min);
for (j=0;j<width-8;j++) printf(" ");
printf("%+4.4g\n",max);
}
/* Call this function for every case in the data set.
After all cases have been passed, call covariance_calculate
*/
void
covariance_accumulate (struct covariance *cov, const struct ccase *c)
{
size_t i, j, m;
const double weight = cov->wv ? case_data (c, cov->wv)->f : 1.0;
assert (cov->passes == 1);
if ( !cov->pass_one_first_case_seen)
{
assert ( cov->state == 0);
cov->state = 1;
}
for (i = 0 ; i < cov->dim; ++i)
{
const union value *val1 = case_data (c, cov->vars[i]);
if ( is_missing (cov, i, c))
continue;
for (j = 0 ; j < cov->dim; ++j)
{
double pwr = 1.0;
int idx;
const union value *val2 = case_data (c, cov->vars[j]);
if ( is_missing (cov, j, c))
continue;
idx = cm_idx (cov, i, j);
if (idx >= 0)
{
cov->cm [idx] += val1->f * val2->f * weight;
}
for (m = 0 ; m < n_MOMENTS; ++m)
{
double *x = gsl_matrix_ptr (cov->moments[m], i, j);
*x += pwr * weight;
pwr *= val1->f;
}
}
}
cov->pass_one_first_case_seen = true;
}
int
lls_regularize2(const gsl_vector *diag, lls_workspace *w)
{
int s = 0;
size_t n = w->ATA->size1;
size_t i;
for (i = 0; i < n; ++i)
{
double di = gsl_vector_get(diag, i);
double *Aii = gsl_matrix_ptr(w->ATA, i, i);
*Aii += di;
}
return s;
} /* lls_regularize2() */
static int
cod_RZ(gsl_matrix * A, gsl_vector * tau)
{
const size_t M = A->size1;
const size_t N = A->size2;
if (tau->size != M)
{
GSL_ERROR("tau has wrong size", GSL_EBADLEN);
}
else if (N < M)
{
GSL_ERROR("N must be >= M", GSL_EINVAL);
}
else if (M == N)
{
/* quick return */
gsl_vector_set_all(tau, 0.0);
return GSL_SUCCESS;
}
else
{
size_t k;
for (k = M; k > 0 && k--; )
{
double *alpha = gsl_matrix_ptr(A, k, k);
gsl_vector_view z = gsl_matrix_subrow(A, k, M, N - M);
double tauk;
/* compute Householder reflection to zero [ A(k,k) A(k,M+1:N) ] */
tauk = cod_householder_transform(alpha, &z.vector);
gsl_vector_set(tau, k, tauk);
if ((tauk != 0) && (k > 0))
{
gsl_vector_view w = gsl_vector_subvector(tau, 0, k);
gsl_matrix_view B = gsl_matrix_submatrix(A, 0, k, k, N - k);
cod_householder_mh(tauk, &z.vector, &B.matrix, &w.vector);
}
}
return GSL_SUCCESS;
}
}
/** Assign submatrix */
void matrix<double>::assign(const size_t& i, const size_t& j, const matrix<double>& a)
{
size_t ki,kj;
double *x;
if(i+a.size_i() <= size_i() && j+a.size_j() <= size_j())
for(ki=i;ki<i+a.size_i();ki++)
for(kj=j;kj<j+a.size_j();kj++)
{
x = gsl_matrix_ptr(_matrix, ki, kj);
*x = a(ki-i,kj-j);
}
else
{
std::cout << "\n ** Wrong size assign in matrix<double> assign submatrix" << std::endl;
exit(EXIT_FAILURE);
}
}
static gsl_matrix *
covariance_calculate_single_pass (struct covariance *cov)
{
size_t i, j;
size_t m;
for (m = 0; m < n_MOMENTS; ++m)
{
/* Divide the moments by the number of samples */
if ( m > 0)
{
for (i = 0 ; i < cov->dim; ++i)
{
for (j = 0 ; j < cov->dim; ++j)
{
double *x = gsl_matrix_ptr (cov->moments[m], i, j);
*x /= gsl_matrix_get (cov->moments[0], i, j);
if ( m == MOMENT_VARIANCE)
*x -= pow2 (gsl_matrix_get (cov->moments[1], i, j));
}
}
}
}
/* Centre the moments */
for ( j = 0 ; j < cov->dim - 1; ++j)
{
for (i = j + 1 ; i < cov->dim; ++i)
{
double *x = &cov->cm [cm_idx (cov, i, j)];
*x /= gsl_matrix_get (cov->moments[0], i, j);
*x -=
gsl_matrix_get (cov->moments[MOMENT_MEAN], i, j)
*
gsl_matrix_get (cov->moments[MOMENT_MEAN], j, i);
}
}
return cm_to_gsl (cov);
}
/* Call this function for every case in the data set */
void
covariance_accumulate_pass1 (struct covariance *cov, const struct ccase *c)
{
size_t i, j, m;
const double weight = cov->wv ? case_data (c, cov->wv)->f : 1.0;
assert (cov->passes == 2);
if (!cov->pass_one_first_case_seen)
{
assert (cov->state == 0);
cov->state = 1;
}
if (cov->categoricals)
categoricals_update (cov->categoricals, c);
for (i = 0 ; i < cov->dim; ++i)
{
double v1 = get_val (cov, i, c);
if ( is_missing (cov, i, c))
continue;
for (j = 0 ; j < cov->dim; ++j)
{
double pwr = 1.0;
if ( is_missing (cov, j, c))
continue;
for (m = 0 ; m <= MOMENT_MEAN; ++m)
{
double *x = gsl_matrix_ptr (cov->moments[m], i, j);
*x += pwr * weight;
pwr *= v1;
}
}
}
cov->pass_one_first_case_seen = true;
}
void cholUpdate(gsl_matrix* R, gsl_vector* x)
{
int n = R->size1;
int i = 0;
double c; double s;
for (i=0;i<n;i++) {
double* a = gsl_matrix_ptr(R,i,i);
double* b = gsl_vector_ptr(x, i);
My_drotg(a,b,&c,&s);
if ((*a)<0.0) {
*a = - (*a);
c = - c;
s = - s;
}
if (i<n-1) {
gsl_vector_view Ri = gsl_matrix_column(R, i);
gsl_vector_view Rii = gsl_vector_subvector(&Ri.vector, i+1, n-i-1);
gsl_vector_view xi = gsl_vector_subvector(x, i+1, n-i-1);
My_drot(&Rii.vector,&xi.vector,c,s);
}
}
}
static gsl_matrix *
covariance_calculate_double_pass (struct covariance *cov)
{
size_t i, j;
for (i = 0 ; i < cov->dim; ++i)
{
for (j = 0 ; j < cov->dim; ++j)
{
int idx;
double *x = gsl_matrix_ptr (cov->moments[MOMENT_VARIANCE], i, j);
*x /= gsl_matrix_get (cov->moments[MOMENT_NONE], i, j);
idx = cm_idx (cov, i, j);
if ( idx >= 0)
{
x = &cov->cm [idx];
*x /= gsl_matrix_get (cov->moments[MOMENT_NONE], i, j);
}
}
}
return cm_to_gsl (cov);
}
void
update_row_details(gsl_matrix *m, const typename pop_t::gamete_t &g,
const pop_t *pop,
const std::vector<KTfwd::uint_t> &mut_keys,
const size_t row)
{
for (auto &&k : g.smutations)
{
if (pop->mcounts[k] < 2 * pop->N) // skip fixations!!!
{
if (!pop->mcounts[k])
throw std::runtime_error(
"extinct mutation encountered: "
+ std::string(__FILE__) + ", "
+ std::to_string(__LINE__));
auto i = std::find(mut_keys.begin(),
mut_keys.end(), k);
if (i == mut_keys.end())
throw std::runtime_error(
"mutation key not found: "
+ std::string(__FILE__) + ", "
+ std::to_string(__LINE__) + ", "
+ "mcount = "
+ std::to_string(pop->mcounts[k]));
std::size_t col
= std::distance(mut_keys.begin(), i);
if (col + 1 >= m->size2)
throw std::runtime_error(
"second dimension out of range: "
+ std::string(__FILE__) + ", "
+ std::to_string(__LINE__));
auto mp = gsl_matrix_ptr(m, row, col + 1);
*mp += 1.0; // update counts
}
}
}
/* solve system with given lambda and L = diag(L) and test against
* normal equations solution */
static void
test_reg3(const double lambda, const gsl_vector * L, const gsl_matrix * X,
const gsl_vector * y, const gsl_vector * wts, const double tol,
gsl_multifit_linear_workspace * w, const char * desc)
{
const size_t n = X->size1;
const size_t p = X->size2;
double rnorm0, snorm0;
double rnorm1, snorm1;
gsl_vector *c0 = gsl_vector_alloc(p);
gsl_vector *c1 = gsl_vector_alloc(p);
gsl_matrix *XTX = gsl_matrix_alloc(p, p); /* X^T W X + lambda^2 L^T L */
gsl_vector *XTy = gsl_vector_alloc(p); /* X^T W y */
gsl_matrix *Xs = gsl_matrix_alloc(n, p); /* standard form X~ */
gsl_vector *ys = gsl_vector_alloc(n); /* standard form y~ */
gsl_vector *Lc = gsl_vector_alloc(p);
gsl_vector *r = gsl_vector_alloc(n);
gsl_permutation *perm = gsl_permutation_alloc(p);
int signum;
size_t j;
/* compute Xs = sqrt(W) X, ys = sqrt(W) y */
gsl_multifit_linear_wstdform1(NULL, X, wts, y, Xs, ys, w);
/* construct XTy = X^T W y */
gsl_blas_dgemv(CblasTrans, 1.0, Xs, ys, 0.0, XTy);
/* construct XTX = X^T W X + lambda^2 L^T L */
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, Xs, Xs, 0.0, XTX);
for (j = 0; j < p; ++j)
{
double lj = gsl_vector_get(L, j);
*gsl_matrix_ptr(XTX, j, j) += pow(lambda * lj, 2.0);
}
/* solve XTX c = XTy with LU decomp */
gsl_linalg_LU_decomp(XTX, perm, &signum);
gsl_linalg_LU_solve(XTX, perm, XTy, c0);
/* solve with reg routine */
gsl_multifit_linear_wstdform1(L, X, wts, y, Xs, ys, w);
gsl_multifit_linear_svd(Xs, w);
gsl_multifit_linear_solve(lambda, Xs, ys, c1, &rnorm0, &snorm0, w);
gsl_multifit_linear_genform1(L, c1, c1, w);
/* test snorm = ||L c1|| */
gsl_vector_memcpy(Lc, c1);
gsl_vector_mul(Lc, L);
snorm1 = gsl_blas_dnrm2(Lc);
gsl_test_rel(snorm0, snorm1, tol, "test_reg3: %s, snorm lambda=%g n=%zu p=%zu",
desc, lambda, n, p);
/* test rnorm = ||y - X c1||, compute again Xs = sqrt(W) X and ys = sqrt(W) y */
gsl_multifit_linear_wstdform1(NULL, X, wts, y, Xs, ys, w);
gsl_vector_memcpy(r, ys);
gsl_blas_dgemv(CblasNoTrans, -1.0, Xs, c1, 1.0, r);
rnorm1 = gsl_blas_dnrm2(r);
gsl_test_rel(rnorm0, rnorm1, tol, "test_reg3: %s, rnorm lambda=%g n=%zu p=%zu",
desc, lambda, n, p);
/* test c0 = c1 */
for (j = 0; j < p; ++j)
{
double c0j = gsl_vector_get(c0, j);
double c1j = gsl_vector_get(c1, j);
gsl_test_rel(c1j, c0j, tol, "test_reg3: %s, c0/c1 j=%zu lambda=%g n=%zu p=%zu",
desc, j, lambda, n, p);
}
gsl_matrix_free(Xs);
gsl_matrix_free(XTX);
gsl_vector_free(XTy);
gsl_vector_free(c0);
gsl_vector_free(c1);
gsl_vector_free(Lc);
gsl_vector_free(ys);
gsl_vector_free(r);
gsl_permutation_free(perm);
}
static int
triangular_inverse(CBLAS_UPLO_t Uplo, CBLAS_DIAG_t Diag, gsl_matrix * T)
{
const size_t N = T->size1;
if (N != T->size2)
{
GSL_ERROR ("matrix must be square", GSL_ENOTSQR);
}
else
{
gsl_matrix_view m;
gsl_vector_view v;
size_t i;
if (Uplo == CblasUpper)
{
for (i = 0; i < N; ++i)
{
double aii;
if (Diag == CblasNonUnit)
{
double *Tii = gsl_matrix_ptr(T, i, i);
*Tii = 1.0 / *Tii;
aii = -(*Tii);
}
else
{
aii = -1.0;
}
if (i > 0)
{
m = gsl_matrix_submatrix(T, 0, 0, i, i);
v = gsl_matrix_subcolumn(T, i, 0, i);
gsl_blas_dtrmv(CblasUpper, CblasNoTrans, Diag,
&m.matrix, &v.vector);
gsl_blas_dscal(aii, &v.vector);
}
} /* for (i = 0; i < N; ++i) */
}
else
{
for (i = 0; i < N; ++i)
{
double ajj;
size_t j = N - i - 1;
if (Diag == CblasNonUnit)
{
double *Tjj = gsl_matrix_ptr(T, j, j);
*Tjj = 1.0 / *Tjj;
ajj = -(*Tjj);
}
else
{
ajj = -1.0;
}
if (j < N - 1)
{
m = gsl_matrix_submatrix(T, j + 1, j + 1,
N - j - 1, N - j - 1);
v = gsl_matrix_subcolumn(T, j, j + 1, N - j - 1);
gsl_blas_dtrmv(CblasLower, CblasNoTrans, Diag,
&m.matrix, &v.vector);
gsl_blas_dscal(ajj, &v.vector);
}
} /* for (i = 0; i < N; ++i) */
}
return GSL_SUCCESS;
}
}
void bootstrap(double x[], double y[], double* result, int* b, int* B, int *n, int* d) {
static gsl_rng *restrict r = NULL;
if(r == NULL) { // First call to this function, setup RNG
gsl_rng_env_setup();
r = gsl_rng_alloc(gsl_rng_mt19937);
gsl_rng_set(r, time(NULL));
}
//a stores the sampled indices
int a[ *n ];
//allocate memory for the regression step
gsl_matrix * pred = gsl_matrix_alloc ( *n, *d );
gsl_vector * resp = gsl_vector_alloc( *n );
gsl_multifit_linear_workspace * work = gsl_multifit_linear_alloc ( *n, *d );
gsl_vector* coef = gsl_vector_alloc ( *d );
gsl_matrix* cov = gsl_matrix_alloc ( *d, *d );
gsl_matrix * T_boot = gsl_matrix_alloc ( *B, *d );
double chisq;
//create bootstrap samples
for ( int i = 0; i < *B; i++ ) {
//sample the indices
samp_k_from_n( n, b, a, r);
printf("dfdfdfd");
//transfer x to a matrix pred and y to a vector resp
for ( int i = 0; i < *n; i++ ) {
gsl_vector_set (resp, i, y[ a[i] ]);
for (int j = 0; j < *d; j++)
gsl_matrix_set (pred, i, j, x[ j + ( a[ i ] * (*d) ) ]);
}
//linera regression
gsl_multifit_linear ( pred, resp, coef, cov, &chisq, work );
//pass the elements of coef to the ith row of T_boot
gsl_matrix_set_row ( T_boot, i, coef );
}
//compute the standard deviation of each coefficient accros the bootstrap repetitions
for ( int j = 0; j < *d; j++){
result[ j ] = sqrt( gsl_stats_variance( gsl_matrix_ptr ( T_boot, 0, j ), 1, *B ) );
}
//free the memory
gsl_matrix_free (pred);
gsl_vector_free(resp);
gsl_multifit_linear_free ( work);
gsl_vector_free (coef);
//gsl_vector_free (w);
gsl_matrix_free (cov);
printf("\nI AM DONE\n\n");
}
double& matrix::operator()(size_t x, size_t y) {
if (!ptr_) throw std::runtime_error("empty gsl::matrix");
return *gsl_matrix_ptr(ptr_, x, y);
}
/** Set element (i,j) */
double& matrix<double>::operator()(const size_t& i, const size_t& j)
{
double *x = gsl_matrix_ptr(_matrix, i, j);
return *x;
}
int GlmTest::summary(glm *fit)
{
double lambda;
unsigned int k;
unsigned int nRows=tm->nRows, nVars=tm->nVars, nParam=tm->nParam;
unsigned int mtype = fit->mmRef->model-1;
PoissonGlm pNull(fit->mmRef), pAlt(fit->mmRef);
BinGlm binNull(fit->mmRef), binAlt(fit->mmRef);
NBinGlm nbNull(fit->mmRef), nbAlt(fit->mmRef);
glm *PtrNull[3] = { &pNull, &nbNull, &binNull };
glm *PtrAlt[3] = { &pAlt, &nbAlt, &binAlt };
gsl_vector_view teststat, unitstat;
gsl_matrix_view L1;
// To estimate initial Beta from PtrNull->Beta
// gsl_vector *ref=gsl_vector_alloc(nParam);
// gsl_matrix *BetaO=gsl_matrix_alloc(nParam, nVars);
smryStat = gsl_matrix_alloc((nParam+1), nVars+1);
Psmry = gsl_matrix_alloc((nParam+1), nVars+1);
gsl_matrix_set_zero (Psmry);
// initialize the design matrix for all hypo tests
GrpMat *GrpXs = (GrpMat *)malloc((nParam+2)*sizeof(GrpMat));
GrpXs[0].matrix = gsl_matrix_alloc(nRows, nParam);
gsl_matrix_memcpy(GrpXs[0].matrix, fit->Xref); // the alt X
GrpXs[1].matrix = gsl_matrix_alloc(nRows, 1); // overall test
gsl_matrix_set_all (GrpXs[1].matrix, 1.0);
for (k=2; k<nParam+2; k++) { // significance tests
GrpXs[k].matrix = gsl_matrix_alloc(nRows, nParam-1);
subX2(fit->Xref, k-2, GrpXs[k].matrix);
}
// Calc test statistics
if ( tm->test == WALD ) {
// the overall test compares to mean
teststat = gsl_matrix_row(smryStat, 0);
L1=gsl_matrix_submatrix(L,1,0,nParam-1,nParam);
lambda=gsl_vector_get(tm->smry_lambda, 0);
GetR(fit->Res, tm->corr, lambda, Rlambda);
GeeWald(fit, &L1.matrix, &teststat.vector);
// the significance test
for (k=2; k<nParam+2; k++) {
teststat = gsl_matrix_row(smryStat, k-1);
L1 = gsl_matrix_submatrix(L, k-2, 0, 1, nParam);
GeeWald(fit, &L1.matrix, &teststat.vector);
}
}
else if (tm->test==SCORE) {
for (k=1; k<nParam+2; k++) {
teststat=gsl_matrix_row(smryStat, k-1);
PtrNull[mtype]->regression(fit->Yref,GrpXs[k].matrix,fit->Oref,NULL);
lambda=gsl_vector_get(tm->smry_lambda, k);
GetR(PtrNull[mtype]->Res, tm->corr, lambda, Rlambda);
GeeScore(GrpXs[0].matrix, PtrNull[mtype], &teststat.vector);
}
}
else {
for (k=1; k<nParam+2; k++) {
teststat=gsl_matrix_row(smryStat, k-1);
PtrNull[mtype]->regression(fit->Yref,GrpXs[k].matrix,fit->Oref,NULL);
GeeLR(fit, PtrNull[mtype], &teststat.vector); // works better
}
}
// sort id if the unitvaraite test is free step-down
gsl_permutation **sortid;
sortid=(gsl_permutation **)malloc((nParam+1)*sizeof(gsl_permutation *));
for ( k=0; k<(nParam+1); k++ ) {
teststat = gsl_matrix_row (smryStat, k);
unitstat = gsl_vector_subvector(&teststat.vector, 1, nVars);
sortid[k] = gsl_permutation_alloc(nVars);
gsl_sort_vector_index (sortid[k], &unitstat.vector);
gsl_permutation_reverse(sortid[k]); // rearrange in descending order
}
if (tm->resamp==MONTECARLO) {
lambda=gsl_vector_get(tm->smry_lambda,0);
GetR(fit->Res, tm->corr, lambda, Sigma);
setMonteCarlo(fit, XBeta, Sigma);
}
nSamp=0;
double *suj, *buj, *puj;
gsl_matrix *bStat = gsl_matrix_alloc((nParam+1), nVars+1);
gsl_matrix_set_zero (bStat);
gsl_matrix *bY = gsl_matrix_alloc(nRows, nVars);
gsl_matrix *bO = gsl_matrix_alloc(nRows, nVars);
gsl_matrix_memcpy (bO, fit->Eta);
double diff, timelast=0;
clock_t clk_start=clock();
for ( unsigned int i=0; i<tm->nboot; i++) {
if ( tm->resamp==CASEBOOT )
resampSmryCase(fit,bY,GrpXs,bO,i);
else resampNonCase(fit, bY, i);
if ( tm->test == WALD ) {
PtrAlt[mtype]->regression(bY,GrpXs[0].matrix,bO,NULL);
// the overall test compares to mean
teststat = gsl_matrix_row(bStat, 0);
L1=gsl_matrix_submatrix(L,1,0,nParam-1,nParam);
lambda=gsl_vector_get(tm->smry_lambda, 0);
GetR(PtrAlt[mtype]->Res, tm->corr, lambda, Rlambda);
GeeWald(PtrAlt[mtype], &L1.matrix, &teststat.vector);
// the significance test
for (k=2; k<nParam+2; k++) {
teststat = gsl_matrix_row(bStat, k-1);
L1 = gsl_matrix_submatrix(L, k-2, 0, 1, nParam);
GeeWald(PtrAlt[mtype], &L1.matrix, &teststat.vector);
}
}
else if (tm->test==SCORE) {
for (k=1; k<nParam+2; k++) {
teststat=gsl_matrix_row(bStat, k-1);
PtrNull[mtype]->regression(bY,GrpXs[k].matrix,bO,NULL);
lambda=gsl_vector_get(tm->smry_lambda,k);
GetR(PtrNull[mtype]->Res, tm->corr, lambda, Rlambda);
GeeScore(GrpXs[0].matrix, PtrNull[mtype], &teststat.vector);
}
}
else { // use single bAlt estimate works better
PtrAlt[mtype]->regression(bY,GrpXs[0].matrix,bO,NULL);
for (k=1; k<nParam+2; k++) {
teststat=gsl_matrix_row(bStat, k-1);
PtrNull[mtype]->regression(bY,GrpXs[k].matrix,bO,NULL);
GeeLR(PtrAlt[mtype], PtrNull[mtype], &teststat.vector);
}
}
for (k=0; k<(nParam+1); k++) {
buj = gsl_matrix_ptr (bStat, k, 0);
suj = gsl_matrix_ptr (smryStat, k, 0);
puj = gsl_matrix_ptr (Psmry, k, 0);
if ( *buj >= *suj ) *puj=*puj+1;
calcAdjustP(tm->punit, nVars, buj+1, suj+1, puj+1, sortid[k]);
} // end for j loop
nSamp++;
// Prompts
if ((tm->showtime==TRUE)&(i%100==0)) {
diff=(float)(clock()-clk_start)/(float)CLOCKS_PER_SEC;
timelast+=(double)diff/60;
printf("\tResampling run %d finished. Time elapsed: %.2f min ...\n", i, timelast);
clk_start=clock();
}
} // end for i loop
// ========= Get P-values ========= //
if ( tm->punit == FREESTEP ) {
for (k=0; k<(nParam+1); k++) {
puj = gsl_matrix_ptr (Psmry, k, 1);
reinforceP( puj, nVars, sortid[k] );
} }
// p = (#exceeding observed stat + 1)/(#nboot+1)
gsl_matrix_add_constant (Psmry, 1.0);
gsl_matrix_scale (Psmry, (double)1.0/(nSamp+1));
for (k=0; k<nVars; k++) aic[k]=-fit->ll[k]+2*(nParam+1);
// === release memory ==== //
PtrAlt[mtype]->releaseGlm();
if ( tm->test!=WALD )
PtrNull[mtype]->releaseGlm();
gsl_matrix_free(bStat);
gsl_matrix_free(bY);
gsl_matrix_free(bO);
for (k=0; k<nParam+1; k++)
if (sortid[k]!=NULL) gsl_permutation_free(sortid[k]);
free(sortid);
if ( GrpXs != NULL ) {
for ( unsigned int k=0; k<nParam+2; k++ )
if ( GrpXs[k].matrix != NULL )
gsl_matrix_free (GrpXs[k].matrix);
free(GrpXs);
}
return SUCCESS;
}
/**
main simulation loop
*/
int main() {
// init own parameters.
initDerivedParams();
// init random generator
gsl_rng_env_setup();
r = gsl_rng_alloc(gsl_rng_default);
gsl_rng_set(r, SEED_MAIN);
// file handle for xxx file
FILE *postF = fopen(FILENAME_POST, FILEPOST_FLAG);
// file handle for xxx file
FILE *preF = fopen(FILENAME_PRE, "wb");
// set up vectors:
// to hold post synaptic potentials [unused??]
gsl_vector *psp = gsl_vector_alloc(NPRE);
// to hold post synaptic potentials 1st filtered
gsl_vector *pspS = gsl_vector_alloc(NPRE);
// to hold "excitatory" part of psp for Euler integration
gsl_vector *sue = gsl_vector_alloc(NPRE);
// to hold "inhibitory" part of psp for Euler integration
gsl_vector *sui = gsl_vector_alloc(NPRE);
// to hold psp 2nd filter
gsl_vector *pspTilde = gsl_vector_alloc(NPRE);
// to hold weights
gsl_vector *w = gsl_vector_alloc(NPRE);
// to hold xxx
gsl_vector *pres = gsl_vector_alloc(NPRE);
// ?? ou XXX \todo
#ifdef PREDICT_OU
gsl_vector *ou = gsl_vector_alloc(N_OU);
gsl_vector *preU = gsl_vector_calloc(NPRE);
gsl_vector *wInput = gsl_vector_alloc(N_OU);
gsl_matrix *wPre = gsl_matrix_calloc(NPRE, N_OU);
double *preUP = gsl_vector_ptr(preU,0);
double *ouP = gsl_vector_ptr(ou,0);
double *wInputP = gsl_vector_ptr(wInput,0);
double *wPreP = gsl_matrix_ptr(wPre,0,0);
#endif
// get pointers to array within the gsl_vector data structures above.
double *pspP = gsl_vector_ptr(psp,0);
double *pspSP = gsl_vector_ptr(pspS,0);
double *sueP = gsl_vector_ptr(sue,0);
double *suiP = gsl_vector_ptr(sui,0);
double *pspTildeP = gsl_vector_ptr(pspTilde,0);
double *wP = gsl_vector_ptr(w,0);
double *presP = gsl_vector_ptr(pres,0);
for(int i=0; i<NPRE; i++) {
// init pspP etc to zero
*(pspP+i) = 0;
*(sueP+i) = 0;
*(suiP+i) = 0;
#ifdef RANDI_WEIGHTS
// Gaussian weights
*(wP+i) = gsl_ran_gaussian(r, .1);
#else
*(wP+i) = 0;
#endif
}
//! OU \todo what for?
#ifdef PREDICT_OU
for(int j=0; j < N_OU; j++) {
*(ouP + j) = gsl_ran_gaussian(r, 1) + M_OU;
*(wInputP + j) = gsl_ran_lognormal(r, 0., 2.)/N_OU/exp(2.)/2.;
for(int i=0; i < NPRE; i++) *(wPreP + j*NPRE + i) = gsl_ran_lognormal(r, 0., 2.)/N_OU/exp(2.)/2.;
}
#endif
// temp variables for the simulation yyyy
double
u = 0, // soma potential.
uV = 0, // some potential from dendrite only (ie discounted
// dendrite potential
rU = 0, // instantneou rate
rV = 0, // rate on dendritic potential only
uI = 0, // soma potential only from somatic inputs
rI = 0, // rate on somatic potential only
uInput = 0; // for OU?
// run simulatio TRAININGCYCLES number of times
for( int s = 0; s < TRAININGCYCLES; s++) {
// for all TIMEBINS
for( int t = 0; t < TIMEBINS; t++) {
#ifdef PREDICT_OU
for(int i = 0; i < N_OU; i++) {
*(ouP+i) = runOU(*(ouP+i), M_OU, GAMMA_OU, S_OU);
}
gsl_blas_dgemv(CblasNoTrans, 1., wPre, ou, 0., preU);
#endif
// update PSP of our neurons for inputs from all presynaptic neurons
for( int i = 0; i < NPRE; i++) {
#ifdef RAMPUPRATE
/** just read in the PRE_ACT and generate a spike and store it in presP -- so PRE_ACT has inpretation of potential */
updatePre(sueP+i, suiP+i, pspP + i, pspSP + i, pspTildeP + i, *(presP + i) = spiking(PRE_ACT[t*NPRE + i], gsl_rng_uniform(r)));
#elif defined PREDICT_OU
//*(ouP+i) = runOU(*(ouP+i), M_OU, GAMMA_OU, S_OU); // why commented out?
updatePre(sueP+i, suiP+i, pspP + i, pspSP + i, pspTildeP + i, *(presP + i) = DT * phi(*(preUP+i)));//spiking(DT * phi(*(preUP+i)), gsl_rng_uniform(r))); // why commented out?
#else
// PRE_ACT intepreated as spikes
updatePre(sueP+i, suiP+i, pspP + i, pspSP + i, pspTildeP + i, *(presP + i) = PRE_ACT[t*NPRE + i]);
#endif
} // endfor NPRE
#ifdef PREDICT_OU
gsl_blas_ddot(wInput, ou, &uInput);
GE[t] = DT * phi(uInput);
#endif
// now update the membrane potential.
updateMembrane(&u, &uV, &uI, w, psp, GE[t], GI[t]);
// now calculate rates from from potentials.
#ifdef POSTSPIKING // usually switch off as learning is faster when
// learning from U
// with low-pass filtering of soma potential from actual
// generation of spikes (back propgating dentric spikes?
rU = GAMMA_POSTS*rU + (1-GAMMA_POSTS)*spiking(DT * phi(u), gsl_rng_uniform(r))/DT;
#else
// simpler -- direct.
rU = phi(u);
#endif
rV = phi(uV); rI = phi(uI);
// now update weights based on rU, RV, the 2nd filtered PSP and
// the pspSP
for(int i = 0; i < NPRE; i++) {
updateWeight(wP + i, rU, *(pspTildeP+i), rV, *(pspSP+i));
}
#ifdef TAUEFF
/**
write rU to postF, but only for the last run of the
simulation and then only before the STIM_ONSET time --
ie it is the trained output without somatic drive.
*/
if(s == TRAININGCYCLES - 1 && t < STIM_ONSET/DT) {
fwrite(&rU, sizeof(double), 1, postF);
}
#else
/**
for every 10th training cycle write all variables below to
postF in order:
*/
if(s%(TRAININGCYCLES/10)==0) {
fwrite(&rU, sizeof(double), 1, postF);
fwrite(GE+t, sizeof(double), 1, postF);
fwrite(&rV, sizeof(double), 1, postF);
fwrite(&rI, sizeof(double), 1, postF);
fwrite(&u, sizeof(double), 1, postF);
}
if(s == TRAININGCYCLES - 1) {
#ifdef RECORD_PREACT
// for the last cycle also record the activity of the
// presynaptic neurons
fwrite(PRE_ACT + t * NPRE, sizeof(double), 20, preF);
//fwrite(ouP, sizeof(double), 20, preF);
fwrite(presP, sizeof(double), 20, preF);
#else
// and the 1st and 2nd filtered PSP
fwrite(pspSP, sizeof(double), 1, preF);
fwrite(pspTildeP, sizeof(double), 1, preF);
#endif
}
#endif
}
}
fclose(preF);
fclose(postF);
return 0;
}
int GlmTest::anova(glm *fit, gsl_matrix *isXvarIn)
{
// Assume the models have been already sorted (in R)
Xin = isXvarIn;
nModels = Xin->size1;
double *rdf = new double [nModels];
unsigned int nP, i, j, k;
unsigned int ID0, ID1, nP0, nP1;
unsigned int nRows=tm->nRows, nVars=tm->nVars, nParam=tm->nParam;
unsigned int mtype = fit->mmRef->model-1;
dfDiff = new unsigned int [nModels-1];
anovaStat = gsl_matrix_alloc((nModels-1), nVars+1);
Panova = gsl_matrix_alloc((nModels-1), nVars+1);
gsl_vector *bStat = gsl_vector_alloc(nVars+1);
gsl_matrix_set_zero (anovaStat);
gsl_matrix_set_zero (Panova);
gsl_vector_set_zero (bStat);
PoissonGlm pNull(fit->mmRef), pAlt(fit->mmRef);
BinGlm binNull(fit->mmRef), binAlt(fit->mmRef);
NBinGlm nbNull(fit->mmRef), nbAlt(fit->mmRef);
PoissonGlm pNullb(fit->mmRef), pAltb(fit->mmRef);
BinGlm binNullb(fit->mmRef), binAltb(fit->mmRef);
NBinGlm nbNullb(fit->mmRef), nbAltb(fit->mmRef);
glm *PtrNull[3] = { &pNull, &nbNull, &binNull };
glm *PtrAlt[3] = { &pAlt, &nbAlt, &binAlt };
glm *bNull[3] = { &pNullb, &nbNullb, &binNullb };
glm *bAlt[3] = { &pAltb, &nbAltb, &binAltb };
double *suj, *buj, *puj;
gsl_vector_view teststat, unitstat,ref1, ref0;
gsl_matrix *X0=NULL, *X1=NULL, *L1=NULL, *tmp1=NULL, *BetaO=NULL;
gsl_matrix *bO=NULL, *bY=gsl_matrix_alloc(nRows, nVars);
bO = gsl_matrix_alloc(nRows, nVars);
gsl_permutation *sortid=NULL;
if (tm->punit==FREESTEP) sortid = gsl_permutation_alloc(nVars);
// ======= Fit the (first) Alt model =========//
for (i=0; i<nModels; i++) {
nP = 0;
for (k=0; k<nParam; k++)
if (gsl_matrix_get(Xin,i,k)!=FALSE) nP++;
rdf[i] = nRows-nP;
}
for (i=1; i<nModels; i++) {
// ======= Fit the Null model =========//
ID0 = i; ID1 = i-1;
nP0 = nRows - (unsigned int)rdf[ID0];
nP1 = nRows - (unsigned int)rdf[ID1];
// Degrees of freedom
dfDiff[i-1] = nP1 - nP0;
ref1=gsl_matrix_row(Xin, ID1);
ref0=gsl_matrix_row(Xin, ID0);
X0 = gsl_matrix_alloc(nRows, nP0);
subX(fit->Xref, &ref0.vector, X0);
X1 = gsl_matrix_alloc(nRows, nP1);
subX(fit->Xref, &ref1.vector, X1);
// ======= Get multivariate test statistics =======//
// Estimate shrinkage parametr only once under H1
// See "FW: Doubts R package "mvabund" (12/14/11)
teststat = gsl_matrix_row(anovaStat, (i-1));
PtrNull[mtype]->regression(fit->Yref, X0, fit->Oref, NULL);
if (tm->test == SCORE) {
lambda = gsl_vector_get(tm->anova_lambda, ID0);
GetR(PtrNull[mtype]->Res, tm->corr, lambda, Rlambda);
GeeScore(X1, PtrNull[mtype], &teststat.vector);
}
else if (tm->test==WALD) {
PtrAlt[mtype]->regression(fit->Yref, X1, fit->Oref, NULL);
L1 = gsl_matrix_alloc (nP1-nP0, nP1);
tmp1 = gsl_matrix_alloc (nParam, nP1);
subX(L, &ref1.vector, tmp1);
subXrow1(tmp1, &ref0.vector, &ref1.vector, L1);
lambda = gsl_vector_get(tm->anova_lambda, ID1);
GetR(PtrAlt[mtype]->Res, tm->corr, lambda, Rlambda);
GeeWald(PtrAlt[mtype], L1, &teststat.vector);
}
else {
BetaO = gsl_matrix_alloc(nP1, nVars);
addXrow2(PtrNull[mtype]->Beta, &ref1.vector, BetaO);
PtrAlt[mtype]->regression(fit->Yref, X1, fit->Oref, BetaO);
GeeLR(PtrAlt[mtype], PtrNull[mtype], &teststat.vector);
}
if (tm->resamp==MONTECARLO) {
lambda=gsl_vector_get(tm->anova_lambda,ID0);
GetR(fit->Res, tm->corr, lambda, Sigma);
setMonteCarlo (PtrNull[mtype], XBeta, Sigma);
}
// ======= Get univariate test statistics =======//
if (tm->punit == FREESTEP) {
unitstat=gsl_vector_subvector(&teststat.vector,1,nVars);
gsl_sort_vector_index (sortid, &unitstat.vector);
gsl_permutation_reverse(sortid);
}
// ======= Get resampling distribution under H0 ===== //
nSamp=0;
double dif, timelast=0;
clock_t clk_start=clock();
if (tm->showtime==TRUE)
printf("Resampling begins for test %d.\n", i);
for (j=0; j<tm->nboot; j++) {
// printf("simu %d :", j);
gsl_vector_set_zero (bStat);
if ( tm->resamp == CASEBOOT ) {
resampAnovaCase(PtrAlt[mtype],bY,X1,bO,j);
subX(X1, &ref0.vector, X0);
}
else {
resampNonCase(PtrNull[mtype], bY, j);
gsl_matrix_memcpy(bO, fit->Oref);
}
if ( tm->test == WALD ) {
bAlt[mtype]->regression(bY,X1,bO,NULL);
lambda = gsl_vector_get(tm->anova_lambda, ID1);
GetR(bAlt[mtype]->Res, tm->corr, lambda, Rlambda);
GeeWald(bAlt[mtype], L1, bStat);
}
else if ( tm->test == SCORE ) {
bNull[mtype]->regression(bY,X0,bO,NULL);
lambda = gsl_vector_get(tm->anova_lambda, ID0);
GetR(bNull[mtype]->Res, tm->corr, lambda, Rlambda);
GeeScore(X1, bNull[mtype], bStat);
}
else {
bNull[mtype]->regression(bY,X0,bO,NULL);
addXrow2(bNull[mtype]->Beta, &ref1.vector, BetaO);
bAlt[mtype]->regression(bY,X1,bO,BetaO);
GeeLR(bAlt[mtype], bNull[mtype], bStat);
}
// ----- get multivariate counts ------- //
buj = gsl_vector_ptr (bStat,0);
suj = gsl_matrix_ptr (anovaStat, i-1, 0);
puj = gsl_matrix_ptr (Panova, i-1, 0);
if ( *(buj) > (*(suj)-1e-8) ) *puj=*puj+1;
// ------ get univariate counts ---------//
calcAdjustP(tm->punit,nVars,buj+1,suj+1,puj+1,sortid);
nSamp++;
// Prompts
if ((tm->showtime==TRUE)&(j%100==0)) {
dif = (float)(clock() - clk_start)/(float)CLOCKS_PER_SEC;
timelast+=(double)dif/60;
printf("\tResampling run %d finished. Time elapsed: %.2f minutes...\n", j, timelast);
clk_start=clock();
}
} // end j for loop
// ========= get p-values ======== //
if ( tm->punit == FREESTEP) {
puj = gsl_matrix_ptr (Panova, i-1, 1);
reinforceP(puj, nVars, sortid);
}
if (BetaO!=NULL) gsl_matrix_free(BetaO);
if (X0!=NULL) gsl_matrix_free(X0);
if (X1!=NULL) gsl_matrix_free(X1);
if (tm->test == WALD) {
if (L1!=NULL) gsl_matrix_free(L1);
if (tmp1!=NULL) gsl_matrix_free(tmp1);
}
} // end i for loop and test for loop
// p = (#exceeding observed stat + 1)/(#nboot+1)
gsl_matrix_add_constant (Panova, 1.0);
gsl_matrix_scale (Panova, (double)1/(nSamp+1.0));
bAlt[mtype]->releaseGlm();
PtrAlt[mtype]->releaseGlm();
if ( tm->test!=WALD ) {
bNull[mtype]->releaseGlm();
PtrNull[mtype]->releaseGlm();
}
delete []rdf;
if (sortid != NULL )
gsl_permutation_free(sortid);
gsl_vector_free(bStat);
gsl_matrix_free(bY);
if (bO!=NULL) gsl_matrix_free(bO);
return SUCCESS;
}
void calibrator::calculateWeights(vector <ofPoint> eyePoints, vector <ofPoint> screenPoints){
int length = eyePoints.size();
int nTerms = 6;
gsl_matrix * x = gsl_matrix_alloc(length,nTerms);
gsl_vector * yx = gsl_vector_alloc(length);
gsl_vector * yy = gsl_vector_alloc(length);
gsl_vector * w = gsl_vector_alloc(nTerms);
double * ptr;
double * ptrScreenX;
double * ptrScreenY;
ptr = gsl_matrix_ptr(x,0,0);
ptrScreenX = gsl_vector_ptr(yx,0);
ptrScreenY = gsl_vector_ptr(yy,0);
for (int i = 0; i < length; i++){
float xPosEye = eyePoints[i].x;
float yPosEye = eyePoints[i].y;
// Ax + Bx^2 + Cy + Dy^2 + Exy + Fx^3 + Gy^3 + H
*ptr++ = xPosEye;
*ptr++ = xPosEye*xPosEye;
*ptr++ = yPosEye;
*ptr++ = yPosEye*yPosEye;
*ptr++ = xPosEye*yPosEye;
//*ptr++ = xPosEye*xPosEye*xPosEye;
//*ptr++ = yPosEye*yPosEye*yPosEye;
*ptr++ = 1;
*ptrScreenX++ = screenPoints[i].x;
*ptrScreenY++ = screenPoints[i].y;
}
gsl_vector *cx = gsl_vector_calloc(nTerms);
gsl_vector *cy = gsl_vector_calloc(nTerms);
gsl_matrix *cov = gsl_matrix_calloc(nTerms, nTerms);
double chisq;
gsl_multifit_linear_workspace *work = gsl_multifit_linear_alloc(length, nTerms);
int res = gsl_multifit_linear (x,
yx,
cx,
cov,
&chisq,
work);
int res2 = gsl_multifit_linear (x,
yy,
cy,
cov,
&chisq,
work);
printf("-------------------------------------------- \n");
double * xptr = gsl_vector_ptr(cx,0);
double * yptr = gsl_vector_ptr(cy,0);
for (int i = 0; i < nTerms; i++){
printf("cx %i = %f \n", i, xptr[i]);
cxfit[i] = xptr[i];
}
for (int i = 0; i < nTerms; i++){
printf("cy %i = %f \n", i, yptr[i]);
cyfit[i] = yptr[i];
}
bBeenFit = true;
printf("-------------------------------------------- \n");
//return ;
}
SaLSA::SaLSA(const Everything& e, const FluidSolverParams& fsp)
: PCM(e, fsp), siteShape(fsp.solvents[0]->molecule.sites.size())
{
logPrintf(" Initializing non-local response weight functions:\n");
const double dG = gInfo.dGradial, Gmax = gInfo.GmaxGrid;
unsigned nGradial = unsigned(ceil(Gmax/dG))+5;
//Initialize fluid molecule's spherically-averaged electron density kernel:
const auto& solvent = fsp.solvents[0];
std::vector<double> nFluidSamples(nGradial);
for(unsigned i=0; i<nGradial; i++)
{ double G = i*dG;
nFluidSamples[i] = 0.;
for(const auto& site: solvent->molecule.sites)
{ double nTilde = site->elecKernel(G);
for(const vector3<>& r: site->positions)
nFluidSamples[i] += nTilde * bessel_jl(0, G*r.length());
}
}
nFluid.init(0, nFluidSamples, dG);
//Determine dipole correlation factors:
double chiRot = 0., chiPol = 0.;
for(const auto& c: fsp.components)
{ chiRot += c->Nbulk * c->molecule.getDipole().length_squared()/(3.*fsp.T);
chiPol += c->Nbulk * c->molecule.getAlphaTot();
}
double sqrtCrot = (epsBulk>epsInf && chiRot) ? sqrt((epsBulk-epsInf)/(4.*M_PI*chiRot)) : 1.;
double epsInfEff = chiRot ? epsInf : epsBulk; //constrain to epsBulk for molecules with no rotational susceptibility
double sqrtCpol = (epsInfEff>1. && chiPol) ? sqrt((epsInfEff-1.)/(4.*M_PI*chiPol)) : 1.;
//Rotational and translational response (includes ionic response):
const double bessel_jl_by_Gl_zero[4] = {1., 1./3, 1./15, 1./105}; //G->0 limit of j_l(G)/G^l
for(const auto& c: fsp.components)
for(int l=0; l<=fsp.lMax; l++)
{ //Calculate radial densities for all m:
gsl_matrix* V = gsl_matrix_calloc(nGradial, 2*l+1); //allocate and set to zero
double prefac = sqrt(4.*M_PI*c->Nbulk/fsp.T);
for(unsigned iG=0; iG<nGradial; iG++)
{ double G = iG*dG;
for(const auto& site: c->molecule.sites)
{ double Vsite = prefac * site->chargeKernel(G);
for(const vector3<>& r: site->positions)
{ double rLength = r.length();
double bessel_jl_by_Gl = G ? bessel_jl(l,G*rLength)/pow(G,l) : bessel_jl_by_Gl_zero[l]*pow(rLength,l);
vector3<> rHat = (rLength ? 1./rLength : 0.) * r;
for(int m=-l; m<=+l; m++)
*gsl_matrix_ptr(V,iG,l+m) += Vsite * bessel_jl_by_Gl * Ylm(l,m, rHat);
}
}
}
//Scale dipole active modes:
for(int lm=0; lm<2l+1; lm++)
if(l==1 && fabs(gsl_matrix_get(V,0,lm))>1e-6)
for(unsigned iG=0; iG<nGradial; iG++)
*gsl_matrix_ptr(V,iG,lm) *= sqrtCrot;
//Get linearly-independent non-zero modes by performing an SVD:
gsl_vector* S = gsl_vector_alloc(2*l+1);
gsl_matrix* U = gsl_matrix_alloc(2*l+1, 2*l+1);
gsl_matrix* tmpMat = gsl_matrix_alloc(2*l+1, 2*l+1);
gsl_vector* tmpVec = gsl_vector_alloc(2*l+1);
gsl_linalg_SV_decomp_mod(V, tmpMat, U, S, tmpVec);
gsl_vector_free(tmpVec);
gsl_matrix_free(tmpMat);
gsl_matrix_free(U);
//Add response functions for non-singular modes:
for(int mode=0; mode<2*l+1; mode++)
{ double Smode = gsl_vector_get(S, mode);
if(Smode*Smode < 1e-3) break;
std::vector<double> Vsamples(nGradial);
for(unsigned iG=0; iG<nGradial; iG++)
Vsamples[iG] = Smode * gsl_matrix_get(V, iG, mode);
response.push_back(std::make_shared<MultipoleResponse>(l, -1, 1, Vsamples, dG));
}
gsl_vector_free(S);
gsl_matrix_free(V);
}
//Polarizability response:
for(unsigned iSite=0; iSite<solvent->molecule.sites.size(); iSite++)
{ const Molecule::Site& site = *(solvent->molecule.sites[iSite]);
if(site.polKernel)
{ std::vector<double> Vsamples(nGradial);
double prefac = sqrtCpol * sqrt(solvent->Nbulk * site.alpha);
for(unsigned iG=0; iG<nGradial; iG++)
Vsamples[iG] = prefac * site.polKernel(iG*dG);
response.push_back(std::make_shared<MultipoleResponse>(1, iSite, site.positions.size(), Vsamples, dG));
}
}
const double GzeroTol = 1e-12;
//Compute bulk properties and print summary:
double epsBulk = 1.; double k2factor = 0.; std::map<int,int> lCount;
for(const std::shared_ptr<MultipoleResponse>& resp: response)
{ lCount[resp->l]++;
double respGzero = (4*M_PI) * pow(resp->V(0), 2) * resp->siteMultiplicity;
if(resp->l==0) k2factor += respGzero;
if(resp->l==1) epsBulk += respGzero;
}
for(auto lInfo: lCount)
logPrintf(" l: %d #weight-functions: %d\n", lInfo.first, lInfo.second);
logPrintf(" Bulk dielectric-constant: %lg", epsBulk);
if(k2factor > GzeroTol) logPrintf(" screening-length: %lg bohrs.\n", sqrt(epsBulk/k2factor));
else logPrintf("\n");
if(fsp.lMax >= 1) myassert(fabs(epsBulk-this->epsBulk) < 1e-3); //verify consistency of correlation factors
myassert(fabs(k2factor-this->k2factor) < 1e-3); //verify consistency of site charges
//Initialize preconditioner kernel:
std::vector<double> KkernelSamples(nGradial);
for(unsigned i=0; i<nGradial; i++)
{ double G = i*dG, G2=G*G;
//Compute diagonal part of the hessian ( 4pi(Vc^-1 + chi) ):
double diagH = G2;
for(const auto& resp: response)
diagH += pow(G2,resp->l) * pow(resp->V(G), 2);
//Set its inverse square-root as the preconditioner:
KkernelSamples[i] = (diagH>GzeroTol) ? 1./sqrt(diagH) : 0.;
}
Kkernel.init(0, KkernelSamples, dG);
//MPI division:
TaskDivision(response.size(), mpiUtil).myRange(rStart, rStop);
}
void calibrationManager::calculateWeights(vector <ofPoint> trackedPoints, vector <ofPoint> knownPoints){
int length = trackedPoints.size();
int nTerms = 6;
gsl_matrix * x = gsl_matrix_alloc(length,nTerms);
gsl_vector * yx = gsl_vector_alloc(length);
gsl_vector * yy = gsl_vector_alloc(length);
gsl_vector * w = gsl_vector_alloc(nTerms);
double * ptr;
double * ptrScreenX;
double * ptrScreenY;
ptr = gsl_matrix_ptr(x,0,0);
ptrScreenX = gsl_vector_ptr(yx,0);
ptrScreenY = gsl_vector_ptr(yy,0);
for (int i = 0; i < length; i++){
float xPosEye = trackedPoints[i].x;
float yPosEye = trackedPoints[i].y;
// was -- Ax + Bx^2 + Cy + Dy^2 + Exy + Fx^3 + Gy^3 + H
// now -- Ax + Bx^2 + Cy + Dy^2 + Exy + F
*ptr++ = xPosEye;
*ptr++ = xPosEye*xPosEye;
*ptr++ = yPosEye;
*ptr++ = yPosEye*yPosEye;
*ptr++ = xPosEye*yPosEye;
//*ptr++ = xPosEye*xPosEye*xPosEye; // the cubed term was too much, it seemed like.
//*ptr++ = yPosEye*yPosEye*yPosEye;
*ptr++ = 1;
*ptrScreenX++ = knownPoints[i].x;
*ptrScreenY++ = knownPoints[i].y;
}
gsl_vector *cx = gsl_vector_calloc(nTerms);
gsl_vector *cy = gsl_vector_calloc(nTerms);
gsl_matrix *cov = gsl_matrix_calloc(nTerms, nTerms);
double chisq;
gsl_multifit_linear_workspace *work = gsl_multifit_linear_alloc(length, nTerms);
int res = gsl_multifit_linear (x,
yx,
cx,
cov,
&chisq,
work);
int res2 = gsl_multifit_linear (x,
yy,
cy,
cov,
&chisq,
work);
double * xptr = gsl_vector_ptr(cx,0);
double * yptr = gsl_vector_ptr(cy,0);
printf("-------------------------------------------- \n");
for (int i = 0; i < nTerms; i++){
printf("cx %i = %f \n", i, xptr[i]);
cxfit[i] = xptr[i];
}
for (int i = 0; i < nTerms; i++){
printf("cy %i = %f \n", i, yptr[i]);
cyfit[i] = yptr[i];
}
printf("-------------------------------------------- \n");
bBeenFit = true;
//std::exit(0);
//return ;
}
