RcppExport SEXP rthkendall(SEXP x_, SEXP y_, SEXP nthreads)
{
Rcpp::NumericVector x(x_);
Rcpp::NumericVector y(y_);
Rcpp::NumericVector RET(1);
const int n = LENGTH(x);
#if RTH_OMP
omp_set_num_threads(INT(nthreads));
#elif RTH_TBB
tbb::task_scheduler_init init(INT(nthreads));
#endif
thrust::counting_iterator<int> seqa(0);
thrust::counting_iterator<int> seqb = seqa + n - 1;
floublevec dx(x.begin(), x.end());
floublevec dy(y.begin(), y.end());
intvec tmp(n-1);
thrust::transform(seqa,seqb,tmp.begin(),calcgti(dx,dy,n));
int totcount = thrust::reduce(tmp.begin(),tmp.end());
flouble npairs = n * (n-1) / 2;
REAL(RET)[0] = (double) (totcount - (npairs-totcount)) / npairs;
return RET;
}
RcppExport SEXP rthhist(SEXP x_, SEXP nbins_, SEXP nch_, SEXP nthreads)
{
Rcpp::NumericVector x(x_);
const int n = x.size();
const int nbins = INTEGER(nbins_)[0];
const int nch = INTEGER(nch_)[0];
floublevec dx(x.begin(), x.end());
Rcpp::IntegerVector bincounts(nbins);
Rcpp::NumericVector R_left(1);
Rcpp::NumericVector R_binwidth(1);
#if RTH_OMP
omp_set_num_threads(INT(nthreads));
#elif RTH_TBB
tbb::task_scheduler_init init(INT(nthreads));
#endif
// 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];
bincounts[binnum] = sum;
}
REAL(R_left)[0] = (double) left;
REAL(R_binwidth)[0] = (double) binwidth;
return Rcpp::List::create(Rcpp::Named("counts") = bincounts,
Rcpp::Named("left") = R_left,
Rcpp::Named("binwidth") = R_binwidth);
}
void AlignementGet::run()
{
try
{
if(Alignement_init)
{
if( (Alignement_identity->at(Alignement_hit_b->id())).first == -1)
{
FastaThread seqa(*Alignement_fasta_a, *Alignement_hit_a);
FastaThread seqb(*Alignement_fasta_b, *Alignement_hit_b);
Alignement_first_seq = seqa.find();
Alignement_second_seq = seqb.find();
pair<long int, long int> identity = compute_identity(false);
if((Alignement_first_seq->length() - identity.second) > 0)
{
if( (identity.first/(Alignement_first_seq->length() - identity.second)) >= 0.5)
{
delete Alignement_first_seq;
delete Alignement_second_seq;
Alignement_first_seq = seqa.find();
Alignement_second_seq = seqb.find();
Alignement_identity->at(Alignement_hit_b->id()) = compute_identity(true);
}
if( (Alignement_identity->at(Alignement_hit_b->id())).first > identity.first || (Alignement_identity->at(Alignement_hit_b->id())).first == -1)
{
Alignement_identity->at(Alignement_hit_b->id()) = identity;
}
}
delete Alignement_first_seq;
delete Alignement_second_seq;
}
}
}
catch(exception const& e)
{
cerr << "ERROR : " << e.what() << " in : void AlignementGet::run()" << endl;
exit(-1);
}
}
// data x has lower, upper bds given in ub_; count computation will be
// divided into nch_ chunks, performed by nthreads threads
RcppExport SEXP rthtable(SEXP x_, SEXP lb_, SEXP ub_,
SEXP nch_, SEXP nthreads)
{
// housekeeping regarding input data
Rcpp::IntegerMatrix x(x_);
// x is the data matrix, one observation per row (but stored in
// column-major order); each column is a separate variable, i.e.
// a separate dimension in the output table
intvec dx(x.begin(), x.end()); // input data copied to device
const int nobsv = x.nrow(); // number of observations
const int ndim = x.ncol(); // e.g. 2 for an m x n table
// configuration of output table
//
// R tables are stored in a generalized column-major format; e.g.
// for an m x n x k table, row index varies most rapidly, then column
// index and finally layer index
//
// set up the ndim lower- and upper-bound pairs; variable in
// dimension i of the table takes on values in lb[i} through ub[i]
std::vector<int> lbstd =
Rcpp::as<std::vector<int> >(lb_); // lower bounds on data vals
std::vector<int> ubstd =
Rcpp::as<std::vector<int> >(ub_); // upper bounds on data vals
int *lb = &lbstd[0];
int *ub = &ubstd[0];
// find number of table cells, ncells, and the range for each
// variable, in lurng
int ncells = 1,i;
int lurng[ndim]; // "lower-upper range"
for (i = 0; i < ndim; i++) {
lurng[i] = ub[i] - lb[i] + 1;
ncells *= lurng[i];
}
// counts for the table; will eventually be the output
Rcpp::IntegerVector rvalcounts(ncells);
// partitioning of work
const int nch = INTEGER(nch_)[0];
#if RTH_OMP
omp_set_num_threads(INT(nthreads));
#elif RTH_TBB
// tbb::task_scheduler_init init(INT(nthreads));
// for unknown reasons, this code does not work under TBB
return Rcpp::wrap(1);
#endif
// form matrix of cell counts, one row per chunk, row-major order
intvec dcellcounts(nch*ncells);
// products needed to compute linear cell indices
int bases[ndim],prod=1;
for (i = 0; i < ndim; i++) {
bases[i] = prod;
prod *= lurng[i];
};
// the heart of the computation, a for_each() loop, one iteration per
// chunk (chunking should improve cache performance)
thrust::counting_iterator<int> seqa(0);
thrust::counting_iterator<int> seqb = seqa + nch;
thrust::for_each(seqa,seqb,
do1chunk(dx.begin(),dcellcounts.begin(),lb,lurng,bases,
nobsv,ndim,ncells,nch));
// copy result to host and combine the subhistograms
int hvalcounts[nch*ncells];
thrust::copy(dcellcounts.begin(),dcellcounts.end(),hvalcounts);
int cellnum,chunknum;
for (cellnum = 0; cellnum < ncells; cellnum++) {
int sum = 0;
for (chunknum = 0; chunknum < nch; chunknum++)
sum += hvalcounts[chunknum*ncells + cellnum];
rvalcounts[cellnum] = sum;
}
return rvalcounts;
}
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;
}
