SEXP assignRawSymmetricMatrixDiagonal(SEXP destination_, SEXP indices_, SEXP source_) { BEGIN_RCPP Rcpp::S4 destination = destination_; Rcpp::RawVector source = source_; Rcpp::RawVector destinationData = destination.slot("data"); Rcpp::IntegerVector indices = indices_; if(&(source(0)) == &(destinationData(0))) { throw std::runtime_error("Source and destination cannot be the same in assignRawSymmetricMatrixDiagonal"); } if((indices.size()*(indices.size()+(R_xlen_t)1))/(R_xlen_t)2 != source.size()) { throw std::runtime_error("Mismatch between index length and source object size"); } for(R_xlen_t column = 0; column < indices.size(); column++) { for(R_xlen_t row = 0; row <= column; row++) { R_xlen_t rowIndex = indices[row]; R_xlen_t columnIndex = indices[column]; if(rowIndex > columnIndex) { std::swap(rowIndex, columnIndex); } destinationData((columnIndex*(columnIndex-(R_xlen_t)1))/(R_xlen_t)2+rowIndex-(R_xlen_t)1) = source((column*(column+(R_xlen_t)1))/(R_xlen_t)2 + row); } } END_RCPP }
// [[Rcpp::export]] Rcpp::RawVector magick_image_write( XPtrImage input, Rcpp::CharacterVector format, Rcpp::IntegerVector quality, Rcpp::IntegerVector depth, Rcpp::CharacterVector density, Rcpp::CharacterVector comment){ if(!input->size()) return Rcpp::RawVector(0); XPtrImage image = copy(input); #if MagickLibVersion >= 0x691 //suppress write warnings see #74 and #116 image->front().quiet(true); #endif if(format.size()) for_each ( image->begin(), image->end(), Magick::magickImage(std::string(format[0]))); if(quality.size()) for_each ( image->begin(), image->end(), Magick::qualityImage(quality[0])); if(depth.size()) for_each ( image->begin(), image->end(), Magick::depthImage(depth[0])); if(density.size()){ for_each ( image->begin(), image->end(), Magick::resolutionUnitsImage(Magick::PixelsPerInchResolution)); for_each ( image->begin(), image->end(), Magick::densityImage(Point(density[0]))); } if(comment.size()) for_each ( image->begin(), image->end(), Magick::commentImage(std::string(comment.at(0)))); Magick::Blob output; writeImages( image->begin(), image->end(), &output ); Rcpp::RawVector res(output.length()); std::memcpy(res.begin(), output.data(), output.length()); return res; }
SEXP hclustThetaMatrix(SEXP mpcrossRF_, SEXP preClusterResults_) { BEGIN_RCPP Rcpp::List preClusterResults = preClusterResults_; bool noDuplicates; R_xlen_t preClusterMarkers = countPreClusterMarkers(preClusterResults_, noDuplicates); if(!noDuplicates) { throw std::runtime_error("Duplicate marker indices in call to hclustThetaMatrix"); } Rcpp::S4 mpcrossRF = mpcrossRF_; Rcpp::S4 rf = mpcrossRF.slot("rf"); Rcpp::S4 theta = rf.slot("theta"); Rcpp::RawVector data = theta.slot("data"); Rcpp::NumericVector levels = theta.slot("levels"); Rcpp::CharacterVector markers = theta.slot("markers"); if(markers.size() != preClusterMarkers) { throw std::runtime_error("Number of markers in precluster object was inconsistent with number of markers in mpcrossRF object"); } R_xlen_t resultDimension = preClusterResults.size(); //Allocate enough storage. This symmetric matrix stores the *LOWER* triangular part, in column-major storage. Excluding the diagonal. Rcpp::NumericVector result(((resultDimension-(R_xlen_t)1)*resultDimension)/(R_xlen_t)2); for(R_xlen_t column = 0; column < resultDimension; column++) { Rcpp::IntegerVector columnMarkers = preClusterResults(column); for(R_xlen_t row = column + 1; row < resultDimension; row++) { Rcpp::IntegerVector rowMarkers = preClusterResults(row); double total = 0; R_xlen_t counter = 0; for(R_xlen_t columnMarkerCounter = 0; columnMarkerCounter < columnMarkers.size(); columnMarkerCounter++) { R_xlen_t marker1 = columnMarkers[columnMarkerCounter]-(R_xlen_t)1; for(R_xlen_t rowMarkerCounter = 0; rowMarkerCounter < rowMarkers.size(); rowMarkerCounter++) { R_xlen_t marker2 = rowMarkers[rowMarkerCounter]-(R_xlen_t)1; R_xlen_t column = std::max(marker1, marker2); R_xlen_t row = std::min(marker1, marker2); Rbyte thetaDataValue = data((column*(column+(R_xlen_t)1))/(R_xlen_t)2 + row); if(thetaDataValue != 0xFF) { total += levels(thetaDataValue); counter++; } } } if(counter == 0) total = 0.5; else total /= counter; result(((resultDimension-(R_xlen_t)1)*resultDimension)/(R_xlen_t)2 - ((resultDimension - column)*(resultDimension-column-(R_xlen_t)1))/(R_xlen_t)2 + row-column-(R_xlen_t)1) = total; } } return result; END_RCPP }
static Rcpp::NumericMatrix x_tilde(Rcpp::NumericMatrix X, Rcpp::IntegerVector nk, Rcpp::IntegerMatrix groups, Rcpp::NumericVector d_cur, Rcpp::NumericMatrix eta_cur) { int K = nk.size(); int n_tot = X.nrow(); int p = X.ncol(); int L = groups.ncol(); Rcpp::NumericMatrix result(n_tot, p * K); int idx = 0; for (int k = 0; k < K; k++) { int n = nk[k]; for (int j = 0; j < p; j++) { //calculate sum for column j double sum = 0.0; for (int l = 0; l < L; l++) { if (elem(groups, j, l)) { sum += d_cur[l] * elem(eta_cur, l, k); } } //multiply column j in submatrix k of X with sum for (int i = 0; i < n; i++) { elem(result, idx + i, p * k + j) = elem(X, idx + i, j) * sum; } } idx += n; } return result; }
static void print(Rcpp::IntegerVector a) { for (int i = 0; i < a.size(); i++) { printf("%d ", a[i]); } putchar('\n'); }
static double bic_logistic(Rcpp::NumericMatrix X, Rcpp::NumericVector y, Rcpp::NumericMatrix beta_new, double eps, Rcpp::IntegerVector nk) { int n_tot = X.nrow(); int p = X.ncol(); int K = nk.size(); int idx = 0; double ll = 0.0; for (int k = 0; k < K; k++) { int n = nk[k]; for (int i = 0; i < n; i++) { double lp = 0.0; for (int j = 0; j < p; j++) { lp += elem(X, idx+i, j) * elem(beta_new, j, k); } ll += y[idx+i] * lp - log(1.0 + exp(lp)); } idx += n; } double bic = -2.0 * ll + df(beta_new, eps) * log(n_tot); return bic; }
static double bic_linear(Rcpp::NumericMatrix X, Rcpp::NumericVector y, Rcpp::NumericMatrix beta_new, double eps, Rcpp::IntegerVector nk) { int n_tot = X.nrow(); int p = X.ncol(); int K = nk.size(); /*calculate SSe*/ double SSe = 0.0; int idx = 0; for (int k = 0; k < K; k++) { int n = nk[k]; for (int i = 0; i < n; i++) { double Xrow_betacol = 0.0; for (int j = 0; j < p; j++) { Xrow_betacol += elem(X, idx+i, j) * elem(beta_new, j, k); } SSe += pow(y[idx+i] - Xrow_betacol, 2); } idx += n; } double ll = -n_tot / 2.0 * (log(SSe) - log(n_tot) + log(2.0 * M_PI) + 1); double bic = -2 * ll + df(beta_new, eps) * log(n_tot); return bic; }
static Rcpp::NumericMatrix next_beta(Rcpp::IntegerVector nk, Rcpp::IntegerMatrix groups, Rcpp::NumericMatrix alpha_new, Rcpp::NumericVector d_new, Rcpp::NumericMatrix eta_new) { int K = nk.size(); int p = groups.nrow(); int L = groups.ncol(); Rcpp::NumericMatrix result(p, K); for (int k = 0; k < K; k++) { for (int j = 0; j < p; j++) { double sum = 0.0; for (int l = 0; l < L; l++) { if (elem(groups, j, l)) { sum += d_new[l] * elem(eta_new, l, k); } } elem(result, j, k) = elem(alpha_new, j, k) * sum; } } return result; }
// Calculate CPO for spatial Copula Cox PH arma::vec LinvSpCopulaCox(Rcpp::NumericVector tobs, Rcpp::IntegerVector delta, Rcpp::NumericVector Xbeta, Rcpp::NumericVector h, Rcpp::NumericVector d, arma::mat Cinv, arma::vec z){ int n = delta.size(); arma::vec res(n); for(int i=0; i<n; ++i){ double Cii = Cinv(i,i); double s2i = 1.0/Cii; double mui = -s2i*( arma::dot(Cinv.col(i), z) - Cii*z[i] ); double si = std::sqrt(s2i); double Fi = Foft(tobs[i], h, d, Xbeta[i]); double PinvFyi = Rf_qnorm5(Fi, 0, 1, true, false); double newzi = (PinvFyi-mui)/si; if(delta[i]==0){ double St = 1.0-Rf_pnorm5(newzi, 0, 1, true, false); //Rprintf( "St=%f\n", St ); res(i) = 1.0/St; } else { double fi = foft(tobs[i], h, d, Xbeta[i]); double diff = -0.5*std::pow(newzi, 2) + 0.5*std::pow(PinvFyi, 2); double ft = (1.0/si*std::exp(diff)*fi); res(i) = 1.0/ft; //Rprintf( "ft=%f\n", ft ); } } return(res); }
static Rcpp::NumericMatrix x_tilde_2(Rcpp::NumericMatrix X, Rcpp::IntegerVector nk, Rcpp::IntegerMatrix groups, Rcpp::NumericMatrix alpha_new, Rcpp::NumericMatrix eta_cur) { int K = nk.size(); int n_tot = X.nrow(); int p = X.ncol(); int L = groups.ncol(); Rcpp::NumericMatrix result(n_tot, L); for (int l = 0; l < L; l++) { int k = -1; int n = 0; for (int i = 0; i < n_tot; i++) { if (i == n){ k +=1; n += nk[k]; } double sum = 0.0; for (int j = 0; j < p; j++) { if (elem(groups, j, l)) { sum += elem(X, i, j) * elem(alpha_new, j, k); } } elem(result, i, l) = elem(eta_cur, l, k) * sum; } } return result; }
//' Update eigen values, vectors, and inverse matrices for irms //' //' @param tpm_prods array of transition probability matrix products //' @param tpms array of transition probability matrices //' @param pop_mat population level bookkeeping matrix //' @param obstimes vector of observation times //' //' @return Updated eigenvalues, eigenvectors, and inverse matrices // [[Rcpp::export]] void tpmProdSeqs(Rcpp::NumericVector& tpm_prods, Rcpp::NumericVector& tpms, const Rcpp::IntegerVector obs_time_inds) { // Get indices int n_obs = obs_time_inds.size(); Rcpp::IntegerVector tpmDims = tpms.attr("dim"); // Ensure obs_time_inds starts at 0 Rcpp::IntegerVector obs_inds = obs_time_inds - 1; // Set array pointers arma::cube prod_arr(tpm_prods.begin(), tpmDims[0], tpmDims[1], tpmDims[2], false); arma::cube tpm_arr(tpms.begin(), tpmDims[0], tpmDims[1], tpmDims[2], false); // Generate tpm products and store them in the appropriate spots in the tpm product array for(int j = 0; j < (n_obs - 1); ++j) { prod_arr.slice(obs_inds[j+1] - 1) = tpm_arr.slice(obs_inds[j+1] - 1); for(int k = (obs_inds[j+1] - 2); k > (obs_inds[j] - 1); --k) { prod_arr.slice(k) = tpm_arr.slice(k) * prod_arr.slice(k + 1); } } }
static Rcpp::NumericMatrix x_tilde_3(Rcpp::NumericMatrix X, Rcpp::IntegerVector nk, Rcpp::IntegerMatrix groups, Rcpp::NumericMatrix alpha_new, Rcpp::NumericVector d_new) { int K = nk.size(); int n_tot = X.nrow(); int p = X.ncol(); int L = groups.ncol(); Rcpp::NumericMatrix result(n_tot, L * K); int idx = 0; for (int k = 0; k < K; k++) { int n = nk[k]; for (int l = 0; l < L; l++) { for (int i = 0; i < n; i++) { double sum = 0.0; for (int j = 0; j < p; j++) { if (elem(groups, j, l)) { sum += elem(X, idx + i, j) * elem(alpha_new, j, k); } } elem(result, idx + i, L * k + l) = d_new[l] * sum; } } idx += n; } return result; }
void check_topset(const Rcpp::IntegerVector& top) { for (size_t t=1; t<top.size(); ++t) { if (top[t] < top[t-1]) { throw std::runtime_error("numbers of top genes must be sorted"); } } return; }
//[[Rcpp::export]] Rcpp::CharacterVector edgeIdCpp (Rcpp::IntegerMatrix edge, std::string type) { Rcpp::IntegerVector ances = getAnces(edge); Rcpp::IntegerVector desc = getDesc(edge); int nedge; if (type == "tip" || type == "internal") { Rcpp::IntegerVector tips = tipsFast(ances); nedge = tips.size(); Rcpp::IntegerVector ans = match(tips, desc); if (type == "tip") { Rcpp::IntegerVector tmpAnces(nedge); Rcpp::IntegerVector tmpDesc(nedge); for (int j = 0; j < nedge; j++) { tmpAnces[j] = ances[ans[j]-1]; tmpDesc[j] = desc[ans[j]-1]; } Rcpp::CharacterVector c1(nedge); c1 = edgeIdCppInternal(tmpAnces, tmpDesc); return c1; } else if (type == "internal") { int allEdges = ances.size(); Rcpp::IntegerVector idEdge = Rcpp::seq_len(allEdges); Rcpp::IntegerVector intnd = Rcpp::setdiff(idEdge, ans); nedge = intnd.size(); Rcpp::IntegerVector tmpAnces(nedge); Rcpp::IntegerVector tmpDesc(nedge); for (int j = 0; j < nedge; j++) { tmpAnces[j] = ances[intnd[j]-1]; tmpDesc[j] = desc[intnd[j]-1]; } Rcpp::CharacterVector c1(nedge); c1 = edgeIdCppInternal(tmpAnces, tmpDesc); return c1; } } else { nedge = ances.size(); Rcpp::IntegerVector tmpAnces = ances; Rcpp::IntegerVector tmpDesc = desc; Rcpp::CharacterVector c1(nedge); c1 = edgeIdCppInternal(tmpAnces, tmpDesc); return c1; } return ""; }
// Calculate mk = sum_i I(M(ti)=k), k=1, ..., M with m0=0; // where h=(h0, h1, ..., hM) with h0=0 and d=(d0, d1, ..., dM) with d0=0, dM=R_PosInf void Getmk(Rcpp::IntegerVector& mk, const Rcpp::IntegerVector& Mt){ int n = Mt.size(); std::fill(mk.begin(), mk.end(), 0); for (int i=0; i<n; ++i){ int k = Mt[i]; mk[k] +=1; } }
Rcpp::IntegerVector match_and_substract(Rcpp::IntegerVector x, Rcpp::IntegerVector yInt) { int y(1); y = yInt[0]; for (unsigned k=0; k < x.size(); ++k) { if (x[k] > y) x[k] = x[k] - 1; } return x; }
// Calculate lk, k=1, ..., M with m0=0; // where h=(h0, h1, ..., hM) with h0=0 and d=(d0, d1, ..., dM) with d0=0, dM=R_PosInf void Getlk(Rcpp::NumericVector& lk, const Rcpp::IntegerVector& Mt, int M1, Rcpp::NumericVector d, const Rcpp::NumericVector& t, const Rcpp::NumericVector& Xbeta){ int n = Mt.size(); std::fill(lk.begin(), lk.end(), 0); for (int k=1; k<M1; ++k){ for (int i=0; i<n; ++i){ if(Mt[i]>=k) lk[k] += (std::min(d[k],t[i])-d[k-1])*std::exp(Xbeta[i]); } } }
void fill(Rcpp::IntegerVector idx, SEXP A){ viennacl::vector_range<viennacl::vector_base<T> > v_sub(*shptr.get(), r); #ifdef UNDEF Eigen::Matrix<T, Eigen::Dynamic, 1> Am; Am = Rcpp::as<Eigen::Matrix<T, Eigen::Dynamic, 1> >(A); for(int i = 0; i < idx.size(); i++) { v_sub(idx[i]) = Am(i); } #endif }
std::vector<int> tabulate_tips (Rcpp::IntegerVector ances) { // tabulates ancestor nodes that are not the root. int n = Rcpp::max(ances); std::vector<int> ans(n); for (int i=0; i < ances.size(); i++) { int j = ances[i]; if (j > 0) { ans[j - 1]++; } } return ans; }
bool intercrossingGenerations(Rcpp::DataFrame& pedigree, int nFounders, Rcpp::IntegerVector& mpcrossID, std::vector<int>& output) { #define pedFind(id) findIDInPedigree(id, pedigree) int nFinals = mpcrossID.size(); int nPedigreeRows = pedigree.nrows(); Rcpp::IntegerVector male = Rcpp::as<Rcpp::IntegerVector>(pedigree("Male")), female = Rcpp::as<Rcpp::IntegerVector>(pedigree("Female")); for(int finalCounter = 0; finalCounter < nFinals; finalCounter++) { int currentPedRow = pedFind(mpcrossID[finalCounter]); if(currentPedRow < 0 || currentPedRow > nPedigreeRows) return false; //Counter to stop if the loop goes too long and might be infinite int loopCounter = 0; //Pick the last row and proceed backwards up the pedigree until we're through all the selfing generations while(male(currentPedRow) == female(currentPedRow)) { int nextPedID = male(currentPedRow); if(nextPedID < 0 || nextPedID > nPedigreeRows) return false; currentPedRow = pedFind(nextPedID); if(currentPedRow < 0 || currentPedRow > nPedigreeRows) return false; loopCounter++; if(loopCounter > 2000) return false; } //When we reach an NA in the pedigree the while condition will terminate, which is an error if((male(currentPedRow) != male(currentPedRow)) || (female(currentPedRow) != female(currentPedRow))) { return false; } int ngen = 0; while(male(currentPedRow) > 0) { int nextPedID = male(currentPedRow); if(nextPedID < 0 || nextPedID > nPedigreeRows) return false; currentPedRow = pedFind(nextPedID); if(currentPedRow < 0 || currentPedRow > nPedigreeRows) return false; ngen++; if(ngen > 2000) return false; } //another check for NA values if(male(currentPedRow) != male(currentPedRow)) { return false; } output[finalCounter] = ngen - (int)((log(nFounders) / log(2)) + 0.5); if(output[finalCounter] < 0) return false; } #undef pedFind return true; }
// [[Rcpp::export]] Rcpp::IntegerVector tabulate_cpp(const Rcpp::IntegerVector & v, R_xlen_t nlevels) { // Using R_xlen_t to avoid checking for entries < 0 std::vector<R_xlen_t> table(nlevels); R_xlen_t n = v.size(); for (R_xlen_t i = 0; i < n; ++i) { table.at( v.at(i) - 1 ) ++; } // Wrapp may throw errors with R_xlen_t // return wrap(table); IntegerVector a(table.size()); std::copy(table.begin(), table.end(), a.begin()); return a; }
////////////////////////////////////////////////////////////////////// // Independent Cox PH ///////////////////////////////////////////////////////////////////// // Calculate CPO for Independent Cox PH arma::vec LinvIndeptCox(Rcpp::NumericVector tobs, Rcpp::IntegerVector delta, Rcpp::NumericVector Xbeta, Rcpp::NumericVector h, Rcpp::NumericVector d){ int n = delta.size(); arma::vec res(n); for(int i=0; i<n; ++i){ if(delta[i]==0){ res[i] = 1.0/(1.0-Foft(tobs[i], h, d, Xbeta[i])); }else{ res[i] = 1.0/foft(tobs[i], h, d, Xbeta[i]); } } return(res); }
void ribi::ctm::Helper::CalcMaxLikelihood( const std::string& newick, Rate& birth_rate, Rate& death_rate, const Part part ) const { assert(!newick.empty()); auto& r = ribi::Rinside().Get(); r.parseEval("library(ape)"); r.parseEval("library(DDD)"); r["newick"] = newick; r.parseEval("phylogeny <- read.tree(text = newick)"); r.parseEval("branch_lengths <- phylogeny$edge.length"); switch (part) { case Part::branch_lengths: r["part"] = 0; break; case Part::phylogeny : r["part"] = 1; break; } r.parseEval( "max_likelihood <- bd_ML(" " brts = branch_lengths," " cond = 1," // # cond == 1 : conditioning on stem or crown age and non-extinction of the phylogeny " btorph = part" ")" ); r.parseEval("lambda0 <- max_likelihood$lambda0"); r.parseEval("mu0 <- max_likelihood$mu0"); r.parseEval("conv <- max_likelihood$conv"); const Rcpp::DoubleVector lambda0 = r["lambda0"]; const Rcpp::DoubleVector mu0 = r["mu0"]; const Rcpp::IntegerVector conv = r["conv"]; assert(lambda0.size() == 1); assert(mu0.size() == 1); assert(conv.size() == 1); const bool has_converged = conv[0] == 0; if (!has_converged) { std::stringstream s; s << __func__ << ": has not converged" ; throw std::runtime_error(s.str()); } birth_rate = lambda0[0] / boost::units::si::second; death_rate = mu0[0] / boost::units::si::second; }
SEXP rawSymmetricMatrixSubsetObject(SEXP object_, SEXP indices_) { BEGIN_RCPP Rcpp::S4 object = object_; Rcpp::RawVector oldData = object.slot("data"); Rcpp::IntegerVector indices = indices_; R_xlen_t newNMarkers = indices.size(); Rcpp::RawVector newData((indices.size() * (indices.size() + (R_xlen_t)1))/(R_xlen_t)2); R_xlen_t counter = 0; //Column for(R_xlen_t j = 0; j < newNMarkers; j++) { //Row for(R_xlen_t i = 0; i <= j; i++) { R_xlen_t indexJ = indices[j], indexI = indices[i]; if(indexI > indexJ) std::swap(indexI, indexJ); newData(counter) = oldData[(indexJ*(indexJ-(R_xlen_t)1))/(R_xlen_t)2 + indexI - (R_xlen_t)1]; counter++; } } return newData; END_RCPP }
Permutation::Permutation(Rcpp::IntegerVector &vv) : d_perm(vv), n(vv.size()) { int *vpt = vv.begin(); std::vector<bool> chk(n); std::fill(chk.begin(), chk.end(), false); for (int i = 0; i < n; i++) { int vi = vpt[i]; if (vi < 0 || n <= vi) throw runtime_error("permutation elements must be in [0,n)"); if (chk[vi]) throw runtime_error("permutation is not a permutation"); chk[vi] = true; } }
//[[Rcpp::export]] Rcpp::IntegerVector tipsSafe (Rcpp::IntegerVector ances, Rcpp::IntegerVector desc) { Rcpp::IntegerVector res = Rcpp::match(desc, ances); Rcpp::LogicalVector istip = Rcpp::is_na(res); int nedge = ances.size(); std::vector<int> y(nedge); int j = 0; for(int i = 0; i < nedge; i++) { if (istip[i]) { y[j] = desc[i]; j++; } } Rcpp::IntegerVector ans(j); std::copy (y.begin(), y.begin()+j, ans.begin()); std::sort (ans.begin(), ans.end()); return ans; }
Rcpp::CharacterVector edgeIdCppInternal (Rcpp::IntegerVector tmp1, Rcpp::IntegerVector tmp2) { Rcpp::CharacterVector tmpV1 = Rcpp::as< Rcpp::CharacterVector >(tmp1); Rcpp::CharacterVector tmpV2 = Rcpp::as< Rcpp::CharacterVector >(tmp2); int Ne = tmp1.size(); Rcpp::CharacterVector res(Ne); for (int i = 0; i < Ne; i++) { std::string tmpS1; tmpS1 = tmpV1[i]; std::string tmpS2; tmpS2 = tmpV2[i]; std::string tmpS; tmpS = tmpS1.append("-"); tmpS = tmpS.append(tmpS2); res[i] = tmpS; } return res; }
// [[Rcpp::export]] XPtrImage magick_image_readbin(Rcpp::RawVector x, Rcpp::CharacterVector density, Rcpp::IntegerVector depth, bool strip = false){ XPtrImage image = create(); #if MagickLibVersion >= 0x689 Magick::ReadOptions opts = Magick::ReadOptions(); #if MagickLibVersion >= 0x690 opts.quiet(1); #endif if(density.size()) opts.density(std::string(density.at(0)).c_str()); if(depth.size()) opts.depth(depth.at(0)); Magick::readImages(image.get(), Magick::Blob(x.begin(), x.length()), opts); #else Magick::readImages(image.get(), Magick::Blob(x.begin(), x.length())); #endif if(strip) for_each (image->begin(), image->end(), Magick::stripImage()); return image; }
SEXP constructDissimilarityMatrixInternal(unsigned char* data, std::vector<double>& levels, int size, SEXP clusters_, int start, const std::vector<int>& currentPermutation) { Rcpp::IntegerVector clusters = Rcpp::as<Rcpp::IntegerVector>(clusters_); int minCluster = *std::min_element(clusters.begin(), clusters.end()), maxCluster = *std::max_element(clusters.begin(), clusters.end()); if(minCluster != 1) { throw std::runtime_error("Clusters must have consecutive indices starting at 1"); } std::vector<std::vector<int> > groupIndices(maxCluster); for(int i = 0; i < clusters.size(); i++) { groupIndices[clusters[i]-1].push_back(currentPermutation[i + start]); } std::vector<int> table(levels.size()); Rcpp::NumericMatrix result(maxCluster, maxCluster); for(int rowCluster = 1; rowCluster <= maxCluster; rowCluster++) { for(int columnCluster = 1; columnCluster <= rowCluster; columnCluster++) { const std::vector<int>& columnIndices = groupIndices[columnCluster-1]; const std::vector<int>& rowIndices = groupIndices[rowCluster-1]; std::fill(table.begin(), table.end(), 0); for(std::vector<int>::const_iterator columnMarker = columnIndices.begin(); columnMarker != columnIndices.end(); columnMarker++) { for(std::vector<int>::const_iterator rowMarker = rowIndices.begin(); rowMarker != rowIndices.end(); rowMarker++) { int x = *rowMarker, y = *columnMarker; if(x < y) std::swap(x, y); int byte = data[x *(x + (R_xlen_t)1)/(R_xlen_t)2 + y]; if(byte == 255) throw std::runtime_error("Values of NA not allowed"); table[byte]++; } } double sum = 0; for(int i = 0; i < table.size(); i++) sum += table[i] * levels[i]; result(rowCluster-1, columnCluster-1) = result(columnCluster-1, rowCluster-1) = sum / (columnIndices.size() * rowIndices.size()); } } return result; }
SEXP top_cumprop_internal(Rcpp::RObject incoming, Rcpp::IntegerVector topset) { auto mat=beachmat::create_matrix<M>(incoming); const size_t ncells=mat->get_ncol(); const size_t ngenes=mat->get_nrow(); check_topset(topset); Rcpp::NumericMatrix percentages(topset.size(), ncells); typename M::vector holder(ngenes); for (size_t c=0; c<ncells; ++c) { mat->get_col(c, holder.begin()); // need to copy as cumsum will change ordering. double totals=std::accumulate(holder.begin(), holder.end(), static_cast<typename M::type>(0)); auto cur_col=percentages.column(c); compute_cumsum<typename M::type, typename M::vector>(holder.begin(), ngenes, topset, cur_col.begin()); for (auto& p : cur_col) { p/=totals; } } return percentages; }