Пример #1
0
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
}
Пример #2
0
// [[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;
}
Пример #3
0
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
}
Пример #4
0
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;
}
Пример #5
0
static void print(Rcpp::IntegerVector a)
{
  for (int i = 0; i < a.size(); i++) {
    printf("%d ", a[i]);
  }
  putchar('\n');
}
Пример #6
0
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;
}
Пример #7
0
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;
}
Пример #8
0
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;
}
Пример #9
0
// 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);
}
Пример #10
0
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;
}
Пример #11
0
//' 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);
                }

        }
}
Пример #12
0
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;
}
Пример #13
0
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;
}
Пример #14
0
//[[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 "";
}
Пример #15
0
// 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;
  }
}
Пример #16
0
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;
}
Пример #17
0
// 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]);
    }
  }
}
Пример #18
0
        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            
        }
Пример #19
0
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;
}
Пример #20
0
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;
}
Пример #21
0
// [[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;
}
Пример #22
0
//////////////////////////////////////////////////////////////////////
// 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;
}
Пример #24
0
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
}
Пример #25
0
    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;
	}
    }
Пример #26
0
//[[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;
}
Пример #27
0
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;
}
Пример #28
0
// [[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;
}
Пример #29
0
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;
}
Пример #30
0
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;
}