void LinearGaussian::init_and_weight(NumericMatrix & xparticles, NumericVector & logweights){ RNGScope scope; int nparticles = xparticles.nrow(); std::fill(xparticles.begin(), xparticles.end(), 0); xparticles(_,0) = rnorm(nparticles, 0, sigma / sqrt(1 - rho*rho)); for (int iparticle = 0; iparticle < nparticles; iparticle++){ logweights(iparticle) = Minus1Div2SdMeasurSquared * (xparticles(iparticle,0) - observations(0, 0)) * (xparticles(iparticle,0) - observations(0, 0)); } }
// [[Rcpp::export]] NumericMatrix matrixSqrt(NumericMatrix orig) { // allocate the matrix we will return NumericMatrix mat(orig.nrow(), orig.ncol()); // transform it std::transform(orig.begin(), orig.end(), mat.begin(), ::sqrt); // return the new matrix return mat; }
// [[Rcpp::export]] List MatrixExample(NumericMatrix orig) { NumericMatrix mat(orig.nrow(), orig.ncol()); // we could query size via // int n = mat.nrow(), k=mat.ncol(); // and loop over the elements, but using the STL is so much nicer // so we use a STL transform() algorithm on each element std::transform(orig.begin(), orig.end(), mat.begin(), sqrt_double ); List result = List::create( Named( "result" ) = mat, Named( "original" ) = orig ); return result ; }
// Scan a single chromosome with additive covariates and weights // // genoprobs = 3d array of genotype probabilities (individuals x genotypes x positions) // pheno = matrix of numeric phenotypes (individuals x phenotypes) // (no missing data allowed, values should be in [0,1]) // addcovar = additive covariates (an intercept, at least) // weights = vector of weights // // output = matrix of (weighted) residual sums of squares (RSS) (phenotypes x positions) // // [[Rcpp::export]] NumericMatrix scan_binary_onechr_weighted(const NumericVector& genoprobs, const NumericMatrix& pheno, const NumericMatrix& addcovar, const NumericVector& weights, const int maxit=100, const double tol=1e-6, const double qr_tol=1e-12, const double eta_max=30.0) { const int n_ind = pheno.rows(); if(Rf_isNull(genoprobs.attr("dim"))) throw std::invalid_argument("genoprobs should be a 3d array but has no dim attribute"); const Dimension d = genoprobs.attr("dim"); if(d.size() != 3) throw std::invalid_argument("genoprobs should be a 3d array"); if(n_ind != d[0]) throw std::range_error("nrow(pheno) != nrow(genoprobs)"); if(n_ind != addcovar.rows()) throw std::range_error("nrow(pheno) != nrow(addcovar)"); if(n_ind != weights.size()) throw std::range_error("nrow(pheno) != length(weights)"); const int n_pos = d[2]; const int n_gen = d[1]; const int n_add = addcovar.cols(); const int g_size = n_ind * n_gen; const int n_phe = pheno.cols(); NumericMatrix result(n_phe, n_pos); NumericMatrix X(n_ind, n_gen+n_add); if(n_add > 0) // paste in covariates, if present std::copy(addcovar.begin(), addcovar.end(), X.begin() + g_size); for(int pos=0, offset=0; pos<n_pos; pos++, offset += g_size) { Rcpp::checkUserInterrupt(); // check for ^C from user // copy genoprobs for this pos into a matrix std::copy(genoprobs.begin() + offset, genoprobs.begin() + offset + g_size, X.begin()); for(int phe=0; phe<n_phe; phe++) { // calc rss and paste into ith column of result result(phe,pos) = calc_ll_binreg_weighted(X, pheno(_,phe), weights, maxit, tol, qr_tol, eta_max); } } return result; }
// [[Rcpp::export]] NumericMatrix samplehouseholds_format2(NumericMatrix phi, NumericMatrix w, NumericVector pi, NumericVector d, List lambda, int currrentbatch, int nHouseholds, int householdsize) { int K = w.nrow(); int L = w.ncol(); int p = d.length(); int n_lambdas = lambda.length(); int *lambda_columns = new int[n_lambdas]; double **lambdas = new double*[n_lambdas]; int maxDDtp = phi.nrow(); int maxdd = maxDDtp / p; //int ncol = householdsize * DIM + 1 + householdsize; //output data: zero-based //column 0: household unique index //column 1: member index within the household (pernum:person number?) //column 2 to 2+p-1: individual data //column 2+p: 2+p+n_lambdas-2: household level data //column 2+p+n_lambdas-1: household group indicator //column last hh_size: individual group indicator int DIM = 2 + p + n_lambdas - 1; //not output the household size int ncol = DIM * householdsize + householdsize + 1; NumericMatrix data(nHouseholds, ncol); //copy data from list of matrices to C++ for (int i = 0; i < n_lambdas; i++) { NumericMatrix l = lambda[i]; lambda_columns[i] = l.ncol(); lambdas[i] = new double[l.length()]; std::copy(l.begin(), l.end(), lambdas[i]); } //printf("in samplehouseholds\n"); NumericVector rand = runif(nHouseholds * ncol); //at most this many sampleHouseholds_imp_format2(data.begin(), rand.begin(), lambdas, lambda_columns, w.begin(), phi.begin(), pi.begin(),d.begin(), nHouseholds, householdsize, K, L,maxdd,p, currrentbatch,n_lambdas); //clean up delete [] lambda_columns; for (int i = 0; i < n_lambdas; i++) { delete [] lambdas[i]; } delete [] lambdas; //printf("done samplehouseholds\n"); return data; }
double nlsResp::updateMu(const VectorXd& gamma) { int n = d_y.size(); if (gamma.size() != d_gamma.size()) throw invalid_argument("size mismatch in updateMu"); std::copy(gamma.data(), gamma.data() + gamma.size(), d_gamma.data()); const VectorXd lp(d_gamma + d_offset); // linear predictor const double *gg = lp.data(); for (int p = 0; p < d_pnames.size(); ++p) { std::string pn(d_pnames[p]); NumericVector pp = d_nlenv.get(pn); std::copy(gg + n * p, gg + n * (p + 1), pp.begin()); } NumericVector rr = d_nlmod.eval(SEXP(d_nlenv)); if (rr.size() != n) throw invalid_argument("dimension mismatch"); std::copy(rr.begin(), rr.end(), d_mu.data()); NumericMatrix gr = rr.attr("gradient"); std::copy(gr.begin(), gr.end(), d_sqrtXwt.data()); return updateWrss(); }
/** * Update L, Ut and cu for new weights. * * Update Ut from Zt and sqrtXwt, then L from Lambda and Ut * Update cu from wtres, Lambda and Ut. * * @param Xwt Matrix of weights for the model matrix * @param wtres weighted residuals */ void reModule::reweight(Rcpp::NumericMatrix const& Xwt, Rcpp::NumericVector const& wtres) { double mone = -1., one = 1.; int Wnc = Xwt.ncol(); if (d_Ut) M_cholmod_free_sparse(&d_Ut, &c); if (Wnc == 1) { d_Ut = M_cholmod_copy_sparse(&d_Zt, &c); chmDn csqrtX(Xwt); M_cholmod_scale(&csqrtX, CHOLMOD_COL, d_Ut, &c); } else { int n = Xwt.nrow(); CHM_TR tr = M_cholmod_sparse_to_triplet(&d_Zt, &c); int *j = (int*)tr->j, nnz = tr->nnz; double *x = (double*)tr->x, *W = Xwt.begin(); for (int k = 0; k < nnz; k++) { x[k] *= W[j[k]]; j[k] = j[k] % n; } tr->ncol = (size_t)n; d_Ut = M_cholmod_triplet_to_sparse(tr, nnz, &c); M_cholmod_free_triplet(&tr, &c); } // update the factor L CHM_SP LambdatUt = d_Lambda.crossprod(d_Ut); d_L.update(*LambdatUt, 1.); d_ldL2 = d_L.logDet2(); // update cu chmDn ccu(d_cu), cwtres(wtres); copy(d_u0.begin(), d_u0.end(), d_cu.begin()); M_cholmod_sdmult(LambdatUt, 0/*trans*/, &one, &mone, &cwtres, &ccu, &c); M_cholmod_free_sparse(&LambdatUt, &c); NumericMatrix ans = d_L.solve(CHOLMOD_L, d_L.solve(CHOLMOD_P, d_cu)); copy(ans.begin(), ans.end(), d_cu.begin()); d_CcNumer = inner_product(d_cu.begin(), d_cu.end(), d_cu.begin(), double()); }
double nlmerResp::updateMu(Rcpp::NumericVector const &gamma) throw(std::runtime_error) { int n = d_y.size(); #ifdef USE_RCPP_SUGAR Rcpp::NumericVector gam = gamma + d_offset; #else NumericVector gam(d_offset.size()); std::transform(gamma.begin(), gamma.end(), d_offset.begin(), gam.begin(), std::plus<double>()); #endif double *gg = gam.begin(); for (int p = 0; p < d_pnames.size(); p++) { std::string pn(d_pnames[p]); Rcpp::NumericVector pp = d_nlenv.get(pn); std::copy(gg + n * p, gg + n * (p + 1), pp.begin()); } NumericVector rr = d_nlmod.eval(SEXP(d_nlenv)); if (rr.size() != n) throw std::runtime_error("dimension mismatch"); std::copy(rr.begin(), rr.end(), d_mu.begin()); NumericMatrix rrg = rr.attr("gradient"); std::copy(rrg.begin(), rrg.end(), d_sqrtXwt.begin()); return updateWrss(); }
// [[Rcpp::export]] NumericMatrix getRandomMatrix_AbundanceQuantMatrix(NumericVector mAbundance, NumericVector nAbundance, NumericMatrix quantInteractions, NumericMatrix probInteractions) { //TODO make sure all lengths are okay NumericVector m_abundance = clone(mAbundance); NumericVector n_abundance = clone(nAbundance); NumericMatrix to_return(probInteractions.nrow(), probInteractions.ncol()); double total_interactions = std::accumulate(quantInteractions.begin(), quantInteractions.end(), 0); double num_cur_interactions = 0; double num_m_left = std::accumulate(m_abundance.begin(), m_abundance.end(), 0); double num_n_left = std::accumulate(n_abundance.begin(), n_abundance.end(), 0); while(num_cur_interactions < total_interactions) { //pick an M int random_m = round(runif(1, 0, num_m_left - 1)[0]); int random_m_idx = -1; int m_sum = 0; for (int m_idx = 0; m_idx < m_abundance.size(); m_idx++) { m_sum += m_abundance[m_idx]; if (m_sum >= random_m) { random_m_idx = m_idx; break; } } if (random_m_idx < 0) { //TODO We broke something... std::cerr << "nah, this isn't right... m" << std::endl; } //pick an N int random_n = round(runif(1, 0, num_n_left - 1)[0]); int random_n_idx = -1; int n_sum = 0; for (int n_idx = 0; n_idx < n_abundance.size(); n_idx++) { n_sum += n_abundance[n_idx]; if (n_sum >= random_n) { random_n_idx = n_idx; break; } } if (random_n_idx < 0) { //TODO We broke something... std::cerr << "nah, this isn't right... n" << std::endl; } //can they interact? If so, add the edge if(runif(1, 0, 1)[0] < probInteractions(random_m_idx, random_n_idx)) { //update mAbundances, nAbundances, num_cur_interactions, and num_left num_cur_interactions += 1; m_abundance[random_m_idx] -= 1; n_abundance[random_n_idx] -= 1; num_m_left -= 1; num_n_left -= 1; to_return(random_m_idx, random_n_idx) += 1; } } return to_return; }
// [[Rcpp::export]] NumericVector getMonotonicTimeseries(NumericMatrix originalMatrix, int timeSteps, int nodfFrequency, bool sortFirst=true) { RNGScope scope; std::vector<double> nodf_timeseries; NumericMatrix random_mat(originalMatrix.nrow(), originalMatrix.ncol()); int num_edges = std::accumulate(originalMatrix.begin(), originalMatrix.end(), 0); int num_m = originalMatrix.nrow(); int num_n = originalMatrix.ncol(); double lambda_edge = (double(num_edges) - 1) /timeSteps; double lambda_m = (double(num_m) - 1)/timeSteps; double lambda_n = (double(num_n) - 1)/timeSteps; int cur_edges = 1; int cur_m = 1; int cur_n = 1; int time_step = 0; while(cur_m < num_m || cur_n < num_n || cur_edges < num_edges) { if(time_step > 0 && time_step % nodfFrequency == 0) { NumericMatrix to_test = random_mat(Range(0, cur_m - 1), Range(0, cur_n - 1)); if(sortFirst) to_test = sortMatrix(to_test); List nodf_result = calculateNODF(to_test); nodf_timeseries.push_back(Rcpp::as<double>(nodf_result["NODF"])); } //add m (hosts) if (cur_m < num_m) cur_m += rpois(1, lambda_m)[0]; cur_m = std::min(cur_m, num_m); //add n (parasites) if (cur_n < num_n) cur_n += rpois(1, lambda_n)[0]; cur_n = std::min(cur_n, num_n); //TODO: make sure cur_n and cur_m never go > m and n, since in this model, //we have a max size on our matrix from the start. //add edges if(cur_edges < num_edges) { int edge_event = rpois(1, lambda_edge)[0]; if(cur_m*cur_n - cur_edges < edge_event) { //not enough space for edges... //max out how many edges we should add then edge_event = cur_m * cur_n - cur_edges; } int num_edges_left = edge_event; while(num_edges_left > 0) { //better algorithm : count how many non-edges there are, use that as prob of picking 1 of them //iterate through matrix until we find a 0, then pull from ^ prob to add edge or not... int num_vacant_edges = cur_m * cur_n - cur_edges; double prob_add_edge = 1 / double(num_vacant_edges); for(int i = 0; i < cur_m; i++) { for(int j=0; j < cur_n; j++) { double ran_draw = runif(1, 0, 1)[0]; if(random_mat(i,j) == 0 && ran_draw < prob_add_edge && num_edges_left > 0) { num_edges_left -= 1; cur_edges += 1; random_mat(i, j) = 1; } } } } } time_step += 1; } return wrap(nodf_timeseries); }
// [[Rcpp::export]] NumericMatrix getRandomMatrix_GrowMonotonic(NumericMatrix originalMatrix, int timeSteps=100) { RNGScope scope; NumericMatrix random_mat(originalMatrix.nrow(), originalMatrix.ncol()); int num_edges = std::accumulate(originalMatrix.begin(), originalMatrix.end(), 0); int num_m = originalMatrix.nrow(); int num_n = originalMatrix.ncol(); double lambda_edge = (double(num_edges) - 1) /timeSteps; double lambda_m = (double(num_m) - 1)/timeSteps; double lambda_n = (double(num_n) - 1)/timeSteps; int cur_edges = 1; int cur_m = 1; int cur_n = 1; while(cur_m < num_m || cur_n < num_n || cur_edges < num_edges) { //add m (hosts) if (cur_m < num_m) cur_m += rpois(1, lambda_m)[0]; cur_m = std::min(cur_m, num_m); //add n (parasites) if (cur_n < num_n) cur_n += rpois(1, lambda_n)[0]; cur_n = std::min(cur_n, num_n); //TODO: make sure cur_n and cur_m never go > m and n, since in this model, //we have a max size on our matrix from the start. //add edges if(cur_edges < num_edges) { int edge_event = rpois(1, lambda_edge)[0]; if(cur_m*cur_n - cur_edges < edge_event) { //not enough space for edges... //max out how many edges we should add then edge_event = cur_m * cur_n - cur_edges; } int num_edges_left = edge_event; while(num_edges_left > 0) { //better algorithm : count how many non-edges there are, use that as prob of picking 1 of them //iterate through matrix until we find a 0, then pull from ^ prob to add edge or not... int num_vacant_edges = cur_m * cur_n - cur_edges; double prob_add_edge = 1 / double(num_vacant_edges); for(int i = 0; i < cur_m; i++) { for(int j=0; j < cur_n; j++) { double ran_draw = runif(1, 0, 1)[0]; if(random_mat(i,j) == 0 && ran_draw < prob_add_edge && num_edges_left > 0) { num_edges_left -= 1; cur_edges += 1; random_mat(i, j) = 1; } } } } } } return random_mat; }
NumericMatrix stl_sort_matrix(NumericMatrix x) { NumericMatrix y = clone(x); std::sort(y.begin(), y.end()); return y; }
/** * Solve for the increment given the updated cu * * @param cu */ void reModule::updateIncr(const Rcpp::NumericVector& cu) { NumericMatrix nu = d_L.solve(CHOLMOD_Pt, d_L.solve(CHOLMOD_Lt, cu)); copy(nu.begin(), nu.end(), d_incr.begin()); }
/** * Solve for the increment only. * */ double reModule::solveIncr() { NumericMatrix mm = d_L.solve(CHOLMOD_Pt, d_L.solve(CHOLMOD_Lt, d_cu)); copy(mm.begin(), mm.end(), d_incr.begin()); return d_CcNumer; }
RcppExport SEXP R_glmApply2( SEXP expression_, SEXP data_, SEXP pBigMat_, SEXP env_, SEXP terms_, SEXP nthreads_, SEXP useMean_, SEXP useIdentityLink_, SEXP univariate_, SEXP multivariate_, SEXP quiet_, SEXP cincl_){ BEGIN_RCPP CharacterVector expression( expression_ ); Environment env( env_ ); std::vector<int> terms = as<std::vector<int> >( terms_ ); int nthreads = as<int>( nthreads_ ); bool useMean = (bool) as<int>( useMean_ ); bool useIdentityLink = as<int>( useIdentityLink_ ); bool univariate = as<int>( univariate_ ); bool multivariate = as<int>( multivariate_ ); bool quiet = as<int>( quiet_ ); std::vector<int> cincl = as<std::vector<int> >( cincl_ ); regressionType regressType = useIdentityLink ? LINEAR : LOGISTIC; featureBatcher fbatch( data_, pBigMat_, 10000, cincl); // Get original number of threads int n_threads_original = omp_get_max_threads(); // Set threads to 1 omp_set_num_threads( nthreads ); // Intel paralellism #ifdef INTEL mkl_set_num_threads( 1 ); #endif // disable nested OpenMP parallelism omp_set_nested(0); // Process exression, X_loop and env Rexpress expr( as<string>( expression ), fbatch.get_N_indivs(), env ); RcppGSL::matrix<double> Y = expr.get_response_m(); int n_indivs = Y->size1; int n_pheno = Y->size2; if( n_pheno > 1 && regressType == LOGISTIC ){ Y.free(); throw invalid_argument("Cannot do multivariate logistic regression\n"); } RcppGSL::matrix<double> Xn = expr.get_model_matrix_null(); if( n_pheno == 1 ) multivariate = false; // Check that sizes of and X_loop match if( n_indivs != fbatch.get_N_indivs() ){ Y.free(); Xn.free(); throw invalid_argument("Dimensions of response and design matrix do not match\n"); } NumericMatrix pValues; NumericMatrix pValues_multivariate; // Define p-values matrix to be returned, only of the corresponding test is performed // Initialize values to NAN if( univariate ){ pValues = NumericMatrix( fbatch.get_N_features(), n_pheno ); std::fill(pValues.begin(), pValues.end(), NAN); } if( multivariate ){ pValues_multivariate = NumericMatrix( fbatch.get_N_features(), 2 ); std::fill(pValues_multivariate.begin(), pValues_multivariate.end(), NAN); } // X_clean = model.matrix.default( y ~ sex:One + age ) // Replace marker with 1's so that design matrix for marker j can be created by multiplcation RcppGSL::matrix<double> X_clean = expr.get_model_matrix_clean(); // If trying to access index beyond range // Exit gracefully if( terms[which_max(terms)] >= X_clean->size2 ){ Y.free(); Xn.free(); X_clean.free(); throw range_error("Element in \"terms\" is out of range"); } // get indeces of columns that depend on SNP vector<int> loopIndex = expr.get_loop_terms(); // Indeces that don't depend on SNP, i,e. are complementary vector<int> loopCompl; for(int i=0; i<X_clean->size2; i++){ if( ! is_in_vector(loopIndex, i) ){ loopCompl.push_back(i); } } // Extract covariate terms gsl_matrix *X_clean_cov = gsl_matrix_alloc(X_clean->size1, loopCompl.size()); gsl_matrix_sub_col(X_clean, loopCompl, X_clean_cov); LM_preproc *preproc = LM_preproc_alloc( Y, X_clean_cov); gsl_matrix_free(X_clean_cov); long batch_size = MAX( 1, fbatch.getBatchSize()/100.0 ); long tests_completed = 0; Progress p(0, false); time_t start_time; time(&start_time); bool useThisChunk; for(int i_set=0; i_set<fbatch.get_N_features(); i_set+=fbatch.getBatchSize()){ // Load data from binary matrix (or do noting if NumericMatrix is used) useThisChunk = fbatch.loadNextChunk(); if( ! useThisChunk ) continue; #pragma omp parallel { Preproc_workspace *proc_work = Preproc_workspace_alloc( Y, loopIndex.size(), preproc); // Variables local to each thread gsl_matrix *X = gsl_matrix_alloc( X_clean->size1, X_clean->size2 ); gsl_vector_view col_view, col_view_y; gsl_vector *marker_j = gsl_vector_alloc( fbatch.get_N_indivs() ); GLM_MV_workspace *workmv; GLM_IRLS_workspace *irls_workspace; gsl_vector *y, *beta; double sig_e, log_L; int rank; if( regressType == LINEAR ){ workmv = GLM_MV_workspace_alloc(Y->size1, X->size2, Y->size2, true, false); }else{ y = gsl_vector_attach_array( Y->data, Y->size1 ); beta = gsl_vector_calloc( X->size2 ); irls_workspace = GLM_IRLS_workspace_alloc( X->size1, X->size2, true); } double Hotelling, Pillai; bool isMissing; #pragma omp for //schedule(static, batch_size) for(int j=0; j<fbatch.getBatchSize(); j++){ // If element j+i_set is not include include list, than skip if( ! fbatch.contains_element(j+i_set) ){ continue; } #pragma omp critical tests_completed++; fbatch.getFeautureInChunk( j, marker_j ); if( useMean ) isMissing = gsl_vector_set_missing_mean( marker_j ); else isMissing = any_is_na( marker_j->data, marker_j->size ); // Check if X has an NA value // If it does, set the p-value to if( isMissing && ! useMean){ if( univariate ){ #pragma omp critical for(int k=0; k<n_pheno; k++){ pValues(j+i_set,k) = NA_REAL; } } #pragma omp critical if( multivariate ){ pValues_multivariate(j+i_set,0) = NA_REAL; pValues_multivariate(j+i_set,1) = NA_REAL; } continue; } // Copy clean version of matrices to active variables gsl_matrix_memcpy( X, X_clean ); for(int k=0; k<loopIndex.size(); k++){ // X_design[,loopIndex[k]] = X_design[,loopIndex[k]] * marker_j col_view = gsl_matrix_column( (gsl_matrix*)(X), loopIndex[k] ); gsl_vector_mul( &col_view.vector, marker_j ); } // Evaluate regression if( regressType == LINEAR ){ // Extract marker terms gsl_matrix *X_markers = gsl_matrix_alloc(X->size1, loopIndex.size()); gsl_matrix_sub_col(X, loopIndex, X_markers); gsl_vector *pvals = GLM_regression_preproc( Y, X_markers, workmv, preproc, proc_work); gsl_matrix_free(X_markers); #pragma omp critical for(int k=0; k<n_pheno; k++){ pValues(j+i_set,k) = gsl_vector_get(pvals, k); } gsl_vector_free( pvals ); /*if( multivariate ){ GLM_HotellingPillai_test( X, workmv, terms, &Hotelling, &Pillai ); #pragma omp critical { pValues_multivariate(j+i_set,0) = Hotelling; pValues_multivariate(j+i_set,1) = Pillai; } }*/ /*if( univariate ){ // Perform Wald test gsl_vector *pvals = GLM_wald_test( workmv, terms ); #pragma omp critical for(int k=0; k<n_pheno; k++){ pValues(j+i_set,k) = gsl_vector_get(pvals, k); } gsl_vector_free( pvals ); }*/ }else{ // LOGISTIC GLM_unpenalized_regression_IRLS(y, X, beta, &sig_e, &log_L, &rank, regressType, false, irls_workspace); #pragma omp critical pValues(j+i_set,0) = GLM_wald_test( beta, irls_workspace->Sigma, X->size1, terms, regressType, irls_workspace->design_is_singular); } } // END for Preproc_workspace_free(proc_work); gsl_matrix_free( X ); gsl_vector_free( marker_j ); if( regressType == LINEAR ){ GLM_MV_workspace_free( workmv ); }else{ GLM_IRLS_workspace_free( irls_workspace ); gsl_vector_free(y); gsl_vector_free(beta); } } // End parallel if( ! quiet ) Rcpp::Rcout << print_progress( tests_completed, fbatch.get_N_features_included(), 25, start_time); if( Progress::check_abort() ){ Y.free(); Xn.free(); X_clean.free(); return wrap(0); } } // End set loop // Restore original number of threads omp_set_num_threads( n_threads_original ); if( ! quiet ) Rcpp::Rcout << endl; Y.free(); Xn.free(); X_clean.free(); LM_preproc_free( preproc ); Rcpp::List res = Rcpp::List::create(Rcpp::Named("pValues") = pValues, Rcpp::Named("pValues_mv") = pValues_multivariate); return( res ); END_RCPP }
void LinearGaussian::rinit(NumericMatrix & xparticles){ RNGScope scope; int nparticles = xparticles.nrow(); std::fill(xparticles.begin(), xparticles.end(), 0); xparticles(_,0) = rnorm(nparticles, 0, sigma / sqrt(1 - rho*rho)); }
// [[Rcpp::export]] List auxGAPbbDpMulthreadKPs(IntegerMatrix cost, NumericMatrix profitOrLoss, IntegerVector budget, int maxCore = 7, double tlimit = 60, bool greedyBranching = true, String optim = "max") { int Ntask = cost.ncol(), Nagent = cost.nrow(); vec<signed char> Bcontainer(cost.size() + Ntask, -1); vec<WV<double, int> > costprofitInfo(cost.size()); double C = -std::numeric_limits<double>::max(); if(optim == "max") { for(int i = 0, iend = cost.size(); i < iend; ++i) { costprofitInfo[i].weight = cost[i]; costprofitInfo[i].value = profitOrLoss[i]; } } else { C = *std::max_element(profitOrLoss.begin(), profitOrLoss.end()) + 1; for(int i = 0, iend = cost.size(); i < iend; ++i) { costprofitInfo[i].weight = cost[i]; costprofitInfo[i].value = C - profitOrLoss[i]; } } vec<WV<double, int>*> wvptr(Ntask); for(int j = 0; j < Ntask; ++j) { wvptr[j] = &costprofitInfo[0] + j * INT(Nagent); } WV<double, int> **info = &wvptr[0]; vec<int> residualBudget(budget.begin(), budget.end()); vec<signed char> solution; double solutionRevenue = 0; std::time_t timer; time(&timer); int Nnode = 0, Nkp = 0; if(greedyBranching) { solutionRevenue = gapBabDp<double, int, true> ( solution, Bcontainer, Nagent, Ntask, info, &residualBudget[0], maxCore, timer, tlimit, Nnode, Nkp); } else { solutionRevenue = gapBabDp<double, int, false> ( solution, Bcontainer, Nagent, Ntask, info, &residualBudget[0], maxCore, timer, tlimit, Nnode, Nkp); } if(solutionRevenue == -std::numeric_limits<double>::max()) return List::create(); if(C != -std::numeric_limits<double>::max()) { solutionRevenue = C * Ntask - solutionRevenue; } IntegerVector agentCost(Nagent); IntegerVector assignment(Ntask); for(int i = 0; i < Nagent; ++i) { agentCost[i] = 0; for(int j = 0; j < Ntask; ++j) { if(solution[j * (Nagent + 1) + i] <= 0) continue; agentCost[i] += cost[j * Nagent + i]; assignment[j] = i + 1; } } return List::create(Named("totalProfitOrLoss") = solutionRevenue, Named("agentCost") = agentCost, Named("assignment") = assignment, Named("nodes") = Nnode, Named("bkpSolved") = Nkp); }