// [[Rcpp::export]] NumericVector CPP_row_norms_sparse(int nr, int nc, IntegerVector p, IntegerVector row_of, NumericVector x, int norm_code, double p_norm = 2.0) { check_norm(norm_code, p_norm); NumericVector norms(nr, 0.0); NumericVector::iterator _x = x.begin(); IntegerVector::iterator _p = p.begin(); IntegerVector::iterator _row_of = row_of.begin(); NumericVector::iterator _norms = norms.begin(); for (int col = 0; col < nc; col++) { for (int i = _p[col]; i < _p[col+1]; i++) { int row = _row_of[i]; if (norm_code == 0) _norms[row] += _x[i] * _x[i]; else if (norm_code == 1) { if (fabs(_x[i]) > _norms[row]) _norms[row] = fabs(_x[i]); } else if (norm_code == 2) _norms[row] += fabs(_x[i]); else if (norm_code == 3) { if (p_norm > 0) _norms[row] += pow(fabs(_x[i]), p_norm); else _norms[row] += (_x[i] != 0); } } } if (norm_code == 0) norms = sqrt(norms); else if (norm_code == 3 && p_norm > 1.0) norms = pow(norms, 1.0 / p_norm); /* no adjustment needed for Maximum and Manhattan norms */ return norms; }
// [[Rcpp::export]] NumericVector CPP_dsm_score_sparse(int nr, int nc, IntegerVector p, IntegerVector row_of, NumericVector f, NumericVector f1, NumericVector f2, double N, int am_code, int sparse, int transform_code) { if (am_code < 0 || am_code >= am_table_entries) stop("internal error -- invalid AM code"); am_func AM = am_table[am_code]; /* selected association measure */ // -- don't check whether sparse=TRUE, so power users can compute non-sparse AMs for nonzero entries of the sparse matrix // if (!sparse) stop("only sparse association scores can be used with sparse matrix representation"); int n_items = f.size(); NumericVector scores(n_items); if (am_code != 0 && (nr != f1.size() || nc != f2.size())) stop("internal error -- marginal vectors f1 and f2 not conformable with matrix f"); IntegerVector::iterator _p = p.begin(); IntegerVector::iterator _row_of = row_of.begin(); NumericVector::iterator _f = f.begin(); NumericVector::iterator _f1 = f1.begin(); NumericVector::iterator _f2 = f2.begin(); NumericVector::iterator _scores = scores.begin(); for (int col = 0; col < nc; col++) { for (int i = _p[col]; i < _p[col+1]; i++) { /* frequeny measure (*am_code == 0) is a special case, since marginals may not be available ("reweight" mode) */ double score = (am_code == 0) ? _f[i] : AM(_f[i], _f1[_row_of[i]], _f2[col], N, sparse); _scores[i] = (transform_code) ? transform(score, transform_code) : score; } } return scores; }
// [[Rcpp::export]] List runit_lang_binarycall(IntegerVector x1, IntegerVector x2 ){ Language call( "seq", Named("from", 10 ), Named("to", 0 ) ) ; List output( x1.size() ) ; std::transform( x1.begin(), x1.end(), x2.begin(), output.begin(), binary_call<int,int>(call) ) ; return output ; }
// [[Rcpp::export]] List integer_erase_range_2( IntegerVector x, IntegerVector y ){ IntegerVector::iterator it = x.begin()+1 ; while( it != x.end() ){ it = x.erase(it) ; } it = y.begin() + 1 ; while( it != y.end() ){ it = y.erase(it) ; } return List::create( x, y ) ; }
// [[Rcpp::export(".LRmix")]] NumericVector LRmix(IntegerVector ProfVic, IntegerVector ProfSus, List listFreqs){ int i; int nLoci = listFreqs.size(); NumericVector LocusLRs(nLoci); for(i = 0; i < nLoci; i++){ NumericVector Freqs = as<NumericVector>(listFreqs[i]); LocusLRs[i] = locusLRmix(ProfVic.begin() + 2 * i, ProfSus.begin() + 2 * i, Freqs); } return LocusLRs; }
inline STORAGE process_chunk(const SlicingIndex& indices) { int n = indices.size(); if (n == 0 || idx > n || idx < -n) return def; int i = idx > 0 ? (idx -1) : (n+idx); typedef VectorSliceVisitor<ORDER_RTYPE> Slice; typedef OrderVectorVisitorImpl<ORDER_RTYPE,true,Slice> Visitor; typedef Compare_Single_OrderVisitor<Visitor> Comparer; Comparer comparer(Visitor(Slice(order, indices))); IntegerVector sequence = seq(0,n-1); std::nth_element(sequence.begin(), sequence.begin() + i, sequence.end(), comparer); return data[ indices[ sequence[i] ] ]; }
void single_session(IntegerVector timestamps, IntegerVector& delta_output, int& ts_iter_count, int& threshold, std::deque <int>& hash_reps){ int delta_holding; int hash_rep_holding = 1; delta_output[ts_iter_count] = NA_INTEGER; if(timestamps.size() >= 2) { std::sort(timestamps.begin(), timestamps.end()); for(unsigned int i = 1; i < timestamps.size(); i++){ ts_iter_count++; delta_holding = (timestamps[i] - timestamps[i-1]); if(delta_holding >= threshold){ delta_output[ts_iter_count] = NA_INTEGER; hash_reps.push_back(hash_rep_holding); hash_rep_holding = 1; } else { if(timestamps[i] == NA_INTEGER || timestamps[i-1] == NA_INTEGER){ delta_output[ts_iter_count] = NA_INTEGER; } else { delta_output[ts_iter_count] = delta_holding; } hash_rep_holding++; } } } hash_reps.push_back(hash_rep_holding); ts_iter_count++; }
// [[Rcpp::export]] SEXP next_combinations_replace(Environment I, unsigned long d) { IntegerVector x = I["index"]; unsigned int n = I["unique_n"]; unsigned int r = x.size(); IntegerVector status = I["status"]; unsigned int i,j; unsigned int* xptr = (unsigned int *) x.begin(); if (as<int>(I["status"]) == 0) { if (!MBnext_multicombination(xptr, n, r)) { return R_NilValue; } } else { I["status"] = 0; } if (d>1) { IntegerMatrix P(d,r); P(0,_) = x+1; for(i=1; i<d; i++) { if(!MBnext_multicombination(xptr, n, r)) { I["status"] = i; break; } P(i,_) = x+1; } return P; } else { IntegerVector y(r); for(j=0; j<r; j++) y[j] = xptr[j]+1; return y; } }
//' @title Mode //' @description //' \code{mode} returns the most frequent value of an integer vector //' //' @param x - An integer vector //' //' @examples //' mode(c(1,2,2)) //' //' @return Most frequent value of \code{x} //' //' @export // [[Rcpp::export]] int mode(IntegerVector x) { if(x.size()==0) return NA_INTEGER; IntegerVector y = clone(x); std::sort(y.begin(),y.end()); int maxCount=1, mode=y[0], count=1; for(int i=1;i<y.size();i++){ if(y[i]==y[i-1]) count++; else { if(count>maxCount) { maxCount=count; mode=y[i-1]; } count=1; } } if(count>maxCount) mode=y[y.size()-1]; return mode; }
// [[Rcpp::export]] S4 CPP_scale_margins_sparse(S4 M, NumericVector rows, NumericVector cols, bool duplicate = true) { if (!M.is("dgCMatrix")) stop("internal error -- not a canonical sparse matrix"); IntegerVector dims = M.slot("Dim"); int nr = dims[0], nc = dims[1]; if (nr != rows.size() || nc != cols.size()) stop("internal error -- row/column weights not conformable with matrix"); if (duplicate) M = clone(M); IntegerVector p = M.slot("p"); IntegerVector::iterator _p = p.begin(); IntegerVector row_of = M.slot("i"); IntegerVector::iterator _row_of = row_of.begin(); NumericVector x = M.slot("x"); NumericVector::iterator _x = x.begin(); NumericVector::iterator _rows = rows.begin(); for (int col = 0; col < nc; col++) { double col_weight = cols[col]; for (int i = _p[col]; i < _p[col+1]; i++) { _x[i] *= _rows[_row_of[i]] * col_weight; } } return M; }
// [[Rcpp::export]] NumericVector CPP_col_norms_sparse(int nr, int nc, IntegerVector p, IntegerVector row_of, NumericVector x, int norm_code, double p_norm = 2.0) { check_norm(norm_code, p_norm); NumericVector norms(nc, 0.0); NumericVector::iterator _x = x.begin(); IntegerVector::iterator _p = p.begin(); // IntegerVector::iterator _row_of = row_of.begin(); NumericVector::iterator _norms = norms.begin(); for (int col = 0; col < nc; col++) { double accum = 0.0; for (int i = _p[col]; i < _p[col+1]; i++) { if (norm_code == 0) accum += _x[i] * _x[i]; else if (norm_code == 1) { if (fabs(_x[i]) > accum) accum = fabs(_x[i]); } else if (norm_code == 2) accum += fabs(_x[i]); else if (norm_code == 3) { if (p_norm > 0) accum += pow(fabs(_x[i]), p_norm); else accum += (_x[i] != 0); } } if (norm_code == 0) _norms[col] = sqrt(accum); else if (norm_code == 3 && p_norm > 1.0) _norms[col] = pow(accum, 1.0 / p_norm); else /* other norms */ _norms[col] = accum; } return norms; }
// **********************************************************// // Calculate xi over the entire corpus // // **********************************************************// // [[Rcpp::export]] List xi_all(NumericMatrix timemat, NumericMatrix eta1,NumericMatrix eta2, IntegerVector edgetrim) { List xi(timemat.nrow()); for (IntegerVector::iterator it = edgetrim.begin(); it != edgetrim.end(); ++it) { xi[*it-1] = ximat(timemat(*it-2, _), eta1, eta2); } return xi; }
NumericVector logLikMixHMM(NumericVector transitionMatrix, NumericVector emissionArray, NumericVector initialProbs, IntegerVector obsArray, NumericMatrix coefs, NumericMatrix X_, IntegerVector numberOfStates) { IntegerVector eDims = emissionArray.attr("dim"); //m,p,r IntegerVector oDims = obsArray.attr("dim"); //k,n,r int q = coefs.nrow(); arma::mat coef(coefs.begin(),q,coefs.ncol()); coef.col(0).zeros(); arma::mat X(X_.begin(),oDims[0],q); arma::mat lweights = exp(X*coef).t(); if(!lweights.is_finite()){ return wrap(-std::numeric_limits<double>::max()); } lweights.each_row() /= sum(lweights,0); arma::colvec init(initialProbs.begin(),eDims[0], true); arma::mat transition(transitionMatrix.begin(),eDims[0],eDims[0], true); arma::cube emission(emissionArray.begin(), eDims[0], eDims[1], eDims[2], true); arma::icube obs(obsArray.begin(), oDims[0], oDims[1], oDims[2], false); arma::vec alpha(eDims[0]); NumericVector ll(oDims[0]); double tmp; arma::vec initk(eDims[0]); for(int k = 0; k < oDims[0]; k++){ initk = init % reparma(lweights.col(k),numberOfStates); for(int i=0; i < eDims[0]; i++){ alpha(i) = initk(i); for(int r = 0; r < oDims[2]; r++){ alpha(i) *= emission(i,obs(k,0,r),r); } } tmp = sum(alpha); ll(k) = log(tmp); alpha /= tmp; arma::vec alphatmp(eDims[0]); for(int t = 1; t < oDims[1]; t++){ for(int i = 0; i < eDims[0]; i++){ alphatmp(i) = arma::dot(transition.col(i), alpha); for(int r = 0; r < oDims[2]; r++){ alphatmp(i) *= emission(i,obs(k,t,r),r); } } tmp = sum(alphatmp); ll(k) += log(tmp); alpha = alphatmp/tmp; } } return ll; }
// [[Rcpp::export]] const bool test3(IntegerVector ipd, int ipd_) { //int max_ipd = max(ipd); if (std::find(ipd.begin(), ipd.end(), ipd_) != ipd.end()) { return true; } else { return false; } }
// [[Rcpp::export]] std::tr1::unordered_set<int> unique1(IntegerVector x) { std::tr1::unordered_set<int> seen; for(IntegerVector::iterator it = x.begin(); it != x.end(); ++it) { seen.insert(*it); } return seen; }
RCPP_FUNCTION_2(List, lme4_PermChk, IntegerVector perm, IntegerVector x) { IntegerVector zerob = clone(perm); // modifiable copy int bb = *(std::min_element(zerob.begin(), zerob.end())); if (bb != 0) zerob = zerob - bb; MatrixNs::Permutation pp(zerob); return List::create(_["forw"] = pp.forward(x), _["inv"] = pp.inverse(x)); }
// **********************************************************// // Calculate mu matrix for entire document // // **********************************************************// // [[Rcpp::export]] NumericMatrix mu_mat(NumericMatrix p_d, List xi, IntegerVector edgetrim) { NumericMatrix sample = xi[max(edgetrim)-1]; NumericMatrix mumat(xi.size(), sample.nrow()); for (IntegerVector::iterator it = edgetrim.begin(); it != edgetrim.end(); ++it) { int it2 = *it-1; mumat(it2, _) = mu_vec(p_d(it2, _), xi[it2]); } return mumat; }
int mode(IntegerVector x) { int n=unique(x).size(); NumericVector y(n); for (int i=0; i<n; ++i) y[i]=std::count(x.begin(),x.end(),unique(x)[i]); int m=max(y); int q=std::distance(y.begin(),std::find(y.begin(),y.end(),m)); return unique(x)[q]; }
// **********************************************************// // Likelihood evaluation of Timepart // // **********************************************************// // [[Rcpp::export]] double Timepartsum(NumericMatrix mumat, double sigma_tau, IntegerVector senders, NumericVector timeinc, IntegerVector edgetrim){ double timesum = 0; for (IntegerVector::iterator it = edgetrim.begin(); it != edgetrim.end(); ++it) { int it2 = *it-1; double a_d = senders[it2]; timesum += Timepart(mumat(it2,_), sigma_tau, a_d, timeinc[it2]); } return timesum; }
// [[Rcpp::export]] const bool test2(IntegerVector ipd, int ipd_) { //int max_ipd = max(ipd); std::set<int> ipd_set(ipd.begin(), ipd.end()); if (ipd_set.find(ipd_) != ipd_set.end()) { return true; } else { return false; } }
// [[Rcpp::export]] List runit_lang_unarycallindex(IntegerVector x){ Language call( "seq", 10, 0 ) ; List output( x.size() ) ; std::transform( x.begin(), x.end(), output.begin(), unary_call<int>(call,2) ) ; return output ; }
// [[Rcpp::export]] List runit_lang_unarycall(IntegerVector x){ Language call( "seq", Named("from", 10 ), Named("to", 0 ) ) ; List output( x.size() ) ; std::transform( x.begin(), x.end(), output.begin(), unary_call<int>(call) ) ; return output ; }
//parses the GR object. void parseRegions(std::vector<GArray>& container, RObject& gr, samfile_t* in){ if (not gr.inherits("GRanges")) stop("must provide a GRanges object"); IntegerVector starts = as<IntegerVector>(as<RObject>(gr.slot("ranges")).slot("start")); IntegerVector lens = as<IntegerVector>(as<RObject>(gr.slot("ranges")).slot("width")); RObject chrsRle = as<RObject>(gr.slot("seqnames")); RObject strandsRle = as<RObject>(gr.slot("strand")); RleIter chrs(chrsRle); RleIter strands(strandsRle); container.reserve(container.size() + starts.length()); Iint e_starts = starts.end(); Iint i_starts = starts.begin(); Iint i_lens = lens.begin(); int lastStrandRun = -1; int strand = -1; int lastChrsRun = -1; int rid = -1; for (; i_starts < e_starts; ++i_starts, ++i_lens, chrs.next(), strands.next()){ //if new run, update chromosome if (lastChrsRun != chrs.run){ lastChrsRun = chrs.run; rid = getRefId(in, chrs.getValue()); if (rid == -1) stop("chromosome " + (std::string)chrs.getValue() + " not present in the bam file"); } //if new run, update strand if (lastStrandRun != strands.run){ lastStrandRun = strands.run; const std::string& s = strands.getValue(); if (s == "-"){ strand = -1; } else if (s == "+"){ strand = +1; } else { strand = 0; } } container.push_back(GArray(rid, *i_starts - 1, *i_lens, strand)); } }
//' @title Vertex coloring of a sparse undirected graph //' @description Generate proper vertex coloring of a sparse undirected graph. //' @param pntr,idx row pointers and column indices of the adjacency matrix, in compressed column-oriented format. Must use zero-based indexing. //' @param nvars Number of vertices. //' @return An integer vector of length nvars, where each element represents the color of the corresponding vertex. Indices are zero-based. //' @details For internal use. You should not have to call this function directly. //[[Rcpp::export]] Rcpp::IntegerVector get_colors(const IntegerVector& pntr, //row/col pointer const IntegerVector& idx, // col/row index const int nvars) { std::vector<std::set<int> > P(nvars); std::vector<std::set<int> > forb(nvars); Rcpp::IntegerVector colors(nvars); std::set<int> used; std::set<int> valid; for (int m=0; m < nvars; m++) { P[m] = S(idx.begin()+pntr(m), idx.begin()+pntr(m+1)); // rows } int max_color = 0; used.insert(0); for (int i=0; i<nvars; i++) { if (forb[i].empty()) { colors[i] = 0; } else { valid.clear(); set_difference(used.begin(), used.end(), forb[i].begin(), forb[i].end(), std::inserter(valid,valid.begin())); if (valid.empty()) { // add new color max_color++; used.insert(max_color); colors[i] = max_color; } else { colors[i] = *valid.begin(); } } for (auto j : P[i]) { forb[j].insert(colors[i]); } } return(Rcpp::wrap(colors)); }
//[[Rcpp::export(".locusIBS")]] IntegerVector locusIBS(IntegerVector ProfMat, int N){ // assumes pnProfMat is a vector of length 4 * N IntegerVector result(N); int i; for(i = 0; i < N; i++){ int i1 = 4 * i; result[i] = profIBS(ProfMat.begin() + i1); } return result; }
// get a set of permutations of a vector, as columns of a matrix // [[Rcpp::export]] IntegerMatrix permute_ivector(const int n_perm, const IntegerVector x) { unsigned int length = x.size(); IntegerMatrix result(length,n_perm); for(unsigned int i=0; i<n_perm; i++) { IntegerVector permx = permute_ivector(x); std::copy(permx.begin(), permx.end(), result.begin()+i*length); } return result; }
double prob(IntegerVector Prof, List listFreqs){ int nLoci = listFreqs.size(); int nLoc; double dProd = 1; for(nLoc = 0; nLoc < nLoci; nLoc++){ int i1 = 2*nLoc; NumericVector Freq = as<NumericVector>(listFreqs[nLoc]); dProd *= locusProb(Prof.begin() + i1, Freq); } return dProd; }
List viterbi(NumericVector transitionMatrix, NumericVector emissionArray, NumericVector initialProbs, IntegerVector obsArray) { IntegerVector eDims = emissionArray.attr("dim"); //m,p,r IntegerVector oDims = obsArray.attr("dim"); //k,n,r arma::vec init(initialProbs.begin(), eDims[0], false); arma::mat transition(transitionMatrix.begin(), eDims[0], eDims[0], false); arma::cube emission(emissionArray.begin(), eDims[0], eDims[1], eDims[2], false); arma::icube obs(obsArray.begin(), oDims[0], oDims[1], oDims[2], false); arma::umat q(oDims[0], oDims[1]); arma::vec logp(oDims[0]); arma::mat delta(eDims[0],oDims[1]); arma::umat phi(eDims[0],oDims[1]); for(int k=0; k<oDims[0]; k++){ delta.col(0) = init; for(int r=0; r<eDims[2]; r++){ delta.col(0) += emission.slice(r).col(obs(k,0,r)); } phi.col(0).zeros(); for(int t=1; t<oDims[1]; t++){ for(int j=0; j<eDims[0]; j++){ (delta.col(t-1)+transition.col(j)).max(phi(j,t)); delta(j,t) = delta(phi(j,t),t-1)+transition(phi(j,t),j); for(int r=0; r<eDims[2]; r++){ delta(j,t) += emission(j,obs(k,t,r),r); } } } delta.col(oDims[1]-1).max(q(k,oDims[1]-1)); for(int t=(oDims[1]-2); t>=0; t--){ q(k,t) = phi(q(k,t+1),t+1); } logp(k) = delta.col(oDims[1]-1).max(); } return List::create(Named("q") = wrap(q),Named("logp") = wrap(logp)); }
// [[Rcpp::export]] IntegerVector kMeansRcpp(const NumericMatrix data, const int K, IntegerVector init_labels) { int N = data.nrow(); int p = data.ncol(); bool labels_not_convegent_yet = true; ivec ref_labels(init_labels.begin(), init_labels.size(), false); ivec cluster_labels = zeros<ivec>(N); mat medoids = zeros<mat>(K, p); mat data_all(data.begin(), N, p, false); mat data_temp; rowvec data_sbj; rowvec mdd_vec; // get the initial medoid int cnt_wthn_clstr = 0; int itr_clstrs = 0; int itr_sbjs = 0; double dstnc_ref = datum::inf; double dstnc = 0.0; while (labels_not_convegent_yet) { for (itr_clstrs = 0; itr_clstrs < K; itr_clstrs++) { data_temp = data_all.rows(find(ref_labels == itr_clstrs)); medoids.row(itr_clstrs) = mean(data_temp, 0); } for (itr_sbjs = 0; itr_sbjs < N; itr_sbjs++) { data_sbj = data_all.row(itr_sbjs); // std::cout << data_sbj << std::endl; dstnc_ref = datum::inf; for (itr_clstrs = 0; itr_clstrs < K; itr_clstrs++) { mdd_vec = medoids.row(itr_clstrs); dstnc = norm(data_sbj - mdd_vec, 2); if (dstnc < dstnc_ref) { dstnc_ref = dstnc; cluster_labels(itr_sbjs) = itr_clstrs; } } } if (cluster_labels == ref_labels) { labels_not_convegent_yet = false; } else { ref_labels = cluster_labels; } } // return cluster_labels; return wrap(cluster_labels); }
NumericVector logLikHMM(NumericVector transitionMatrix, NumericVector emissionArray, NumericVector initialProbs, IntegerVector obsArray) { IntegerVector eDims = emissionArray.attr("dim"); //m,p,r IntegerVector oDims = obsArray.attr("dim"); //k,n,r arma::colvec init(initialProbs.begin(),eDims[0], false); arma::mat transition(transitionMatrix.begin(),eDims[0],eDims[0], false); arma::cube emission(emissionArray.begin(), eDims[0], eDims[1], eDims[2], false); arma::icube obs(obsArray.begin(), oDims[0], oDims[1], oDims[2], false); arma::vec alpha(eDims[0]); NumericVector ll(oDims[0]); double tmp; for(int k = 0; k < oDims[0]; k++){ for(int i=0; i < eDims[0]; i++){ alpha(i) = init(i); for(int r = 0; r < oDims[2]; r++){ alpha(i) *= emission(i,obs(k,0,r),r); } } tmp = sum(alpha); ll(k) = log(tmp); alpha /= tmp; arma::vec alphatmp(eDims[0]); for(int t = 1; t < oDims[1]; t++){ for(int i = 0; i < eDims[0]; i++){ alphatmp(i) = arma::dot(transition.col(i), alpha); for(int r = 0; r < oDims[2]; r++){ alphatmp(i) *= emission(i,obs(k,t,r),r); } } tmp = sum(alphatmp); ll(k) += log(tmp); alpha = alphatmp/tmp; } } return ll; }