// [[Rcpp::export]] Rcpp::List calib( arma::mat Y, arma::vec C, arma::mat Z, NumericVector mu_input, IntegerVector mu_dim, NumericVector mu0_input, IntegerVector mu0_dim ) { arma::cube mu(mu_input.begin(), mu_dim[0], mu_dim[1], mu_dim[2]); arma::cube mu0(mu0_input.begin(), mu0_dim[0], mu0_dim[1], mu0_dim[2]); int n = Y.n_rows; int p = Y.n_cols; int niter = Z.n_rows; cube calibration(niter,p,n); calibration.fill(0); mat calibrationMedian(n,p); calibrationMedian.fill(0); for(int it=0; it<niter; it++) { for(int i=0; i<n; i++) calibration.slice(i).row(it) = mu.slice(it).cols(Z(it,i)*p,Z(it,i)*p+p-1).row(C(i)) - mu0.slice(it).col(Z(it,i)).t(); } for( int i = 0; i < n; i++) calibrationMedian.row(i) = median(calibration.slice(i),0); return Rcpp::List::create( Rcpp::Named( "Y_cal" ) = Y - calibrationMedian, Rcpp::Named( "calibration_distribution" ) = calibration, Rcpp::Named( "calibration_median" ) = calibrationMedian ) ; }
// [[Rcpp::export]] SEXP compPvals2(NumericVector nullvec, NumericVector vec) { //Try above except with iterators. Runs about as fast. int n = nullvec.size(); int m = vec.size(); Rcpp::NumericVector pvalVec(m); typedef Rcpp::NumericVector::iterator vec_iterator; vec_iterator it_nv = nullvec.begin(); vec_iterator it_v = vec.begin(); vec_iterator it_pv = pvalVec.begin(); for(int i=0; i<m; i++) { int count = 0; for(int j=0; j<n; j++) { count = count + (it_nv[j]>=it_v[i]); //cout<<count<<endl; } double val = ((double)count)/((double)n); //cout<<val<<endl; it_pv[i] = val; } return pvalVec; }
// [[Rcpp::export]] S4 CPP_scale_margins_sparse(S4 M, NumericVector rows, NumericVector cols, bool duplicate = true) { if (!M.is("dgCMatrix")) stop("internal error -- not a canonical sparse matrix"); IntegerVector dims = M.slot("Dim"); int nr = dims[0], nc = dims[1]; if (nr != rows.size() || nc != cols.size()) stop("internal error -- row/column weights not conformable with matrix"); if (duplicate) M = clone(M); IntegerVector p = M.slot("p"); IntegerVector::iterator _p = p.begin(); IntegerVector row_of = M.slot("i"); IntegerVector::iterator _row_of = row_of.begin(); NumericVector x = M.slot("x"); NumericVector::iterator _x = x.begin(); NumericVector::iterator _rows = rows.begin(); for (int col = 0; col < nc; col++) { double col_weight = cols[col]; for (int i = _p[col]; i < _p[col+1]; i++) { _x[i] *= _rows[_row_of[i]] * col_weight; } } return M; }
// [[Rcpp::export]] NumericVector CPP_dsm_score_sparse(int nr, int nc, IntegerVector p, IntegerVector row_of, NumericVector f, NumericVector f1, NumericVector f2, double N, int am_code, int sparse, int transform_code) { if (am_code < 0 || am_code >= am_table_entries) stop("internal error -- invalid AM code"); am_func AM = am_table[am_code]; /* selected association measure */ // -- don't check whether sparse=TRUE, so power users can compute non-sparse AMs for nonzero entries of the sparse matrix // if (!sparse) stop("only sparse association scores can be used with sparse matrix representation"); int n_items = f.size(); NumericVector scores(n_items); if (am_code != 0 && (nr != f1.size() || nc != f2.size())) stop("internal error -- marginal vectors f1 and f2 not conformable with matrix f"); IntegerVector::iterator _p = p.begin(); IntegerVector::iterator _row_of = row_of.begin(); NumericVector::iterator _f = f.begin(); NumericVector::iterator _f1 = f1.begin(); NumericVector::iterator _f2 = f2.begin(); NumericVector::iterator _scores = scores.begin(); for (int col = 0; col < nc; col++) { for (int i = _p[col]; i < _p[col+1]; i++) { /* frequeny measure (*am_code == 0) is a special case, since marginals may not be available ("reweight" mode) */ double score = (am_code == 0) ? _f[i] : AM(_f[i], _f1[_row_of[i]], _f2[col], N, sparse); _scores[i] = (transform_code) ? transform(score, transform_code) : score; } } return scores; }
// [[Rcpp::export]] NumericVector ptsThresh(NumericVector values,NumericVector endDates,int window){ int valuesLen = values.length(); NumericVector out = clone(values); NumericVector startDates = endDates - window; for (int i = 0; i < valuesLen; ++i){ LogicalVector idx = (endDates <= endDates[i]) & (endDates >= startDates[i]); NumericVector valuesWindow = values[idx]; int lenCur = valuesWindow.length(); if (lenCur == 1){ out[i] = (1.4 / 1.3) * valuesWindow[i]; } if (lenCur == 2){ out[i] = (1.5 / 2.4) * sum(valuesWindow); } if (lenCur == 3){ out[i] = (1.5 / 3.3) * sum(valuesWindow); } if (lenCur == 4){ out[i] = (1.5 / 4.0) * sum(valuesWindow); } if (lenCur >= 5){ std::nth_element(valuesWindow.begin(),valuesWindow.begin() + 5,valuesWindow.end()); out[i] = valuesWindow[4]; } } return out; }
// [[Rcpp::export]] SEXP compPvals3(NumericVector nullvec, NumericVector vec) { //A fancyer version using iterators. Actually runs much slower!!!! int n = nullvec.size(); int m = vec.size(); Rcpp::NumericVector pvalVec(m); typedef Rcpp::NumericVector::iterator vec_iterator; //vec_iterator it_nv = nullvec.begin(); //vec_iterator it_v = vec.begin(); //vec_iterator it_pv = pvalVec.begin(); for(vec_iterator it_v = vec.begin(), it_pv = pvalVec.begin(); it_v != vec.end(); ++it_v, ++it_pv) { int count = 0; for(vec_iterator it_nv = nullvec.begin(); it_nv != nullvec.end(); ++it_nv) { count = count + ( *it_nv >= *it_v ); //cout<<count<<endl; } double val = ((double)count)/((double)n); //cout<<val<<endl; *it_pv = val; } return pvalVec; }
// [[Rcpp::export]] NumericVector ddirichlet(NumericVector xx , NumericVector alphaa){ if (is_true(any(alphaa<=0))){ return wrap(-1e20); } if (is_true(any( (xx <=0) ))){ return wrap(-1e20); } double alpha_sum = std::accumulate(alphaa.begin(), alphaa.end(), 0.0); // this will return alpha_sum = 0 0 0 //return (alpha_sum); NumericVector log_gamma_alpha = lgamma(alphaa); NumericVector log_alpha_sum = lgamma(wrap(alpha_sum)); double sum_log_gamma_alpha = std::accumulate(log_gamma_alpha.begin(), log_gamma_alpha.end(), 0.0); double logD = sum_log_gamma_alpha - as<double>(log_alpha_sum); NumericVector a = ( alphaa - 1.0 ) * log(xx); return wrap( std::accumulate(a.begin(), a.end(), 0.0) - logD ); }
// [[Rcpp::export]] NumericMatrix CPP_dsm_score_dense(NumericMatrix f, NumericVector f1, NumericVector f2, double N, int am_code, int sparse, int transform_code) { if (am_code < 0 || am_code >= am_table_entries) stop("internal error -- invalid AM code"); am_func AM = am_table[am_code]; /* selected association measure */ int nr = f.nrow(), nc = f.ncol(); if (am_code != 0 && (nr != f1.size() || nc != f2.size())) stop("internal error -- marginal vectors f1 and f2 not conformable with matrix f"); NumericMatrix scores(nr, nc); NumericMatrix::iterator _f = f.begin(); NumericVector::iterator _f1 = f1.begin(); NumericVector::iterator _f2 = f2.begin(); NumericMatrix::iterator _scores = scores.begin(); int i = 0; for (int col = 0; col < nc; col++) { for (int row = 0; row < nr; row++) { /* frequeny measure (am_code == 0) is a special case, since marginals may not be available (in "reweight" mode) */ double score = (am_code == 0) ? _f[i] : AM(_f[i], _f1[row], _f2[col], N, sparse); _scores[i] = (transform_code) ? transform(score, transform_code) : score; i++; } } return scores; }
NumericVector logLikMixHMM(NumericVector transitionMatrix, NumericVector emissionArray, NumericVector initialProbs, IntegerVector obsArray, NumericMatrix coefs, NumericMatrix X_, IntegerVector numberOfStates) { IntegerVector eDims = emissionArray.attr("dim"); //m,p,r IntegerVector oDims = obsArray.attr("dim"); //k,n,r int q = coefs.nrow(); arma::mat coef(coefs.begin(),q,coefs.ncol()); coef.col(0).zeros(); arma::mat X(X_.begin(),oDims[0],q); arma::mat lweights = exp(X*coef).t(); if(!lweights.is_finite()){ return wrap(-std::numeric_limits<double>::max()); } lweights.each_row() /= sum(lweights,0); arma::colvec init(initialProbs.begin(),eDims[0], true); arma::mat transition(transitionMatrix.begin(),eDims[0],eDims[0], true); arma::cube emission(emissionArray.begin(), eDims[0], eDims[1], eDims[2], true); arma::icube obs(obsArray.begin(), oDims[0], oDims[1], oDims[2], false); arma::vec alpha(eDims[0]); NumericVector ll(oDims[0]); double tmp; arma::vec initk(eDims[0]); for(int k = 0; k < oDims[0]; k++){ initk = init % reparma(lweights.col(k),numberOfStates); for(int i=0; i < eDims[0]; i++){ alpha(i) = initk(i); for(int r = 0; r < oDims[2]; r++){ alpha(i) *= emission(i,obs(k,0,r),r); } } tmp = sum(alpha); ll(k) = log(tmp); alpha /= tmp; arma::vec alphatmp(eDims[0]); for(int t = 1; t < oDims[1]; t++){ for(int i = 0; i < eDims[0]; i++){ alphatmp(i) = arma::dot(transition.col(i), alpha); for(int r = 0; r < oDims[2]; r++){ alphatmp(i) *= emission(i,obs(k,t,r),r); } } tmp = sum(alphatmp); ll(k) += log(tmp); alpha = alphatmp/tmp; } } return ll; }
// [[Rcpp::export]] NumericVector f1_gamma(NumericMatrix b,NumericVector y,NumericMatrix x,NumericVector alpha,NumericVector wt) { // Get dimensions of x - Note: should match dimensions of // y, b, alpha, and wt (may add error checking) // May want to add method for dealing with alpha and wt when // constants instead of vectors int l1 = x.nrow(), l2 = x.ncol(); int m1 = b.ncol(); // int lalpha=alpha.nrow(); // int lwt=wt.nrow(); Rcpp::NumericMatrix b2temp(l2,1); arma::mat x2(x.begin(), l1, l2, false); arma::mat alpha2(alpha.begin(), l1, 1, false); arma::mat wt2(wt.begin(), l1, 1, false); Rcpp::NumericVector xb(l1); arma::colvec xb2(xb.begin(),l1,false); // Reuse memory - update both below // Moving Loop inside the function is key for speed NumericVector yy(l1); NumericVector res(m1); for(int i=0;i<m1;i++){ b2temp=b(Range(0,l2-1),Range(i,i)); arma::mat b2(b2temp.begin(), l2, 1, false); // mu<-t(exp(alpha+x%*%b)) // disp2<-1/wt // -sum(dgamma(y,shape=1/disp2,scale=mu*disp2,log=TRUE)) xb2=exp(alpha2+ x2 * b2); for(int j=0;j<l1;j++){ xb[j]=xb[j]/wt[j]; } yy=-dgamma_glmb(y,wt,xb,true); res(i) =std::accumulate(yy.begin(), yy.end(), 0.0); } return res; }
// [[Rcpp::export]] NumericVector row_kth(NumericMatrix toSort, int k) { int n = toSort.rows(); NumericVector meds = NumericVector(n); for (int i = 0; i < n; i++) { NumericVector curRow = toSort.row(i); std::nth_element(curRow.begin(), curRow.begin() + k, curRow.end()); meds[i] = curRow[k]; } return meds; }
//' Empirical sample quantile. //' Calculate empirical sample quantile. //' //' @param x A numeric vector, specifying the sample for which the quantile is to be calculated. //' @param q A real number between 0 and 1 inclusive, specifying the desired quantile. //' //' @return The empirical quantile of the provided sample. //' @examples //' x<-rnorm(100) //' qsamp(x, 0.5) //' @export // [[Rcpp::export]] double qsamp(NumericVector x, double q) { int n = x.size(); int Q = floor(n*q); double g = n*q-double(Q); if (g == 0) Q -= 1; //Q = Q, but c++ uses 0-based indexing else Q = Q; //Q -= 1 0-based indexing std::nth_element(x.begin(), x.begin()+Q, x.end()); return x[Q]; }
// Quick and dirty implementation of lowerBound, the complement to R's // findInterval // [[Rcpp::export]] IntegerVector lowerBound(const NumericVector& x, const NumericVector& breaks) { int n = x.size(); IntegerVector out(n); for (int i = 0; i < n; i++) { NumericVector::const_iterator it = std::lower_bound(breaks.begin(), breaks.end(), x[i]); if (it == breaks.end()) --it; out[i] = it - breaks.begin() + 1; } return out; }
// [[Rcpp::export]] SEXP C_MedianSpec(SEXP x) { NumericMatrix VV(x); int n_specs = VV.nrow(); int count_max = VV.ncol(); int position = n_specs / 2; // Euclidian division NumericVector out(count_max); for (int j = 0; j < count_max; j++) { NumericVector y = VV(_,j); // Copy column -- original will not be mod std::nth_element(y.begin(), y.begin() + position, y.end()); out[j] = y[position]; } return out; }
//' Compute complex visibility based on ABCD principle //' //' @param ii ABCD //' @param kx P2VM. By default, c(0,2,2,0) //' @param sx P2VM. By default, c(4,4,4,4) //' @param fx Total flux in ABCD //' // [[Rcpp::export]] ComplexVector gv_abcd2vis(NumericVector ii, NumericVector kx = NumericVector::create(4), NumericVector sx = NumericVector::create(4), NumericVector fx = NumericVector::create(1)) { double vv[2] = {0,0}; ComplexVector vis = ComplexVector(1); abcd2vis(ii.begin(), kx.begin(), sx.begin(), &vv[0], as<double>(fx)); vis[0].r = vv[0]; vis[0].i = vv[1]; return vis; }
//' FITS image writer //' //' Writes a vector, matrix or 3D array to a FITS file as an image. //' The data is written to the primary HDU. //' // [[Rcpp::export]] int gv_writefits_img(NumericVector img, CharacterVector fits_name, CharacterVector hdu_name = "") { IntegerVector dim; if (!img.hasAttribute("dim")) { REprintf("ERROR: image has not been dimensioned.\n"); return 1; } dim = img.attr("dim"); if (dim.length() > 3) { REprintf("ERROR: dimension of more than 3 unsupported.\n"); return 1; } fitsfile *pfits=NULL; int err=0; std::string fname = as<std::string>(fits_name[0]); fits_create_file(&pfits, (char *) fname.c_str(), &err); if (err) { gv_print_fits_err(err); return err; } #ifdef GV_DEBUG Rcout << "Number of dim: " << dim.length() << std::endl; for (int i=0; i<dim.length(); i++) { Rcout << "Dim[" << i << "]: " << dim[i] << std::endl; } Rcout << "Number of elements: " << img.length() << std::endl; double *p = &(*img.begin()); for (int i=0; i<img.length(); i++) { Rcout << "*(p+" << i << ") = " << *(p+i) << std::endl; } #endif long longdim[3], startpix[3] = {1,1,1}; // default start for (int i=0; i<dim.length(); i++) longdim[i] = (long) dim[i]; // start writing to file fits_create_img(pfits, DOUBLE_IMG, dim.length(), longdim, &err); fits_write_pix(pfits, TDOUBLE, startpix, img.length(), &(*img.begin()), &err); fits_close_file(pfits, &err); return err; }
struct spl spl_init(NumericVector x, NumericVector y){ gsl_set_error_handler_off(); struct spl out; int nx = x.size(); out.x = x; out.y = y; out.acc= gsl_interp_accel_alloc(); out.spline = gsl_spline_alloc( gsl_interp_cspline , nx ); double eps = 0.0001; gsl_spline_init(out.spline, x.begin(), y.begin(), nx); out.slope_first= (gsl_spline_eval (out.spline, x[0]+eps, out.acc) - y[0])/eps; out.slope_end = (y[nx-1] - gsl_spline_eval (out.spline, x[nx-1]-eps, out.acc))/eps; return(out); }
// [[Rcpp::export]] double pmvnorm(NumericVector lls, NumericVector uls, NumericVector mu, NumericMatrix sigma) { int n = 2, nu = 0, maxpts = 2000, inform; int infin [2] = {2, 2}; double abseps = 1/1000, releps = 1/1000, error, value; int rnd = 1; double corr = sigma(0, 1) / sqrt(sigma(0, 0) * sigma(1, 1)); /* mvtnorm_C_mvtdst is defined in mvtnorm/inst/include/mvtnormAPI.h */ mvtnorm_C_mvtdst(&n, &nu, lls.begin(), uls.begin(), infin, &corr, mu.begin(), &maxpts, &abseps, &releps, &error, &value, &inform, &rnd); return value; }
// [[Rcpp::export]] void appendRcpp( List fillVecs, NumericVector newLengths, NumericMatrix retmat, NumericVector retmatLengths ) { /* appendRcpp Fills numeric matrix Loop through rows, filling retmat in with the vectors in list then update return matrix size to index the next free */ // Declare vars NumericVector fillTmp; int sizeOld, sizeNew; // Pull out dimensions of return matrix to fill int nrow = retmat.nrow(); int ncol = retmat.ncol(); // Check that dimensions match if ( nrow != retmatLengths.size() || nrow != fillVecs.size() ) { throw std::range_error("In appendC(): dimension mismatch"); } // Traverse ddimensions for (int ii=0; ii<ncol; ii++) { throw std::range_error("In appendC(): exceeded max cols"); // Iterator for row to fill NumericMatrix::Row retRow = retmat(ii, _); // Fill row of return matrix, starting at first non-zero element std::copy( fillTmp.begin(), fillTmp.end(), retRow.begin() + sizeOld ); // Update size of return matrix retmatLengths[ii] = sizeNew; } }
double glmResp::updateWts() { d_sqrtrwt = sqrt(d_weights/d_fam.variance(d_mu)); NumericVector muEta = d_fam.muEta(d_eta); std::transform(muEta.begin(), muEta.end(), d_sqrtrwt.begin(), d_sqrtXwt.begin(), std::multiplies<double>()); return updateWrss(); }
// [[Rcpp::export]] SEXP multFct_left(SEXP x, NumericVector f, SEXP g) { // Multiply a matFct by a matrix from the left // No sanity check performed! NumericVector vec_x(x); NumericVector vec_g(g); IntegerVector dims1 = vec_x.attr("dim"); IntegerVector dims2 = vec_g.attr("dim"); int p = dims2[2]; // NB: 1 less in order to simplify code int r = dims2[3]; int rp = r*p; arma::mat xx(vec_x.begin(), dims1[0], dims1[1], false); arma::cube yf(f.begin(), dims2[0], dims2[1], p+1, false); arma::cube yg(vec_g.begin(), dims2[0], dims2[1], rp, false); arma::cube ff(dims1[0], dims2[1], p+1); arma::cube gg(dims1[0], dims2[1], rp); // find f and g functions for (int j=0; j<=p; j++) ff.slice(j) = xx*yf.slice(j); for (int j=0; j<rp; j++) gg.slice(j) = xx*yg.slice(j); // return to R return(List::create(Rcpp::Named("f")=ff, Rcpp::Named("g")=gg)); }
// [[Rcpp::export]] List split_runs_numeric( NumericVector X ) { List out( X.size() ); std::vector< std::vector< double > > all_nums; std::vector< double > curr_nums; // initial stuff curr_nums.push_back( X[0] ); for( NumericVector::iterator it = X.begin()+1; it != X.end(); ++it ) { if( (*it) != (*(it-1)) ) { all_nums.push_back( curr_nums ); curr_nums.clear(); curr_nums.push_back( *it ); } else { curr_nums.push_back( *it ); } } // push the final vector in all_nums.push_back( curr_nums ); return wrap( all_nums ); }
Rcpp::NumericVector glmerResp::sqrtWrkWt() const { NumericVector me = muEta(); #ifdef USE_RCPP_SUGAR return sqrt(d_weights * me * me / variance()); #else NumericVector vv = variance(); std::transform(me.begin(), me.end(), me.begin(), me.begin(), std::multiplies<double>()); std::transform(me.begin(), me.end(), d_weights.begin(), me.begin(), std::multiplies<double>()); std::transform(me.begin(), me.end(), vv.begin(), me.begin(), std::divides<double>()); std::transform(me.begin(), me.end(), me.begin(), &::sqrt); return me; #endif }
// [[Rcpp::export]] NumericVector CPP_row_norms_sparse(int nr, int nc, IntegerVector p, IntegerVector row_of, NumericVector x, int norm_code, double p_norm = 2.0) { check_norm(norm_code, p_norm); NumericVector norms(nr, 0.0); NumericVector::iterator _x = x.begin(); IntegerVector::iterator _p = p.begin(); IntegerVector::iterator _row_of = row_of.begin(); NumericVector::iterator _norms = norms.begin(); for (int col = 0; col < nc; col++) { for (int i = _p[col]; i < _p[col+1]; i++) { int row = _row_of[i]; if (norm_code == 0) _norms[row] += _x[i] * _x[i]; else if (norm_code == 1) { if (fabs(_x[i]) > _norms[row]) _norms[row] = fabs(_x[i]); } else if (norm_code == 2) _norms[row] += fabs(_x[i]); else if (norm_code == 3) { if (p_norm > 0) _norms[row] += pow(fabs(_x[i]), p_norm); else _norms[row] += (_x[i] != 0); } } } if (norm_code == 0) norms = sqrt(norms); else if (norm_code == 3 && p_norm > 1.0) norms = pow(norms, 1.0 / p_norm); /* no adjustment needed for Maximum and Manhattan norms */ return norms; }
void append( List fillVecs) { // "append" fill oldmat w/ // we will loop through cols, filling retmat in with the vectors in list // then update retmat_size to index the next free // newLenths isn't used, added for compatibility std::size_t sizeOld, sizeAdd, sizeNew, icol; NumericVector fillTmp; // check that number of vectors match if ( nvec != fillVecs.size()) { throw std::range_error("In append(): dimension mismatch"); } for (icol = 0; icol<nvec; icol++){ // vector to append fillTmp = fillVecs[icol]; // compute lengths sizeOld = lengths[icol]; sizeAdd = fillTmp.size(); sizeNew = sizeOld + sizeAdd; // grow data matrix as needed if ( sizeNew > allocLen) { grow(sizeNew); } // iterator for col to fill NumericMatrix::Column dataCol = data(_, icol); // fill row of return matrix, starting at first non-zero elem std::copy( fillTmp.begin(), fillTmp.end(), dataCol.begin() + sizeOld); // update size of retmat lengths[icol] = sizeNew; } }
// [[Rcpp::export]] NumericVector CPP_col_norms_sparse(int nr, int nc, IntegerVector p, IntegerVector row_of, NumericVector x, int norm_code, double p_norm = 2.0) { check_norm(norm_code, p_norm); NumericVector norms(nc, 0.0); NumericVector::iterator _x = x.begin(); IntegerVector::iterator _p = p.begin(); // IntegerVector::iterator _row_of = row_of.begin(); NumericVector::iterator _norms = norms.begin(); for (int col = 0; col < nc; col++) { double accum = 0.0; for (int i = _p[col]; i < _p[col+1]; i++) { if (norm_code == 0) accum += _x[i] * _x[i]; else if (norm_code == 1) { if (fabs(_x[i]) > accum) accum = fabs(_x[i]); } else if (norm_code == 2) accum += fabs(_x[i]); else if (norm_code == 3) { if (p_norm > 0) accum += pow(fabs(_x[i]), p_norm); else accum += (_x[i] != 0); } } if (norm_code == 0) _norms[col] = sqrt(accum); else if (norm_code == 3 && p_norm > 1.0) _norms[col] = pow(accum, 1.0 / p_norm); else /* other norms */ _norms[col] = accum; } return norms; }
// [[Rcpp::export]] List instrumented_count_positive_threaded(NumericVector data, int nthreads){ int n = data.size() ; int chunk_size = n / nthreads ; std::vector<Timer> timers(nthreads) ; std::vector<std::future<int>> futures(nthreads-1) ; std::vector<std::thread> threads(nthreads-1) ; timers[0].step("data structures") ; double* it = data.begin() ; for( int i=0; i<nthreads-1; i++){ InstrumentedTask instr_task(timers[i+1]) ; Task task(instr_task) ; futures[i] = task.get_future(); threads[i] = std::thread( std::move(task), it, it + chunk_size ) ; it += chunk_size ; timers[0].step( "spawning" ) ; } timers[0].step( "spawning" ) ; int result = InstrumentedTask(timers[0])(it, data.end()); for( int i=0; i<nthreads-1; i++) { threads[i].join() ; timers[0].step("fusion") ; result += futures[i].get() ; } timers[0].step( "fusion" ) ; return List::create( _["res"] = result, _["timers"] = timers ); }
// [[Rcpp::export]] NumericVector fstatsC(NumericMatrix pairMat, NumericMatrix mod, NumericMatrix mod0, NumericVector outcome) { int nrow = pairMat.nrow(); int ncol = pairMat.ncol(); double ss, ss0; int df0 = mod0.ncol(); int df = df0+1; // alternative model always has +1 column arma::mat modc(mod.begin(), mod.nrow(), mod.ncol(), false); arma::mat mod0c(mod0.begin(), mod0.nrow(), mod0.ncol(), false); arma::colvec outcomec(outcome.begin(), outcome.size(), false); arma::vec fstats(nrow); arma::vec res = arma::zeros<arma::vec>(outcome.size()); arma::vec res0 = arma::zeros<arma::vec>(outcome.size()); try{ res0 = outcomec - mod0c*arma::solve(mod0c, outcomec); // The residual for the null model remains the same ss0 = arma::as_scalar(arma::trans(res0)*res0); } catch(std::exception &ex) { stop("WTF???"); } for(int i=0; i < nrow; i++){ // loop through all rows in pairMat //modc.insert_cols(mod.ncol(), pairMat(i,_)); can try this later, it's not working for(int j=0; j < pairMat.ncol(); j++){ // this loop is for copying the ith row of pairMat into the last column of modc modc(j,modc.n_cols-1) = pairMat(i,j); // Here we add the current row to the model } try{ res = outcomec - modc*arma::solve(modc, outcomec); // Calculate the residual ss = arma::as_scalar(arma::trans(res)*res); fstats(i) = ((ss0 - ss)/(df-df0))/(ss/(ncol-df)); } catch(std::exception &ex) { fstats(i) = NA_REAL; } } return Rcpp::wrap(fstats); }
// [[Rcpp::export]] arma::cube gibbsCPP(NumericVector p2, int T, int M, double rho, double x0, double y0) { IntegerVector dim_p2=p2.attr("dim"); arma::cube p(p2.begin(), dim_p2[0], dim_p2[1], dim_p2[2]); double x, y; arma::vec n1 = rnormC(76543,M*T); //arma::vec n2 = rnormC(76543,M*T); for(int m=0;m<M;m++) { x = x0; y = y0; p(0,0,m) = x; p(1,0,m) = y; for(int t=1;t<T;t++) { //x = rnormC(1,M*T)[m*t]; //x = x * sqrt(1-pow(rho,2)) + rho * y; //y = rnormC(76543,M*T)[(m*t)+1]; //y = y * sqrt(1-pow(rho,2)) + rho * x; x = n1[m*T]; x = x * sqrt(1-pow(rho,2)) + rho * y; y = n1[m*T+1]; y = y * sqrt(1-pow(rho,2)) + rho * x; p(0,t,m) = x; p(1,t,m) = y; } } return(p); }
//' Sorted vector index. //' //' The sorted vector is returned along with the original index of the vector it belonged to. //' //' @param x A real-valued vector to be sorted. //' //' @return A list with two components: //' \itemize{ //' \item sorted: The sorted version of \code{x}. //' \item index: The index of the \eqn{i^{th}} element in \code{x}. //' } //' //' @examples //' pairSort(c(5, 2, 6)) //' @export //[[Rcpp::export]] List pairSort(NumericVector x) { int n = x.size(); NumericVector x_sorted(n); IntegerVector x_index(n); std::vector<double> arr(x.begin(), x.end()); std::vector<std::pair<double,int> >V; for (int i=0; i<x.size(); i++) { std::pair<double,int>P = std::make_pair(arr[i], i); V.push_back(P); } std::sort(V.begin(), V.end()); for (int i=0; i<x.size(); i++) { x_sorted[i] = V[i].first; x_index[i] = V[i].second; } return List::create(_["sorted"] = x_sorted, _["index"] = x_index); }