/*
* Converts a permutation to a vector.
*/
VECTOR_T* MATLAB_NAMESPACE::to_vector(const gsl_permutation* p) {
VECTOR_T* v = VECTOR_ID(alloc)(p->size);
for (int i = 0; i < (int)p->size; i++) {
VECTOR_ID(set)(v, i, (FP_T)gsl_permutation_get(p, i));
}
return v;
}
/*
* Prints a permutation using the given format for each element. This is only
* provided for debugging purposes. In other cases, use
* gsl_permutation_fprintf.
*/
void BCT_NAMESPACE::printf(const gsl_permutation* p, const std::string& format) {
for (int i = 0; i < (int)p->size; i++) {
std::printf(format.c_str(), gsl_permutation_get(p, i));
std::printf(" ");
}
std::printf("\n");
}
static long indexof_confidence_level(long npix, double *P, double level, gsl_permutation *pix_perm)
{
double accum;
long maxpix;
for (accum = 0, maxpix = 0; maxpix < npix && accum <= level; maxpix ++)
accum += P[gsl_permutation_get(pix_perm, maxpix)];
return maxpix;
}
/*
* Permutes the elements of a vector.
*/
VECTOR_T* MATLAB_NAMESPACE::permute(const gsl_permutation* p, const VECTOR_T* v) {
if (p->size != v->size) return NULL;
VECTOR_T* permuted_v = VECTOR_ID(alloc)(v->size);
for (int i = 0; i < (int)p->size; i++) {
int index = gsl_permutation_get(p, i);
FP_T value = VECTOR_ID(get)(v, index);
VECTOR_ID(set)(permuted_v, i, value);
}
return permuted_v;
}
/*
* Permutes the rows of a matrix.
*/
MATRIX_T* MATLAB_NAMESPACE::permute_rows(const gsl_permutation* p, const MATRIX_T* m) {
if (p->size != m->size1) return NULL;
MATRIX_T* permuted_m = MATRIX_ID(alloc)(m->size1, m->size2);
for (int i = 0; i < (int)p->size; i++) {
int i_row = gsl_permutation_get(p, i);
VECTOR_ID(const_view) m_row_i_row = MATRIX_ID(const_row)(m, i_row);
MATRIX_ID(set_row)(permuted_m, i, &m_row_i_row.vector);
}
return permuted_m;
}
/* to array */
static VALUE rb_gsl_permutation_to_a(VALUE obj)
{
gsl_permutation *p = NULL;
size_t i;
VALUE ary;
Data_Get_Struct(obj, gsl_permutation, p);
ary = rb_ary_new2(p->size);
for (i = 0; i < p->size; i++) {
rb_ary_store(ary, i, INT2FIX(gsl_permutation_get(p, i)));
}
return ary;
}
static VALUE rb_gsl_permutation_print(VALUE obj)
{
gsl_permutation *p = NULL;
size_t size, i;
Data_Get_Struct(obj, gsl_permutation, p);
size = p->size;
for (i = 0; i < size; i++) {
printf("%3d ", (int) gsl_permutation_get(p, i));
if ((i+1)%10 == 0) printf("\n");
}
printf("\n");
return obj;
}
/* to vector */
static VALUE rb_gsl_permutation_to_v(VALUE obj)
{
gsl_permutation *p = NULL;
gsl_vector *v;
size_t size;
size_t i;
Data_Get_Struct(obj, gsl_permutation, p);
size = p->size;
v = gsl_vector_alloc(size);
for (i = 0; i < size; i++) {
gsl_vector_set(v, i, gsl_permutation_get(p, i));
}
return Data_Wrap_Struct(cgsl_vector, 0, gsl_vector_free, v);
}
/* Exponentiate and normalize a log probability sky map. */
static void exp_normalize(long npix, double *P, gsl_permutation *pix_perm)
{
long i;
double accum, max_log_p;
/* Find the value of the greatest log probability. */
max_log_p = P[gsl_permutation_get(pix_perm, 0)];
/* Subtract it off. */
for (i = 0; i < npix; i ++)
P[i] -= max_log_p;
/* Exponentiate to convert from log probability to probability. */
for (i = 0; i < npix; i ++)
P[i] = exp(P[i]);
/* Sum entire sky map to find normalization. */
for (accum = 0, i = 0; i < npix; i ++)
accum += P[gsl_permutation_get(pix_perm, i)];
/* Normalize. */
for (i = 0; i < npix; i ++)
P[i] /= accum;
}
static VALUE rb_gsl_permutation_to_s(VALUE obj)
{
gsl_permutation *v = NULL;
char buf[16];
size_t i;
VALUE str;
Data_Get_Struct(obj, gsl_permutation, v);
str = rb_str_new2("[");
for (i = 0; i < v->size; i++) {
sprintf(buf, " %d", (int) gsl_permutation_get(v, i));
rb_str_cat(str, buf, strlen(buf));
}
sprintf(buf, " ]");
rb_str_cat(str, buf, strlen(buf));
return str;
}
void orderMatrix(const gsl_matrix* x, gsl_matrix* y)
{
int n = x->size1;
int m = x->size2;
gsl_vector* x_norms = gsl_vector_alloc(m);
for (int i =0;i<m;i++)
{
gsl_vector_const_view xcol = gsl_matrix_const_column(x,i);
gsl_vector_set(x_norms, i, -norm2(&xcol.vector));
}
gsl_permutation* p = gsl_permutation_alloc(m);
gsl_sort_vector_index(p, x_norms);
for (int i=0; i<n; i++) {
for (int j=0; j<m; j++) {
gsl_matrix_set(y, i, j, gsl_matrix_get(x, i, gsl_permutation_get(p, j)));
}
}
gsl_vector_free(x_norms);
gsl_permutation_free(p);
}
void minima(double *array, int size, double *val, int *pos, int NMax)
{
size_t i=0, j=0, index=0;
gsl_vector *v = gsl_vector_calloc(size);
gsl_permutation *p = gsl_permutation_calloc(size);
for(i=0; i<size; i++)
gsl_vector_set(v, i, array[i]);
gsl_sort_vector_index(p, v);
for(j=0; j<NMax; j++)
{
index = gsl_permutation_get(p, j);
val[j] = array[index];
pos[j] = index;
}
}
static void
compute_rptdx (const gsl_matrix * r, const gsl_permutation * p,
const gsl_vector * dx, gsl_vector * rptdx)
{
size_t i, j, N = dx->size;
for (i = 0; i < N; i++)
{
double sum = 0;
for (j = i; j < N; j++)
{
size_t pj = gsl_permutation_get (p, j);
sum += gsl_matrix_get (r, i, j) * gsl_vector_get (dx, pj);
}
gsl_vector_set (rptdx, i, sum);
}
}
void maxima(double *array, int size, double *val, int *pos, int NMax)
{
INFO_MSG("Searching for func maxima...");
size_t i=0, j=0, index=0;
gsl_vector *v = gsl_vector_calloc(size);
gsl_permutation *p = gsl_permutation_calloc(size);
for(i=0; i<size; i++)
gsl_vector_set(v, i, array[i]);
gsl_sort_vector_index(p, v);
for(j=0; j<NMax; j++)
{
index = gsl_permutation_get(p, size-j-1);
val[j] = array[index];
pos[j] = index;
}
}
static void diagonalize_covariance(void)
{
gsl_vector *vec_dum=gsl_vector_alloc(glob_n_nu);
gsl_matrix *evec_dum=gsl_matrix_alloc(glob_n_nu,glob_n_nu);
gsl_vector *eval_dum=gsl_vector_alloc(glob_n_nu);
eigenvals=gsl_vector_alloc(glob_n_nu);
eigenvecs=gsl_matrix_alloc(glob_n_nu,glob_n_nu);
//Diagonalize
gsl_eigen_symmv_workspace *w=gsl_eigen_symmv_alloc(glob_n_nu);
gsl_eigen_symmv(covariance,eval_dum,evec_dum,w);
gsl_eigen_symmv_free(w);
//Sort eigenvalues
gsl_permutation *p=gsl_permutation_alloc(glob_n_nu);
gsl_sort_vector_index(p,eval_dum);
int ii;
for(ii=0;ii<glob_n_nu;ii++) {
int inew=gsl_permutation_get(p,ii);
gsl_vector_set(eigenvals,ii,gsl_vector_get(eval_dum,inew));
gsl_matrix_get_col(vec_dum,evec_dum,inew);
gsl_matrix_set_col(eigenvecs,ii,vec_dum);
}
gsl_permutation_free(p);
gsl_vector_free(vec_dum);
gsl_vector_free(eval_dum);
gsl_matrix_free(evec_dum);
FILE *fo;
char fname[256];
sprintf(fname,"%s_pca_eigvals.dat",glob_prefix_out);
fo=my_fopen(fname,"w");
for(ii=0;ii<glob_n_nu;ii++) {
double lambda=gsl_vector_get(eigenvals,ii);
fprintf(fo,"%d %lE\n",ii,lambda);
}
fclose(fo);
}
void orderMatrix(const gsl_matrix* x, gsl_matrix* y, const gsl_matrix* M)
{
int n = x->size1;
int m = x->size2;
gsl_matrix* invM = gsl_matrix_alloc(n,n);
gsl_matrix_memcpy(invM,M);
int info=0;
char lower = 'U';
int lda = invM->tda;
dpotrf_(&lower, &n, invM->data, &lda, &info);
dpotri_(&lower, &n, invM->data, &lda, &info);
for (int i=0; i<n; i++) {
for (int j=i+1 ; j<n; j++) {
gsl_matrix_set(invM,i,j,gsl_matrix_get(invM,j,i)) ;
}
}
gsl_vector* x_ell_norms = gsl_vector_alloc(m);
gsl_vector* temp = gsl_vector_alloc(n);
for (int i =0;i<m;i++)
{
gsl_vector_const_view xcol = gsl_matrix_const_column(x,i);
My_dgemv(CblasNoTrans, 1.0, invM, &xcol.vector, 0.0, temp);
gsl_vector_set(x_ell_norms, i, -My_ddot(&xcol.vector, temp));
}
gsl_permutation* p = gsl_permutation_alloc(m);
gsl_sort_vector_index(p, x_ell_norms);
for (int i=0; i<n; i++) {
for (int j=0; j<m; j++) {
gsl_matrix_set(y, i, j, gsl_matrix_get(x, i, gsl_permutation_get(p, j)));
}
}
gsl_vector_free(x_ell_norms);
gsl_vector_free(temp);
gsl_matrix_free(invM);
gsl_permutation_free(p);
}
int
gsl_multifit_covar (const gsl_matrix * J, double epsrel, gsl_matrix * covar)
{
double tolr;
size_t i, j, k;
size_t kmax = 0;
gsl_matrix * r;
gsl_vector * tau;
gsl_vector * norm;
gsl_permutation * perm;
size_t m = J->size1, n = J->size2 ;
if (m < n)
{
GSL_ERROR ("Jacobian be rectangular M x N with M >= N", GSL_EBADLEN);
}
if (covar->size1 != covar->size2 || covar->size1 != n)
{
GSL_ERROR ("covariance matrix must be square and match second dimension of jacobian", GSL_EBADLEN);
}
r = gsl_matrix_alloc (m, n);
tau = gsl_vector_alloc (n);
perm = gsl_permutation_alloc (n) ;
norm = gsl_vector_alloc (n) ;
{
int signum = 0;
gsl_matrix_memcpy (r, J);
gsl_linalg_QRPT_decomp (r, tau, perm, &signum, norm);
}
/* Form the inverse of R in the full upper triangle of R */
tolr = epsrel * fabs(gsl_matrix_get(r, 0, 0));
for (k = 0 ; k < n ; k++)
{
double rkk = gsl_matrix_get(r, k, k);
if (fabs(rkk) <= tolr)
{
break;
}
gsl_matrix_set(r, k, k, 1.0/rkk);
for (j = 0; j < k ; j++)
{
double t = gsl_matrix_get(r, j, k) / rkk;
gsl_matrix_set (r, j, k, 0.0);
for (i = 0; i <= j; i++)
{
double rik = gsl_matrix_get (r, i, k);
double rij = gsl_matrix_get (r, i, j);
gsl_matrix_set (r, i, k, rik - t * rij);
}
}
kmax = k;
}
/* Form the full upper triangle of the inverse of R^T R in the full
upper triangle of R */
for (k = 0; k <= kmax ; k++)
{
for (j = 0; j < k; j++)
{
double rjk = gsl_matrix_get (r, j, k);
for (i = 0; i <= j ; i++)
{
double rij = gsl_matrix_get (r, i, j);
double rik = gsl_matrix_get (r, i, k);
gsl_matrix_set (r, i, j, rij + rjk * rik);
}
}
{
double t = gsl_matrix_get (r, k, k);
for (i = 0; i <= k; i++)
{
double rik = gsl_matrix_get (r, i, k);
gsl_matrix_set (r, i, k, t * rik);
};
}
}
/* Form the full lower triangle of the covariance matrix in the
strict lower triangle of R and in w */
for (j = 0 ; j < n ; j++)
{
size_t pj = gsl_permutation_get (perm, j);
for (i = 0; i <= j; i++)
{
size_t pi = gsl_permutation_get (perm, i);
double rij;
if (j > kmax)
{
gsl_matrix_set (r, i, j, 0.0);
rij = 0.0 ;
}
else
{
rij = gsl_matrix_get (r, i, j);
}
if (pi > pj)
{
gsl_matrix_set (r, pi, pj, rij);
}
else if (pi < pj)
{
gsl_matrix_set (r, pj, pi, rij);
}
}
{
double rjj = gsl_matrix_get (r, j, j);
gsl_matrix_set (covar, pj, pj, rjj);
}
}
/* symmetrize the covariance matrix */
for (j = 0 ; j < n ; j++)
{
for (i = 0; i < j ; i++)
{
double rji = gsl_matrix_get (r, j, i);
gsl_matrix_set (covar, j, i, rji);
gsl_matrix_set (covar, i, j, rji);
}
}
gsl_matrix_free (r);
gsl_permutation_free (perm);
gsl_vector_free (tau);
gsl_vector_free (norm);
return GSL_SUCCESS;
}
bool CEES_Node::Initialize(CStorageHead &storage, const gsl_rng *r)
{
// random permutation of 0, 1, ..., K-1
gsl_permutation *p = gsl_permutation_alloc(K);
gsl_permutation_init(p);
gsl_ran_shuffle(r, p->data, K, sizeof(int));
int binOffset;
if (next_level == NULL)
binOffset = this->BinID(0);
else
binOffset = next_level->BinID(0);
int index=0, bin_id;
while (index <K )
{
bin_id = binOffset+gsl_permutation_get(p, index);
if (storage.DrawSample(bin_id, r, x_current))
{
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
gsl_permutation_free(p);
return true;
}
index ++;
}
gsl_permutation_free(p);
return false;
// Initialize using samples from the next level;
/*if (next_level == NULL)
{
for (int try_id = id; try_id >=0; try_id --)
{
int bin_id = this->BinID(try_id);
if (storage.DrawSample(bin_id, r, x_current))
{
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
return true;
}
}
for (int try_id = id+1; try_id <K; try_id ++)
{
int bin_id = this->BinID(try_id);
if (storage.DrawSample(bin_id, r, x_current))
{
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
return true;
}
}
}
else
{
// Try next levels' bins with the same or lower energies
for (int try_id = id; try_id >= 0; try_id --)
{
int bin_id_next_level = next_level->BinID(try_id);
if (storage.DrawSample(bin_id_next_level, r, x_current))
{
// x_current.weight will remain the same
// x_current.log_prob needs to be updated according to
// current level's H and T
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
return true;
}
}
// If not successful, then try next level's bins with higher energies
for (int try_id = id+1; try_id <K; try_id ++)
{
int bin_id_next_level = next_level->BinID(try_id);
if (storage.DrawSample(bin_id_next_level, r, x_current))
{
// x_current.weight will remain the same
// x_current.log_prob needs to be updated according to
// current level's H and T
x_current.log_prob = -(x_current.GetWeight() > GetEnergy() ? x_current.GetWeight() : GetEnergy())/GetTemperature();
ring_index_current = GetRingIndex(x_current.GetWeight());
UpdateMinMaxEnergy(x_current.GetWeight());
return true;
}
}
}
return false; */
}
void gsl_matrix_hungarian(gsl_matrix* gm_C,gsl_matrix* gm_P,gsl_vector* gv_col_inc, gsl_permutation* gp_sol, int _bprev_init, gsl_matrix *gm_C_denied, bool bgreedy)
{
// mexPrintf("VV\n");
long dim, startdim, enddim, n1,n2;
double *C;
int i,j;
int **m;
double *z;
hungarian_problem_t p, *q;
int matrix_size;
double C_min=gsl_matrix_min(gm_C)-1;
n1 = gm_C->size1; /* first dimension of the cost matrix */
n2 = gm_C->size2; /* second dimension of the cost matrix */
C = gm_C->data;
//greedy solution
if (bgreedy)
{
int ind,ind1,ind2;
size_t *C_ind=new size_t[n1*n2];
gsl_heapsort_index(C_ind,C,n1*n2,sizeof(double),compare_doubles);
bool* bperm_fix_1=new bool[n1]; bool* bperm_fix_2=new bool[n2]; int inummatch=0;
for (i=0;i<n1;i++) {bperm_fix_1[i]=false;bperm_fix_2[i]=false;};
gsl_matrix_set_zero(gm_P);
for (long l=0;l<n1*n2;l++)
{
ind=C_ind[l];
ind1=floor(ind/n1);
ind2=ind%n2;
if (!bperm_fix_1[ind1] and !bperm_fix_2[ind2])
{
bperm_fix_1[ind1]=true; bperm_fix_2[ind2]=true;
gm_P->data[ind]=1;inummatch++;
};
if (inummatch==n1) break;
};
delete[] bperm_fix_1;delete[] bperm_fix_2;
//because C is a transpose matrix
gsl_matrix_transpose(gm_P);
return;
};
double C_max=((gsl_matrix_max(gm_C)-C_min>1)?(gsl_matrix_max(gm_C)-C_min):1)*(n1>n2?n1:n2);
m = (int**)calloc(n1,sizeof(int*));
// mexPrintf("C[2] = %f \n",C[2]);
for (i=0;i<n1;i++)
{
m[i] = (int*)calloc(n2,sizeof(int));
for (j=0;j<n2;j++)
m[i][j] = (int) (C[i+n1*j] - C_min);
// mexPrintf("m[%d][%d] = %f %f\n",i,j,m[i][j],C[i+n1*j] - C_min);
if (gm_C_denied!=NULL)
for (j=0;j<n2;j++){
if (j==30)
int dbg=1;
bool bden=(gm_C_denied->data[n2*i+j]<1e-10);
if (bden) m[i][j] =C_max;
else
int dbg=1;
};
};
//normalization: rows and columns
// mexPrintf("C[2] = %f \n",C[2]);
double dmin;
for (i=0;i<n1;i++)
{
dmin=m[i][0];
for (j=1;j<n2;j++)
dmin= (m[i][j]<dmin)? m[i][j]:dmin;
for (j=0;j<n2;j++)
m[i][j]-=dmin;
};
for (j=0;j<n2;j++)
{
dmin=m[0][j];
for (i=1;i<n1;i++)
dmin= (m[i][j]<dmin)? m[i][j]:dmin;
for (i=0;i<n1;i++)
m[i][j]-=dmin;
};
if ((_bprev_init) &&(gv_col_inc !=NULL))
{
//dual solution v substraction
for (j=0;j<n2;j++)
for (i=0;i<n1;i++)
m[i][j]-=gv_col_inc->data[j];
//permutation of m columns
int *mt = new int[n2];
for (i=0;i<n1;i++)
{
for (j=0;j<n2;j++) mt[j]=m[i][j];
for (j=0;j<n2;j++) m[i][j]=mt[gsl_permutation_get(gp_sol,j)];
};
delete[] mt;
};
/* initialize the hungarian_problem using the cost matrix*/
matrix_size = hungarian_init(&p, m , n1,n2, HUNGARIAN_MODE_MINIMIZE_COST) ;
/* solve the assignement problem */
hungarian_solve(&p);
q = &p;
//gsl_matrix* gm_P=gsl_matrix_alloc(n1,n2);
gsl_permutation* gp_sol_inv=gsl_permutation_alloc(n2);
if (gp_sol!=NULL)
gsl_permutation_inverse(gp_sol_inv,gp_sol);
else
gsl_permutation_init(gp_sol_inv);
for (i=0;i<n1;i++)
for (j=0;j<n2;j++)
gsl_matrix_set(gm_P,i,j,q->assignment[i][gp_sol_inv->data[j]]);
//initialization by the previous solution
if ((_bprev_init) &&(gv_col_inc !=NULL))
for (j=0;j<n2;j++)
gv_col_inc->data[j]=q->col_inc[gp_sol_inv->data[j]];
if ((_bprev_init) && (gp_sol!=NULL))
{
for (i=0;i<n1;i++)
for (j=0;j<n2;j++)
if (gsl_matrix_get(gm_P,i,j)==HUNGARIAN_ASSIGNED)
gp_sol->data[i]=j;
};
/* free used memory */
gsl_permutation_free(gp_sol_inv);
hungarian_free(&p);
for (i=0;i<n1;i++)
free(m[i]);
free(m);
/* for (int i=0;i<gm_C->size1;i++)
{
for (int j=0;j<gm_C->size1;j++)
{
mexPrintf("G[%d][%d] = %f %f \n",i,j,gsl_matrix_get(gm_P,i,j),gsl_matrix_get(gm_C,i,j));
}
}*/
// mexPrintf("AAA");
//return gm_P;
}
int
gsl_linalg_PTLQ_update (gsl_matrix * Q, gsl_matrix * L,
const gsl_permutation * p,
const gsl_vector * v, gsl_vector * w)
{
if (Q->size1 != Q->size2 || L->size1 != L->size2)
{
return GSL_ENOTSQR;
}
else if (L->size1 != Q->size2 || v->size != Q->size2 || w->size != Q->size2)
{
return GSL_EBADLEN;
}
else
{
size_t j, k;
const size_t N = Q->size1;
const size_t M = Q->size2;
double w0;
/* Apply Given's rotations to reduce w to (|w|, 0, 0, ... , 0)
J_1^T .... J_(n-1)^T w = +/- |w| e_1
simultaneously applied to L, H = J_1^T ... J^T_(n-1) L
so that H is upper Hessenberg. (12.5.2) */
for (k = M - 1; k > 0; k--)
{
double c, s;
double wk = gsl_vector_get (w, k);
double wkm1 = gsl_vector_get (w, k - 1);
create_givens (wkm1, wk, &c, &s);
apply_givens_vec (w, k - 1, k, c, s);
apply_givens_lq (M, N, Q, L, k - 1, k, c, s);
}
w0 = gsl_vector_get (w, 0);
/* Add in v w^T (Equation 12.5.3) */
for (j = 0; j < N; j++)
{
double lj0 = gsl_matrix_get (L, j, 0);
size_t p_j = gsl_permutation_get (p, j);
double vj = gsl_vector_get (v, p_j);
gsl_matrix_set (L, j, 0, lj0 + w0 * vj);
}
/* Apply Givens transformations L' = G_(n-1)^T ... G_1^T H
Equation 12.5.4 */
for (k = 1; k < N; k++)
{
double c, s;
double diag = gsl_matrix_get (L, k - 1, k - 1);
double offdiag = gsl_matrix_get (L, k - 1, k );
create_givens (diag, offdiag, &c, &s);
apply_givens_lq (M, N, Q, L, k - 1, k, c, s);
}
return GSL_SUCCESS;
}
}
int infogap( struct opt_data *op )
{
FILE *fl, *outfl;
double *opt_params, of, maxof;
char buf[255], filename[255];
int i, j, k, n, npar, nrow, ncol, *nPreds, col;
gsl_matrix *ig_mat; //! info gap matrix for sorting
gsl_permutation *p;
nPreds = &op->preds->nTObs; // Set pointer to nObs for convenience
if( op->cd->infile[0] == 0 ) { tprintf( "\nInfile must be specified for infogap run\n" ); return( 0 );}
nrow = count_lines( op->cd->infile ); nrow--; // Determine number of parameter sets in file
npar = count_cols( op->cd->infile, 2 ); npar = npar - 2; // Determine number of parameter sets in file
if( npar != op->pd->nOptParam ) { tprintf( "Number of optimization parameters in %s does not match input file\n", op->cd->infile ); return( 0 ); } // Make sure MADS input file and PSSA file agree
tprintf( "\n%s contains %d parameters and %d parameter sets\n", op->cd->infile, npar, nrow );
ncol = npar + *nPreds + 1; // Number of columns for ig_mat = #pars + #preds + #ofs
ig_mat = gsl_matrix_alloc( nrow, ncol );
p = gsl_permutation_alloc( nrow );
fl = fopen( op->cd->infile, "r" );
if( fl == NULL ) { tprintf( "\nError opening %s\n", op->cd->infile ); return( 0 ); }
tprintf( "Computing predictions for %s...", op->cd->infile );
if( ( opt_params = ( double * ) malloc( npar * sizeof( double ) ) ) == NULL )
{ tprintf( "Not enough memory!\n" ); return( 0 ); }
fgets( buf, sizeof buf, fl ); // Skip header
// Fill in ig_mat
for( i = 0; i < nrow; i++ )
{
fscanf( fl, "%d %lf", &n, &of );
gsl_matrix_set( ig_mat, i, *nPreds, of ); // Place of after predictions
for( j = 0; j < npar; j++ )
{
fscanf( fl, "%lf", &opt_params[j] );
col = *nPreds + 1 + j;
gsl_matrix_set( ig_mat, i, col, opt_params[j] ); // Place after of
}
fscanf( fl, " \n" );
func_global( opt_params, op, op->preds->res, NULL );
for( j = 0; j < *nPreds; j++ )
{
gsl_matrix_set( ig_mat, i, j, op->preds->obs_current[j] ); // Place in first columns
}
}
fclose( fl );
for( k = 0; k < *nPreds; k++ )
{
gsl_vector_view column = gsl_matrix_column( ig_mat, k );
gsl_sort_vector_index( p, &column.vector );
// Print out ig_mat with headers
sprintf( filename, "%s-pred%d.igap", op->root, k );
outfl = fopen( filename , "w" );
if( outfl == NULL ) { tprintf( "\nError opening %s\n", filename ); return( 0 ); }
fprintf( outfl, " %-12s", op->preds->obs_id[k] );
fprintf( outfl, " OFmax OF" );
for( i = 0; i < npar; i++ )
fprintf( outfl, " (%-12s)", op->pd->var_name[i] );
fprintf( outfl, "\n" );
maxof = gsl_matrix_get( ig_mat, gsl_permutation_get( p, 0 ), *nPreds );
for( i = 0; i < nrow; i++ )
{
if( maxof < gsl_matrix_get( ig_mat, gsl_permutation_get( p, i ), *nPreds ) )
maxof = gsl_matrix_get( ig_mat, gsl_permutation_get( p, i ), *nPreds );
fprintf( outfl, "%-12g", gsl_matrix_get( ig_mat, gsl_permutation_get( p, i ), k ) );
fprintf( outfl, "%-12g", maxof );
fprintf( outfl, "%-12g", gsl_matrix_get( ig_mat, gsl_permutation_get( p, i ), *nPreds ) );
for( j = *nPreds + 1; j < ncol; j++ )
fprintf( outfl, "%-12g", gsl_matrix_get( ig_mat, gsl_permutation_get( p, i ), j ) );
fprintf( outfl, "\n" );
}
fclose( outfl );
tprintf( "Done\n" );
tprintf( "Results written to %s\n\n", filename );
}
gsl_matrix_free( ig_mat );
return( 1 );
}
static int
qrsolv (gsl_matrix * r, const gsl_permutation * p, const double lambda,
const gsl_vector * diag, const gsl_vector * qtb,
gsl_vector * x, gsl_vector * sdiag, gsl_vector * wa)
{
size_t n = r->size2;
size_t i, j, k, nsing;
/* Copy r and qtb to preserve input and initialise s. In particular,
save the diagonal elements of r in x */
for (j = 0; j < n; j++)
{
double rjj = gsl_matrix_get (r, j, j);
double qtbj = gsl_vector_get (qtb, j);
for (i = j + 1; i < n; i++)
{
double rji = gsl_matrix_get (r, j, i);
gsl_matrix_set (r, i, j, rji);
}
gsl_vector_set (x, j, rjj);
gsl_vector_set (wa, j, qtbj);
}
/* Eliminate the diagonal matrix d using a Givens rotation */
for (j = 0; j < n; j++)
{
double qtbpj;
size_t pj = gsl_permutation_get (p, j);
double diagpj = lambda * gsl_vector_get (diag, pj);
if (diagpj == 0)
{
continue;
}
gsl_vector_set (sdiag, j, diagpj);
for (k = j + 1; k < n; k++)
{
gsl_vector_set (sdiag, k, 0.0);
}
/* The transformations to eliminate the row of d modify only a
single element of qtb beyond the first n, which is initially
zero */
qtbpj = 0;
for (k = j; k < n; k++)
{
/* Determine a Givens rotation which eliminates the
appropriate element in the current row of d */
double sine, cosine;
double wak = gsl_vector_get (wa, k);
double rkk = gsl_matrix_get (r, k, k);
double sdiagk = gsl_vector_get (sdiag, k);
if (sdiagk == 0)
{
continue;
}
if (fabs (rkk) < fabs (sdiagk))
{
double cotangent = rkk / sdiagk;
sine = 0.5 / sqrt (0.25 + 0.25 * cotangent * cotangent);
cosine = sine * cotangent;
}
else
{
double tangent = sdiagk / rkk;
cosine = 0.5 / sqrt (0.25 + 0.25 * tangent * tangent);
sine = cosine * tangent;
}
/* Compute the modified diagonal element of r and the
modified element of [qtb,0] */
{
double new_rkk = cosine * rkk + sine * sdiagk;
double new_wak = cosine * wak + sine * qtbpj;
qtbpj = -sine * wak + cosine * qtbpj;
gsl_matrix_set(r, k, k, new_rkk);
gsl_vector_set(wa, k, new_wak);
}
/* Accumulate the transformation in the row of s */
for (i = k + 1; i < n; i++)
{
double rik = gsl_matrix_get (r, i, k);
double sdiagi = gsl_vector_get (sdiag, i);
double new_rik = cosine * rik + sine * sdiagi;
double new_sdiagi = -sine * rik + cosine * sdiagi;
gsl_matrix_set(r, i, k, new_rik);
gsl_vector_set(sdiag, i, new_sdiagi);
}
}
/* Store the corresponding diagonal element of s and restore the
corresponding diagonal element of r */
{
double rjj = gsl_matrix_get (r, j, j);
double xj = gsl_vector_get(x, j);
gsl_vector_set (sdiag, j, rjj);
gsl_matrix_set (r, j, j, xj);
}
}
/* Solve the triangular system for z. If the system is singular then
obtain a least squares solution */
nsing = n;
for (j = 0; j < n; j++)
{
double sdiagj = gsl_vector_get (sdiag, j);
if (sdiagj == 0)
{
nsing = j;
break;
}
}
for (j = nsing; j < n; j++)
{
gsl_vector_set (wa, j, 0.0);
}
for (k = 0; k < nsing; k++)
{
double sum = 0;
j = (nsing - 1) - k;
for (i = j + 1; i < nsing; i++)
{
sum += gsl_matrix_get(r, i, j) * gsl_vector_get(wa, i);
}
{
double waj = gsl_vector_get (wa, j);
double sdiagj = gsl_vector_get (sdiag, j);
gsl_vector_set (wa, j, (waj - sum) / sdiagj);
}
}
/* Permute the components of z back to the components of x */
for (j = 0; j < n; j++)
{
size_t pj = gsl_permutation_get (p, j);
double waj = gsl_vector_get (wa, j);
gsl_vector_set (x, pj, waj);
}
return GSL_SUCCESS;
}
int CalcRanksForReHo(float *IND, int idx, THD_3dim_dataset *T, int *NTIE,
int TDIM)
{
int m,mm;
int ISTIE = -1;
int LENTIE = 0;
float TIERANK;
int *toP=NULL; // to reset permuts
int *sorted=NULL; // hold sorted time course, assume has been turned into int
int val;
// GSL stuff
gsl_vector *Y = gsl_vector_calloc(TDIM); // will hold time points
gsl_permutation *P = gsl_permutation_calloc(TDIM); // will hold ranks
toP = (int *)calloc(TDIM,sizeof(int));
sorted = (int *)calloc(TDIM,sizeof(int));
if( (toP ==NULL) || (sorted ==NULL) ) {
fprintf(stderr, "\n\n MemAlloc failure.\n\n");
exit(122);
}
// define time series as gsl vector
for( m=0 ; m<TDIM ; m++)
gsl_vector_set(Y,m, THD_get_voxel(T,idx,m));
// perform permutation
val = gsl_sort_vector_index (P,Y);
// apply permut to get sorted array values
for( m=0 ; m<TDIM ; m++) {
sorted[m] = THD_get_voxel(T,idx,
gsl_permutation_get(P,m));
// information of where it was
toP[m]= (int) gsl_permutation_get(P,m);
// default: just convert perm ind to rank ind:
// series of rank vals
IND[gsl_permutation_get(P,m)]=m+1;
}
// ******** start tie rank adjustment *******
// find ties in sorted, record how many per time
// series, and fix in IND
for( m=1 ; m<TDIM ; m++)
if( (sorted[m]==sorted[m-1]) && LENTIE==0 ) {
ISTIE = m-1; //record where it starts
LENTIE = 2;
}
else if( (sorted[m]==sorted[m-1]) && LENTIE>0 ) {
LENTIE+= 1 ;
}
else if( (sorted[m]!=sorted[m-1]) && LENTIE>0 ) {
// end of tie: calc mean index
TIERANK = 1.0*ISTIE; // where tie started
TIERANK+= 0.5*(LENTIE-1); // make average rank
NTIE[idx]+= LENTIE*(LENTIE*LENTIE-1); // record
// record ave permut ind as rank ind
for( mm=0 ; mm<LENTIE ; mm++) {
IND[toP[ISTIE+mm]] = TIERANK+1;
}
ISTIE = -1; // reset, prob unnec
LENTIE = 0; // reset
} // ******* end of tie rank adjustment ***********
// FREE
gsl_vector_free(Y);
gsl_permutation_free(P);
free(toP);
free(sorted);
RETURN(1);
}
double *bayestar_sky_map_toa_snr(
long *npix, /* Input: number of HEALPix pixels. */
double gmst, /* Greenwich mean sidereal time in radians. */
int nifos, /* Input: number of detectors. */
const float (**responses)[3], /* Pointers to detector responses. */
const double **locations, /* Pointers to locations of detectors in Cartesian geographic coordinates. */
const double *toas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */
const double *snrs, /* Input: array of SNRs. */
const double *w_toas, /* Input: sum-of-squares weights, (1/TOA variance)^2. */
const double *horizons, /* Distances at which a source would produce an SNR of 1 in each detector. */
double min_distance,
double max_distance,
int prior_distance_power) /* Use a prior of (distance)^(prior_distance_power) */
{
long nside;
long maxpix;
long i;
double d1[nifos];
double *P;
gsl_permutation *pix_perm;
/* Hold GSL return values for any thread that fails. */
int gsl_errno = GSL_SUCCESS;
/* Storage for old GSL error handler. */
gsl_error_handler_t *old_handler;
/* Maximum number of subdivisions for adaptive integration. */
static const size_t subdivision_limit = 64;
/* Subdivide radial integral where likelihood is this fraction of the maximum,
* will be used in solving the quadratic to find the breakpoints */
static const double eta = 0.01;
/* Use this many integration steps in 2*psi */
static const int ntwopsi = 16;
/* Number of integration steps in cos(inclination) */
static const int nu = 16;
/* Rescale distances so that furthest horizon distance is 1. */
{
double d1max;
memcpy(d1, horizons, sizeof(d1));
for (d1max = d1[0], i = 1; i < nifos; i ++)
if (d1[i] > d1max)
d1max = d1[i];
for (i = 0; i < nifos; i ++)
d1[i] /= d1max;
min_distance /= d1max;
max_distance /= d1max;
}
/* Evaluate posterior term only first. */
P = bayestar_sky_map_toa_adapt_resolution(&pix_perm, &maxpix, npix, gmst, nifos, locations, toas, w_toas, autoresolution_count_pix_toa_snr);
if (!P)
return NULL;
/* Determine the lateral HEALPix resolution. */
nside = npix2nside(*npix);
/* Zero pixels that didn't meet the TDOA cut. */
for (i = 0; i < maxpix; i ++)
{
long ipix = gsl_permutation_get(pix_perm, i);
P[ipix] = log(P[ipix]);
}
for (; i < *npix; i ++)
{
long ipix = gsl_permutation_get(pix_perm, i);
P[ipix] = -INFINITY;
}
/* Use our own error handler while in parallel section to avoid concurrent
* calls to the GSL error handler, which if provided by the user may not
* be threadsafe. */
old_handler = gsl_set_error_handler(my_gsl_error);
/* Compute posterior factor for amplitude consistency. */
#pragma omp parallel for firstprivate(gsl_errno) lastprivate(gsl_errno)
for (i = 0; i < maxpix; i ++)
{
/* Cancel further computation if a GSL error condition has occurred.
*
* Note: if one thread sets gsl_errno, not necessarily all thread will
* get the updated value. That's OK, because most failure modes will
* cause GSL error conditions on all threads. If we cared to have any
* failure on any thread terminate all of the other threads as quickly
* as possible, then we would want to insert the following pragma here:
*
* #pragma omp flush(gsl_errno)
*
* and likewise before any point where we set gsl_errno.
*/
if (gsl_errno != GSL_SUCCESS)
goto skip;
{
long ipix = gsl_permutation_get(pix_perm, i);
double F[nifos][2];
double theta, phi;
int itwopsi, iu, iifo;
double accum = -INFINITY;
/* Prepare workspace for adaptive integrator. */
gsl_integration_workspace *workspace = gsl_integration_workspace_alloc(subdivision_limit);
/* If the workspace could not be allocated, then record the GSL
* error value for later reporting when we leave the parallel
* section. Then, skip to the next loop iteration. */
if (!workspace)
{
gsl_errno = GSL_ENOMEM;
goto skip;
}
/* Look up polar coordinates of this pixel */
pix2ang_ring(nside, ipix, &theta, &phi);
/* Look up antenna factors */
for (iifo = 0; iifo < nifos; iifo ++)
{
XLALComputeDetAMResponse(&F[iifo][0], &F[iifo][1], responses[iifo], phi, M_PI_2 - theta, 0, gmst);
F[iifo][0] *= d1[iifo];
F[iifo][1] *= d1[iifo];
}
/* Integrate over 2*psi */
for (itwopsi = 0; itwopsi < ntwopsi; itwopsi++)
{
const double twopsi = (2 * M_PI / ntwopsi) * itwopsi;
const double costwopsi = cos(twopsi);
const double sintwopsi = sin(twopsi);
/* Integrate over u; since integrand only depends on u^2 we only
* have to go from u=0 to u=1. We want to include u=1, so the upper
* limit has to be <= */
for (iu = 0; iu <= nu; iu++)
{
const double u = (double)iu / nu;
const double u2 = gsl_pow_2(u);
const double u4 = gsl_pow_2(u2);
double A = 0, B = 0;
double breakpoints[5];
int num_breakpoints = 0;
double log_offset = -INFINITY;
/* The log-likelihood is quadratic in the estimated and true
* values of the SNR, and in 1/r. It is of the form A/r^2 + B/r,
* where A depends only on the true values of the SNR and is
* strictly negative and B depends on both the true values and
* the estimates and is strictly positive.
*
* The middle breakpoint is at the maximum of the log-likelihood,
* occurring at 1/r=-B/2A. The lower and upper breakpoints occur
* when the likelihood becomes eta times its maximum value. This
* occurs when
*
* A/r^2 + B/r = log(eta) - B^2/4A.
*
*/
/* Loop over detectors */
for (iifo = 0; iifo < nifos; iifo++)
{
const double Fp = F[iifo][0]; /* `plus' antenna factor times r */
const double Fx = F[iifo][1]; /* `cross' antenna factor times r */
const double FpFx = Fp * Fx;
const double FpFp = gsl_pow_2(Fp);
const double FxFx = gsl_pow_2(Fx);
const double rhotimesr2 = 0.125 * ((FpFp + FxFx) * (1 + 6*u2 + u4) - gsl_pow_2(1 - u2) * ((FpFp - FxFx) * costwopsi + 2 * FpFx * sintwopsi));
const double rhotimesr = sqrt(rhotimesr2);
/* FIXME: due to roundoff, rhotimesr2 can be very small and
* negative rather than simply zero. If this happens, don't
accumulate the log-likelihood terms for this detector. */
if (rhotimesr2 > 0)
{
A += rhotimesr2;
B += rhotimesr * snrs[iifo];
}
}
A *= -0.5;
{
const double middle_breakpoint = -2 * A / B;
const double lower_breakpoint = 1 / (1 / middle_breakpoint + sqrt(log(eta) / A));
const double upper_breakpoint = 1 / (1 / middle_breakpoint - sqrt(log(eta) / A));
breakpoints[num_breakpoints++] = min_distance;
if(lower_breakpoint > breakpoints[num_breakpoints-1] && lower_breakpoint < max_distance)
breakpoints[num_breakpoints++] = lower_breakpoint;
if(middle_breakpoint > breakpoints[num_breakpoints-1] && middle_breakpoint < max_distance)
breakpoints[num_breakpoints++] = middle_breakpoint;
if(upper_breakpoint > breakpoints[num_breakpoints-1] && upper_breakpoint < max_distance)
breakpoints[num_breakpoints++] = upper_breakpoint;
breakpoints[num_breakpoints++] = max_distance;
}
{
/*
* Set log_offset to the maximum of the logarithm of the
* radial integrand evaluated at all of the breakpoints. */
int ibreakpoint;
for (ibreakpoint = 0; ibreakpoint < num_breakpoints; ibreakpoint++)
{
const double new_log_offset = log_radial_integrand(
breakpoints[ibreakpoint], A, B, prior_distance_power);
if (new_log_offset < INFINITY && new_log_offset > log_offset)
log_offset = new_log_offset;
}
}
{
/* Perform adaptive integration. Stop when a relative
* accuracy of 0.05 has been reached. */
inner_integrand_params integrand_params = {A, B, log_offset, prior_distance_power};
const gsl_function func = {radial_integrand, &integrand_params};
double result, abserr;
int ret = gsl_integration_qagp(&func, &breakpoints[0], num_breakpoints, DBL_MIN, 0.05, subdivision_limit, workspace, &result, &abserr);
/* If the integrator failed, then record the GSL error
* value for later reporting when we leave the parallel
* section. Then, break out of the loop. */
if (ret != GSL_SUCCESS)
{
gsl_errno = ret;
gsl_integration_workspace_free(workspace);
goto skip;
}
/* Take the logarithm and put the log-normalization back in. */
result = log(result) + integrand_params.log_offset;
/* Accumulate result. */
accum = logaddexp(accum, result);
}
}
}
/* Discard workspace for adaptive integrator. */
gsl_integration_workspace_free(workspace);
/* Accumulate (log) posterior terms for SNR and TDOA. */
P[ipix] += accum;
}
skip: /* this statement intentionally left blank */;
}
/* Restore old error handler. */
gsl_set_error_handler(old_handler);
/* Free permutation. */
gsl_permutation_free(pix_perm);
/* Check if there was an error in any thread evaluating any pixel. If there
* was, raise the error and return. */
if (gsl_errno != GSL_SUCCESS)
{
free(P);
GSL_ERROR_NULL(gsl_strerror(gsl_errno), gsl_errno);
}
/* Exponentiate and normalize posterior. */
pix_perm = get_pixel_ranks(*npix, P);
if (!pix_perm)
{
free(P);
return NULL;
}
exp_normalize(*npix, P, pix_perm);
gsl_permutation_free(pix_perm);
return P;
}
int main(int argc, char **argv) {
const int MAX_ITER = 20;
const double TOL = 1e-12;
int rank;
int size;
int P = 8; // number of blocks to update P <= size
/* -----------------------------------
mode controls the selection schemes,
mode =0, fixed P
mode =1, dynamic update P
----------------------------------*/
int mode=1; // number of processors used to update each time
double lambda = 0.1;
srand (time(NULL));
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &rank); // Determine current running process
MPI_Comm_size(MPI_COMM_WORLD, &size); // Total number of processes
// data directory (you need to change the path to your own data directory)
char* dataCenterDir = "../Data/Gaussian";
char* big_dir;
if(argc==2)
big_dir = argv[1];
else
big_dir = "big1";
/* Read in local data */
FILE *f, *test;
int m, n, j;
int row, col;
double entry, startTime, endTime;
double total_start_time, total_end_time;
/*
* Subsystem n will look for files called An.dat and bn.dat
* in the current directory; these are its local data and do not need to be
* visible to any other processes. Note that
* m and n here refer to the dimensions of the *local* coefficient matrix.
*/
/* ------------
Read in A
------------*/
if(rank ==0){
printf("=============================\n");
printf("| Start to load data! |\n");
printf("=============================\n");
}
char s[100];
sprintf(s, "%s/%s/A%d.dat",dataCenterDir,big_dir, rank + 1);
printf("[%d] reading %s\n", rank, s);
f = fopen(s, "r");
if (f == NULL) {
printf("[%d] ERROR: %s does not exist, exiting.\n", rank, s);
exit(EXIT_FAILURE);
}
mm_read_mtx_array_size(f, &m, &n);
gsl_matrix *A = gsl_matrix_calloc(m, n);
for (int i = 0; i < m*n; i++) {
row = i % m;
col = floor(i/m);
fscanf(f, "%lf", &entry);
gsl_matrix_set(A, row, col, entry);
}
fclose(f);
/* ------------
Read in b
-------------*/
sprintf(s, "%s/%s/b.dat", dataCenterDir, big_dir);
printf("[%d] reading %s\n", rank, s);
f = fopen(s, "r");
if (f == NULL) {
printf("[%d] ERROR: %s does not exist, exiting.\n", rank, s);
exit(EXIT_FAILURE);
}
mm_read_mtx_array_size(f, &m, &n);
gsl_vector *b = gsl_vector_calloc(m);
for (int i = 0; i < m; i++) {
fscanf(f, "%lf", &entry);
gsl_vector_set(b, i, entry);
}
fclose(f);
/* ------------
Read in xs
------------*/
sprintf(s, "%s/%s/xs%d.dat", dataCenterDir, big_dir, rank + 1);
printf("[%d] reading %s\n", rank, s);
f = fopen(s, "r");
if (f == NULL) {
printf("[%d] ERROR: %s does not exist, exiting.\n", rank, s);
exit(EXIT_FAILURE);
}
mm_read_mtx_array_size(f, &m, &n);
gsl_vector *xs = gsl_vector_calloc(m);
for (int i = 0; i < m; i++) {
fscanf(f, "%lf", &entry);
gsl_vector_set(xs, i, entry);
}
fclose(f);
m = A->size1;
n = A->size2;
MPI_Barrier(MPI_COMM_WORLD);
/*----------------------------------------
* These are all variables related to GRock
----------------------------------------*/
struct value table[size];
gsl_vector *x = gsl_vector_calloc(n);
gsl_vector *As = gsl_vector_calloc(n);
gsl_vector *invAs = gsl_vector_calloc(n);
gsl_vector *local_b = gsl_vector_calloc(m);
gsl_vector *beta = gsl_vector_calloc(n);
gsl_vector *tmp = gsl_vector_calloc(n);
gsl_vector *d = gsl_vector_calloc(n);
gsl_vector *absd = gsl_vector_calloc(n);
gsl_vector *oldx = gsl_vector_calloc(n);
gsl_vector *tmpx = gsl_vector_calloc(n);
gsl_vector *z = gsl_vector_calloc(m);
gsl_vector *tmpz = gsl_vector_calloc(m);
gsl_vector *Ax = gsl_vector_calloc(m);
gsl_vector *Atmpx = gsl_vector_calloc(m);
gsl_vector *xdiff = gsl_vector_calloc(n);
gsl_permutation *idx = gsl_permutation_calloc(n);
double send[1];
double recv[1];
double err;
int num_upd = (int)(n*0.08);
double sigma = 0.01;
double xs_local_nrm[1], xs_nrm[1];
double local_old_obj, global_old_obj, local_new_obj, global_new_obj;
//calculate the 2 norm of xs
xs_local_nrm[0] = gsl_blas_dnrm2(xs);
xs_local_nrm[0] *=xs_local_nrm[0];
MPI_Allreduce(xs_local_nrm, xs_nrm, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
xs_nrm[0] = sqrt(xs_nrm[0]);
// evaluate the two norm of the columns of A
for(j=0;j<n;j++){
gsl_vector_view column = gsl_matrix_column(A, j);
double d;
d = gsl_blas_dnrm2(&column.vector);
gsl_vector_set(As, j, d*d);
gsl_vector_set(invAs, j, 1./(d*d));
}
if (rank == 0) {
printf("=============================\n");
printf("|GRock start to solve Lasso!|\n");
printf("|---------------------------|\n");
printf("|lambda=%1.2f, m=%d, n=%d |\n", lambda, m, n*size);
if(mode==1) printf("| Mode: dynamic update P. |\n");
else printf("| Mode: fixed update P |\n");
printf("=============================\n");
printf("%3s %8s %8s %5s\n", "iter", "rel_err", "obj", "P");
startTime = MPI_Wtime();
sprintf(s, "results/test%d.m", size);
test = fopen(s, "w");
fprintf(test,"res = [ \n");
}
/* Main BCD loop */
total_start_time = MPI_Wtime();
int iter = 0;
while (iter < MAX_ITER) {
startTime = MPI_Wtime();
/*---------- restore the old x ------------*/
gsl_vector_memcpy(oldx, x);
/*------- calculate local_b = b - sum_{j \neq i} Aj*xj--------- */
gsl_blas_dgemv(CblasNoTrans, 1, A, x, 0, Ax); // Ax = A * x
MPI_Allreduce(Ax->data, z->data, m, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_vector_sub(z, b); // z = Ax - b
gsl_vector_memcpy(local_b, Ax);
gsl_vector_sub(local_b, z);
/* -------calculate beta ------------------*/
gsl_blas_dgemv(CblasTrans, -1, A, z, 0, beta); // beta = A'(b - Ax) + ||A.s||^2 * xs
gsl_vector_memcpy(tmp, As);
pointwise(tmp, x, n);
gsl_vector_add(beta, tmp);
shrink(beta, lambda);
// x = 1/|xs|^2 * shrink(beta, lambda)
gsl_vector_memcpy(x, beta);
pointwise(x, invAs, n);
/* ------calcuate proposed decrease -------- */
gsl_vector_memcpy(d,x);
gsl_vector_sub(d, oldx);
if(mode ==1){
gsl_vector_memcpy(absd, d);
abs_vector(absd, n);
// sort the local array d
gsl_vector_scale(absd, -1.0);
gsl_sort_vector_index(idx, absd);
// printf("|d(0)| = %lf, |d(1)| = %lf \n", gsl_vector_get(absd,0), gsl_vector_get(absd, 3));
// calculate current objective value;
local_old_obj = objective(oldx, lambda, z, size);
MPI_Allreduce(&local_old_obj, &global_old_obj, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
num_upd = fmin(num_upd+1, (int)(0.1*n));
gsl_vector_memcpy(tmpx, oldx);
int upd_idx;
double local_delta = 0, delta=0.0;
for(int i=0; i<num_upd; i++){
upd_idx = gsl_permutation_get(idx, i);
// printf("%d\n", upd_idx);
gsl_vector_set(tmpx, upd_idx, gsl_vector_get(x, upd_idx));
local_delta += gsl_vector_get(d, upd_idx) * gsl_vector_get(d, upd_idx);
}
MPI_Allreduce(&local_delta, &delta, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_blas_dgemv(CblasNoTrans, 1, A, tmpx, 0, Atmpx); // Ax = A * x
MPI_Allreduce(Atmpx->data, tmpz->data, m, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_vector_sub(tmpz, b); // z = Ax - b
local_new_obj = objective(tmpx, lambda, tmpz, size);
MPI_Allreduce(&local_new_obj, &global_new_obj, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
while(global_new_obj - global_old_obj> -sigma * delta){
num_upd = fmax(num_upd-1, 1);
for(int i=0; i<num_upd; i++){
upd_idx = gsl_permutation_get(idx, i);
gsl_vector_set(tmpx, upd_idx, gsl_vector_get(x, upd_idx));
local_delta += gsl_vector_get(d, upd_idx) * gsl_vector_get(d, upd_idx);
}
MPI_Allreduce(&delta, &local_delta, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_blas_dgemv(CblasNoTrans, 1, A, tmpx, 0, Atmpx); // Ax = A * x
MPI_Allreduce(Atmpx->data, tmpz->data, m, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
gsl_vector_sub(tmpz, b); // z = Ax - b
local_new_obj = objective(tmpx, lambda, tmpz, size);
MPI_Allreduce(&local_new_obj, &global_new_obj, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
if(num_upd==1)
break;
}
gsl_vector_memcpy(x, tmpx);
}
if(mode==0){
CBLAS_INDEX_t id = gsl_blas_idamax(d);
double *store = (double*)calloc(size, sizeof(double));
double foo[1];
foo[0] = gsl_vector_get(d,id);
MPI_Allgather(foo, 1, MPI_DOUBLE, store, 1, MPI_DOUBLE, MPI_COMM_WORLD);
for(int i=0;i<size;i++){
table[i].ID = i;
table[i].data = fabs(store[i]);
}
// quick sort to decide which block to update
qsort((void *) & table, size, sizeof(struct value), (compfn)compare );
gsl_vector_memcpy(x, oldx);
if(size>P){
for(int i=0;i<P;i++){
if(rank == table[i].ID)
gsl_vector_set(x, id, gsl_vector_get(oldx, id) + gsl_vector_get(d, id));
}
}else
gsl_vector_set(x, id, gsl_vector_get(oldx, id) + gsl_vector_get(d, id));
local_new_obj = objective(x, lambda, z, size);
MPI_Allreduce(&local_new_obj, &global_new_obj, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
}
/*------------------------------
calculate the relative error
------------------------------*/
gsl_vector_memcpy(xdiff,xs);
gsl_vector_sub(xdiff, x);
err = gsl_blas_dnrm2(xdiff);
send[0] = err*err;
MPI_Allreduce(send, recv, 1, MPI_DOUBLE, MPI_SUM, MPI_COMM_WORLD);
recv[0] = sqrt(recv[0])/xs_nrm[0];
endTime = MPI_Wtime();
if(mode==1) P = num_upd*size;
if (rank == 0) {
if(iter%5 == 0)
printf("%3d %10.2e %10.4f %3d\n", iter,
recv[0], global_new_obj, P);
fprintf(test, "%e \n",recv[0]);
}
/* termination check */
if(recv[0] < TOL){
break;
}
iter++;
}
total_end_time = MPI_Wtime();
/* Have the master write out the results to disk */
if (rank == 0) {
printf("=============================\n");
printf("| GRock solved Lasso! |\n");
printf("|---------------------------|\n");
printf("|Summary: |\n");
printf("| # of iteration: %d |\n", iter);
printf("| relative error: %4.2e|\n", recv[0]);
printf("| objective value: %4.2f |\n", global_new_obj);
printf("| time: %4.1es|\n", total_end_time - total_start_time);
printf("=============================\n");
fprintf(test,"] \n");
fprintf(test,"semilogy(1:length(res),res); \n");
fprintf(test,"xlabel('# of iteration'); ylabel('||x - xs||');\n");
fclose(test);
f = fopen("results/solution.dat", "w");
fprintf(f,"x = [ \n");
gsl_vector_fprintf(f, x, "%lf");
fprintf(f,"] \n");
fclose(f);
endTime = MPI_Wtime();
}
MPI_Finalize(); /* Shut down the MPI execution environment */
/* Clear memory */
gsl_matrix_free(A);
gsl_vector_free(b);
gsl_vector_free(x);
gsl_vector_free(z);
gsl_vector_free(xdiff);
gsl_vector_free(Ax);
gsl_vector_free(As);
gsl_vector_free(invAs);
gsl_vector_free(tmpx);
gsl_vector_free(oldx);
gsl_vector_free(local_b);
gsl_vector_free(beta);
gsl_vector_free(tmpz);
gsl_vector_free(absd);
gsl_vector_free(Atmpx);
gsl_permutation_free(idx);
return 0;
}
double *bayestar_sky_map_toa_phoa_snr(
long *npix, /* Input: number of HEALPix pixels. */
double gmst, /* Greenwich mean sidereal time in radians. */
int nifos, /* Input: number of detectors. */
const float (**responses)[3], /* Pointers to detector responses. */
const double **locations, /* Pointers to locations of detectors in Cartesian geographic coordinates. */
const double *toas, /* Input: array of times of arrival with arbitrary relative offset. (Make toas[0] == 0.) */
const double *phoas, /* Input: array of phases of arrival with arbitrary relative offset. (Make phoas[0] == 0.) */
const double *snrs, /* Input: array of SNRs. */
const double *w_toas, /* Input: sum-of-squares weights, (1/TOA variance)^2. */
const double *w1s, /* Input: first moments of angular frequency. */
const double *w2s, /* Input: second moments of angular frequency. */
const double *horizons, /* Distances at which a source would produce an SNR of 1 in each detector. */
double min_distance,
double max_distance,
int prior_distance_power) /* Use a prior of (distance)^(prior_distance_power) */
{
long nside;
long maxpix;
long i;
double d1[nifos];
double *P;
gsl_permutation *pix_perm;
double complex exp_i_phoas[nifos];
/* Hold GSL return values for any thread that fails. */
int gsl_errno = GSL_SUCCESS;
/* Storage for old GSL error handler. */
gsl_error_handler_t *old_handler;
/* Maximum number of subdivisions for adaptive integration. */
static const size_t subdivision_limit = 64;
/* Subdivide radial integral where likelihood is this fraction of the maximum,
* will be used in solving the quadratic to find the breakpoints */
static const double eta = 0.01;
/* Use this many integration steps in 2*psi */
static const int ntwopsi = 16;
/* Number of integration steps in cos(inclination) */
static const int nu = 16;
/* Number of integration steps in arrival time */
static const int nt = 16;
/* Rescale distances so that furthest horizon distance is 1. */
{
double d1max;
memcpy(d1, horizons, sizeof(d1));
for (d1max = d1[0], i = 1; i < nifos; i ++)
if (d1[i] > d1max)
d1max = d1[i];
for (i = 0; i < nifos; i ++)
d1[i] /= d1max;
min_distance /= d1max;
max_distance /= d1max;
}
(void)w2s; /* FIXME: remove unused parameter */
for (i = 0; i < nifos; i ++)
exp_i_phoas[i] = exp_i(phoas[i]);
/* Evaluate posterior term only first. */
P = bayestar_sky_map_toa_adapt_resolution(&pix_perm, &maxpix, npix, gmst, nifos, locations, toas, w_toas, autoresolution_count_pix_toa_phoa_snr);
if (!P)
return NULL;
/* Determine the lateral HEALPix resolution. */
nside = npix2nside(*npix);
/* Zero all pixels that didn't meet the TDOA cut. */
for (i = maxpix; i < *npix; i ++)
{
long ipix = gsl_permutation_get(pix_perm, i);
P[ipix] = -INFINITY;
}
/* Use our own error handler while in parallel section to avoid concurrent
* calls to the GSL error handler, which if provided by the user may not
* be threadsafe. */
old_handler = gsl_set_error_handler(my_gsl_error);
/* Compute posterior factor for amplitude consistency. */
#pragma omp parallel for firstprivate(gsl_errno) lastprivate(gsl_errno)
for (i = 0; i < maxpix; i ++)
{
/* Cancel further computation if a GSL error condition has occurred.
*
* Note: if one thread sets gsl_errno, not necessarily all thread will
* get the updated value. That's OK, because most failure modes will
* cause GSL error conditions on all threads. If we cared to have any
* failure on any thread terminate all of the other threads as quickly
* as possible, then we would want to insert the following pragma here:
*
* #pragma omp flush(gsl_errno)
*
* and likewise before any point where we set gsl_errno.
*/
if (gsl_errno != GSL_SUCCESS)
goto skip;
{
long ipix = gsl_permutation_get(pix_perm, i);
double complex F[nifos];
double theta, phi;
int itwopsi, iu, it, iifo;
double accum = -INFINITY;
double complex exp_i_toaphoa[nifos];
double dtau[nifos], mean_dtau;
/* Prepare workspace for adaptive integrator. */
gsl_integration_workspace *workspace = gsl_integration_workspace_alloc(subdivision_limit);
/* If the workspace could not be allocated, then record the GSL
* error value for later reporting when we leave the parallel
* section. Then, skip to the next loop iteration. */
if (!workspace)
{
gsl_errno = GSL_ENOMEM;
goto skip;
}
/* Look up polar coordinates of this pixel */
pix2ang_ring(nside, ipix, &theta, &phi);
toa_errors(dtau, theta, phi, gmst, nifos, locations, toas);
for (iifo = 0; iifo < nifos; iifo ++)
exp_i_toaphoa[iifo] = exp_i_phoas[iifo] * exp_i(w1s[iifo] * dtau[iifo]);
/* Find mean arrival time error */
mean_dtau = gsl_stats_wmean(w_toas, 1, dtau, 1, nifos);
/* Look up antenna factors */
for (iifo = 0; iifo < nifos; iifo++)
{
XLALComputeDetAMResponse(
(double *)&F[iifo], /* Type-punned real part */
1 + (double *)&F[iifo], /* Type-punned imag part */
responses[iifo], phi, M_PI_2 - theta, 0, gmst);
F[iifo] *= d1[iifo];
}
/* Integrate over 2*psi */
for (itwopsi = 0; itwopsi < ntwopsi; itwopsi++)
{
const double twopsi = (2 * M_PI / ntwopsi) * itwopsi;
const double complex exp_i_twopsi = exp_i(twopsi);
/* Integrate over u from u=-1 to u=1. */
for (iu = -nu; iu <= nu; iu++)
{
const double u = (double)iu / nu;
const double u2 = gsl_pow_2(u);
double A = 0, B = 0;
double breakpoints[5];
int num_breakpoints = 0;
double log_offset = -INFINITY;
/* The log-likelihood is quadratic in the estimated and true
* values of the SNR, and in 1/r. It is of the form A/r^2 + B/r,
* where A depends only on the true values of the SNR and is
* strictly negative and B depends on both the true values and
* the estimates and is strictly positive.
*
* The middle breakpoint is at the maximum of the log-likelihood,
* occurring at 1/r=-B/2A. The lower and upper breakpoints occur
* when the likelihood becomes eta times its maximum value. This
* occurs when
*
* A/r^2 + B/r = log(eta) - B^2/4A.
*
*/
/* Perform arrival time integral */
double accum1 = -INFINITY;
for (it = -nt/2; it <= nt/2; it++)
{
const double t = mean_dtau + LAL_REARTH_SI / LAL_C_SI * it / nt;
double complex i0arg_complex = 0;
for (iifo = 0; iifo < nifos; iifo++)
{
const double complex tmp = F[iifo] * exp_i_twopsi;
/* FIXME: could use - sign here to avoid conj below, but
* this probably just sets our sign convention relative to
* detection pipeline */
double complex phase_rhotimesr = 0.5 * (1 + u2) * creal(tmp) + I * u * cimag(tmp);
const double abs_rhotimesr_2 = cabs2(phase_rhotimesr);
const double abs_rhotimesr = sqrt(abs_rhotimesr_2);
phase_rhotimesr /= abs_rhotimesr;
i0arg_complex += exp_i_toaphoa[iifo] * exp_i(-w1s[iifo] * t) * phase_rhotimesr * gsl_pow_2(snrs[iifo]);
}
const double i0arg = cabs(i0arg_complex);
accum1 = logaddexp(accum1, log(gsl_sf_bessel_I0_scaled(i0arg)) + i0arg - 0.5 * gsl_stats_wtss_m(w_toas, 1, dtau, 1, nifos, t));
}
/* Loop over detectors */
for (iifo = 0; iifo < nifos; iifo++)
{
const double complex tmp = F[iifo] * exp_i_twopsi;
/* FIXME: could use - sign here to avoid conj below, but
* this probably just sets our sign convention relative to
* detection pipeline */
double complex phase_rhotimesr = 0.5 * (1 + u2) * creal(tmp) + I * u * cimag(tmp);
const double abs_rhotimesr_2 = cabs2(phase_rhotimesr);
const double abs_rhotimesr = sqrt(abs_rhotimesr_2);
A += abs_rhotimesr_2;
B += abs_rhotimesr * snrs[iifo];
}
A *= -0.5;
{
const double middle_breakpoint = -2 * A / B;
const double lower_breakpoint = 1 / (1 / middle_breakpoint + sqrt(log(eta) / A));
const double upper_breakpoint = 1 / (1 / middle_breakpoint - sqrt(log(eta) / A));
breakpoints[num_breakpoints++] = min_distance;
if(lower_breakpoint > breakpoints[num_breakpoints-1] && lower_breakpoint < max_distance)
breakpoints[num_breakpoints++] = lower_breakpoint;
if(middle_breakpoint > breakpoints[num_breakpoints-1] && middle_breakpoint < max_distance)
breakpoints[num_breakpoints++] = middle_breakpoint;
if(upper_breakpoint > breakpoints[num_breakpoints-1] && upper_breakpoint < max_distance)
breakpoints[num_breakpoints++] = upper_breakpoint;
breakpoints[num_breakpoints++] = max_distance;
}
{
/*
* Set log_offset to the maximum of the logarithm of the
* radial integrand evaluated at all of the breakpoints. */
int ibreakpoint;
for (ibreakpoint = 0; ibreakpoint < num_breakpoints; ibreakpoint++)
{
const double new_log_offset = log_radial_integrand(
breakpoints[ibreakpoint], A, B, prior_distance_power);
if (new_log_offset < INFINITY && new_log_offset > log_offset)
log_offset = new_log_offset;
}
}
{
/* Perform adaptive integration. Stop when a relative
* accuracy of 0.05 has been reached. */
inner_integrand_params integrand_params = {A, B, log_offset, prior_distance_power};
const gsl_function func = {radial_integrand, &integrand_params};
double result, abserr;
int ret = gsl_integration_qagp(&func, &breakpoints[0], num_breakpoints, DBL_MIN, 0.05, subdivision_limit, workspace, &result, &abserr);
/* If the integrator failed, then record the GSL error
* value for later reporting when we leave the parallel
* section. Then, break out of the loop. */
if (ret != GSL_SUCCESS)
{
gsl_errno = ret;
gsl_integration_workspace_free(workspace);
goto skip;
}
/* Take the logarithm and put the log-normalization back in. */
result = log(result) + integrand_params.log_offset + accum1;
/* Accumulate result. */
accum = logaddexp(accum, result);
}
}
}
/* Discard workspace for adaptive integrator. */
gsl_integration_workspace_free(workspace);
/* Store log posterior. */
P[ipix] = accum;
}
skip: /* this statement intentionally left blank */;
}
/* Restore old error handler. */
gsl_set_error_handler(old_handler);
/* Free permutation. */
gsl_permutation_free(pix_perm);
/* Check if there was an error in any thread evaluating any pixel. If there
* was, raise the error and return. */
if (gsl_errno != GSL_SUCCESS)
{
free(P);
GSL_ERROR_NULL(gsl_strerror(gsl_errno), gsl_errno);
}
/* Exponentiate and normalize posterior. */
pix_perm = get_pixel_ranks(*npix, P);
if (!pix_perm)
{
free(P);
return NULL;
}
exp_normalize(*npix, P, pix_perm);
gsl_permutation_free(pix_perm);
return P;
}
int
gsl_linalg_QRPT_update (gsl_matrix * Q, gsl_matrix * R,
const gsl_permutation * p,
gsl_vector * w, const gsl_vector * v)
{
const size_t M = R->size1;
const size_t N = R->size2;
if (Q->size1 != M || Q->size2 != M)
{
GSL_ERROR ("Q matrix must be M x M if R is M x N", GSL_ENOTSQR);
}
else if (w->size != M)
{
GSL_ERROR ("w must be length M if R is M x N", GSL_EBADLEN);
}
else if (v->size != N)
{
GSL_ERROR ("v must be length N if R is M x N", GSL_EBADLEN);
}
else
{
size_t j, k;
double w0;
/* Apply Given's rotations to reduce w to (|w|, 0, 0, ... , 0)
J_1^T .... J_(n-1)^T w = +/- |w| e_1
simultaneously applied to R, H = J_1^T ... J^T_(n-1) R
so that H is upper Hessenberg. (12.5.2) */
for (k = M - 1; k > 0; k--)
{
double c, s;
double wk = gsl_vector_get (w, k);
double wkm1 = gsl_vector_get (w, k - 1);
create_givens (wkm1, wk, &c, &s);
apply_givens_vec (w, k - 1, k, c, s);
apply_givens_qr (M, N, Q, R, k - 1, k, c, s);
}
w0 = gsl_vector_get (w, 0);
/* Add in w v^T (Equation 12.5.3) */
for (j = 0; j < N; j++)
{
double r0j = gsl_matrix_get (R, 0, j);
size_t p_j = gsl_permutation_get (p, j);
double vj = gsl_vector_get (v, p_j);
gsl_matrix_set (R, 0, j, r0j + w0 * vj);
}
/* Apply Givens transformations R' = G_(n-1)^T ... G_1^T H
Equation 12.5.4 */
for (k = 1; k < GSL_MIN(M,N+1); k++)
{
double c, s;
double diag = gsl_matrix_get (R, k - 1, k - 1);
double offdiag = gsl_matrix_get (R, k, k - 1);
create_givens (diag, offdiag, &c, &s);
apply_givens_qr (M, N, Q, R, k - 1, k, c, s);
gsl_matrix_set (R, k, k - 1, 0.0); /* exact zero of G^T */
}
return GSL_SUCCESS;
}
}
static int
covar_QRPT (gsl_matrix * r, gsl_permutation * perm,
const double epsrel, gsl_matrix * covar)
{
/* Form the inverse of R in the full upper triangle of R */
double tolr = epsrel * fabs(gsl_matrix_get(r, 0, 0));
const size_t n = r->size2;
size_t i, j, k;
size_t kmax = 0;
for (k = 0 ; k < n ; k++)
{
double rkk = gsl_matrix_get(r, k, k);
if (fabs(rkk) <= tolr)
{
break;
}
gsl_matrix_set(r, k, k, 1.0/rkk);
for (j = 0; j < k ; j++)
{
double t = gsl_matrix_get(r, j, k) / rkk;
gsl_matrix_set (r, j, k, 0.0);
for (i = 0; i <= j; i++)
{
double rik = gsl_matrix_get (r, i, k);
double rij = gsl_matrix_get (r, i, j);
gsl_matrix_set (r, i, k, rik - t * rij);
}
}
kmax = k;
}
/* Form the full upper triangle of the inverse of R^T R in the full
upper triangle of R */
for (k = 0; k <= kmax ; k++)
{
for (j = 0; j < k; j++)
{
double rjk = gsl_matrix_get (r, j, k);
for (i = 0; i <= j ; i++)
{
double rij = gsl_matrix_get (r, i, j);
double rik = gsl_matrix_get (r, i, k);
gsl_matrix_set (r, i, j, rij + rjk * rik);
}
}
{
double t = gsl_matrix_get (r, k, k);
for (i = 0; i <= k; i++)
{
double rik = gsl_matrix_get (r, i, k);
gsl_matrix_set (r, i, k, t * rik);
};
}
}
/* Form the full lower triangle of the covariance matrix in the
strict lower triangle of R and in w */
for (j = 0 ; j < n ; j++)
{
size_t pj = gsl_permutation_get (perm, j);
for (i = 0; i <= j; i++)
{
size_t pi = gsl_permutation_get (perm, i);
double rij;
if (j > kmax)
{
gsl_matrix_set (r, i, j, 0.0);
rij = 0.0 ;
}
else
{
rij = gsl_matrix_get (r, i, j);
}
if (pi > pj)
{
gsl_matrix_set (r, pi, pj, rij);
}
else if (pi < pj)
{
gsl_matrix_set (r, pj, pi, rij);
}
}
{
double rjj = gsl_matrix_get (r, j, j);
gsl_matrix_set (covar, pj, pj, rjj);
}
}
/* symmetrize the covariance matrix */
for (j = 0 ; j < n ; j++)
{
for (i = 0; i < j ; i++)
{
double rji = gsl_matrix_get (r, j, i);
gsl_matrix_set (covar, j, i, rji);
gsl_matrix_set (covar, i, j, rji);
}
}
return GSL_SUCCESS;
}
/* read the configuration file and the graph */
chaincolln chaincolln_readdata(void) {
FILE *fileptr, *initzsfile;
int i, j, k, ndom, nreln, d, r, nitem, dim, maxclass, initclass, relcl, ndim,
domlabel, clusterflag, itemind, nchains, cind, zind;
int *domlabels, *participants, participant;
double val;
double nig[DISTSIZE];
domain *doms;
relation rn;
int *initclasses, ***edgecounts, *relsizes;
char prefix[MAXSTRING];
chaincolln cc;
chain c, c0;
#ifdef GSL
gsl_rng *rng;
const gsl_rng_type *T;
gsl_permutation *perm ;
size_t N;
gsl_rng_env_setup();
T = gsl_rng_default;
rng = gsl_rng_alloc(T);
#endif
fprintf(stdout,"A\n");
nchains = ps.nchains+1;
nig[0] = ps.m; nig[1] = ps.v; nig[2] = ps.a; nig[3] = ps.b;
fileptr = fopen(ps.configfile,"r");
if (fileptr == NULL) {
fprintf(stderr, "couldn't read config file\n"); exit(1);
}
/* initial read of ps.configfile to get ps.maxdim, ps.maxrel, ps.maxitem,
ps.maxclass */
fscanf(fileptr, "%s", prefix);
fscanf(fileptr, "%d %d", &ndom, &nreln);
relsizes= (int *) my_malloc(nreln*sizeof(int));
ps.maxrel = nreln;
ps.maxitem = 0; ps.maxclass = 0;
for (d = 0; d < ndom; d++) {
fscanf(fileptr, "%d %d %d %d", &nitem, &maxclass, &initclass, &clusterflag);
if (nitem > ps.maxitem) {
ps.maxitem = nitem;
}
if (maxclass > ps.maxclass) {
ps.maxclass= maxclass;
}
}
fprintf(stdout,"B\n");
ps.maxdim = 0;
for (r = 0; r < nreln; r++) {
fscanf(fileptr, "%d", &ndim);
relsizes[r] = ndim;
if (ndim > ps.maxdim) {
ps.maxdim = ndim;
}
for (dim=0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &domlabel);
}
}
fclose(fileptr);
fprintf(stdout,"C\n");
domlabels= (int *) my_malloc(ps.maxdim*sizeof(int));
participants= (int *) my_malloc(ps.maxdim*sizeof(int));
initclasses = (int *) my_malloc(ps.maxitem*sizeof(int));
fprintf(stdout,"D \n");
/* initial read of ps.graphname to get ps.maxobjtuples */
edgecounts = (int ***) my_malloc(ps.maxrel*sizeof(int **));
for (i = 0; i < ps.maxrel; i++) {
edgecounts[i] = (int **) my_malloc(ps.maxdim*sizeof(int *));
for (j = 0; j < ps.maxdim; j++) {
edgecounts[i][j] = (int *) my_malloc(ps.maxitem*sizeof(int));
for (k = 0; k < ps.maxitem; k++) {
edgecounts[i][j][k] = 0;
}
}
}
ps.maxobjtuples = 0;
fprintf(stdout,"D2 \n");
fileptr = fopen(ps.graphname,"r");
if (fileptr == NULL) {
fprintf(stderr, "couldn't read graph\n"); exit(1);
}
while( fscanf( fileptr, " %d", &r)!=EOF ) {
fprintf(stdout,"%s %d %d\n",__FILE__,__LINE__,r);
ndim = relsizes[r];
fprintf(stdout,"%s %d %d\n",__FILE__,__LINE__,ndim);
for (dim = 0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &participant);
participants[dim] = participant;
}
fscanf(fileptr, "%lf", &val);
for (dim = 0; dim < ndim; dim++) {
fprintf(stdout,"D2 %d %d %d \n",r,dim,participants[dim]);
edgecounts[r][dim][participants[dim]]++;
fprintf(stdout,"D2 %d %d %d \n",r,dim,participants[dim]);
}
}
fprintf(stdout,"E\n");
fclose(fileptr);
for (i = 0; i < ps.maxrel; i++) {
for (j = 0; j < ps.maxdim; j++) {
for (k = 0; k < ps.maxitem; k++) {
if (edgecounts[i][j][k] > ps.maxobjtuples) {
ps.maxobjtuples = edgecounts[i][j][k];
}
edgecounts[i][j][k]= 0;
}
}
}
fprintf(stdout,"F\n");
free(relsizes);
for (i = 0; i < ps.maxrel; i++) {
for (j = 0; j < ps.maxdim; j++) {
free(edgecounts[i][j]);
}
free(edgecounts[i]);
}
free(edgecounts);
fprintf(stdout,"G\n");
/* second read of ps.configfile where we set up datastructures */
fileptr = fopen(ps.configfile,"r");
if (ps.outsideinit) {
initzsfile= fopen(ps.initfile,"r");
if (initzsfile == NULL) {
fprintf(stderr, "couldn't read initzsfile\n"); exit(1);
}
} else {
initzsfile = NULL;
}
fprintf(stdout,"H\n");
fscanf(fileptr, "%s", prefix);
fscanf(fileptr, "%d %d", &ndom, &nreln);
cc = chaincolln_create(nchains, ndom, nreln, prefix);
c0 = chaincolln_getchain(cc, 0);
fprintf(stdout,"I\n");
/* read domains */
/* input file: nitem maxclass initclass clusterflag*/
for (d = 0; d < ndom; d++) {
fscanf(fileptr, "%d %d %d %d", &nitem, &maxclass, &initclass, &clusterflag);
#ifdef GSL
N = nitem;
#endif
if (ps.outsideinit) {
for (zind = 0; zind < nitem; zind++) {
fscanf(initzsfile, "%d", &initclasses[zind]);
}
}
fprintf(stdout,"J\n");
/* add domains and items to chains */
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_adddomain(c, d, nitem, maxclass, clusterflag, ps.alpha,
ps.alphahyp, initclasses);
#ifdef GSL
perm = gsl_permutation_alloc(N);
gsl_permutation_init(perm);
gsl_ran_shuffle(rng, perm->data, N, sizeof(size_t));
#endif
/* assign items to classes */
relcl = 0;
for (i = 0; i < nitem; i++) {
if (ps.outsideinit) {
chain_additemtoclass(c, d, i, initclasses[i]);
} else {
if (relcl == initclass) relcl = 0;
/* without the GNUSL, each chain gets initialized the same way. This
* is suboptimal */
itemind = i;
#ifdef GSL
itemind = gsl_permutation_get(perm, i);
#endif
chain_additemtoclass(c, d, itemind, relcl);
relcl++;
}
}
#ifdef GSL
gsl_permutation_free(perm);
#endif
}
}
#ifdef GSL
gsl_rng_free(rng);
#endif
fprintf(stdout,"K\n");
/* read relations*/
/* input file: ndim d0 ... dn */
for (r = 0; r < nreln; r++) {
fscanf(fileptr, "%d", &ndim);
for (dim=0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &domlabel);
domlabels[dim] = domlabel;
}
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_addrelation(c, r, ndim, ps.betaprop, ps.betamag, nig, domlabels);
}
}
if (ps.outsideinit) {
fclose(initzsfile);
}
fprintf(stdout,"L\n");
fclose(fileptr);
/* second read of ps.graphname: store edges*/
fileptr = fopen(ps.graphname,"r");
/* input file: relind p0 p1 p2 .. pn val */
while( fscanf( fileptr, " %d", &r)!= EOF ) {
ndim = relation_getdim( chain_getrelation(c0, r) );
doms = relation_getdoms( chain_getrelation(c0, r) );
for (dim = 0; dim < ndim; dim++) {
fscanf(fileptr, "%d", &participant);
fprintf(stdout,"M %d %d\n",dim,participant);
participants[dim] = participant;
domlabels[dim] = domain_getlabel(doms[dim]);
}
for (i = 0; i < ndim; i++) {
for (j = 0; j < i; j++) {
if (participants[i] == participants[j] &&
domlabels[i] == domlabels[j]) {
fprintf(stderr, "Self links not allowed.\n"); exit(1);
}
}
}
fscanf(fileptr, "%lf", &val);
fprintf(stderr,"%d\n",nchains);
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
chain_addedge(c, r, val, participants);
rn = chain_getrelation(c, r);
if (doubleeq(val, 0)) {
relation_setmissing(rn, 1);
}
if (val > 1.5 && relation_getdtype(rn) != CONT) {
relation_setdtype(rn, FREQ);
}
if (!doubleeq(val, (int) val)) {
relation_setdtype(rn, CONT);
relation_setmissing(rn, 1); /* XXX: no sparse continuous matrices */
}
}
}
fprintf(stderr,"N\n");
fclose(fileptr);
for (cind = 0; cind < nchains; cind++) {
c = chaincolln_getchain(cc, cind);
for (i = 0; i < chain_getndomains(c); i++) {
chain_updatedomprobs(c, i);
}
}
fprintf(stderr,"O\n");
free(domlabels); free(participants); free(initclasses);
return cc;
}
void generate_kmeans_centres(const double * X,const int dim_x,const int dim_n,const int dim_b,double * centres){
int i,N, iter,k,num_ix,num_empty_clusters;
int* ind_,*empty_clusters,*minDi,*ix;
size_t *sDi;
double * M, * D,*minDv,*X_ix,*X_ix_m,*X_ink,*sDv;
double dist_old, dist_new;
dist_old = 10000;
gsl_permutation *ind;
const gsl_rng_type *T;
gsl_rng * r;
// finish declaration
N = dim_n;
gsl_rng_env_setup();
T = gsl_rng_default;
r = gsl_rng_alloc(T);
gsl_rng_set(r,3);
ind = gsl_permutation_alloc(N);
gsl_permutation_init(ind);
gsl_ran_shuffle(r,ind->data,N,sizeof(size_t));
// gsl_permutation_fprintf(stdout,ind,"%u");
ind_ = malloc(dim_b*sizeof(int));
for (i=0;i<dim_b;i++){
ind_[i] = (int)(gsl_permutation_get(ind,i));
}
M = malloc(dim_x*dim_b*sizeof(double));
D = malloc(dim_b*dim_n*sizeof(double));
minDv = malloc(dim_n*sizeof(double));
minDi = malloc(dim_n*sizeof(int));
sDv = malloc(dim_n*sizeof(double));
sDi = malloc(dim_n*sizeof(int));
ix = malloc(dim_n*sizeof(int));
X_ix_m= malloc(dim_x*1*sizeof(double));
X_ink = malloc(dim_x*sizeof(double));
ccl_get_sub_mat_cols(X,dim_x,dim_n,ind_,dim_b,M);
empty_clusters = malloc(dim_b*sizeof(int));
num_empty_clusters = 0;
for (iter=0;iter<1001;iter++){
num_empty_clusters = 0;
ccl_mat_distance(M,dim_x,dim_b,X,dim_x,dim_n,D);
ccl_mat_min(D,dim_b,dim_n,1,minDv,minDi);
memcpy(sDv,minDv,dim_n*sizeof(double));
memset(empty_clusters,0,dim_b*sizeof(int));
for (k=0;k<dim_b;k++){
memset(ix,0,dim_n*sizeof(int));
num_ix = ccl_find_index_int(minDi,dim_n,1,k,ix);
// print_mat_i(ix,1,dim_n);
X_ix = malloc(dim_x*num_ix*sizeof(double));
if(num_ix!=0){// not empty
ccl_get_sub_mat_cols(X,dim_x,dim_n,ix,num_ix,X_ix);
ccl_mat_mean(X_ix,dim_x,num_ix,0,X_ix_m);
ccl_mat_set_col(M,dim_x,dim_b,k,X_ix_m);
}
else{
empty_clusters[num_empty_clusters] = k;
num_empty_clusters ++;
}
free(X_ix);
}
dist_new = ccl_vec_sum(minDv,dim_n);
if (num_empty_clusters == 0){
if(fabs(dist_old-dist_new)<1E-10) {
memcpy(centres,M,dim_x*dim_b*sizeof(double));
return;
}
}
else{
// print_mat_i(empty_clusters,1,num_empty_clusters);
gsl_sort_index(sDi,sDv,1,dim_n);
gsl_sort(sDv,1,dim_n);
for (k=0;k<num_empty_clusters;k++){
int ii = (int) sDi[dim_n-k-1];
//print_mat_d(X,dim_x,dim_n);
ccl_get_sub_mat_cols(X,dim_x,dim_n,&ii,1,X_ink);
ccl_mat_set_col(M,dim_x,dim_b,empty_clusters[k],X_ink);
}
}
dist_old = dist_new;
}
memcpy(centres,M,dim_x*dim_b*sizeof(double));
gsl_permutation_free(ind);
gsl_rng_free(r);
free(ind_);
free(empty_clusters);
free(minDi);
free(M);
free(minDv);
free(X_ink);
free(ix);
free(sDi);
free(sDv);
free(X_ix_m);
free(D);
}
