void MlSldaState::InitializeAssignments(bool random_init) {
InitializeResponse();
InitializeLength();
LdawnState::InitializeAssignments(random_init);
if (FLAGS_num_seed_docs > 0) {
const gsl_vector* y = static_cast<lib_corpora::ReviewCorpus*>
(corpus_.get())->train_ratings();
boost::shared_ptr<gsl_permutation> sorted(gsl_permutation_alloc(y->size),
gsl_permutation_free);
boost::shared_ptr<gsl_permutation> rank(gsl_permutation_alloc(y->size),
gsl_permutation_free);
std::vector< std::vector<int> > num_seeds_used;
num_seeds_used.resize(corpus_->num_languages());
for (int ii = 0; ii < corpus_->num_languages(); ++ii) {
num_seeds_used[ii].resize(num_topics_);
}
gsl_sort_vector_index(sorted.get(), y);
gsl_permutation_inverse(rank.get(), sorted.get());
// We add one for padding so we don't try to set a document to be equal to
// the number of topics.
double num_train = corpus_->num_train() + 1.0;
int train_seen = 0;
int num_docs = corpus_->num_docs();
for (int dd = 0; dd < num_docs; ++dd) {
MlSeqDoc* doc = corpus_->seq_doc(dd);
int lang = doc->language();
if (!corpus_->doc(dd)->is_test()) {
// We don't assign to topic zero, so it can be stopwordy
int val = (int) floor((num_topics_ - 1) *
rank->data[train_seen] / num_train) + 1;
// Stop once we've used our limit of seed docs (too many leads to an
// overfit initial state)
if (num_seeds_used[lang][val] < FLAGS_num_seed_docs) {
cout << "Initializing doc " << lang << " " << dd << " to " << val <<
" score=" << truth_[dd] << endl;
for (int jj = 0; jj < (int)topic_assignments_[dd].size(); ++jj) {
int term = (*doc)[jj];
const topicmod_projects_ldawn::WordPaths word =
wordnet_->word(lang, term);
int num_paths = word.size();
if (num_paths > 0) {
ChangePath(dd, jj, val, rand() % num_paths);
} else {
if (use_aux_topics())
ChangeTopic(dd, jj, val);
}
}
++num_seeds_used[lang][val];
}
++train_seen;
}
}
}
}
/** This function sorts the whole of a \c apop_data set based on one column. Sorts in place, with little additional memory used.
Uses the \c gsl_sort_vector_index function internally, and that function just ignores NaNs; therefore this function just leaves NaNs exactly where they lay.
\param data The input set to be modified. (No default, must not be \c NULL.)
\param sortby The column of data by which the sorting will take place. As usual, -1 indicates the vector element. (default: column zero of the matrix if there is a matrix; if there's a vector but no matrix, then -1).
\param asc If 'd' or 'D', sort in descending order; else sort in ascending order. (Default: ascending)
\return A pointer to the data set, so you can do things like \c apop_data_show(apop_data_sort(d, -1)).
This function uses the \ref designated syntax for inputs.
*/
APOP_VAR_HEAD apop_data * apop_data_sort(apop_data *data, int sortby, char asc){
apop_data * apop_varad_var(data, NULL);
apop_assert_s(data, "You gave me NULL data to sort.");
int apop_varad_var(sortby, 0);
if (sortby==0 && !data->matrix && data->vector) //you meant sort the vector
sortby = -1;
char apop_varad_var(asc, 0);
APOP_VAR_ENDHEAD
size_t height = (sortby==-1) ? data->vector->size: data->matrix->size1;
size_t sorted[height];
size_t i, *perm, start=0;
gsl_permutation *p = gsl_permutation_alloc(height);
memset(sorted, 0, sizeof(size_t)*height);
if (sortby == -1)
gsl_sort_vector_index (p, data->vector);
else {
APOP_COL(data, sortby, v);
gsl_sort_vector_index (p, v);
}
perm = p->data;
if (asc=='d' || asc=='D') //reverse the perm matrix.
for (size_t j=0; j< height/2; j++){
double t = perm[j];
perm[j] = perm[height-1-j];
perm[height-1-j] = t;
}
while (1){
i =
start = find_min_unsorted(sorted, height, start);
if (i==-1)
break;
Apop_data_row(data, start, firstrow);
apop_data *first_row_storage = apop_data_copy(firstrow);
sorted[start]++;
while (perm[i]!=start){
//copy from perm[i] to i
Apop_data_row(data, perm[i], onerow);
apop_data_set_row(data, onerow, i);
sorted[perm[i]]++;
i = perm[i];
}
apop_data_set_row(data, first_row_storage, i);
apop_data_free(first_row_storage);
}
gsl_permutation_free(p);
return data;
}
CAMLprim value
ml_gsl_sort_vector_index (value p, value v)
{
GSL_PERMUT_OF_BIGARRAY(p);
_DECLARE_VECTOR(v);
_CONVERT_VECTOR(v);
gsl_sort_vector_index (&perm_p, &v_v);
return Val_unit;
}
/* Return indices of sorted pixels from greatest to smallest. */
static gsl_permutation *get_pixel_ranks(long npix, double *P)
{
gsl_permutation *pix_perm = gsl_permutation_alloc(npix);
if (pix_perm)
{
gsl_vector_view P_vector = gsl_vector_view_array(P, npix);
gsl_sort_vector_index(pix_perm, &P_vector.vector);
gsl_permutation_reverse(pix_perm);
}
return pix_perm;
}
double kendall(double *arr1,double *arr2,int n)
{
static gsl_vector *vec = NULL;
static gsl_permutation *perm=NULL,*rank1=NULL,*rank2=NULL;
static double *r=NULL;
int i;
double S,W,R;
double nx=0;
if (vec == NULL) {
vec = gsl_vector_calloc(n);
perm = gsl_permutation_alloc(n);
rank1 = gsl_permutation_alloc(n);
rank2 = gsl_permutation_alloc(n);
r = (double *) VCalloc(n,sizeof(double));
}
for (i=0; i<n; i++) gsl_vector_set(vec,i,arr1[i]);
gsl_sort_vector_index (perm, vec);
gsl_permutation_inverse (rank1, perm);
for (i=0; i<n; i++) gsl_vector_set(vec,i,arr2[i]);
gsl_sort_vector_index (perm, vec);
gsl_permutation_inverse (rank2, perm);
for (i=0; i<n; i++) r[i] = (double)(rank1->data[i] + rank2->data[i]);
nx = (double)n;
R = 0;
for (i=0; i<n; i++) R += r[i];
R /= nx;
S = 0;
for (i=0; i<n; i++) S += SQR(r[i] - R);
W = 12.0*S/(4.0*(nx*nx-1.0)*nx);
return W;
}
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;
}
}
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 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);
}
/** Sort an \ref apop_data set on an arbitrary sequence of columns.
The \c sort_order set is a one-row data set that should look like the data set being
sorted. The easiest way to generate it is to use \ref Apop_r to pull one row of the
table, then copy and fill it. For each column you want used in the sort, assign a ranking giving whether the column should be sorted first, second, .... Columns you don't want used in the sorting should be set to \c NAN. Ties are broken by the earlier element in the default order (see below).
E.g., to sort by the last column of a five-column matrix first, then the next-to-last column, then the next-to-next-to-last, then by the first text column, then by the second text column:
\code
apop_data *sort_order = apop_data_copy(Apop_r(data, 0));
sort_order->vector = NULL; //so it will be skipped.
Apop_data_fill(sort_order, NAN, NAN, 3, 2, 1);
apop_text_add(sort_order, 0, 0, "4");
apop_text_add(sort_order, 0, 1, "5");
apop_data_sort(data, sort_order);
\endcode
I use only comparisons, not the actual numeric values, so you can use any sequence of
numbers: (1, 2, 3) and (-1.32, 0, 27) work identically.
\li Strings are sorted case-insensitively, using \c strcasecmp. [exercise for the reader: modify the source to use Glib's locale-correct string sorting.]
\li The setup generates a lexicographic sort using the columns you specify. If you would like a different sort order, such as Euclidian distance to the origin, you can generate a new column expressing your preferred metric, and then sorting on that. See the example below.
\param data The data set to be sorted. If \c NULL, this function is a no-op that returns \c NULL.
\param sort_order A \ref apop_data set describing the order in which columns are used for sorting, as above. If \c NULL, then sort by the vector, then each matrix column, then text, then weights, then row names.
\param inplace If 'n', make a copy, else sort in place. (default: 'y').
\param asc If 'a', ascending; if 'd', descending. This is applied to all columns; column-by-column application is to do. (default: 'a').
\param col_order For internal use only. In your call, it should be \c NULL; the \ref designated syntax will takes care of it for you.
\return A pointer to the sorted data set. If <tt>inplace=='y'</tt> (the default), then this is the same as the input set.
A few examples:
\include "sort_example.c"
\li This function uses the \ref designated syntax for inputs.
*/
APOP_VAR_HEAD apop_data *apop_data_sort(apop_data *data, apop_data *sort_order, char asc, char inplace, double *col_order){
apop_data * apop_varad_var(data, NULL);
Apop_stopif(!data, return NULL, 1, "You gave me NULL data to sort. Returning NULL");
apop_data * apop_varad_var(sort_order, NULL);
char apop_varad_var(inplace, 'y');
char apop_varad_var(asc, 'a');
double * apop_varad_var(col_order, NULL);
APOP_VAR_ENDHEAD
if (!data) return NULL;
apop_data *out = inplace=='n' ? apop_data_copy(data) : data;
apop_data *xx = sort_order ? sort_order : out;
Get_vmsizes(xx); //firstcol, msize2
int cols_to_sort_ct = msize2 - firstcol +1 + !!(xx->weights) + xx->textsize[1] + !!xx->names->rowct;
double so[cols_to_sort_ct];
if (!col_order){
generate_sort_order(out, sort_order, cols_to_sort_ct, so);
col_order = so;
}
bool is_text = ((int)*col_order != *col_order);
bool is_name = (*col_order == 0.2);
gsl_vector_view c;
gsl_vector *cc = NULL;
if (!is_text && *col_order>=0){
c = gsl_matrix_column(out->matrix, *col_order);
cc = &c.vector;
}
gsl_vector *thiscol = cc ? cc
: (*col_order==-2) ? out->weights
: (*col_order==-1) ? out->vector
: NULL;
size_t height = thiscol ? thiscol->size
: is_name ? out->names->rowct
: *out->textsize;
gsl_permutation *p = gsl_permutation_alloc(height);
if (!is_text) gsl_sort_vector_index (p, thiscol);
else {
gsl_permutation_init(p);
d = out;
offset = is_name ? -1 : *col_order-0.5;
qsort(p->data, height, sizeof(size_t), compare_strings);
}
size_t *perm = p->data;
if (asc=='d' || asc=='D') //reverse the perm matrix.
for (size_t j=0; j< height/2; j++){
double t = perm[j];
perm[j] = perm[height-1-j];
perm[height-1-j] = t;
}
rearrange(out, height, perm);
gsl_permutation_free(p);
if (col_order[1] == -100) return out;
/*Second pass:
find blocks where all are of the same value.
After you pass a block of size > 1 row where all vals in this col are identical,
sort that block, using the rest of the sort order. */
int bottom=0;
if (!is_text){
double last_val = gsl_vector_get(thiscol, 0);
for (int i=1; i< height+1; i++){
double this_val=0;
if ((i==height || (this_val=gsl_vector_get(thiscol, i)) != last_val)
&& bottom != i-1){
apop_data_sort_base(Apop_rs(out, bottom, i-bottom), sort_order, 'a', 'y', col_order+1);
}
if (last_val != this_val) bottom = i;
last_val = this_val;
}
} else {
char *last_val = is_name ? out->names->row[0] : out->text[0][(int)(*col_order-0.5)];
for (int i=1; i< height+1; i++){
char *this_val = i==height ? NULL : is_name ? out->names->row[i] : out->text[i][(int)(*col_order-0.5)];
if ((i==height || strcasecmp(this_val, last_val))
&& bottom != i-1){
apop_data_sort_base(Apop_rs(out, bottom, i-bottom), sort_order, 'a', 'y', col_order+1);
}
if (this_val && strcmp(last_val, this_val)) bottom = i;
last_val = this_val;
}
}
return out;
}
VImage
PairedWilcoxTest(VImage *src1, VImage *src2, VImage dest, int n) {
int i, m, k, b, r, c, nslices, nrows, ncols;
int sumpos, sumneg, w;
double wx, u, v, z, p, tiny = 1.0e-10;
double *ptr1, *ptr2;
float *table = NULL;
gsl_vector *vec1 = NULL, *vec2 = NULL;
gsl_permutation *perm = NULL, *rank = NULL;
extern void gsl_sort_vector_index(gsl_permutation *, gsl_vector *);
nslices = VImageNBands(src1[0]);
nrows = VImageNRows(src1[0]);
ncols = VImageNColumns(src1[0]);
dest = VCopyImage(src1[0], NULL, VAllBands);
VFillImage(dest, VAllBands, 0);
VSetAttr(VImageAttrList(dest), "num_images", NULL, VShortRepn, (VShort)n);
VSetAttr(VImageAttrList(dest), "patient", NULL, VStringRepn, "paired_wilcoxtest");
VSetAttr(VImageAttrList(dest), "modality", NULL, VStringRepn, "zmap");
m = 0;
for(i = 1; i <= n; i++)
m += i;
if(n > 18) {
table = getTable(n);
for(i = 0; i < m; i++) {
p = table[i];
p *= 0.5;
if(p < tiny)
p = tiny;
z = p2z(p);
if(z < 0)
z = 0;
table[i] = z;
}
} else {
table = (float *) VMalloc(sizeof(float) * m);
for(i = 0; i < m; i++) {
for(i = 0; i < m; i++) {
wx = i;
p = LevelOfSignificanceWXMPSR(wx, (long int)n);
p *= 0.5;
z = p2z(p);
table[i] = z;
}
}
}
vec1 = gsl_vector_calloc(n);
vec2 = gsl_vector_calloc(n);
perm = gsl_permutation_alloc(n);
rank = gsl_permutation_alloc(n);
for(b = 0; b < nslices; b++) {
for(r = 0; r < nrows; r++) {
for(c = 0; c < ncols; c++) {
k = 0;
ptr1 = vec1->data;
ptr2 = vec2->data;
for(i = 0; i < n; i++) {
u = VPixel(src1[i], b, r, c, VFloat);
v = VPixel(src2[i], b, r, c, VFloat);
if(ABS(u) > tiny && ABS(v) > tiny)
k++;
*ptr1++ = ABS(u - v);
*ptr2++ = u - v;
}
if(k < n / 2)
continue;
gsl_sort_vector_index(perm, vec1);
gsl_permutation_inverse(rank, perm);
sumpos = sumneg = 0;
ptr2 = vec2->data;
for(i = 0; i < n; i++) {
u = *ptr2++;
if(u > 0)
sumpos += rank->data[i];
else if(u < 0)
sumneg += rank->data[i];
}
w = sumpos;
if(sumpos > sumneg)
w = sumneg;
if(w >= m)
z = 0;
else
z = table[w];
if(sumneg > sumpos)
z = -z;
VPixel(dest, b, r, c, VFloat) = z;
}
}
}
return dest;
}
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;
}
void MAIAllocator::Run() {
// fetch channel matrix
gsl_matrix_complex hmm = min1.GetDataObj();
// hmm : channel coeffs matrix h(n) (M**2xN)
// ij
// ch matrix structure
//
// +- -+
// | h(0) . . . . h(n) | |
// | 11 11 | |
// | | | Rx1
// | h(0) . . . . h(n) | |
// | 12 12 | |
// | |
// | h(0) . . . . h(n) | |
// | 21 21 | |
// | | | Rx2
// | h(0) . . . . h(n) | |
// | 22 22 | |
// +- -+
//
// where h(n) represents the channel impulse response
// ij
//
// at time n, from tx_i to rx_j
// the matrix has MxM rows and N comumns.
// The (i,j) channel is locater at row i*M+j
// with i,j in the range [0,M-1] and rows counting from 0
//
//
// fetch error report
// e(u) = errors for user u in the last ERROR_REPORT_INTERVAL (ERI) frames
gsl_vector_uint temperr = vin2.GetDataObj();
// update error reports at receiver rx_m every ERI
if (ericount % ERROR_REPORT_INTERVAL == 0) { // once every ERU
if (temperr.size == M()) {
gsl_vector_uint_memcpy(errs,&temperr);
}
ericount = 0;
}
//
// every DECISION_INTERVAL frames we updates the CSI knowledge
//
if (framecount % DECISION_INTERVAL == 0) {
for (int u=0;u<M();u++) { // user loop
// extract time domain response from hmm corresponding to txn-->rxn channel
gsl_vector_complex_const_view hii = gsl_matrix_complex_const_row(&hmm,u*M()+u);
// copy the N-sized vector hii into u-th column of huu
gsl_matrix_complex_set_col(huu,u,&hii.vector);
} // user loop
//cout << "maiallocator:453 - CSI update received" << endl;
// huu matrix structure
//
// +- -+
// | h(0) . . . . h(n) |
// | 11 uu |
// | |
// | h(n) . . . . h(n) |
// | 11 uu |
// +- -+
//
// where h(n) represents the channel impulse response
// ii
//
// at time n, from tx_u to rx_u
// the matrix has N rows and M columns.
//
// ATTENTION! user_0 channel response is the first column
//
// Hmat(NxM) = Fourier( huu(NxM) )
//
gsl_blas_zgemm(CblasNoTrans,
CblasNoTrans,
gsl_complex_rect(1,0),
transform_mat,
huu,
gsl_complex_rect(0,0),
Hmat);
#ifdef SHOW_MATRIX
cout << "Hmat(freq,user) (frame:" << framecount << ") = " << endl;
gsl_matrix_complex_show(Hmat);
#endif
//
// ***********************************************************
// CARRIER ALLOCATION STRATEGIES
// ***********************************************************
//
switch (Mode()) {
case 0: // FIXED_ALLOCATION
break;
case 1: // GIVE_BEST_CARR
//
// SORT CARRIERS OF EACH USERS
//
// uses Hmat: the frequency responses of channel tx_n --> rx_n
//
// starting from user u ...
// find the best (in u ranking) unused carrier and assign it to u
// next user until no more available carriers
for(int u=0; u<M(); u++) { // cycle through users
gsl_vector_complex_const_view huser
= gsl_matrix_complex_const_column(Hmat,u);
gsl_vector_uint_view sortindu = gsl_matrix_uint_column(Hperm,u);
for (int j=0; j<N(); j++) {
double currpower
= gsl_complex_abs2(gsl_vector_complex_get(&huser.vector,j));
gsl_vector_set(huserabs,j,currpower);
}
// sort over c using abs(h(u,c))
gsl_sort_vector_index(p,huserabs);
for (int j=0; j<N(); j++) {
uint currindex = p->data[j];
gsl_vector_uint_set(&sortindu.vector,j,currindex);
}
}
//
// FIND INITIAL USER RANDOMLY
//
curruser = gsl_rng_uniform_int(ran,M());
//
// ASSIGN FREQUENCIES
//
gsl_vector_uint_set_all(nextcarr,0);
gsl_vector_uint_set_all(usedcarr,0);
for (int j=0; j<J(); j++) {
for (int uu=0; uu<M(); uu++) {
int u = (uu+curruser) % M();
int isassigned = 0;
while (! isassigned) {
int tag = gsl_vector_uint_get(nextcarr,u);
gsl_vector_uint_set(nextcarr,u,++tag);
int carrier = gsl_matrix_uint_get(Hperm,N()-tag,u);
if (! gsl_vector_uint_get(usedcarr,carrier)) {
isassigned = 1;
gsl_vector_uint_set(usedcarr,carrier,isassigned);
gsl_matrix_uint_set(signature_frequencies,u,j,carrier);
} else if (tag==N()) {
cerr << "Block: " << BlockName << " allocation problem." << endl;
exit(1);
}
}
}
}
//
// show channels and permutations
//
// gsl_matrix_complex_show(Hmat);
//gsl_matrix_uint_show(Hperm);
//gsl_matrix_uint_show(signature_frequencies);
break;
case 2: // SWAP_BAD_GOOD
//
// SWAP_BAD_GOOD
//
// sort carriers for each user
// choose randomly a starting user u
// for each user starting with u
// swap worst carrier used by u with best carrier if used by others
// sort carriers
for(int u=0; u<M(); u++) {
gsl_vector_complex_const_view huser
= gsl_matrix_complex_const_column(Hmat,u);
gsl_vector_uint_view sortindu = gsl_matrix_uint_column(Hperm,u);
gsl_vector_view huserabs = gsl_matrix_column(habs,u);
for (int j=0; j<N(); j++) {
double currpower
= gsl_complex_abs2(gsl_vector_complex_get(&huser.vector,j));
gsl_vector_set(&huserabs.vector,j,currpower);
}
//
// sort channels for user <u>
//
gsl_sort_vector_index(p,&huserabs.vector);
for (int j=0; j<N(); j++) {
uint currindex = p->data[j];
gsl_vector_uint_set(&sortindu.vector,j,currindex);
}
}
//
// Hperm(N,USERS) contains sorted channels index for each users
// habs(N,USERS) contains channel energy per each user
//
//
// FIND INITIAL USER RANDOMLY for fairness
//
curruser = gsl_rng_uniform_int(ran,M());
//
// ASSIGN FREQUENCIES
//
//
// for each user ...
//
for (int uu=0; uu<M(); uu++) {
int u = (uu+curruser) % M();
//
// worst allocated channel for user u
//
double worstvalue=GSL_POSINF;
unsigned int worstjindex;
for (int j=0; j<J(); j++) {
unsigned int chind = gsl_matrix_uint_get(signature_frequencies,u,j);
double currh = gsl_matrix_get(habs,chind,u);
if (currh < worstvalue) {
worstvalue = currh;
worstjindex = j;
}
}
//
// find best channel allocated by other users
//
//
double bestvalue=0;
unsigned int bestuser, bestjindex;
for (int uuu=0; uuu<M()-1; uuu++) {
unsigned int otheru = (uuu+u) % M();
for (int j=0; j<J(); j++) {
unsigned int chind
= gsl_matrix_uint_get(signature_frequencies,otheru,j);
double currh = gsl_matrix_get(habs,chind,otheru);
if (currh > bestvalue) {
bestvalue = currh;
bestjindex = j;
bestuser = otheru;
}
}
}
//
// finally the swap !
//
unsigned int chind
= gsl_matrix_uint_get(signature_frequencies,u,worstjindex);
gsl_matrix_uint_set(signature_frequencies,u,worstjindex,
gsl_matrix_uint_get(signature_frequencies,
bestuser,bestjindex));
gsl_matrix_uint_set(signature_frequencies,bestuser,bestjindex,chind);
// cout << "\n\nProcessing user " << u << endl
// << "\tSwapped " << u << "." << worstjindex
// << " <-> " << bestuser << "." << bestjindex << endl;
}
break;
case 3: // BEST_OVERLAP
//
// SORT CARRIERS OF EACH USERS
//
gsl_matrix_uint_memcpy(signature_frequencies,
signature_frequencies_init);
for(int u=0; u<M(); u++) {
gsl_vector_complex_const_view huser
= gsl_matrix_complex_const_column(Hmat,u);
gsl_vector_uint_view sortindu = gsl_matrix_uint_column(Hperm,u);
for (int j=0; j<N(); j++) {
double currpower = gsl_complex_abs2(gsl_vector_complex_get(&huser.vector,
j));
gsl_vector_set(huserabs,j,currpower);
}
gsl_sort_vector_index(p,huserabs);
for (int j=0; j<N(); j++) {
uint currindex = p->data[j];
gsl_vector_uint_set(&sortindu.vector,j,currindex);
}
}
//
// each user take his best carriers allowing carrier overlap
//
for (int u=0; u<M(); u++) {
for (int j=0; j<J(); j++) {
int carrier = gsl_matrix_uint_get(Hperm,N()-j-1,u);
gsl_matrix_uint_set(signature_frequencies,u,j,carrier);
}
}
//
// show channels and permutations
//
//gsl_matrix_complex_show(Hmat);
//gsl_matrix_uint_show(Hperm);
//gsl_matrix_uint_show(signature_frequencies);
break;
case 4: // SOAR_AI
//
// SOAR
//
// agent crai5
// bases the decisions on the frequency response tx_m --> rx_m in Hmat(N,M)
// for each user it proposes a swap between carriers if the instantaneous impulse channel response
// is better
//
// agent crai6
// for each user it proposes a swap of allocated carriers with one other users
// error report is the metric for correct decisions (RL)
#ifdef PAUSED
// keypress
cout << "pause maillocator: before decision loop ... (press ENTER key)" << endl;
cin.ignore();
#endif
// Every DECISION_INTERVAL we increase the input-time and allow decisions
if (framecount % DECISION_INTERVAL == 0) {
pAgent->Update(inputTime,++input_time);
pAgent->Commit();
}
// run agent till output
noDecisions = 0;
numberCommands=0;
while (! (noDecisions) ) { // main decisional loop
//
// INPUT LINK Update
//
UpdateInputLink();
//pAgent->RunSelf(1);
pAgent->RunSelfTilOutput();
numberCommands = pAgent->GetNumberCommands() ;
#ifdef PAUSED
// keypress
cout << "pause maillocator: after RunSelfTilOutput() ... (press ENTER key)" << endl;
cin.ignore();
#endif
// loop through received commands
for (int cmd = 0 ; cmd < numberCommands ; cmd++) {
Identifier* pCommand = pAgent->GetCommand(cmd) ;
string name = pCommand->GetCommandName() ;
if (name == "assign-free") {
std::string sUid = pCommand->GetParameterValue("uid");
std::string sDeassign = pCommand->GetParameterValue("deassign");
std::string sAssign = pCommand->GetParameterValue("assign");
#ifdef SHOW_SOAR
cout << "assign-free command received [ u:"
<< sUid << " , -"
<< sDeassign << " , +"
<< sAssign << " ]"
<< endl;
#endif
AssignFree(sUid,sDeassign,sAssign);
pCommand->AddStatusComplete();
} else if (name == "swap-carriers") {
std::string sU1 = pCommand->GetParameterValue("u1");
std::string sC1 = pCommand->GetParameterValue("c1");
std::string sU2 = pCommand->GetParameterValue("u2");
std::string sC2 = pCommand->GetParameterValue("c2");
#ifdef SHOW_SOAR
cout << "swap-carriers command received [ u1:"
<< sU1 << " , c1:"
<< sC1 << " , u2:"
<< sU2 << " , c2:"
<< sC2 << " ]" << endl;
#endif
SwapCarriers(sU1,sC1,sU2,sC2);
pCommand->AddStatusComplete();
} else if (name == "increase-power") {
std::string sUid = pCommand->GetParameterValue("uid");
std::string sCid = pCommand->GetParameterValue("cid");
#ifdef SHOW_SOAR
cout << "increase-power command received [ u:"
<< sUid << " , c:"
<< sCid << " ]" << endl;
#endif
IncreasePower(sUid,sCid);
pCommand->AddStatusComplete();
break;
} else if (name == "no-choices") {
#ifdef SHOW_SOAR
cout << "no-choices command received" << endl;
#endif
noDecisions = 1;
pCommand->AddStatusComplete();
break;
} else {
#ifdef SHOW_SOAR
cout << "ignoring unknown output command from SOAR" << endl;
#endif
break;
}
// cout << "framecount = " << framecount << endl;
} // end command loop
} // while (! (noDecisions) )
break;
} // switch (Mode())
} // if DECISION_INTERVAL % 0
//
// every 10s dump frame count
//
time(&nowtime);
if (difftime(nowtime,reporttime) > TIMEDELTA) {
reporttime = nowtime;
cout << "frame:" << framecount << "\r";
cout.flush();
}
//////// production of data
framecount++;
ericount++;
mout1.DeliverDataObj( *signature_frequencies );
mout2.DeliverDataObj( *signature_powers );
#ifdef SHOW_MATRIX
cout << "signature frequencies (frame:" << framecount-1 << ") = " << endl;
gsl_matrix_uint_show(signature_frequencies);
#endif
}
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 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 void
fit_rvine_trees(igraph_t **trees,
const gsl_matrix *data,
const dml_vine_weight_t weight,
const dml_vine_trunc_t trunc,
const dml_copula_indeptest_t indeptest,
const double indeptest_level,
const dml_copula_type_t *types,
const size_t types_size,
const dml_copula_select_t select,
const gsl_rng *rng)
{
size_t m, n;
igraph_t *graph;
igraph_vector_t *graph_weight;
dml_copula_t *copula;
gsl_vector *x;
igraph_integer_t e; // Edge id.
igraph_integer_t a, aa, ab, b, ba, bb; // Vertex id.
gsl_vector *u = NULL, *v = NULL;
igraph_integer_t Cea, Ceb;
gsl_vector_short *Ue, *Ua, *Ub;
size_t k;
dml_measure_t *measure;
double tree_aic, copula_aic;
gsl_permutation *perm, *rank, *u_rank = NULL, *v_rank = NULL;
igraph_i_set_attribute_table(&igraph_cattribute_table);
m = data->size1;
n = data->size2;
graph = g_malloc(sizeof(igraph_t));
graph_weight = g_malloc(sizeof(igraph_vector_t));
perm = gsl_permutation_alloc(m);
for (k = 0; k < n - 1; k++) { // Tree index.
if (k == 0) {
igraph_full(graph, n, IGRAPH_UNDIRECTED, IGRAPH_NO_LOOPS);
// Assign the observations to the nodes.
for (size_t i = 0; i < n; i++) { // Variable and node index.
x = gsl_vector_alloc(m);
gsl_matrix_get_col(x, data, i);
// Results of the h-function of the copula assigned to the
// edge that corresponds to this vertex in the previous tree.
// h for the h-function with its arguments in order and
// hrev for the h-function with its arguments reversed. In the
// first tree both are equal to the observations of the
// corresponding variable, in the rest of the trees they differ.
SETVAP(graph, "h", i, x);
SETVAP(graph, "hrev", i, x);
gsl_sort_vector_index(perm, x);
rank = gsl_permutation_alloc(m);
gsl_permutation_inverse(rank, perm);
// Ranks of the h and hrev vectors.
SETVAP(graph, "hrank", i, rank);
SETVAP(graph, "hrevrank", i, rank);
}
for (e = 0; e < igraph_ecount(graph); e++) {
igraph_edge(graph, e, &a, &b);
// Variables "connected" by this edge.
Ue = gsl_vector_short_calloc(n);
gsl_vector_short_set(Ue, a, 1);
gsl_vector_short_set(Ue, b, 1);
SETEAP(graph, "Ue", e, Ue);
// Conditioned set.
SETEAN(graph, "Cea", e, a + 1);
SETEAN(graph, "Ceb", e, b + 1);
Cea = EAN(graph, "Cea", e);
Ceb = EAN(graph, "Ceb", e);
// Calculate the weight of the edge.
u = VAP(graph, "h", a);
v = VAP(graph, "h", b);
u_rank = VAP(graph, "hrank", a);
v_rank = VAP(graph, "hrank", b);
// The conditioned set is ordered to make the order of the
// arguments in the bivariate copulas unique as suggested in
// Czado, C. (2010) Pair-Copula Constructions of Multivariate
// Copulas. In Jaworski, P. and Durante, F. and Hardle, W. K.
// and Rychlik, T. (eds.) Copula Theory and Its Applications,
// Springer-Verlag, 93-109.
if (Cea < Ceb) {
rvine_set_weight(graph, weight, e, u, v, u_rank, v_rank);
} else {
rvine_set_weight(graph, weight, e, v, u, v_rank, u_rank);
}
}
} else {
igraph_empty(graph, n - k, IGRAPH_UNDIRECTED);
// Adding all "possible" edges.
for (a = 0; a < igraph_vcount(graph) - 1; a++) {
for (b = a + 1; b < igraph_vcount(graph); b++) {
igraph_edge(trees[k - 1], a, &aa, &ab);
igraph_edge(trees[k - 1], b, &ba, &bb);
// Checking the proximity condition.
if (aa == ba || aa == bb || ab == ba || ab == bb) {
igraph_add_edge(graph, a, b);
igraph_get_eid(graph, &e, a, b, IGRAPH_UNDIRECTED, 1);
// Variables "connected" by this edge and conditioned set.
Ua = EAP(trees[k - 1], "Ue", a);
Ub = EAP(trees[k - 1], "Ue", b);
Ue = gsl_vector_short_calloc(n);
for (size_t i = 0; i < n; i++) {
gsl_vector_short_set(Ue, i,
gsl_vector_short_get(Ua, i)
| gsl_vector_short_get(Ub, i));
if (gsl_vector_short_get(Ua, i)
&& !gsl_vector_short_get(Ub, i)) {
SETEAN(graph, "Cea", e, i + 1);
}
if (gsl_vector_short_get(Ub, i)
&& !gsl_vector_short_get(Ua, i)) {
SETEAN(graph, "Ceb", e, i + 1);
}
}
SETEAP(graph, "Ue", e, Ue);
}
}
}
// Compute pseudo-observations and edge weights.
for (a = 0; a < igraph_vcount(graph); a++) {
// See the comment in the code for the first tree.
SETVAP(graph, "h", a, NULL);
SETVAP(graph, "hrev", a, NULL);
SETVAP(graph, "hrank", a, NULL);
SETVAP(graph, "hrevrank", a, NULL);
}
for (e = 0; e < igraph_ecount(graph); e++) {
igraph_edge(graph, e, &a, &b);
Cea = EAN(graph, "Cea", e);
Ceb = EAN(graph, "Ceb", e);
// Assign u and u_rank.
if ((Cea == EAN(trees[k - 1], "Cea", a)
&& (EAN(trees[k - 1], "Cea", a)
< EAN(trees[k - 1], "Ceb", a)))
|| (Cea != EAN(trees[k - 1], "Cea", a)
&& (EAN(trees[k - 1], "Cea", a)
> EAN(trees[k - 1], "Ceb", a)))) {
u = VAP(graph, "h", a);
if (u == NULL) {
copula = EAP(trees[k - 1], "copula", a);
measure = EAP(trees[k - 1], "measure", a);
u = gsl_vector_alloc(m);
dml_copula_h(copula, measure->x, measure->y, u);
SETVAP(graph, "h", a, u);
gsl_sort_vector_index(perm, u);
rank = gsl_permutation_alloc(m);
gsl_permutation_inverse(rank, perm);
SETVAP(graph, "hrank", a, rank);
}
u_rank = VAP(graph, "hrank", a);
}
if ((Cea == EAN(trees[k - 1], "Cea", a)
&& (EAN(trees[k - 1], "Cea", a)
> EAN(trees[k - 1], "Ceb", a)))
|| (Cea != EAN(trees[k - 1], "Cea", a)
&& (EAN(trees[k - 1], "Cea", a)
< EAN(trees[k - 1], "Ceb", a)))) {
u = VAP(graph, "hrev", a);
if (u == NULL) {
copula = EAP(trees[k - 1], "copula", a);
measure = EAP(trees[k - 1], "measure", a);
u = gsl_vector_alloc(m);
dml_copula_h(copula, measure->y, measure->x, u);
SETVAP(graph, "hrev", a, u);
gsl_sort_vector_index(perm, u);
rank = gsl_permutation_alloc(m);
gsl_permutation_inverse(rank, perm);
SETVAP(graph, "hrevrank", a, rank);
}
u_rank = VAP(graph, "hrevrank", a);
}
// Assign v and v_rank.
if ((Ceb == EAN(trees[k - 1], "Cea", b)
&& (EAN(trees[k - 1], "Cea", b)
< EAN(trees[k - 1], "Ceb", b)))
|| (Ceb != EAN(trees[k - 1], "Cea", b)
&& (EAN(trees[k - 1], "Cea", b)
> EAN(trees[k - 1], "Ceb", b)))) {
v = VAP(graph, "h", b);
if (v == NULL) {
copula = EAP(trees[k - 1], "copula", b);
measure = EAP(trees[k - 1], "measure", b);
v = gsl_vector_alloc(m);
dml_copula_h(copula, measure->x, measure->y, v);
SETVAP(graph, "h", b, v);
gsl_sort_vector_index(perm, v);
rank = gsl_permutation_alloc(m);
gsl_permutation_inverse(rank, perm);
SETVAP(graph, "hrank", b, rank);
}
v_rank = VAP(graph, "hrank", b);
}
if ((Ceb == EAN(trees[k - 1], "Cea", b)
&& (EAN(trees[k - 1], "Cea", b)
> EAN(trees[k - 1], "Ceb", b)))
|| (Ceb != EAN(trees[k - 1], "Cea", b)
&& (EAN(trees[k - 1], "Cea", b)
< EAN(trees[k - 1], "Ceb", b)))) {
v = VAP(graph, "hrev", b);
if (v == NULL) {
copula = EAP(trees[k - 1], "copula", b);
measure = EAP(trees[k - 1], "measure", b);
v = gsl_vector_alloc(m);
dml_copula_h(copula, measure->y, measure->x, v);
SETVAP(graph, "hrev", b, v);
gsl_sort_vector_index(perm, v);
rank = gsl_permutation_alloc(m);
gsl_permutation_inverse(rank, perm);
SETVAP(graph, "hrevrank", b, rank);
}
v_rank = VAP(graph, "hrevrank", b);
}
// Set the weight of the edge. The arguments are ordered here.
// The order determines the x and y fields of measure.
if (Cea < Ceb) {
rvine_set_weight(graph, weight, e, u, v, u_rank, v_rank);
} else {
rvine_set_weight(graph, weight, e, v, u, v_rank, u_rank);
}
}
}
// Compute the minimum weight spanning tree.
trees[k] = g_malloc(sizeof(igraph_t));
igraph_vector_init(graph_weight, igraph_ecount(graph));
EANV(graph, "weight", graph_weight);
igraph_minimum_spanning_tree_prim(graph, trees[k], graph_weight);
igraph_vector_destroy(graph_weight);
tree_aic = 0;
for (e = 0; e < igraph_ecount(trees[k]); e++) {
igraph_edge(trees[k], e, &a, &b);
Cea = EAN(trees[k], "Cea", e);
Ceb = EAN(trees[k], "Ceb", e);
measure = EAP(trees[k], "measure", e);
// Assign a bivariate copula to the edge.
if (Cea < Ceb) {
copula = dml_copula_select(measure->x, measure->y, measure,
indeptest, indeptest_level, types,
types_size, select, rng);
// Get information for the truncation of the vine.
if (trunc == DML_VINE_TRUNC_AIC) {
dml_copula_aic(copula, measure->x, measure->y, &copula_aic);
tree_aic += copula_aic;
}
} else {
copula = dml_copula_select(measure->y, measure->x, measure,
indeptest, indeptest_level, types,
types_size, select, rng);
// Get information for the truncation of the vine.
if (trunc == DML_VINE_TRUNC_AIC) {
dml_copula_aic(copula, measure->y, measure->x, &copula_aic);
tree_aic += copula_aic;
}
}
SETEAP(trees[k], "copula", e, copula);
}
igraph_destroy(graph);
// Check if the vine should be truncated.
if (trunc == DML_VINE_TRUNC_AIC && tree_aic >= 0) {
// Free the memory used for the last tree.
rvine_tree_cleanup(trees[k]);
for (e = 0; e < igraph_ecount(trees[k]); e++) {
copula = EAP(trees[k], "copula", e);
dml_copula_free(copula);
}
igraph_destroy(trees[k]);
g_free(trees[k]);
trees[k] = NULL;
break;
}
if (k > 0) rvine_tree_cleanup(trees[k - 1]);
}
// Cleanup the last tree if the vine was completely estimated.
// If the vine was truncated, the last tree will be freed in
// the function vine_fit_rvine, because the rvine_trees_to_vine
// function needs some attributes of its edges.
if (k == n - 1) {
rvine_tree_cleanup(trees[n - 2]);
}
g_free(graph_weight);
g_free(graph);
gsl_permutation_free(perm);
}
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);
}
AnovaTest::AnovaTest(mv_Method *mm, gsl_matrix *Y, gsl_matrix *X, gsl_matrix *isXvarIn):mmRef(mm), Yref(Y), Xref(X), inRef(isXvarIn)
{
unsigned int hid, aid;
unsigned int i, j, count;
nModels=inRef->size1, nParam=Xref->size2;
nRows=Yref->size1, nVars=Yref->size2;
// printf("initialize public variables: stats\n");
multstat=(double *)malloc((nModels-1)*sizeof(double));
Pmultstat = (double *)malloc((nModels-1)*sizeof(double));
for (j=0; j<nModels-1; j++) *(Pmultstat+j)=0.0;
dfDiff = (unsigned int *)malloc((nModels-1)*sizeof(unsigned int));
statj = gsl_matrix_alloc(nModels-1, nVars);
Pstatj = gsl_matrix_alloc(nModels-1, nVars);
gsl_matrix_set_zero(Pstatj);
bStatj = gsl_vector_alloc(nVars);
Hats = (mv_mat *)malloc(nModels*sizeof(mv_mat));
sortid = (gsl_permutation **)malloc((nModels-1)*sizeof(gsl_permutation *));
for (i=0; i<nModels; i++ ) {
// Hats[i]
Hats[i].mat=gsl_matrix_alloc(nRows, nRows);
Hats[i].SS=gsl_matrix_alloc(nVars, nVars);
Hats[i].R=gsl_matrix_alloc(nVars, nVars);
Hats[i].Res=gsl_matrix_alloc(nRows, nVars);
Hats[i].Y = gsl_matrix_alloc(nRows, nVars);
Hats[i].sd = gsl_vector_alloc(nVars);
count = 0;
for (j=0; j<nParam; j++){
count+=(unsigned int)gsl_matrix_get(inRef, i, j);
}
// printf("count=%d \n", count);
Hats[i].X = gsl_matrix_alloc(nRows, count);
Hats[i].Coef=gsl_matrix_alloc(count, nVars);
gsl_vector_view refi=gsl_matrix_row(inRef, i);
subX(Xref, &refi.vector, Hats[i].X);
calcSS(Yref, &(Hats[i]), mmRef);
// displaymatrix(Hats[i].SS, "SS");
}
for (i=1; i<nModels; i++) {
hid = i; aid = i-1;
if ( mmRef->resamp != CASEBOOT ) {
// fit = Y- resi
gsl_matrix_memcpy (Hats[i].Y, Yref);
gsl_matrix_sub (Hats[i].Y, Hats[i].Res);
}
gsl_vector_view statij = gsl_matrix_row(statj, aid);
testStatCalc(&(Hats[hid]), &(Hats[aid]), mmRef, TRUE, (multstat+aid), &statij.vector);
dfDiff[aid] = Hats[aid].X->size2-Hats[hid].X->size2;
// sortid
sortid[aid] = gsl_permutation_alloc(nVars);
gsl_sort_vector_index (sortid[aid], &statij.vector);
// rearrange sortid in descending order
gsl_permutation_reverse (sortid[aid]);
}
// initialize resampling indices
// getBootID(); done in R
bootID = NULL;
// Initialize GSL rnd environment variables
const gsl_rng_type *T;
gsl_rng_env_setup();
T = gsl_rng_default;
// an mt19937 generator with a seed of 0
rnd = gsl_rng_alloc(T);
if (mmRef->reprand!=TRUE){
struct timeval tv; // seed generation based on time
gettimeofday(&tv, 0);
unsigned long mySeed=tv.tv_sec + tv.tv_usec;
gsl_rng_set(rnd, mySeed); // reset seed
}
// printf("Anova test initialized.\n");
}
