void Testiwishart(CuTest* tc) {
/*set a non-trivial location matrix*/
gsl_matrix* V = gsl_matrix_alloc(DIM, DIM);
gsl_matrix_set_identity(V);
gsl_matrix_add_constant(V, 1.0);
p = mcmclib_iwishart_lpdf_alloc(V, P);
x = gsl_vector_alloc(DIM * DIM);
gsl_matrix_view X_v = gsl_matrix_view_vector(x, DIM, DIM);
gsl_matrix* X = &(X_v.matrix);
gsl_matrix_set_identity(X);
gsl_matrix_add_constant(X, 1.0);
/*check for side-effects*/
double tmp = lpdf(1.0);
CuAssertTrue(tc, tmp == lpdf(1.0));
CuAssertDblEquals(tc, -18.188424, lpdf(1.0), TOL);
CuAssertDblEquals(tc, 49.59203, lpdf(0.5), TOL);
CuAssertDblEquals(tc, -88.468878, lpdf(2.0), TOL);
mcmclib_iwishart_lpdf_free(p);
gsl_vector_free(x);
gsl_matrix_free(V);
}
// Get the centroid, i.e., the site that has the lowest
// distance to other sites. This is done by computing the
// L2 norm (using the GLS BLAS interface) of the columns of
// the distance matrix. This is effectively the distance of
// a given sequence to all other sequences. The minimum
// value of the L2 norms gives corresponds to the centroid
pair<int,double> shapeAlign::getCentroid(void){
gsl_vector * dists = gsl_vector_alloc(nSites);
gsl_matrix_add_constant(D,-1.0);
for (size_t i = 0; i < nSites; i++){
gsl_vector_view column = gsl_matrix_column(D,i);
gsl_vector_set(dists,i,gsl_blas_dnrm2(&column.vector));
}
gsl_matrix_add_constant(D,1.0);
int minIdx = gsl_vector_min_index(dists);
double dist = gsl_vector_get(dists,minIdx);
gsl_vector_free(dists);
return make_pair(minIdx,dist);
}
/** Subtraction operator (double) */
matrix<double> matrix<double>::operator-(const double& a)
{
matrix<double> m1(_matrix);
if (gsl_matrix_add_constant(m1.as_gsl_type_ptr(), -a))
{
std::cout << "\n Error in matrix<double> - (double)" << std::endl;
exit(EXIT_FAILURE);
}
return m1;
}
void c_ctr::read_init_information(const char* theta_init_path,
const char* beta_init_path,
const c_corpus* c,
double alpha_smooth) {
int num_topics = m_num_factors;
m_theta = gsl_matrix_alloc(c->m_num_docs, num_topics);
printf("\nreading theta initialization from %s\n", theta_init_path);
FILE * f = fopen(theta_init_path, "r");
mtx_fscanf(f, m_theta);
fclose(f);
//smoothing
gsl_matrix_add_constant(m_theta, alpha_smooth);
//normalize m_theta, in case it's not
for (size_t j = 0; j < m_theta->size1; j ++) {
gsl_vector_view theta_v = gsl_matrix_row(m_theta, j);
vnormalize(&theta_v.vector);
}
m_beta = gsl_matrix_alloc(num_topics, c->m_size_vocab);
printf("reading beta initialization from %s\n", beta_init_path);
f = fopen(beta_init_path, "r");
mtx_fscanf(f, m_beta);
fclose(f);
// exponentiate if it's not
if (mget(m_beta, 0, 0) < 0) {
mtx_exp(m_beta);
}
else {
gsl_matrix_add_constant(m_beta, beta_smooth);
for (size_t j = 0; j < m_beta->size1; j ++) {
gsl_vector_view beta_v = gsl_matrix_row(m_beta, j);
vnormalize(&beta_v.vector);
}
}
}
void CRebuildGraph::printingCompareMatrixResults(float delta,
gsl_matrix *F,
gsl_matrix* matrixA
){
CFuncTrace lFuncTrace(false,"CRebuildGraph::printingCompareMatrixResults");
lFuncTrace.trace(CTrace::TRACE_DEBUG,"DIFERENCIA (delta) -> %f",delta);
//Per presentar-la, definim positiva i normalitzem la matriu F
if(gsl_matrix_min(F)<0)
gsl_matrix_add_constant (F, -gsl_matrix_min(F));
if(gsl_matrix_max(F)>0)
gsl_matrix_scale (F, 1/gsl_matrix_max(F));
FILE *out;
out=fopen("sortida.txt","w");
lFuncTrace.trace(CTrace::TRACE_DEBUG,"Resultats en sortida.txt");
fprintf(out, "DIFERENCIA (delta) -> %f\n\n",delta);
for(int i=0; i<matrixA->size1; i++){
for(int j=0; j<matrixA->size1; j++){
if(gsl_matrix_get(matrixA,i,j)==0){
fprintf(out," ");
}else if(gsl_matrix_get(matrixA,i,j)==1){
fprintf(out,"#");
}else{
printf("\nERROR-Matriu no valida %f",gsl_matrix_get(matrixA,i,j));
exit(1);
}
}
fprintf(out,"\t|\t");
for(int j=0; j<matrixA->size1; j++){
if(gsl_matrix_get(F,i,j)<0.2)
fprintf(out," ");
else if(gsl_matrix_get(F,i,j)<0.4)
fprintf(out,"∑");
else if(gsl_matrix_get(F,i,j)<0.6)
fprintf(out,"^");
else if(gsl_matrix_get(F,i,j)<0.8)
fprintf(out,"-");
else if(gsl_matrix_get(F,i,j)<0.95)
fprintf(out,"/");
else
fprintf(out,"#");
}
fprintf(out,"\n");
}
fclose(out);
}
/**
* The function creates and loads the segmentation image
* of a flux_cube file into a gsl_matrix_int structure.
*
* @param fcube_file - the file name of the fluxcube
*
* @return ret - pointer to the gsl_matrix_int structure
*/
gsl_matrix_int *
load_segmentation(const char fcube_file[])
{
gsl_matrix_int *segmentation;
gsl_matrix *dvals;
int i,j;
double diff;
// load the segmentation image into a gsl_matrix_(double)
dvals = FITSimage_to_gsl(fcube_file, 2, 1);
// add 0.5 to get proper rounding with (int)
gsl_matrix_add_constant (dvals, 0.5);
// allocate space for the integer matrix
segmentation = gsl_matrix_int_alloc(dvals->size1,dvals->size2);
// fill the integer matrix with values from the double matrix
for (i=0; i < dvals->size1; i++)
{
for (j=0; j < dvals->size2; j++)
{
gsl_matrix_int_set(segmentation, i, j, (int)gsl_matrix_get(dvals, i, j));
diff = gsl_matrix_get(dvals, i, j) - (double)gsl_matrix_int_get(segmentation, i, j);
if (diff > 0.6 || diff < 0.4)
fprintf(stdout, "diff %f; %f --> %i, (%i, %i)\n", diff, gsl_matrix_get(dvals, i, j), gsl_matrix_int_get(segmentation, i, j), i, j);
}
}
// free the space for the double matrix
gsl_matrix_free(dvals);
return segmentation;
}
void glm::initialGlm(gsl_matrix *Y, gsl_matrix *X, gsl_matrix *O, gsl_matrix *B)
{
releaseGlm();
nRows = Y->size1;
nVars = Y->size2;
nParams = X->size2;
unsigned int i, j;
theta = new double [nVars];
ll = new double [nVars];
dev = new double [nVars];
aic = new double [nVars];
iterconv = new unsigned int [nVars];
Xref = gsl_matrix_alloc(nRows, nParams);
gsl_matrix_memcpy (Xref, X);
Yref = gsl_matrix_alloc(nRows, nVars);
gsl_matrix_memcpy (Yref, Y);
if (O==NULL) Oref=NULL;
else {
Oref = gsl_matrix_alloc(nRows, nVars);
gsl_matrix_memcpy(Oref, O);
}
Beta = gsl_matrix_alloc(nParams, nVars);
varBeta = gsl_matrix_alloc(nParams, nVars);
Mu = gsl_matrix_alloc(nRows, nVars);
Eta = gsl_matrix_alloc(nRows, nVars);
Res = gsl_matrix_alloc(nRows, nVars);
Var = gsl_matrix_alloc(nRows, nVars);
wHalf = gsl_matrix_alloc(nRows, nVars);
sqrt1_Hii = gsl_matrix_alloc(nRows, nVars);
PitRes = gsl_matrix_alloc(nRows, nVars);
gsl_matrix_set_zero (varBeta);
for (j=0; j<nVars; j++) {
theta[j] = maxtol; // i.e. phi=0
ll[j] = 0;
dev[j] = 0;
aic[j] = 0;
iterconv[j] = 0;
}
// Note: setting the initial value is important
// e.g., using mean(Y) for binomial regression doesn't work
// gsl_matrix *t1;
// t1 = gsl_matrix_alloc(nRows, 1);
// gsl_matrix_set_all (t1, 1.0); // intercept
// GetMean(t1, Y, Mu);
// gsl_matrix_free(t1);
//
// Use binomial$initialize: MuStart = (Y+0.5)/2
// It seems to work for poisson and negative.binomial as well
double LinAdjust, ScaleAdjust;
double eij;
if (mmRef->model==BIN) {
LinAdjust=0.5;
ScaleAdjust=0.5;
}
else {
LinAdjust=0.1;
ScaleAdjust=1;
}
if (B!=NULL) {
gsl_matrix_memcpy(Beta, B);
gsl_blas_dgemm (CblasNoTrans, CblasNoTrans,1.0,X,Beta,0.0,Eta);
for (i=0; i<nRows; i++)
for (j=0; j<nVars; j++) {
eij = gsl_matrix_get(Eta, i, j);
// to avoid nan
if (eij>link(maxtol)) eij = link(maxtol);
if (eij<link(mintol)) eij = link(mintol);
gsl_matrix_set(Eta, i, j, eij);
gsl_matrix_set(Mu, i, j, invLink(eij));
}
}
else if (O!=NULL) {
gsl_matrix_set_zero(Beta);
gsl_matrix_memcpy(Eta, O);
for (i=0; i<nRows; i++)
for (j=0; j<nVars; j++) {
eij = gsl_matrix_get(Eta, i, j);
// to avoid nan
if (eij>link(maxtol)) eij = link(maxtol);
if (eij<link(mintol)) eij = link(mintol);
gsl_matrix_set(Eta, i, j, eij);
gsl_matrix_set(Mu, i, j, invLink(eij));
}
}
else {
gsl_matrix_memcpy(Mu, Yref);
gsl_matrix_add_constant(Mu, LinAdjust);
gsl_matrix_scale(Mu, ScaleAdjust);
// gsl_matrix_set_zero (Eta); // intercept
for (i=0; i<nRows; i++)
for (j=0; j<nVars; j++) {
eij = link(gsl_matrix_get(Mu, i, j));
if (eij>link(maxtol)) eij = link(maxtol);
if (eij<link(mintol)) eij = link(mintol);
gsl_matrix_set(Eta, i, j, eij);
gsl_matrix_set(Mu, i, j, invLink(eij));
}
gsl_matrix_set_zero (Beta); // intercept
gsl_vector_view b0=gsl_matrix_column(Beta, 0);
gsl_vector_set_all(&b0.vector, 1.0);
// printf("LinAdjust=%.2f, ScaleAdjust=%.2f\n", LinAdjust, ScaleAdjust);
}
rdf = nRows - nParams;
}
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;
}
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;
}
int
Matrix::subtractScalar(double aVal)
{
gsl_matrix_add_constant(matrix,-1*aVal);
return 0;
}
int
Matrix::addScalar(double aVal)
{
gsl_matrix_add_constant(matrix,aVal);
return 0;
}
matrix operator+(const matrix& m, double x) {
matrix out(m);
gsl_matrix_add_constant(out.ptr_, x);
return out;
}
/// add a constant to this matrix
/// @param d :: A number
GSLMatrix &GSLMatrix::operator+=(const double &d) {
gsl_matrix_add_constant(&m_view.matrix, d);
return *this;
}
int main() {
srand(time(NULL));
int states = 6;
int unfiltered_states = 3;
gsl_matrix *state_mean = gsl_matrix_calloc(states,1);
gsl_matrix_set(state_mean, 0,0, 3);
gsl_matrix_set(state_mean, 1,0, 3);
gsl_matrix *state_covariance = gsl_matrix_calloc(states,states);
gsl_matrix *observation_mean = gsl_matrix_calloc(states,1);
gsl_matrix *observation_covariance = gsl_matrix_calloc(states,states);
//gsl_matrix_set(observation_covariance, 0, 0, hdop);
//gsl_matrix_set(observation_covariance, 1, 1, hdop);
//gsl_matrix_set(observation_covariance, 2, 2, vert_err);
//gsl_matrix_set(observation_covariance, 3, 3, (2*hdop)/pow(timestep,2));
//gsl_matrix_set(observation_covariance, 4, 4, (2*hdop)/pow(timestep,2));
//gsl_matrix_set(observation_covariance, 5, 5, (2*vert_err)/pow(timestep,2));
//gsl_matrix_set(observation_covariance, 0, 3, timestep*(2*hdop)/pow(timestep,2));
//gsl_matrix_set(observation_covariance, 3, 0, timestep*(2*hdop)/pow(timestep,2));
//gsl_matrix_set(observation_covariance, 1, 4, timestep*(2*hdop)/pow(timestep,2));
//gsl_matrix_set(observation_covariance, 4, 1, timestep*(2*hdop)/pow(timestep,2));
//gsl_matrix_set(observation_covariance, 2, 5, timestep*(2*vert_err)/pow(timestep,2));
//gsl_matrix_set(observation_covariance, 5, 2, timestep*(2*vert_err)/pow(timestep,2));
gsl_matrix *observation_transformation = gsl_matrix_calloc(states,states);
gsl_matrix *estimate_mean = gsl_matrix_calloc(states,1);
gsl_matrix *estimate_covariance = gsl_matrix_calloc(states,states);
gsl_matrix *kalman_gain = gsl_matrix_calloc(states,states);
gsl_matrix *temp21a = gsl_matrix_calloc(states,1);
gsl_matrix *temp21b = gsl_matrix_calloc(states,1);
gsl_matrix *temp22a = gsl_matrix_calloc(states,states);
gsl_matrix *temp22b = gsl_matrix_calloc(states,states);
gsl_matrix *predict = gsl_matrix_calloc(states,states);
//gsl_matrix_set(predict, 0, 0, 1);
//gsl_matrix_set(predict, 1, 1, 1);
//gsl_matrix_set(predict, 2, 2, 1);
gsl_matrix_set(predict, 3, 3, 1);
gsl_matrix_set(predict, 4, 4, 1);
gsl_matrix_set(predict, 5, 5, 1);
//gsl_matrix_set(predict, 0, 3, timestep);
//gsl_matrix_set(predict, 1, 4, timestep);
//gsl_matrix_set(predict, 2, 5, timestep);
gsl_matrix *control = gsl_matrix_calloc(states, unfiltered_states);
//gsl_matrix_set(control, 0, 0, 0.5*pow(timestep,2));
//gsl_matrix_set(control, 1, 1, 0.5*pow(timestep,2));
//gsl_matrix_set(control, 2, 2, 0.5*pow(timestep,2));
//gsl_matrix_set(control, 3, 0, timestep);
//gsl_matrix_set(control, 4, 1, timestep);
//gsl_matrix_set(control, 5, 2, timestep);
gsl_vector *acceleration = gsl_vector_calloc(unfiltered_states);
gsl_vector *velocity = gsl_vector_calloc(unfiltered_states);
gsl_vector *location = gsl_vector_calloc(unfiltered_states);
gsl_vector *delta_location = gsl_vector_calloc(unfiltered_states);
gsl_vector *temp_location = gsl_vector_calloc(unfiltered_states);
double timestep;
int hdop;
int vert_err;
int s;
double error;
for (int t = 1; t < 1000000; t++) {
timestep = 1;
gsl_vector_set(acceleration, 0, (rand()%101)-52);
gsl_vector_set(acceleration, 1, (rand()%101)-46);
gsl_vector_set(acceleration, 2, (rand()%101)-54);
gsl_vector_add(velocity, acceleration);
gsl_vector_add(location, velocity);
gsl_vector_memcpy(delta_location, location);
gsl_vector_sub(delta_location, temp_location);
gsl_vector_memcpy(temp_location, location);
gsl_matrix_set(predict, 0, 3, timestep);
gsl_matrix_set(predict, 1, 4, timestep);
gsl_matrix_set(predict, 2, 5, timestep);
gsl_matrix_set(control, 0, 0, 0.5*pow(timestep,2));
gsl_matrix_set(control, 1, 1, 0.5*pow(timestep,2));
gsl_matrix_set(control, 2, 2, 0.5*pow(timestep,2));
gsl_matrix_set(control, 3, 0, timestep);
gsl_matrix_set(control, 4, 1, timestep);
gsl_matrix_set(control, 5, 2, timestep);
hdop = 5;
vert_err = 5;
gsl_matrix_set(observation_covariance, 0, 0, hdop);
gsl_matrix_set(observation_covariance, 1, 1, hdop);
gsl_matrix_set(observation_covariance, 2, 2, vert_err);
gsl_matrix_set(observation_covariance, 3, 3, (2*hdop)/pow(timestep,2));
gsl_matrix_set(observation_covariance, 4, 4, (2*hdop)/pow(timestep,2));
gsl_matrix_set(observation_covariance, 5, 5, (2*vert_err)/pow(timestep,2));
gsl_matrix_set(observation_covariance, 0, 3, timestep*(2*hdop)/pow(timestep,2));
gsl_matrix_set(observation_covariance, 3, 0, timestep*(2*hdop)/pow(timestep,2));
gsl_matrix_set(observation_covariance, 1, 4, timestep*(2*hdop)/pow(timestep,2));
gsl_matrix_set(observation_covariance, 4, 1, timestep*(2*hdop)/pow(timestep,2));
gsl_matrix_set(observation_covariance, 2, 5, timestep*(2*vert_err)/pow(timestep,2));
gsl_matrix_set(observation_covariance, 5, 2, timestep*(2*vert_err)/pow(timestep,2));
//observation_transformation = observation_mean[k] * pseudoinverse(state_mean[k-1])
gsl_matrix_set_zero(temp21a);
gsl_matrix_set(temp21a, 0, 0, gsl_vector_get(delta_location,0));
gsl_matrix_set(temp21a, 1, 0, gsl_vector_get(delta_location,1));
gsl_matrix_set(temp21a, 2, 0, gsl_vector_get(delta_location,2));
gsl_matrix_set(temp21a, 3, 0, gsl_vector_get(velocity,0));
gsl_matrix_set(temp21a, 4, 0, gsl_vector_get(velocity,1));
gsl_matrix_set(temp21a, 5, 0, gsl_vector_get(velocity,2));
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, temp21a, pseudo_inverse(state_mean), 0, observation_transformation);
//observation_mean[k] = observation_transformation * state_mean[k-1]
gsl_matrix_memcpy(temp21a, state_mean);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, observation_transformation, temp21a, 0, observation_mean);
//observation_covariance[k] = observation_transformation * state_covariance * transpose(observation_transformation)
/* gsl_matrix_set_zero(temp22a);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1, state_covariance, observation_transformation, 0, temp22a); //notice observation_transformation is transposed
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, observation_transformation, temp22a, 0, observation_covariance);
*/
gsl_matrix_set(observation_covariance, 0, 3, timestep*3);
gsl_matrix_set(observation_covariance, 3, 0, timestep*3);
gsl_matrix_set(observation_covariance, 1, 4, timestep*5);
gsl_matrix_set(observation_covariance, 4, 1, timestep*5);
gsl_matrix_set(observation_covariance, 2, 5, timestep*6);
gsl_matrix_set(observation_covariance, 5, 2, timestep*6);
//estimate_mean = predict * state_mean + control * acceleration;
gsl_matrix_set_zero(estimate_mean);
gsl_matrix_set_zero(temp21a);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, predict, state_mean, 0, estimate_mean);
gsl_matrix_view test = gsl_matrix_view_vector(acceleration, unfiltered_states, 1);
gsl_matrix * tmp = &test.matrix;
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, control, tmp, 0, temp21a);
gsl_matrix_add(estimate_mean, temp21a);
//estimate_covariance = predict * state_covariance * transpose(predict) + noise;
gsl_matrix_set_zero(estimate_covariance);
gsl_matrix_set_zero(temp22a);
gsl_blas_dgemm(CblasNoTrans, CblasTrans, 1, state_covariance, predict, 0, temp22a); //notice predict is transposed
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, predict, temp22a, 0, estimate_covariance);
gsl_matrix_add_constant(estimate_covariance, 0.1); //adxl345 noise, this is completely wrong
//kalman_gain = estimate_covariance * pseudoinverse(estimate_covariance + observation_covariance);
gsl_matrix_set_zero(kalman_gain);
gsl_matrix_set_zero(temp22a);
gsl_matrix_memcpy(temp22a, observation_covariance);
gsl_matrix_add(temp22a, estimate_covariance);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, estimate_covariance, pseudo_inverse(temp22a), 0, kalman_gain);
//state_mean = estimate_mean + kalman_gain * ( observation_mean - estimate_mean );
gsl_matrix_set_zero(state_mean);
gsl_matrix_set_zero(temp21a);
gsl_matrix_memcpy(temp21a, observation_mean);
gsl_matrix_sub(temp21a, estimate_mean);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, kalman_gain, temp21a, 0, state_mean);
gsl_matrix_add(state_mean, estimate_mean);
//state_covariance = estimate_covariance - kalman_gain * ( estimate_covariance );
gsl_matrix_set_zero(state_covariance);
gsl_matrix_set_zero(temp22a);
gsl_blas_dgemm(CblasNoTrans, CblasNoTrans, 1, kalman_gain, estimate_covariance, 0, temp22a);
gsl_matrix_add(state_covariance, estimate_covariance);
gsl_matrix_sub(state_covariance, temp22a);
printf("state_mean:");
gsl_matrix_fprintf(stdout, state_mean, "%f");
//printf("state_covariance:");
//gsl_matrix_fprintf(stdout, state_covariance, "%f");
printf("observation_mean:");
gsl_matrix_fprintf(stdout, observation_mean, "%f");
//printf("observation_covariance:");
//gsl_matrix_fprintf(stdout, observation_covariance, "%f");
printf("estimate_mean:");
gsl_matrix_fprintf(stdout, estimate_mean, "%f");
//printf("estimate_covariance:");
//gsl_matrix_fprintf(stdout, estimate_covariance, "%f");
gsl_matrix_set_zero(temp21a);
gsl_matrix_memcpy(temp21a, observation_mean);
gsl_matrix_sub(temp21a, state_mean);
gsl_matrix_div_elements(temp21a, observation_mean);
gsl_matrix_mul_elements(temp21a, temp21a);
for (int i = states-1; i >= 0; i--) {
error += gsl_matrix_get(temp21a, i, 0);
}
printf("error: %f\n", error);
printf("error/time: %f\n", error/t);
printf("\n");
usleep(1000000);
}
}
void CNumMat::operator+=(double x)
{
assert(m_mat!=NULL);
if(gsl_matrix_add_constant(m_mat,x))
throw BPException("gsl_matrix_add_constant");
}
int AnovaTest::resampTest(void)
{
// printf("Start resampling test ...\n");
unsigned int i, j, p, id;
unsigned int maxiter=mmRef->nboot;
double hii, score;
gsl_matrix *bX, *bY;
bY = gsl_matrix_alloc(nRows, nVars);
bX = gsl_matrix_alloc(nRows, nParam);
// initialize permid
unsigned int *permid=NULL;
if ( bootID == NULL ) {
if ( mmRef->resamp == PERMUTE ){
permid = (unsigned int *)malloc(nRows*sizeof(unsigned int));
for (i=0; i<nRows; i++)
permid[i] = i;
} }
// else
// displaymatrix(bootID, "bootID received");
// resampling options
if (mmRef->resamp == CASEBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for ( j=0; j<nRows; j++ ){
// resampling index
if (bootID == NULL)
id = gsl_rng_uniform_int(rnd, nRows);
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// resample Y and X
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view Xj=gsl_matrix_row(Xref, id);
gsl_matrix_set_row (bX, j, &Xj.vector);
}
anovacase(bY, bX);
nSamp++;
}
}
else if (mmRef->resamp == RESIBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for (p=1; p<nModels; p++) {
if (mmRef->reprand!=TRUE) {
GetRNGstate();
printf("reprand==FALSE\n");
}
for (j=0; j<nRows; j++){
// resampling index
if (bootID == NULL)
id = gsl_rng_uniform_int(rnd, nRows);
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// bootr by resampling resi=(Y-fit)
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, id, id);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
Yj=gsl_matrix_row(Hats[p].Y, j);
gsl_vector_add (&bootr.vector, &Yj.vector);
}
if (mmRef->reprand!=TRUE) PutRNGstate();
anovaresi(bY, p);
}
nSamp++;
} }
else if (mmRef->resamp == SCOREBOOT) {
nSamp = 0;
for (i=0; i<maxiter; i++) {
for (p=1; p<nModels; p++) {
for ( j=0; j<nRows; j++ ) {
// random score
if ( bootID == NULL )
score = gsl_ran_ugaussian (rnd);
else
score = (double)gsl_matrix_get(bootID, i, j);
// bootr = (Y - fit)*score
gsl_vector_view Yj=gsl_matrix_row(Yref, j);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, j);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, j, j);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
gsl_vector_scale (&bootr.vector, score);
gsl_vector_add (&bootr.vector, &Fj.vector);
}
anovaresi(bY, p);
}
nSamp++;
} }
else if ( mmRef->resamp == PERMUTE ) {
gsl_matrix_add_constant (Pstatj, 1.0);
for (p=0; p<nModels-1; p++)
Pmultstat[p]=1.0; // include itself
nSamp = 1;
for (i=0; i<maxiter-1; i++) { //999
for (p=1; p<nModels; p++){
if (bootID == NULL )
gsl_ran_shuffle(rnd, permid, nRows, sizeof(unsigned int));
// get bootr by permuting resi:Y-fit
for (j=0; j<nRows; j++){
if (bootID == NULL)
id = permid[j];
else
id = (unsigned int) gsl_matrix_get(bootID, i, j);
// bootr by resampling resi=(Y-fit)
gsl_vector_view Yj=gsl_matrix_row(Yref, id);
gsl_vector_view Fj=gsl_matrix_row(Hats[p].Y, id);
gsl_matrix_set_row (bY, j, &Yj.vector);
gsl_vector_view bootr=gsl_matrix_row(bY, j);
gsl_vector_sub (&bootr.vector, &Fj.vector);
if (mmRef->student==TRUE) {
hii = gsl_matrix_get(Hats[p].mat, id, id);
gsl_vector_scale (&bootr.vector, 1/sqrt(1-hii));
}
// bY = Y + bootr
Yj=gsl_matrix_row(Hats[p].Y, j);
gsl_vector_add (&bootr.vector, &Yj.vector);
}
anovaresi(bY, p);
}
nSamp++;
}
}
else
GSL_ERROR("Invalid resampling option", GSL_EINVAL);
// p-values
unsigned int sid, sid0;
double *pj;
for (i=0; i<nModels-1; i++) {
Pmultstat[i]=(double) (Pmultstat[i]+1)/(nSamp+1); // adjusted with +1
pj = gsl_matrix_ptr (Pstatj, i, 0);
if ( mmRef->punit == FREESTEP ){
for (j=1; j<nVars; j++){
sid = gsl_permutation_get(sortid[i], j);
sid0 = gsl_permutation_get(sortid[i], j-1);
*(pj+sid)=MAX(*(pj+sid), *(pj+sid0));
}
}
if ( mmRef->punit == STEPUP ){
for (j=2; j<nVars; j++){
sid = gsl_permutation_get(sortid[i], nVars-j);
sid0 = gsl_permutation_get(sortid[i], nVars-j+1);
*(pj+sid) = MIN(*(pj+sid), *(pj+sid0));
}
}
for (j=0; j<nVars; j++)
*(pj+j) = (double)(*(pj+j)+1)/(nSamp+1); // adjusted with +1
}
// free memory
gsl_matrix_free(bX);
gsl_matrix_free(bY);
if (permid!=NULL) free(permid);
return 0;
}
