void vector_fscan(FILE* stream, gsl_vector* v) {
size_t i;
for (i = 0; i < v->size - 1; i++) {
fscanf(stream, "%lg ", gsl_vector_ptr(v, i));
}
fscanf(stream, "%lg\n", gsl_vector_ptr(v, i));
}
double* begin(GSL_vector& v)
{
if (v.size())
return gsl_vector_ptr(v.raw(), 0);
return nullptr;
}
/*
* Update the cost after swapping current medoid m with non-medoid n
* Distance to closest medoid, closest medoid index are updated.
*/
static double pam_swap_cost(pam_partition p, size_t m, size_t n)
{
double cost = 0.0;
size_t i, cl;
gsl_vector_view col;
/* Update for each column */
for (i = 0; i < p->M->size2; i++) {
cl = gsl_vector_ulong_get(p->cl_index, i);
/* If closest to medoid being removed, find new closest medoid */
if (cl == m) {
col = gsl_matrix_column(p->M, i);
gsl_vector_masked_min_index(&(col.vector), p->in_set,
&cl,
gsl_vector_ptr(p->cl_dist,
i));
gsl_vector_ulong_set(p->cl_index, i, cl);
} else {
/* Check if the new medoid is closer than the old */
assert(gsl_vector_get(p->cl_dist, i) ==
gsl_matrix_get(p->M,
gsl_vector_ulong_get(p->cl_index, i), i));
if (gsl_matrix_get(p->M, n, i) <
gsl_vector_get(p->cl_dist, i)) {
gsl_vector_set(p->cl_dist, i,
gsl_matrix_get(p->M, n, i));
gsl_vector_ulong_set(p->cl_index, i, n);
}
}
cost += gsl_vector_get(p->cl_dist, i);
}
return cost;
}
void gaussian_gen(const gsl_rng* rng, const gaussian_t* dist,
gsl_vector* result) {
assert(result->size == dist->dim);
size_t i;
for (i = 0; i < result->size; i++) {
gsl_vector_set(result, i, gsl_ran_ugaussian(rng));
}
if (gaussian_isdiagonal(dist)) {
for (i = 0; i < result->size; i++) {
double* p = gsl_vector_ptr(result, i);
*p *= DEBUG_SQRT(gsl_vector_get(dist->diag, i));
}
}
else {
gsl_matrix* v = gsl_matrix_alloc(dist->dim, dist->dim);
gsl_matrix_memcpy(v, dist->cov);
gsl_linalg_cholesky_decomp(v);
gsl_blas_dtrmv(CblasLower, CblasNoTrans, CblasNonUnit, v, result);
gsl_matrix_free(v);
}
gsl_vector_add(result, dist->mean);
}
void gsl_vector_step_random(const gsl_rng* r, gsl_vector* v,
const double step_size)
{
const size_t n = v->size;
gsl_vector* vp = gsl_vector_alloc(n);
// Set normal distributed random numbers as elements of v_new and
// compute the euclidean norm of this vector.
double length = 0.;
for (size_t i = 0; i < n; ++i)
{
double* vp_i = gsl_vector_ptr(vp, i);
*vp_i = gsl_ran_ugaussian(r);
length += pow(*vp_i, 2);
}
length = sqrt(length);
// Scale vp so that the elements of vp are uniformly distributed
// within an n-sphere of radius step_size.
const double scale = pow(pow(step_size, boost::numeric_cast<int>(n))
* gsl_rng_uniform_pos(r), 1.0/n) / length;
gsl_vector_scale(vp, scale);
gsl_vector_add(v, vp);
}
//Use this function to produce test data below.
apop_data *draw_exponentiated_normal(double mu, double sigma, double draws){
apop_model *n01 = apop_model_set_parameters(apop_normal, mu, sigma);
apop_data *d = apop_data_alloc(draws);
gsl_rng *r = apop_rng_alloc(13);
for (int i=0; i< draws; i++) apop_draw(gsl_vector_ptr(d->vector,i), r, n01);
apop_vector_exp(d->vector);
return d;
}
int
gsl_multifit_linear_applyW(const gsl_matrix * X,
const gsl_vector * w,
const gsl_vector * y,
gsl_matrix * WX,
gsl_vector * Wy)
{
const size_t n = X->size1;
const size_t p = X->size2;
if (n != y->size)
{
GSL_ERROR("y vector does not match X", GSL_EBADLEN);
}
else if (w != NULL && n != w->size)
{
GSL_ERROR("weight vector does not match X", GSL_EBADLEN);
}
else if (n != WX->size1 || p != WX->size2)
{
GSL_ERROR("WX matrix dimensions do not match X", GSL_EBADLEN);
}
else if (n != Wy->size)
{
GSL_ERROR("Wy vector must be length n", GSL_EBADLEN);
}
else
{
size_t i;
/* copy WX = X; Wy = y if distinct pointers */
if (WX != X)
gsl_matrix_memcpy(WX, X);
if (Wy != y)
gsl_vector_memcpy(Wy, y);
if (w != NULL)
{
/* construct WX = sqrt(W) X and Wy = sqrt(W) y */
for (i = 0; i < n; ++i)
{
double wi = gsl_vector_get(w, i);
double swi;
gsl_vector_view row = gsl_matrix_row(WX, i);
double *yi = gsl_vector_ptr(Wy, i);
if (wi < 0.0)
wi = 0.0;
swi = sqrt(wi);
gsl_vector_scale(&row.vector, swi);
*yi *= swi;
}
}
return GSL_SUCCESS;
}
}
double* end(GSL_vector& v)
{
if (v.size()) {
double* last = gsl_vector_ptr(v.raw(), v.size() - 1);
return ++last;
}
return nullptr;
}
static double
cholesky_LDLT_norm1(const gsl_matrix * LDLT, const gsl_permutation * p, gsl_vector * work)
{
const size_t N = LDLT->size1;
gsl_vector_const_view D = gsl_matrix_const_diagonal(LDLT);
gsl_vector_view diagA = gsl_vector_subvector(work, N, N);
double max = 0.0;
size_t i, j;
/* reconstruct diagonal entries of original matrix A */
for (j = 0; j < N; ++j)
{
double Ajj;
/* compute diagonal (j,j) entry of A */
Ajj = gsl_vector_get(&D.vector, j);
for (i = 0; i < j; ++i)
{
double Di = gsl_vector_get(&D.vector, i);
double Lji = gsl_matrix_get(LDLT, j, i);
Ajj += Di * Lji * Lji;
}
gsl_vector_set(&diagA.vector, j, Ajj);
}
gsl_permute_vector_inverse(p, &diagA.vector);
for (j = 0; j < N; ++j)
{
double sum = 0.0;
double Ajj = gsl_vector_get(&diagA.vector, j);
for (i = 0; i < j; ++i)
{
double *wi = gsl_vector_ptr(work, i);
double Aij = gsl_matrix_get(LDLT, i, j);
double absAij = fabs(Aij);
sum += absAij;
*wi += absAij;
}
gsl_vector_set(work, j, sum + fabs(Ajj));
}
for (i = 0; i < N; ++i)
{
double wi = gsl_vector_get(work, i);
max = GSL_MAX(max, wi);
}
return max;
}
int
lls_fold(gsl_matrix *A, gsl_vector *b,
gsl_vector *wts, lls_workspace *w)
{
const size_t n = A->size1;
if (A->size2 != w->p)
{
GSL_ERROR("A has wrong size2", GSL_EBADLEN);
}
else if (n != b->size)
{
GSL_ERROR("b has wrong size", GSL_EBADLEN);
}
else if (n != wts->size)
{
GSL_ERROR("wts has wrong size", GSL_EBADLEN);
}
else
{
int s = 0;
size_t i;
double bnorm;
for (i = 0; i < n; ++i)
{
gsl_vector_view rv = gsl_matrix_row(A, i);
double *bi = gsl_vector_ptr(b, i);
double wi = gsl_vector_get(wts, i);
double swi = sqrt(wi);
/* A <- sqrt(W) A */
gsl_vector_scale(&rv.vector, swi);
/* b <- sqrt(W) b */
*bi *= swi;
}
/* ATA += A^T W A, using only the upper half of the matrix */
s = gsl_blas_dsyrk(CblasUpper, CblasTrans, 1.0, A, 1.0, w->ATA);
if (s)
return s;
/* ATb += A^T W b */
s = gsl_blas_dgemv(CblasTrans, 1.0, A, b, 1.0, w->ATb);
if (s)
return s;
/* bTb += b^T W b */
bnorm = gsl_blas_dnrm2(b);
w->bTb += bnorm * bnorm;
return s;
}
} /* lls_fold() */
/** Return a new vector that is the moving average of the input vector.
\param v The input vector, unsmoothed
\param bandwidth The number of elements to be smoothed.
*/
gsl_vector *apop_vector_moving_average(gsl_vector *v, size_t bandwidth) {
apop_assert_c(v, NULL, 0, "You asked me to smooth a NULL vector; returning NULL.\n");
apop_assert_s(bandwidth, "Bandwidth must be >=1.\n");
int halfspan = bandwidth/2;
gsl_vector *vout = gsl_vector_calloc(v->size - halfspan*2);
for(size_t i=0; i < vout->size; i ++) {
double *item = gsl_vector_ptr(vout, i);
for (int j=-halfspan; j < halfspan+1; j ++)
*item += gsl_vector_get(v, j+ i+ halfspan);
*item /= halfspan*2 +1;
}
return vout;
}
//This is a substitute for apop_pmf_compress, because
//we can use knowledge of our special case to work more efficiently
void merge_two_sets(apop_data *left, apop_data *right){
for (int i=0; i< right->matrix->size1; i++) {
Apop_row(right, i, Rrow);
double *r = gsl_vector_ptr(Rrow->weights, 0);
if (!*r) continue;
int j;
bool done = false;
#pragma omp parallel for private(j) shared(done)
for (j=0; j< left->matrix->size1; j++){
Apop_row(left, j, Lrow);
if (are_equal(Rrow, Lrow)){
*gsl_vector_ptr(Lrow->weights, 0) += *r;
*r = 0;
done = true;
if (done) j = left->matrix->size1;
}
}
}
apop_data_rm_rows(right, .do_drop=weightless);
//apop_data_listwise_delete(left, .inplace='y');
apop_data_stack(left, right, .inplace='y');
}
GSL_vector::GSL_vector(std::initializer_list<double> list)
{
if (list.size() == 0)
return;
vec = gsl_vector_alloc(list.size());
if (!vec)
throw OutOfMemoryError(
"Allocation of GSL_vector of size " + std::to_string(list.size())
+ " failed.");
std::copy(list.begin(), list.end(), gsl_vector_ptr(vec, 0));
}
void VarproFunction::fillZmatTmpJac( gsl_matrix *Zmatr, const gsl_vector* y,
const gsl_matrix *PhiTRt, double factor ) {
for (size_t j_1 = 0; j_1 < getM(); j_1++) {
for (size_t j = 0; j < getD(); j++) {
gsl_vector tJr = gsl_matrix_row(Zmatr, j_1 + j * getM()).vector;
myDeriv->calcDijGammaYr(&tJr, PhiTRt, j_1, j, y);
gsl_vector_scale(&tJr, -factor);
for (size_t k = 0; k < getN(); k++) { /* Convert to vector strides */
(*gsl_vector_ptr(&tJr, j + k * getD())) +=
gsl_matrix_get(myMatr, k, j_1);
}
}
}
}
void cholDowndate(gsl_matrix* R, gsl_vector* x, int* info)
{
int n = R->size1;
int i;
gsl_vector* c = gsl_vector_calloc(n);
gsl_vector* s = gsl_vector_calloc(n);
My_dtrsv(CblasLower, CblasNoTrans, CblasNonUnit, R, x);
double aux = norm2(x);
if (aux>1.0) {
*info = -1;
return;
}
if (aux>0.5) {
aux = sin(acos(aux));
}
else {
aux = cos(asin(aux));
}
for (i=n-1; i>=0; i--) {
double c1,s1;
My_drotg(&aux,gsl_vector_ptr(x,i),&c1,&s1);
if (aux<0.0) {
aux = -aux;
gsl_vector_set(c,i, - c1);
gsl_vector_set(s,i, - s1);
}
else {
gsl_vector_set(c,i,c1);
gsl_vector_set(s,i,s1);
}
}
for (int j=0; j<n; j++) {
aux = 0.0;
for (int ii=0; ii<=j; ii++) {
i = j-ii;
double temp = gsl_vector_get(c,i)*aux+gsl_vector_get(s,i)*gsl_matrix_get(R,j,i);
double temp2 = gsl_matrix_get(R,j,i);
gsl_matrix_set(R,j,i,gsl_vector_get(c,i)*temp2-gsl_vector_get(s,i)*aux);
aux = temp;
}
}
gsl_vector_free(c);
gsl_vector_free(s);
}
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 chapeau_output ( chapeau * ch, int timestep ) {
if (ch&&ch->ofp&&!(timestep%ch->outputFreq)) {
int outputlevel=ch->outputLevel;
int i;
fwrite(×tep,sizeof(int),1,ch->ofp);
if (outputlevel & 1) { // 0th bit = output knots as y
for (i=0;i<ch->m;i++) {
fwrite(gsl_vector_ptr(ch->lam,i),sizeof(double),1,ch->ofp);
//fprintf(stderr,"### %i %g\n",i,*gsl_vector_ptr(ch->lam,i));
}
}
if (outputlevel & 2) {
for (i=0;i<ch->m;i++) {
fwrite(&(ch->hits[i]),sizeof(int),1,ch->ofp);
}
}
fflush(ch->ofp);
}
}
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;
}
/* In this version, both the reference row and the weight set to be culled
may have NaNs. We still require compabibility in those fields where both
have data, but where one has a NaN and the other doesn't, we write down
the nonmissing value for that field, regardless of which side it came from.
Therefore, the resultant data has fewer NaN fields than either source, and
repeating this over several iterations can eventually produce a NaN-free set.
Not all data sets can complete like this.
If a row has NaNs, but there is no additional fill-in, then give it zero weight.
The rules:
--If a row has any NaN data, skip self in the cullback.
--If there is another row with unambiguously more data, skip this row.
--As an elaboration, if there is complete data anywhere in the candidate set, ignore
any incomplete rows (even if they are complete after fillin).
So, I need two passes:
(1) mark whether the row has NaNs.
(2) mark whether any admissable row has no NaNs.
(3) Check whether the row has any fill-ins. If has NaNs but no fill-ins, then it is either self or has even less data.
2nd pass:
(4) If any admissable rows have no NaNs, zero out all previously admissable
rows with NaNs.
*/
static double cull_w_nans(apop_data const *onerow, apop_data *cullback){
if (!cullback || !cullback->matrix) return 0;
bool has_nans[cullback->matrix->size1];
bool complete_admissable_row = false;
for (int row=0; row<cullback->matrix->size1; row++){
Apop_row(cullback, row, cull_row);
has_nans[row] = false;
bool this_row_has_fillins = false;
double *weight = gsl_vector_ptr(cullback->weights, row);
for (int i=0; i< cull_row->matrix->size2; i++){
double ref_field = apop_data_get(onerow, .col=i);
double *cull_field = apop_data_ptr(cull_row, .col=i);
has_nans[row] = has_nans[row] || isnan(*cull_field); //step (1)
if (!isnan(*cull_field) && !isnan(ref_field)){
if (onerow->more && onerow->more->text[i][0][0]=='r'){//near-misses OK.
double dist = fabs(ref_field - *cull_field);
*cull_row->weights->data *= 1/(1+dist);
break;
} else if ((*cull_field != ref_field) //mismatch
|| (has_nans[row] && complete_admissable_row)) { //step (4)
*weight = 0;
break;
}
}
if (isnan(*cull_field) && !isnan(ref_field)){
*cull_field = ref_field;
this_row_has_fillins = true;
}
}
if (!has_nans[row] && *weight != 0) //step (2)
complete_admissable_row = true;
if (has_nans[row] && !this_row_has_fillins) //step (3)
*weight = 0;
}
if (complete_admissable_row) //step (4)
for (int row=0; row<cullback->matrix->size1; row++)
if (has_nans[row]) gsl_vector_set(cullback->weights, row, 0);
return 0;
}
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);
}
}
}
/* compute 1-norm of original matrix, stored in upper triangle of LLT;
* diagonal entries have to be reconstructed */
static double
cholesky_norm1(const gsl_matrix * LLT, gsl_vector * work)
{
const size_t N = LLT->size1;
double max = 0.0;
size_t i, j;
for (j = 0; j < N; ++j)
{
double sum = 0.0;
gsl_vector_const_view lj = gsl_matrix_const_subrow(LLT, j, 0, j + 1);
double Ajj;
/* compute diagonal (j,j) entry of A */
gsl_blas_ddot(&lj.vector, &lj.vector, &Ajj);
for (i = 0; i < j; ++i)
{
double *wi = gsl_vector_ptr(work, i);
double Aij = gsl_matrix_get(LLT, i, j);
double absAij = fabs(Aij);
sum += absAij;
*wi += absAij;
}
gsl_vector_set(work, j, sum + fabs(Ajj));
}
for (i = 0; i < N; ++i)
{
double wi = gsl_vector_get(work, i);
max = GSL_MAX(max, wi);
}
return max;
}
double& Vector::operator () (unsigned int i)
{
return *gsl_vector_ptr(_V, i);
}
void KFKSDS_deriv_C (int *dim, double *sy, double *sZ, double *sT, double *sH,
double *sR, double *sV, double *sQ, double *sa0, double *sP0, double *dvof,
double *epshat, double *vareps, double *etahat, double *vareta,
double *r, double *N, double *dr, double *dN,
double *dahat, double *dvareps)
{
//int s, p = dim[1], mp1 = m + 1;
int i, ip1, j, k, n = dim[0], m = dim[2],
ir = dim[3], rp1 = ir + 1, nrp1 = n * rp1,
rp1m = rp1 * m, iaux, irp1m,
irsod = ir * sizeof(double), msod = m * sizeof(double),
nsod = n * sizeof(double), rp1msod = rp1 * msod;
//double invf[n], vof[n], msHsq, dfinvfsq[nrp1];
double msHsq;
std::vector<double> invf(n);
std::vector<double> vof(n);
std::vector<double> dfinvfsq(nrp1);
gsl_matrix_view Q = gsl_matrix_view_array(sQ, m, m);
gsl_vector_view Z = gsl_vector_view_array(sZ, m);
gsl_vector * Z_cp = gsl_vector_alloc(m);
gsl_matrix * ZtZ = gsl_matrix_alloc(m, m);
gsl_matrix_view maux1, maux2;
maux1 = gsl_matrix_view_array(gsl_vector_ptr(&Z.vector, 0), m, 1);
gsl_vector_memcpy(Z_cp, &Z.vector);
maux2 = gsl_matrix_view_array(gsl_vector_ptr(Z_cp, 0), 1, m);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix,
&maux2.matrix, 0.0, ZtZ);
gsl_matrix * a_pred = gsl_matrix_alloc(n, m);
std::vector<gsl_matrix*> P_pred(n);
gsl_matrix * K = gsl_matrix_alloc(n, m);
gsl_vector_view K_irow;
std::vector<gsl_matrix*> L(n);
gsl_vector_view Qdiag = gsl_matrix_diagonal(&Q.matrix);
gsl_vector * Qdiag_msq = gsl_vector_alloc(m);
gsl_vector_memcpy(Qdiag_msq, &Qdiag.vector);
gsl_vector_mul(Qdiag_msq, &Qdiag.vector);
gsl_vector_scale(Qdiag_msq, -1.0);
std::vector<gsl_matrix*> da_pred(rp1);
std::vector< std::vector<gsl_matrix*> > dP_pred(n, std::vector<gsl_matrix*>(rp1));
std::vector<gsl_matrix*> dK(n);
// filtering
KF_deriv_aux_C(dim, sy, sZ, sT, sH, sR, sV, sQ, sa0, sP0,
&invf, &vof, dvof, &dfinvfsq, a_pred, &P_pred, K,
&L, &da_pred, &dP_pred, &dK);
// state vector smoothing and disturbances smoothing
gsl_matrix_view V = gsl_matrix_view_array(sV, ir, ir);
gsl_matrix_view R = gsl_matrix_view_array(sR, m, ir);
gsl_vector_view vaux;
gsl_vector *vaux2 = gsl_vector_alloc(m);
gsl_matrix *Mmm = gsl_matrix_alloc(m, m);
gsl_matrix *Mmm2 = gsl_matrix_alloc(m, m);
gsl_matrix *Mrm = gsl_matrix_alloc(ir, m);
gsl_vector_memcpy(Z_cp, &Z.vector);
gsl_matrix *r0 = gsl_matrix_alloc(n + 1, m);
gsl_vector_view r_row_t;
gsl_vector_view r_row_tp1 = gsl_matrix_row(r0, n);
gsl_vector_set_zero(&r_row_tp1.vector);
std::vector<gsl_matrix*> N0(n + 1);
N0.at(n) = gsl_matrix_calloc(m, m);
gsl_vector_view Ndiag;
gsl_vector *var_eps = gsl_vector_alloc(n);
msHsq = -1.0 * pow(*sH, 2);
//vaux = gsl_vector_view_array(invf, n);
vaux = gsl_vector_view_array(&invf[0], n);
gsl_vector_set_all(var_eps, msHsq);
gsl_vector_mul(var_eps, &vaux.vector);
gsl_vector_add_constant(var_eps, *sH);
gsl_vector *vr = gsl_vector_alloc(ir);
gsl_matrix *dL = gsl_matrix_alloc(m, m);
std::vector<gsl_matrix*> dr0(n + 1);
dr0.at(n) = gsl_matrix_calloc(rp1, m);
gsl_vector_view dr_row_t, dr_row_tp1;
std::vector< std::vector<gsl_matrix*> > dN0(n + 1, std::vector<gsl_matrix*>(rp1));
for (j = 0; j < rp1; j++)
{
(dN0.at(n)).at(j) = gsl_matrix_calloc(m, m);
}
for (i = n-1; i > -1; i--)
{
ip1 = i + 1;
iaux = (i-1) * rp1m;
irp1m = i * rp1m;
if (i != n-1) //the case i=n-1 was initialized above
r_row_tp1 = gsl_matrix_row(r0, ip1);
r_row_t = gsl_matrix_row(r0, i);
gsl_blas_dgemv(CblasTrans, 1.0, L.at(i), &r_row_tp1.vector,
0.0, &r_row_t.vector);
gsl_vector_memcpy(Z_cp, &Z.vector);
gsl_vector_scale(Z_cp, vof.at(i));
gsl_vector_add(&r_row_t.vector, Z_cp);
gsl_vector_memcpy(vaux2, &r_row_tp1.vector);
memcpy(&r[i * m], vaux2->data, msod);
N0.at(i) = gsl_matrix_alloc(m, m);
gsl_matrix_memcpy(N0.at(i), ZtZ);
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L.at(i), N0.at(ip1), 0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, L.at(i), invf.at(i), N0.at(i));
vaux = gsl_matrix_diagonal(N0.at(ip1));
gsl_vector_memcpy(vaux2, &vaux.vector);
memcpy(&N[i * m], vaux2->data, msod);
K_irow = gsl_matrix_row(K, i);
gsl_blas_ddot(&K_irow.vector, &r_row_tp1.vector, &epshat[i]);
epshat[i] -= vof.at(i);
epshat[i] *= -*sH;
maux1 = gsl_matrix_view_array(gsl_vector_ptr(&K_irow.vector, 0), 1, m);
maux2 = gsl_matrix_view_array(gsl_vector_ptr(Z_cp, 0), 1, m);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix, N0.at(ip1),
0.0, &maux2.matrix);
vaux = gsl_vector_view_array(gsl_vector_ptr(var_eps, i), 1);
gsl_blas_dgemv(CblasNoTrans, msHsq, &maux2.matrix, &K_irow.vector,
1.0, &vaux.vector);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, &V.matrix, &R.matrix,
0.0, Mrm);
gsl_blas_dgemv(CblasNoTrans, 1.0, Mrm, &r_row_tp1.vector,
0.0, vr);
memcpy(&etahat[i*ir], vr->data, irsod);
Ndiag = gsl_matrix_diagonal(N0.at(ip1));
gsl_vector_memcpy(Z_cp, &Ndiag.vector);
gsl_vector_mul(Z_cp, Qdiag_msq);
gsl_vector_add(Z_cp, &Qdiag.vector);
gsl_blas_dgemv(CblasTrans, 1.0, &R.matrix, Z_cp, 0.0, vr);
memcpy(&vareta[i*ir], vr->data, irsod);
// derivatives
dr0.at(i) = gsl_matrix_alloc(rp1, m);
for (j = 0; j < rp1; j++)
{
k = i + j * n;
gsl_vector_memcpy(Z_cp, &Z.vector);
gsl_vector_scale(Z_cp, dvof[k]);
vaux = gsl_matrix_row(dK.at(i), j);
maux1 = gsl_matrix_view_array(gsl_vector_ptr(&vaux.vector, 0), m, 1);
maux2 = gsl_matrix_view_array(gsl_vector_ptr(&Z.vector, 0), 1, m);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, &maux1.matrix,
&maux2.matrix, 0.0, dL);
dr_row_t = gsl_matrix_row(dr0.at(i), j);
dr_row_tp1 = gsl_matrix_row(dr0.at(ip1), j);
gsl_blas_dgemv(CblasTrans, 1.0, dL, &r_row_tp1.vector, 0.0, &dr_row_t.vector);
gsl_vector_add(&dr_row_t.vector, Z_cp);
gsl_blas_dgemv(CblasTrans, 1.0, L.at(i), &dr_row_tp1.vector, 1.0, &dr_row_t.vector);
(dN0.at(i)).at(j) = gsl_matrix_alloc(m, m);
gsl_matrix_memcpy((dN0.at(i)).at(j), ZtZ);
gsl_matrix_scale((dN0.at(i)).at(j), -1.0 * dfinvfsq.at(k));
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, dL, N0.at(ip1), 0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, L.at(i),
1.0, (dN0.at(i)).at(j));
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L.at(i),
(dN0.at(ip1)).at(j), 0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, L.at(i),
1.0, (dN0.at(i)).at(j));
gsl_blas_dgemm(CblasTrans, CblasNoTrans, 1.0, L.at(i),
N0.at(ip1), 0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm, dL,
1.0, (dN0.at(i)).at(j));
if (i != 0)
{
vaux = gsl_matrix_diagonal((dN0.at(i)).at(j));
gsl_vector_memcpy(vaux2, &vaux.vector);
memcpy(&dN[iaux + j * m], vaux2->data, msod);
}
vaux = gsl_matrix_row(da_pred.at(j), i);
gsl_blas_dgemv(CblasNoTrans, 1.0, (dP_pred.at(i)).at(j) , &r_row_t.vector,
1.0, &vaux.vector);
gsl_blas_dgemv(CblasNoTrans, 1.0, P_pred.at(i), &dr_row_t.vector,
1.0, &vaux.vector);
gsl_vector_memcpy(vaux2, &vaux.vector);
memcpy(&dahat[irp1m + j * m], vaux2->data, msod);
gsl_matrix_memcpy(Mmm, (dP_pred.at(i)).at(j));
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, (dP_pred.at(i)).at(j),
N0.at(i), 0.0, Mmm2);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm2, P_pred.at(i),
1.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, P_pred.at(i),
(dN0.at(i)).at(j), 0.0, Mmm2);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm2, P_pred.at(i),
1.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, P_pred.at(i),
N0.at(i), 0.0, Mmm2);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, Mmm2,
(dP_pred.at(i)).at(j), 1.0, Mmm);
gsl_matrix_mul_elements(Mmm, ZtZ);
std::vector<double> vmm(Mmm->data, Mmm->data + m*m);
dvareps[i*rp1 + j] = std::accumulate(vmm.begin(), vmm.end(), 0.0);
gsl_matrix_free((dN0.at(ip1)).at(j));
gsl_matrix_free((dP_pred.at(i)).at(j));
}
if (i != 0)
{
memcpy(&dr[iaux], (dr0.at(i))->data, rp1msod);
}
gsl_matrix_free(dr0.at(ip1));
gsl_matrix_free(dK.at(i));
gsl_matrix_free(P_pred.at(i));
gsl_matrix_free(L.at(i));
gsl_matrix_free(N0.at(ip1));
}
gsl_matrix_free(N0.at(0));
gsl_matrix_free(dr0.at(0));
for (j = 0; j < rp1; j++)
{
gsl_matrix_free((dN0.at(0)).at(j));
gsl_matrix_free(da_pred.at(j));
}
memcpy(&vareps[0], var_eps->data, nsod);
gsl_matrix_free(Mmm);
gsl_matrix_free(Mmm2);
gsl_matrix_free(Mrm);
gsl_matrix_free(r0);
gsl_matrix_free(K);
gsl_matrix_free(dL);
gsl_matrix_free(a_pred);
gsl_vector_free(Z_cp);
gsl_matrix_free(ZtZ);
gsl_vector_free(var_eps);
gsl_vector_free(vr);
gsl_vector_free(Qdiag_msq);
gsl_vector_free(vaux2);
}}
double&
GslVector::operator[](unsigned int i)
{
return *gsl_vector_ptr(m_vec,i);
}
/** Set i-th element */
double& vector<double>::operator()(const size_t& i)
{
double *x = gsl_vector_ptr(_vector, i);
return *x;
}
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;
}
/**
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;
}
double& vector::operator[](size_t off) {
if (!ptr_) throw std::runtime_error("empty gsl::vector");
return *gsl_vector_ptr(ptr_, off);
}
void KF_deriv_steady_C (int *dim, double *sy, double *sZ, double *sT, double *sH,
double *sR, double *sV, double *sQ, double *sa0, double *sP0,
double *tol, int *maxiter,
std::vector<double> *invf, std::vector<double> *vof,
double *dvof, std::vector<double> *dfinvfsq,
gsl_matrix *a_pred, std::vector<gsl_matrix*> *P_pred,
gsl_matrix *K, std::vector<gsl_matrix*> *L,
std::vector<gsl_matrix*> *da_pred,
std::vector< std::vector<gsl_matrix*> > *dP_pred,
std::vector<gsl_matrix*> *dK)
{
//int s, p = dim[1], mp1 = m + 1;
int i, j, k, n = dim[0], m = dim[2],
jm1, r = dim[3], rp1 = r + 1,
conv = 0, counter = 0;
//double v, f, fim1, df[rp1], dv, dtmp; //Kisum, Kim1sum;
double v, f, fim1, dv, dtmp; //Kisum, Kim1sum;
std::vector<double> df(rp1);
//double mll = 0.0; // for debugging
// data and state space model matrices
gsl_vector_view Z = gsl_vector_view_array(sZ, m);
gsl_matrix_view T = gsl_matrix_view_array(sT, m, m);
gsl_matrix_view Q = gsl_matrix_view_array(sQ, m, m);
// storage vectors and matrices
gsl_vector *Vm = gsl_vector_alloc(m);
gsl_vector *Vm_cp = gsl_vector_alloc(m);
gsl_vector *Vm_cp2 = gsl_vector_alloc(m);
gsl_vector *Vm_cp3 = gsl_vector_alloc(m);
gsl_vector *Vm3 = gsl_vector_alloc(m);
gsl_matrix *Mmm = gsl_matrix_alloc(m, m);
gsl_matrix *M1m = gsl_matrix_alloc(1, m);
gsl_matrix *Mm1 = gsl_matrix_alloc(m, 1);
gsl_vector_view a0 = gsl_vector_view_array(sa0, m);
gsl_vector *a_upd = gsl_vector_alloc(m);
gsl_vector_memcpy(a_upd, &a0.vector);
gsl_matrix_view P0 = gsl_matrix_view_array(sP0, m, m);
gsl_matrix *P_upd = gsl_matrix_alloc(m, m);
gsl_matrix_memcpy(P_upd, &P0.matrix);
gsl_vector_view K_irow, m_irow, m2_irow, m3_irow, K_im1row; //Kri;
gsl_matrix_view maux1;
gsl_matrix_view Zm = gsl_matrix_view_array(gsl_vector_ptr(&Z.vector, 0), 1, m);
gsl_vector *mZ = gsl_vector_alloc(m);
gsl_vector_memcpy(mZ, &Z.vector);
gsl_vector_scale(mZ, -1.0);
//std::vector<std::vector<gsl_matrix*> *> *da_pred;
std::vector<gsl_matrix*> dP_upd(rp1);
for (j = 0; j < rp1; j++)
{
da_pred[0].at(j) = gsl_matrix_alloc(n, m);
dP_upd.at(j) = gsl_matrix_calloc(m, m);
}
gsl_matrix *da_upd = gsl_matrix_calloc(rp1, m);
// filtering recursions
for (i = 0; i < n; i++)
{
m_irow = gsl_matrix_row(a_pred, i);
gsl_blas_dgemv(CblasNoTrans, 1.0, &T.matrix, a_upd, 0.0, &m_irow.vector);
P_pred[0].at(i) = gsl_matrix_alloc(m, m);
if (conv == 0) {
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &T.matrix, P_upd,
0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, Mmm, &T.matrix,
0.0, P_pred[0].at(i));
gsl_matrix_add(P_pred[0].at(i), &Q.matrix);
} else {
gsl_matrix_memcpy(P_pred[0].at(i), P_pred[0].at(i-1));
}
gsl_blas_ddot(&Z.vector, &m_irow.vector, &v);
v = sy[i] - v;
if (conv == 0) {
gsl_blas_dgemv(CblasNoTrans, 1.0, P_pred[0].at(i), &Z.vector,
0.0, Vm);
gsl_blas_ddot(&Z.vector, Vm, &f);
f += *sH;
invf->at(i) = 1.0 / f;
} else {
invf->at(i) = invf->at(i-1);
}
gsl_vector_memcpy(Vm_cp, Vm);
gsl_vector_memcpy(Vm_cp2, Vm);
gsl_vector_memcpy(Vm_cp3, Vm);
vof->at(i) = v * invf->at(i); // v[i]/f[i];
if (conv == 0) {
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm, 0), m, 1);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, &maux1.matrix,
&maux1.matrix, 0.0, Mmm);
gsl_matrix_scale(Mmm, invf->at(i));
gsl_matrix_memcpy(P_upd, P_pred[0].at(i));
gsl_matrix_sub(P_upd, Mmm);
}
gsl_vector_memcpy(a_upd, &m_irow.vector);
gsl_vector_scale(Vm_cp3, vof->at(i));
gsl_vector_add(a_upd, Vm_cp3);
K_irow = gsl_matrix_row(K, i);
gsl_vector_scale(Vm_cp, invf->at(i));
if (conv == 0) {
gsl_blas_dgemv(CblasNoTrans, 1.0, &T.matrix, Vm_cp, 0.0, &K_irow.vector);
} else {
K_im1row = gsl_matrix_row(K, i-1);
gsl_vector_memcpy(&K_irow.vector, &K_im1row.vector);
}
L[0].at(i) = gsl_matrix_alloc(m, m);
if (conv == 0) {
maux1 = gsl_matrix_view_array(gsl_vector_ptr(&K_irow.vector, 0), m, 1);
gsl_matrix_memcpy(L[0].at(i), &T.matrix);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, &maux1.matrix,
&Zm.matrix, 1.0, L[0].at(i));
} else {
gsl_matrix_memcpy(L[0].at(i), L[0].at(i-1));
}
// derivatives
dK[0].at(i) = gsl_matrix_alloc(rp1, m);
for (j = 0; j < rp1; j++)
{
k = i + j * n;
m_irow = gsl_matrix_row(da_upd, j);
m2_irow = gsl_matrix_row(da_pred[0].at(j), i);
gsl_blas_dgemv(CblasNoTrans, 1.0, &T.matrix, &m_irow.vector,
0.0, &m2_irow.vector);
gsl_blas_ddot(mZ, &m2_irow.vector, &dv);
(dP_pred[0].at(i)).at(j) = gsl_matrix_alloc(m, m);
if (conv == 0) {
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &T.matrix, dP_upd.at(j),
0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, Mmm, &T.matrix,
0.0, (dP_pred[0].at(i)).at(j));
if (j != 0)
{
jm1 = j - 1;
dtmp = gsl_matrix_get((dP_pred[0].at(i)).at(j), jm1, jm1);
gsl_matrix_set((dP_pred[0].at(i)).at(j), jm1, jm1, dtmp + 1.0);
}
} else {
gsl_matrix_memcpy((dP_pred[0].at(i)).at(j), (dP_pred[0].at(i-1)).at(j));
}
if (conv == 0) {
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &Zm.matrix,
(dP_pred[0].at(i)).at(j), 0.0, M1m);
m_irow = gsl_matrix_row(M1m, 0);
gsl_blas_ddot(&m_irow.vector, &Z.vector, &df[j]);
if (j == 0) {
df[j] += 1.0;
}
}
dvof[k] = (dv * f - v * df[j]) * pow(invf->at(i), 2);
m_irow = gsl_matrix_row(da_upd, j);
gsl_blas_dgemv(CblasNoTrans, vof->at(i), (dP_pred[0].at(i)).at(j), &Z.vector,
0.0, &m_irow.vector);
gsl_vector_add(&m_irow.vector, &m2_irow.vector);
dtmp = -1.0 * df[j] * invf->at(i);
gsl_blas_daxpy(dtmp, Vm_cp3, &m_irow.vector);
gsl_blas_daxpy(dv, Vm_cp, &m_irow.vector);
dfinvfsq->at(k) = df[j] * pow(invf->at(i), 2);
if (conv == 0) {
gsl_matrix_memcpy(dP_upd.at(j), (dP_pred[0].at(i)).at(j));
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, (dP_pred[0].at(i)).at(j),
&Zm.matrix, 0.0, Mm1);
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm_cp, 0), 1, m);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, Mm1, &maux1.matrix,
1.0, dP_upd.at(j));
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm_cp2, 0), m, 1);
gsl_matrix_memcpy(Mm1, &maux1.matrix);
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm_cp2, 0), 1, m);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, dfinvfsq->at(k), Mm1,
&maux1.matrix, 1.0, dP_upd.at(j));
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm_cp, 0), m, 1);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix,
&Zm.matrix, 0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, Mmm,
(dP_pred[0].at(i)).at(j), 1.0, dP_upd.at(j));
}
m3_irow = gsl_matrix_row(dK[0].at(i), j);
if (conv == 0) {
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &T.matrix,
(dP_pred[0].at(i)).at(j), 0.0, Mmm);
gsl_blas_dgemv(CblasNoTrans, 1.0, Mmm, &Z.vector, 0.0, &m3_irow.vector);
gsl_vector_scale(&m3_irow.vector, invf->at(i));
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &T.matrix,
P_pred[0].at(i), 0.0, Mmm);
gsl_blas_dgemv(CblasNoTrans, 1.0, Mmm, &Z.vector, 0.0, Vm3);
gsl_vector_scale(Vm3, dfinvfsq->at(k));
gsl_vector_sub(&m3_irow.vector, Vm3);
} else {
K_im1row = gsl_matrix_row(dK[0].at(i-1), j);
gsl_vector_memcpy(&m3_irow.vector, &K_im1row.vector);
}
}
// check if convergence to the steady state has been reached
if ((i > 0) & (conv == 0))
{
if (i == 1)
{
fim1 = f + 1.0;
}
if (fabs(f - fim1) < *tol)
{
counter += 1;
}
fim1 = f;
if (counter == *maxiter) {
conv = 1;
dim[5] = i;
}
}
}
// deallocate memory
for (j = 0; j < rp1; j++)
{
gsl_matrix_free(dP_upd.at(j));
}
gsl_vector_free(mZ);
gsl_vector_free(a_upd);
gsl_matrix_free(P_upd);
gsl_vector_free(Vm);
gsl_vector_free(Vm_cp);
gsl_vector_free(Vm_cp2);
gsl_vector_free(Vm_cp3);
gsl_vector_free(Vm3);
gsl_matrix_free(Mmm);
gsl_matrix_free(M1m);
gsl_matrix_free(Mm1);
gsl_matrix_free(da_upd);
}
void KF_deriv_aux_C (int *dim, double *sy, double *sZ, double *sT, double *sH,
double *sR, double *sV, double *sQ, double *sa0, double *sP0,
std::vector<double> *invf, std::vector<double> *vof,
double *dvof, std::vector<double> *dfinvfsq,
gsl_matrix *a_pred, std::vector<gsl_matrix*> *P_pred,
gsl_matrix *K, std::vector<gsl_matrix*> *L,
std::vector<gsl_matrix*> *da_pred,
std::vector< std::vector<gsl_matrix*> > *dP_pred,
std::vector<gsl_matrix*> *dK)
{
//int s, p = dim[1], mp1 = m + 1;
int i, j, k, n = dim[0], m = dim[2],
jm1, r = dim[3], rp1 = r + 1;
double v, f, df, dv, dtmp;
// data and state space model matrices
gsl_vector_view Z = gsl_vector_view_array(sZ, m);
gsl_matrix_view T = gsl_matrix_view_array(sT, m, m);
gsl_matrix_view Q = gsl_matrix_view_array(sQ, m, m);
// storage vectors and matrices
gsl_vector *Vm = gsl_vector_alloc(m);
gsl_vector *Vm_cp = gsl_vector_alloc(m);
gsl_vector *Vm_cp2 = gsl_vector_alloc(m);
gsl_vector *Vm3 = gsl_vector_alloc(m);
gsl_matrix *Mmm = gsl_matrix_alloc(m, m);
gsl_matrix *M1m = gsl_matrix_alloc(1, m);
gsl_matrix *Mm1 = gsl_matrix_alloc(m, 1);
gsl_vector_view a0 = gsl_vector_view_array(sa0, m);
gsl_vector *a_upd = gsl_vector_alloc(m);
gsl_vector_memcpy(a_upd, &a0.vector);
gsl_matrix_view P0 = gsl_matrix_view_array(sP0, m, m);
gsl_matrix *P_upd = gsl_matrix_alloc(m, m);
gsl_matrix_memcpy(P_upd, &P0.matrix);
gsl_vector_view K_irow, m_irow, m2_irow, m3_irow;
gsl_matrix_view maux1;
gsl_matrix_view Zm = gsl_matrix_view_array(gsl_vector_ptr(&Z.vector, 0), 1, m);
gsl_vector *mZ = gsl_vector_alloc(m);
gsl_vector_memcpy(mZ, &Z.vector);
gsl_vector_scale(mZ, -1.0);
std::vector<gsl_matrix*> dP_upd(rp1);
for (j = 0; j < rp1; j++)
{
da_pred[0].at(j) = gsl_matrix_alloc(n, m);
dP_upd.at(j) = gsl_matrix_calloc(m, m);
}
gsl_matrix *da_upd = gsl_matrix_calloc(rp1, m);
// filtering recursions
for (i = 0; i < n; i++)
{
m_irow = gsl_matrix_row(a_pred, i);
gsl_blas_dgemv(CblasNoTrans, 1.0, &T.matrix, a_upd, 0.0, &m_irow.vector);
P_pred[0].at(i) = gsl_matrix_alloc(m, m);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &T.matrix, P_upd,
0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, Mmm, &T.matrix,
0.0, P_pred[0].at(i));
gsl_matrix_add(P_pred[0].at(i), &Q.matrix);
gsl_blas_ddot(&Z.vector, &m_irow.vector, &v);
v = sy[i] - v;
gsl_blas_dgemv(CblasNoTrans, 1.0, P_pred[0].at(i), &Z.vector,
0.0, Vm);
gsl_blas_ddot(&Z.vector, Vm, &f);
f += *sH;
gsl_vector_memcpy(Vm_cp, Vm);
gsl_vector_memcpy(Vm_cp2, Vm);
invf->at(i) = 1.0 / f;
vof->at(i) = v * invf->at(i); // v[i]/f[i];
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm, 0), m, 1);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, &maux1.matrix,
&maux1.matrix, 0.0, Mmm);
gsl_matrix_scale(Mmm, invf->at(i));
gsl_vector_memcpy(a_upd, &m_irow.vector);
gsl_vector_scale(Vm, vof->at(i));
gsl_vector_add(a_upd, Vm);
gsl_matrix_memcpy(P_upd, P_pred[0].at(i));
gsl_matrix_sub(P_upd, Mmm);
K_irow = gsl_matrix_row(K, i);
gsl_vector_scale(Vm_cp, invf->at(i));
gsl_blas_dgemv(CblasNoTrans, 1.0, &T.matrix, Vm_cp, 0.0, &K_irow.vector);
L[0].at(i) = gsl_matrix_alloc(m, m);
maux1 = gsl_matrix_view_array(gsl_vector_ptr(&K_irow.vector, 0), m, 1);
gsl_matrix_memcpy(L[0].at(i), &T.matrix);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, &maux1.matrix,
&Zm.matrix, 1.0, L[0].at(i));
// derivatives
dK[0].at(i) = gsl_matrix_alloc(rp1, m);
for (j = 0; j < rp1; j++)
{
k = i + j * n;
m_irow = gsl_matrix_row(da_upd, j);
m2_irow = gsl_matrix_row(da_pred[0].at(j), i);
gsl_blas_dgemv(CblasNoTrans, 1.0, &T.matrix, &m_irow.vector,
0.0, &m2_irow.vector);
gsl_blas_ddot(mZ, &m2_irow.vector, &dv);
(dP_pred[0].at(i)).at(j) = gsl_matrix_alloc(m, m);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &T.matrix, dP_upd.at(j),
0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, Mmm, &T.matrix,
0.0, (dP_pred[0].at(i)).at(j));
if (j != 0)
{
jm1 = j - 1;
dtmp = gsl_matrix_get((dP_pred[0].at(i)).at(j), jm1, jm1);
gsl_matrix_set((dP_pred[0].at(i)).at(j), jm1, jm1, dtmp + 1.0);
}
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &Zm.matrix,
(dP_pred[0].at(i)).at(j), 0.0, M1m);
m_irow = gsl_matrix_row(M1m, 0);
gsl_blas_ddot(&m_irow.vector, &Z.vector, &df);
if (j == 0) {
df += 1.0;
}
dvof[k] = (dv * f - v * df) * pow(invf->at(i), 2);
m_irow = gsl_matrix_row(da_upd, j);
gsl_blas_dgemv(CblasNoTrans, vof->at(i), (dP_pred[0].at(i)).at(j), &Z.vector,
0.0, &m_irow.vector);
gsl_vector_add(&m_irow.vector, &m2_irow.vector);
dtmp = -1.0 * df * invf->at(i);
gsl_blas_daxpy(dtmp, Vm, &m_irow.vector);
gsl_blas_daxpy(dv, Vm_cp, &m_irow.vector);
gsl_matrix_memcpy(dP_upd.at(j), (dP_pred[0].at(i)).at(j));
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1.0, (dP_pred[0].at(i)).at(j),
&Zm.matrix, 0.0, Mm1);
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm_cp, 0), 1, m);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, Mm1, &maux1.matrix,
1.0, dP_upd.at(j));
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm_cp2, 0), m, 1);
gsl_matrix_memcpy(Mm1, &maux1.matrix);
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm_cp2, 0), 1, m);
dfinvfsq->at(k) = df * pow(invf->at(i), 2);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, dfinvfsq->at(k), Mm1,
&maux1.matrix, 1.0, dP_upd.at(j));
maux1 = gsl_matrix_view_array(gsl_vector_ptr(Vm_cp, 0), m, 1);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &maux1.matrix,
&Zm.matrix, 0.0, Mmm);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, -1.0, Mmm,
(dP_pred[0].at(i)).at(j), 1.0, dP_upd.at(j));
m3_irow = gsl_matrix_row(dK[0].at(i), j);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &T.matrix,
(dP_pred[0].at(i)).at(j), 0.0, Mmm);
gsl_blas_dgemv(CblasNoTrans, 1.0, Mmm, &Z.vector, 0.0, &m3_irow.vector);
gsl_vector_scale(&m3_irow.vector, invf->at(i));
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1.0, &T.matrix,
P_pred[0].at(i), 0.0, Mmm);
gsl_blas_dgemv(CblasNoTrans, 1.0, Mmm, &Z.vector, 0.0, Vm3);
gsl_vector_scale(Vm3, dfinvfsq->at(k));
gsl_vector_sub(&m3_irow.vector, Vm3);
}
}
// deallocate memory
for (j = 0; j < rp1; j++)
{
gsl_matrix_free(dP_upd.at(j));
}
gsl_vector_free(mZ);
gsl_vector_free(a_upd);
gsl_matrix_free(P_upd);
gsl_vector_free(Vm);
gsl_vector_free(Vm_cp);
gsl_vector_free(Vm_cp2);
gsl_vector_free(Vm3);
gsl_matrix_free(Mmm);
gsl_matrix_free(M1m);
gsl_matrix_free(Mm1);
gsl_matrix_free(da_upd);
}