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