// [[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 );
}
// 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;
}
//' 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);
}
// [[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]]
double GoFBHK(NumericVector x,double a) {
double s = 0;
double n = x.size();
double e = n/sum(x);
NumericMatrix k(2,n);
double res=0;
NumericVector k1(n);
NumericVector k2(n);
NumericVector y = e*x;
std::sort(y.begin(),y.end());
k(0,0) = y[1];
k(1,0) = 0;
for(int i=0; i<(n-1);i++){
s = 0;
s = sum(y[Range(0,i)]);
k(0,(i+1)) = s/n + y[i+1]*(1-(i+1)/n) - (i+1)/n;
k(1,(i+1)) = (i+1)/n - s/n - y[i]*(1-(i+1)/n);
}
k1 = k(0,_);
k2 = k(1,_);
s=k1[which_max(k1)];
e=k2[which_max(k2)];
res= sqrt(n)*std::max(s,e);
return res;
}
// [[Rcpp::export]]
NumericVector loopC(NumericVector nodelist,int al,IntegerVector x, IntegerVector x2, List pm_lc, NumericMatrix Lix, int finind){
NumericVector::iterator k;
LogicalVector res;
IntegerVector daughter;
int temp1, temp2;
int k2;
int l = 0;
int g = 0;
int n = x.size();
LogicalVector in1(x2.size());
LogicalVector in2(x2.size());
IntegerVector indices = seq_len(n); //from 1 to n...
for(k = nodelist.begin(); k != nodelist.end(); ++k) {
k2 = nodelist[l];
res = x == k2;
daughter = x2[res];
in1 = x2==daughter[0];
in2 = x2==daughter[1];
temp1 = as<int>(indices[in1]);
temp2 = as<int>(indices[in2]);
NumericMatrix pmtmp1 = pm_lc[temp1 - 1];
NumericMatrix pmtmp2 = pm_lc[temp2 - 1];
for(g = 0; g<al; ++g){
Lix(k2 - 1, g) = sum(Lix.row(daughter[0] - 1) * pmtmp1.row(g)) *
sum(Lix.row(daughter[1] - 1) * pmtmp2.row(g));
}
l=l+1;
}
NumericVector res2 = Lix(finind,_);
return res2;
}
// [[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]]
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;
}
}
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]]
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 );
}
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();
}
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]]
double sum2(NumericVector x) {
double total = 0;
for(NumericVector::iterator it = x.begin(); it != x.end(); it++) {
total += *it;
}
return total;
}
// [[Rcpp::export]]
NumericVector Cquant(NumericVector A, NumericVector probs) {
NumericVector q(probs) ;
NumericVector y = wrap(na_omit(A)) ;
std::sort(y.begin(), y.end());
return y[y.size()*(q - 0.000000001)];
}
double glmerResp::residDeviance() const {
#ifdef USE_RCPP_SUGAR
return sum(devResid());
#else
NumericVector dd = devResid();
return std::accumulate(dd.begin(), dd.end(), double());
#endif
}
double glmerResp::updateWts() {
#ifdef USE_RCPP_SUGAR
d_sqrtrwt = sqrt(d_weights/variance());
NumericVector tmp = muEta() * d_sqrtrwt;
#else
NumericVector vv = variance();
std::transform(d_weights.begin(), d_weights.end(), vv.begin(),
d_sqrtrwt.begin(), std::divides<double>());
std::transform(d_sqrtrwt.begin(), d_sqrtrwt.end(),
d_sqrtrwt.begin(), &::sqrt);
NumericVector tmp = muEta();
std::transform(tmp.begin(), tmp.end(), d_sqrtrwt.begin(),
tmp.begin(), std::multiplies<double>());
#endif
std::copy(tmp.begin(), tmp.end(), d_sqrtXwt.begin());
return updateWrss();
}
//' De-duplicates a numeric vector/data.table/data.frame
//' @description These set of functions take a vector, or a datatable/dataframe (with a particular column)
//' and compress it by de-duplicating its values. Ideally, this is a good way to reduce the amount of data
//' for time-series use cases
//'
//' @param x A vector/data.table/data.frame
//' @param returnIndex If TRUE, will return indexes, otherwise will return actual values
//' @param key If using a data.table/data.frame, the index for performing the operation on
//'
//' @return Returns a vector/data.table/data.frame that has been de-deduplicated.
//' De-duplicated means that consecutive duplicate values are reduced to the first occurance.
//'
//' @examples
//' vec <- c(1,1,2,2,3,3,4,4,5,5,4,4,3,3,2,2,1,1)
//' vdeduplicate(vec)
//' vdeduplicate(vec, TRUE)
// [[Rcpp::export]]
NumericVector vdeduplicate(NumericVector x, bool returnIndex = false){
NumericVector::iterator it, out_it, i;
NumericVector xx = clone(x);
if(returnIndex){
it = uniqueIndex(xx.begin(), xx.end()); //cloning object so it does not change the actual R object
}else{
it = std::unique (xx.begin(), xx.end());
}
NumericVector out(std::distance(xx.begin(),it));
//Loops through using iterators
//Because the values that we want are at x[0] (aka *x.begin()) and go to where 'it' left off
//We just need to get the value of all the pointers between those to pointers
for(i = xx.begin(),out_it = out.begin(); i != it; ++i, ++out_it){
*out_it = *i;
}
return out;
}
// [[Rcpp::export]]
double sum3(NumericVector x) {
double total = 0;
NumericVector::iterator it;
for(it = x.begin(); it != x.end(); ++it) {
total += *it;
}
return total;
}
double dev(const colvec& resid, double taue)
{
// NumericVector r(resid);
// devvec is an nc x 1 vector
NumericVector r = wrap(resid);
NumericVector devvec = dnorm( r, 0.0, sqrt(1/taue), true ); /* logD */
double deviance = accumulate(devvec.begin(),devvec.end(),0.0);
deviance *= -2;
return(deviance);
}
// [[Rcpp::export]]
NumericVector row_medians(NumericMatrix toSort) {
int n = toSort.rows();
int medN = toSort.cols();
NumericVector meds = NumericVector(n);
for (int i = 0; i < n; i++) {
NumericVector curRow = toSort.row(i);
std::nth_element(curRow.begin(), curRow.begin() + curRow.size()/2 - 1, curRow.end());
double med1 = curRow[curRow.size()/2 - 1];
if (medN % 2 == 0) {
std::nth_element(curRow.begin(), curRow.begin() + curRow.size()/2, curRow.end());
double med2 = curRow[curRow.size()/2];
meds[i] = (med1 + med2)/2.0;
} else {
meds[i] = med1;
}
}
return meds;
}
// [[Rcpp::export]]
double median_rcpp(NumericVector x) {
NumericVector y = clone(x);
int n, half;
double y1, y2;
n = y.size();
half = n / 2;
if(n % 2 == 1) {
// median for odd length vector
std::nth_element(y.begin(), y.begin()+half, y.end());
return y[half];
} else {
// median for even length vector
std::nth_element(y.begin(), y.begin()+half, y.end());
y1 = y[half];
std::nth_element(y.begin(), y.begin()+half-1, y.begin()+half);
y2 = y[half-1];
return (y1 + y2) / 2.0;
}
}
// [[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;
}
double glmerResp::updateMu(const Rcpp::NumericVector& gamma) {
#ifdef USE_RCPP_SUGAR
d_eta = d_offset + gamma;
#else
std::transform(d_offset.begin(), d_offset.end(), gamma.begin(),
d_eta.begin(), std::plus<double>());
#endif
NumericVector mmu = d_fam.linkInv(d_eta);
std::copy(mmu.begin(), mmu.end(), d_mu.begin());
return updateWrss();
}
//' 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];
}
void sampleRho(Rcpp::NumericVector& rho, Rcpp::NumericMatrix& A, arma::mat A_restrict, double rhoa, double rhob){
int k = A.ncol();
int p = A.nrow();
arma::rowvec A_maxnnz_col = arma::sum(A_restrict, 0);
for (int i=0; i<k; i++) {
NumericMatrix::Column col = A.column(i) ;
NumericVector As = ifelse(abs(col)<1e-10, 0.0, 1.0);
double nnz = std::accumulate(As.begin(), As.end(), 0.0);
double maxnnz = A_maxnnz_col(i);
rho(i) = Rf_rbeta(rhoa + nnz, rhob + maxnnz-nnz);
}
}
// [[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;
}
// use calc_resid_linreg for a 3-dim array
// [[Rcpp::export]]
NumericVector calc_resid_linreg_3d(const NumericMatrix& X, const NumericVector& P)
{
int nrowx = X.rows();
int sizep = P.size();
NumericMatrix pr(nrowx, sizep/nrowx);
std::copy(P.begin(), P.end(), pr.begin()); // FIXME I shouldn't need to copy
NumericMatrix result = calc_resid_linreg(X, pr);
result.attr("dim") = P.attr("dim");
return result;
}
NumericVector permut(const NumericVector& a)
{
// already added by sourceCpp(), but needed standalone
RNGScope scope;
// clone a into b to leave a alone
NumericVector b = clone(a);
random_shuffle(b.begin(), b.end(), randWrapper);
return b;
}
// get a set of permutations of a vector, as columns of a matrix
// [[Rcpp::export]]
NumericMatrix permute_nvector(const int n_perm, const NumericVector x)
{
unsigned int length = x.size();
NumericMatrix result(length,n_perm);
for(unsigned int i=0; i<n_perm; i++) {
NumericVector permx = permute_nvector(x);
std::copy(permx.begin(), permx.end(), result.begin()+i*length);
}
return result;
}
