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"); }