extern "C" SEXP rthpearson(SEXP x, SEXP y, SEXP nthreads) { SEXP cor; int n = LENGTH(x); doublevec dx(REAL(x), REAL(x)+n); doublevec dy(REAL(x), REAL(x)+n); double zero = (double) 0.0; RTH_GEN_NTHREADS(nthreads); double xy = thrust::inner_product(dx.begin(), dx.end(), dy.begin(), zero); double x2 = thrust::inner_product(dx.begin(), dx.end(), dx.begin(), zero); double y2 = thrust::inner_product(dy.begin(), dy.end(), dy.begin(), zero); double xt = thrust::reduce(dx.begin(), dx.end()); double yt = thrust::reduce(dy.begin(), dy.end()); double xm = xt/n, ym = yt/n; double xsd = sqrt(x2/n - xm*xm); double ysd = sqrt(y2/n - ym*ym); PROTECT(cor = allocVector(REALSXP, 1)); REAL(cor)[0] = (xy/n - xm*ym) / (xsd*ysd); UNPROTECT(1); return cor; }
extern "C" SEXP c_rthgini(SEXP x, SEXP mu, SEXP unbiased_, SEXP nthreads) { const int unbiased = INTEGER(unbiased_)[0]; const int n = LENGTH(x); SEXP gini; PROTECT(gini = allocVector(REALSXP, 1)); RTH_GEN_NTHREADS(nthreads); thrust::device_vector<double> dx(REAL(x), REAL(x)+n); thrust::sort(dx.begin(), dx.end()); thrust::counting_iterator<int> begin(0); thrust::counting_iterator<int> end = begin + n; thrust::plus<flouble> binop; DBL(gini) = (double) thrust::transform_reduce(begin, end, compute_gini(n, dx.begin()), (flouble) 0., binop); if (unbiased) DBL(gini) = DBL(gini) / (n*(n-1)*DBL(mu)); else DBL(gini) = DBL(gini) / (n*n*DBL(mu)); return gini; }
// computes moving averages from x of window width w extern "C" SEXP rthma(SEXP x, SEXP w, SEXP nthreads) { SEXP xb; const int xas = LENGTH(x); const int wa = INTEGER(w)[0]; RTH_GEN_NTHREADS(nthreads); // set up device vector and copy xa to it thrust::device_vector<double> dx(REAL(x), REAL(x)+xas); if (xas < wa) return R_NilValue; // allocate device storage for cumulative sums, and compute them thrust::device_vector<double> csums(xas + 1); thrust::exclusive_scan(dx.begin(), dx.end(), csums.begin()); // need one more sum at (actually past) the end csums[xas] = REAL(x)[xas-1] + csums[xas-1]; // compute moving averages from cumulative sums PROTECT(xb = allocVector(REALSXP, xas - wa + 1)); thrust::transform(csums.begin() + wa, csums.end(), csums.begin(), REAL(xb), minus_and_divide(double(wa))); UNPROTECT(1); return xb; }
extern "C" SEXP rth_rnorm(SEXP n_, SEXP mean_, SEXP sd_, SEXP seed_, SEXP nthreads) { SEXP x; const uint64_t n = (uint64_t) INTEGER(n_)[0]; const flouble mean = (flouble) REAL(mean_)[0]; const flouble sd = (flouble) REAL(sd_)[0]; const unsigned int seed = INTEGER(seed_)[0]; RTH_GEN_NTHREADS(nthreads); thrust::device_vector<flouble> vec(n); const thrust::tuple<const unsigned int, const flouble, const flouble> t(seed, mean, sd); thrust::transform(thrust::counting_iterator<int>(0), thrust::counting_iterator<int>(n), vec.begin(), parallel_random_normal(t)); // thrust::host_vector<flouble> x(n); PROTECT(x = allocVector(REALSXP, n)); thrust::copy(vec.begin(), vec.end(), REAL(x)); UNPROTECT(1); return x; }
// Wrappers extern "C" SEXP rth_norm(SEXP x_, SEXP p_, SEXP nthreads) { double *x = REAL(x_); int len = LENGTH(x_); double p = REAL(p_)[0]; SEXP nrm; PROTECT(nrm = allocVector(REALSXP, 1)); RTH_GEN_NTHREADS(nthreads); REAL(nrm)[0] = calc_norm(x, len, p); UNPROTECT(1); return nrm; }
// FIXME very slow extern "C" SEXP rthmean(SEXP x, SEXP nthreads) { SEXP avg; PROTECT(avg = allocVector(REALSXP, 1)); const int n = LENGTH(x); RTH_GEN_NTHREADS(nthreads); thrust::device_vector<flouble> dx(REAL(x), REAL(x)+n); thrust::plus<flouble> binop; REAL(avg)[0] = (double) thrust::transform_reduce(dx.begin(), dx.end(), div_by_n(n), (flouble) 0., binop); UNPROTECT(1); return avg; }
extern "C" SEXP rthhist(SEXP x, SEXP nbins_, SEXP nch_, SEXP nthreads) { const int n = LENGTH(x); const int nbins = INTEGER(nbins_)[0]; const int nch = INTEGER(nch_)[0]; floublevec dx(REAL(x), REAL(x)+n); SEXP bincounts, R_left, R_binwidth; PROTECT(bincounts = allocVector(INTSXP, nbins)); PROTECT(R_left = allocVector(REALSXP, 1)); PROTECT(R_binwidth = allocVector(REALSXP, 1)); SEXP ret, retnames; RTH_GEN_NTHREADS(nthreads); // determine binwidth etc. thrust::pair<floubleveciter, floubleveciter> mm = thrust::minmax_element(dx.begin(), dx.end()); flouble left = *(mm.first), right = *(mm.second); flouble binwidth = (right - left) / nbins; // form matrix of bin counts, one row per chunk intvec dbincounts(nch*nbins); // the heart of the computation, a for_each() loop, one iteration per // chunk thrust::counting_iterator<int> seqa(0); thrust::counting_iterator<int> seqb = seqa + nch; thrust::for_each(seqa,seqb, do1chunk(dx.begin(),dbincounts.begin( ), n, nbins, nch, left, binwidth)); // copy result to host and combine the subhistograms int hbincounts[nch*nbins]; thrust::copy(dbincounts.begin(), dbincounts.end(), hbincounts); int binnum,chunknum; for (binnum = 0; binnum < nbins; binnum++) { int sum = 0; for (chunknum = 0; chunknum < nch; chunknum++) sum += hbincounts[chunknum*nbins + binnum]; INTEGER(bincounts)[binnum] = sum; } REAL(R_left)[0] = (double) left; REAL(R_binwidth)[0] = (double) binwidth; PROTECT(retnames = allocVector(STRSXP, 3)); SET_STRING_ELT(retnames, 0, mkChar("counts")); SET_STRING_ELT(retnames, 1, mkChar("left")); SET_STRING_ELT(retnames, 2, mkChar("binwidth")); PROTECT(ret = allocVector(VECSXP, 3)); SET_VECTOR_ELT(ret, 0, bincounts); SET_VECTOR_ELT(ret, 1, R_left); SET_VECTOR_ELT(ret, 2, R_binwidth); setAttrib(ret, R_NamesSymbol, retnames); UNPROTECT(5); return ret; }