예제 #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
SEXP rawSymmetricMatrixToDist(SEXP object)
{
BEGIN_RCPP
	Rcpp::S4 rawSymmetric = object;
	Rcpp::NumericVector levels = Rcpp::as<Rcpp::NumericVector>(rawSymmetric.slot("levels"));
	Rcpp::CharacterVector markers = Rcpp::as<Rcpp::CharacterVector>(rawSymmetric.slot("markers"));
	Rcpp::RawVector data = Rcpp::as<Rcpp::RawVector>(rawSymmetric.slot("data"));
	R_xlen_t size = markers.size(), levelsSize = levels.size();

	Rcpp::NumericVector result(size*(size - 1)/2, 0);
	int counter = 0;
	for(R_xlen_t row = 0; row < size; row++)
	{
		for(R_xlen_t column = row+1; column < size; column++)
		{
			int byte = data(column * (column + (R_xlen_t)1)/(R_xlen_t)2 + row);
			if(byte == 255) result(counter) = std::numeric_limits<double>::quiet_NaN();
			else result(counter) = levels(byte);
			counter++;
		}
	}
	result.attr("Size") = (int)size;
	result.attr("Labels") = markers;
	result.attr("Diag") = false;
	result.attr("Upper") = false;
	result.attr("class") = "dist";
	return result;
END_RCPP
}
예제 #3
0
SEXP assignRawSymmetricMatrixFromEstimateRF(SEXP destination_, SEXP rowIndices_, SEXP columnIndices_, SEXP source_)
{
BEGIN_RCPP
	Rcpp::S4 destination = destination_;
	Rcpp::RawVector source = source_;
	Rcpp::RawVector destinationData = destination.slot("data");
	Rcpp::IntegerVector rowIndices = rowIndices_;
	Rcpp::IntegerVector columnIndices = columnIndices_;

	if(&(source(0)) == &(destinationData(0)))
	{
		throw std::runtime_error("Source and destination cannot be the same in assignRawSymmetricMatrixDiagonal");
	}

	std::vector<int> markerRows, markerColumns;
	markerRows = Rcpp::as<std::vector<int> >(rowIndices);
	markerColumns = Rcpp::as<std::vector<int> >(columnIndices);
	if(countValuesToEstimate(markerRows, markerColumns) != (unsigned long long)source.size())
	{
		throw std::runtime_error("Mismatch between index length and source object size");
	}

	triangularIterator iterator(markerRows, markerColumns);
	R_xlen_t counter = 0;
	for(; !iterator.isDone(); iterator.next())
	{
		std::pair<int, int> markerPair = iterator.get();
		R_xlen_t markerRow = markerPair.first, markerColumn = markerPair.second;
		destinationData((markerColumn*(markerColumn-(R_xlen_t)1))/(R_xlen_t)2 + (markerRow - (R_xlen_t)1)) = source(counter);
		counter++;
	}
	return R_NilValue;
END_RCPP
}
예제 #4
0
파일: respModule.cpp 프로젝트: rforge/lme4
    glmerResp::glmerResp(Rcpp::S4 xp) throw (std::runtime_error)
	: merResp(xp),
	  d_fam(SEXP(xp.slot("family"))),
	  d_n(       xp.slot("n")),
	  d_eta(     xp.slot("eta")) {
	updateWts();
    }
예제 #5
0
// construct cell type from equivalent class in R
CellType::CellType(unsigned id, const Rcpp::S4& type)
{
    mID = id;
    mName = Rcpp::as<std::string>(type.slot("name"));
    mSize = Rcpp::as<double>(type.slot("size"));
    mMinCycle = Rcpp::as<double>(type.slot("minCycle"));
    mCellTypeClass = type;
}
// [[Rcpp::export]]
Rcpp::NumericVector marginal_theta(Rcpp::S4 xmod) {
  RNGScope scope ;
  Rcpp::S4 model_(xmod) ;
  Rcpp::S4 model = clone(model_) ;
  Rcpp::S4 params=model.slot("mcmc.params") ;
  Rcpp::S4 chains(model.slot("mcmc.chains")) ;  
  int S = params.slot("iter") ;
  // Assume current values are the modes (in R, useModes(object) ensures this)
  // List modes = model.slot("modes") ;
  // NumericVector thetastar = as<NumericVector>(modes["theta"]) ;
  List modes = model.slot("modes") ;
  NumericVector theta_ = as<NumericVector>(modes["theta"]) ;
  NumericVector thetastar=clone(theta_) ;
  int K = thetastar.size() ;
  NumericVector p_theta(S) ;
  NumericVector muc = chains.slot("mu") ;
  NumericVector tau2c = chains.slot("tau2") ;
  NumericMatrix sigma2 = chains.slot("sigma2") ;
  NumericVector tauc = sqrt(tau2c) ;
  NumericVector tmp(K) ;

  IntegerMatrix Z = chains.slot("z") ;
  IntegerVector zz ;

  double tau2_tilde ;
  NumericVector sigma2_tilde(K) ;

  // this should be updated for each iteration
  NumericVector data_mean(K) ;
  IntegerVector nn(K) ;
  double post_prec;
  double tau_n;
  double mu_n;
  double w1;
  double w2;

  for(int s=0; s < S; ++s){
    zz = Z(s, _) ;
    model.slot("z") = zz ;
    nn = tableZ(K, zz) ;
    data_mean = compute_means(model) ;
    tau2_tilde = 1/tau2c[s] ;
    sigma2_tilde = 1.0/sigma2(s, _) ;
    //tmp = dnorm(thetastar, muc[s], tauc[s]) ;
    double prod = 1.0;
    for(int k = 0; k < K; ++k) {
      post_prec = tau2_tilde + sigma2_tilde[k] * nn[k];
      tau_n = sqrt(1/post_prec);
      w1 = tau2_tilde/post_prec;
      w2 = nn[k]*sigma2_tilde[k]/post_prec;
      mu_n = w1*muc[s] + w2*data_mean[k];
      tmp = dnorm(thetastar, mu_n, tau_n) ;
      prod = prod * tmp[k] ;
    }
    p_theta[s] = prod ;
  }
  return p_theta ;
}
예제 #7
0
void parse_gb_feature_table(
    Rcpp::S4& gb_feature,
    const std::vector<std::string>& feature_string,
    std::string& accession )
{   
    std::smatch m;
    std::string this_line("");
    std::vector<std::string> merged_lines;
    // merge qualifier values that occupy more than one line into "merged_lines"
    // Define qualifier position: Optional FT + blanks followed by forward slash
    static const std::regex QUAL_POS("^(FT)?\\s+/");
    static const std::regex TRANS("^translation=");
    std::vector<std::string>::const_iterator s_it = std::begin(feature_string);
    for ( ; s_it != std::end(feature_string); s_it++ ) {
        std::regex_search( std::begin(*s_it), std::end(*s_it), m, QUAL_POS ); 
        if ( m[0].matched ) {
            merged_lines.push_back(this_line);
            // If we have an embl file trim FT, whitespace and /
            // If we have a gbk file trim whitespace and /
            this_line = *s_it;
            this_line = ltrim(this_line, "FT");
            this_line = ltrim(this_line, " /");
            this_line = rtrim(this_line, " \n\r\t");
        } else {
            std::string tmp = *s_it;
            tmp = ltrim(tmp, "FT");
            tmp = ltrim(tmp, " /");
            tmp = rtrim(tmp, " \n\r\t");
            if ( std::regex_search( this_line, m, TRANS ) ) {
                // don't add whitespace when joining translations
                this_line += tmp;
            } else {
                this_line += " " + tmp;
            }
        }
        // Push the last qualifier
        if ( s_it == std::end(feature_string) - 1 ) {
            merged_lines.push_back(this_line);
        }
    }
    
    // Get key
    int begin_key = merged_lines[0].find_first_not_of(" ");
    int end_key = merged_lines[0].find_first_of( " ", begin_key );
    std::string key = merged_lines[0].substr( begin_key, end_key - 1 );
    gb_feature.slot("key") = key;
    
    // Get location
    Rcpp::S4 gb_location = Rcpp::S4("gbLocation");
    std::string gb_base_span = merged_lines[0].substr( end_key, merged_lines[0].length() - end_key );
    parse_gb_location( gb_location, gb_base_span, accession );
    gb_feature.slot("location") = gb_location;
    
    merged_lines.erase( std::begin(merged_lines) );
    gb_feature.slot("qualifiers") = parse_gb_qualifiers(merged_lines);
}
예제 #8
0
SEXP rawSymmetricMatrixSubsetByMatrix(SEXP object_, SEXP index_)
{
BEGIN_RCPP
	Rcpp::S4 object;
	try
	{
		object = object_;
	}
	catch(...)
	{
		throw std::runtime_error("Input object must be an S4 object");
	}

	Rcpp::RawVector data;
	try
	{
		data = Rcpp::as<Rcpp::RawVector>(object.slot("data"));
	}
	catch(...)
	{
		throw std::runtime_error("Slot object@data must be a raw vector");
	}

	Rcpp::NumericVector levels;
	try
	{
		levels = Rcpp::as<Rcpp::NumericVector>(object.slot("levels"));
	}
	catch(...)
	{
		throw std::runtime_error("Slot object@levels must be a numeric vector");
	}

	Rcpp::IntegerMatrix index;
	try
	{
		index = index_;
	}
	catch(...)
	{
		throw std::runtime_error("Input index must be an integer matrix");
	}

	int nIndices = index.nrow();
	Rcpp::NumericVector output(nIndices);
	for(int row = 0; row < nIndices; row++)
	{
		R_xlen_t i = index(row, 0);
		R_xlen_t j = index(row, 1);
		if(i > j) std::swap(i, j);
		output(row) = levels[data[(j*(j-(R_xlen_t)1))/(R_xlen_t)2 + i-(R_xlen_t)1]];
	}
	return output;
END_RCPP
}
예제 #9
0
파일: reModule.cpp 프로젝트: rforge/lme4
    reModule::reModule(Rcpp::S4 xp)
	: d_L(     S4(clone(SEXP(xp.slot("L"))))),
	  d_Lambda(S4(clone(SEXP(xp.slot("Lambda"))))),
	  d_Zt(          S4(xp.slot("Zt"))),
	  d_Lind(           xp.slot("Lind")),
	  d_lower(          xp.slot("lower")),
	  d_theta(          xp.slot("theta")),
	  d_u0(             d_L.n),
	  d_incr(           d_L.n),
	  d_u(              d_L.n),
	  d_cu(             d_L.n) {
	d_Ut = (CHM_SP)NULL;
    }
예제 #10
0
double cpp_luT(
	Rcpp::S4 xR,
	Rcpp::S4 dR) {

	const bool BisVCL=1;
	const int ctx_id = INTEGER(xR.slot(".context_index"))[0]-1;

	std::shared_ptr<viennacl::matrix<T> > vclX = getVCLptr<T>(xR.slot("address"), BisVCL, ctx_id);
	std::shared_ptr<viennacl::vector_base<T> > vclD = getVCLVecptr<T>(dR.slot("address"), BisVCL, ctx_id);


	return(luT(*vclX, *vclD));
}
예제 #11
0
//Returns the value of any((object@data >= length(object@levels)) & object@data != as.raw(255))
SEXP checkRawSymmetricMatrix(SEXP rawSymmetric_)
{
BEGIN_RCPP
	Rcpp::S4 rawSymmetric = rawSymmetric_;
	Rcpp::NumericVector levels = Rcpp::as<Rcpp::NumericVector>(rawSymmetric.slot("levels"));
	Rcpp::RawVector data = Rcpp::as<Rcpp::RawVector>(rawSymmetric.slot("data"));
	R_xlen_t size = data.size(), levelsSize = levels.size();
	for(R_xlen_t i = 0; i < size; i++)
	{
		if(data[i] >= levelsSize && data[i] != 0xff) return Rcpp::wrap(true);
	}
	return Rcpp::wrap(false);
END_RCPP
}
// [[Rcpp::export]]
Rcpp::NumericVector p_mu_reduced(Rcpp::S4 xmod) {
  RNGScope scope ;
  Rcpp::S4 model(xmod) ;
  Rcpp::S4 mcmcp = model.slot("mcmc.params") ;
  Rcpp::S4 chains = model.slot("mcmc.chains") ;
  Rcpp::S4 hypp = model.slot("hyperparams") ;
  List modes = model.slot("modes") ;
  //
  //
  NumericVector x = model.slot("data") ;    
  int K = hypp.slot("k") ;
  int S = mcmcp.slot("iter") ;  
  int N = x.size() ;
  //
  NumericVector p_=as<NumericVector>(modes["mixprob"]) ;
  NumericVector theta_=as<NumericVector>(modes["theta"]) ;
  NumericVector mu_=as<NumericVector>(modes["mu"]) ;
  NumericVector pstar = clone(p_) ;
  NumericVector mustar = clone(mu_) ;
  NumericVector thetastar = clone(theta_) ;
  IntegerMatrix Z = chains.slot("z") ;
  NumericVector tau2chain = chains.slot("tau2") ;
  IntegerVector zz(N) ;

  IntegerVector nn(K) ;
  NumericVector mu0=hypp.slot("mu.0") ;
  double mu_0 = mu0[0] ;
  NumericVector tau2_0 = hypp.slot("tau2.0") ;
  double tau20_tilde = 1.0/tau2_0[0] ;

  double mu_k ;
  NumericVector tau2_tilde = 1.0/tau2chain ;
  double w1 ;
  double w2 ;
  double tau_k ;
  NumericVector p_mu(S) ;
  NumericVector tmp(1) ;
  for(int s = 0; s < S; ++s){
    zz = Z(s, _) ;
    nn = tableZ(K, zz) ;
    double total = 0.0 ;
    double thetabar = 0.0 ;    
    for(int k = 0; k < K; k++) total += nn[k] ;    
    for(int k = 0; k < K; k++) thetabar += nn[k] * thetastar[k] / total ;
    double post_prec = tau20_tilde + K*tau2_tilde[s] ;
    w1 = tau20_tilde/post_prec ;
    w2 = K*tau2_tilde[s]/post_prec ;
    mu_k =  w1*mu_0 +  w2*thetabar ;
    tau_k = sqrt(1.0/post_prec) ;
    tmp  = dnorm(mustar, mu_k, tau_k) ;
    p_mu[s] = tmp[0] ;
  }
  return p_mu ;
}
예제 #13
0
파일: respModule.cpp 프로젝트: rforge/lme4
    merResp::merResp(Rcpp::S4 xp)  throw (std::runtime_error)
	: d_y(                    xp.slot("y")),
	  d_weights(        xp.slot("weights")),
	  d_offset(          xp.slot("offset")),
	  d_mu(                 d_y.size(), 0.),
	  d_sqrtrwt(                d_y.size()),
	  d_wtres(                  d_y.size()),
	  d_sqrtXwt(d_y.size(), d_offset.size()/d_y.size()) {
	int n = d_y.size(), os = d_offset.size();
	if (d_mu.size() != n || d_weights.size() != n || d_sqrtrwt.size() != n)
	    throw std::runtime_error("y, mu, sqrtrwt and weights slots must have equal lengths");
	if (os < 1 || os % n)
	    throw std::runtime_error("length(offset) must be a positive multiple of length(y)");
	init();
    }
예제 #14
0
SEXP constructDissimilarityMatrix(SEXP object, SEXP clusters_)
{
BEGIN_RCPP
	Rcpp::S4 rawSymmetric = object;
	Rcpp::NumericVector levels = Rcpp::as<Rcpp::NumericVector>(rawSymmetric.slot("levels"));
	Rcpp::CharacterVector markers = Rcpp::as<Rcpp::CharacterVector>(rawSymmetric.slot("markers"));
	Rcpp::RawVector data = Rcpp::as<Rcpp::RawVector>(rawSymmetric.slot("data"));
	int nMarkers = markers.size();
	std::vector<double> levelsCopied = Rcpp::as<std::vector<double> >(levels);
	
	std::vector<int> permutation(nMarkers);
	for(int i = 0; i < nMarkers; i++) permutation[i] = i;
	return constructDissimilarityMatrixInternal(&(data(0)), levelsCopied, nMarkers, clusters_, 0, permutation);
END_RCPP
}
예제 #15
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
}
예제 #16
0
// [[Rcpp::export]]
Rcpp::NumericVector p_sigma2_batch(Rcpp::S4 xmod) {
  RNGScope scope ;
  Rcpp::S4 model_(xmod) ;
  Rcpp::S4 model = clone(model_) ;
  Rcpp::S4 chains=model.slot("mcmc.chains") ;
  Rcpp::S4 params=model.slot("mcmc.params") ;
  int S = params.slot("iter") ;
  List modes = model.slot("modes") ;
  NumericMatrix sigma2_ = as<NumericMatrix>(modes["sigma2"]) ;
  NumericMatrix theta_ = as<NumericMatrix>(modes["theta"]) ;
  NumericMatrix sigma2star=clone(sigma2_) ;
  NumericMatrix thetastar=clone(theta_) ;
  int K = thetastar.ncol() ;
  int B = thetastar.nrow() ;
  NumericMatrix prec(B, K) ;
  NumericVector p_prec(S) ;
  NumericVector tmp(K) ;
  NumericVector nu0 (1) ;
  NumericVector s20 (1) ;
  //
  // These chains have already been updated
  //
  NumericVector nu0chain = chains.slot("nu.0") ;
  NumericVector s20chain = chains.slot("sigma2.0") ;
  NumericVector d(1) ;
  //
  // Run reduced Gibbs  -- theta is fixed at modal ordinate
  //
  for(int k=0; k < K; ++k){
    prec(_, k) = 1.0/sigma2star(_, k) ;
  }  
  for(int s=0; s < S; ++s){
    s20 = s20chain[s] ;
    nu0 = nu0chain[s] ;
    double total = 1.0 ;
    for(int b=0; b < B; ++b) {
      tmp = dgamma(prec(b, _), 0.5*nu0[0], 2.0 / (nu0[0]*s20[0])) ;
      for(int k = 0; k < K; ++k){
        //total = log(tmp[k]) ;
        total = total * tmp[k] ;
      }
    }
    p_prec[s] = total ;
  }
  return p_prec ;
}
// [[Rcpp::export]]
Rcpp::NumericVector p_s20_reduced(Rcpp::S4 xmod) {
  RNGScope scope ;
  Rcpp::S4 model(xmod) ;
  Rcpp::S4 mcmcp = model.slot("mcmc.params") ;
  Rcpp::S4 chains = model.slot("mcmc.chains") ;
  Rcpp::S4 hypp = model.slot("hyperparams") ;
  List modes = model.slot("modes") ;
  //
  //
  NumericVector x = model.slot("data") ;    
  int K = hypp.slot("k") ;
  int S = mcmcp.slot("iter") ;  
  //
  NumericVector p_=as<NumericVector>(modes["mixprob"]) ;
  NumericVector theta_=as<NumericVector>(modes["theta"]) ;
  NumericVector mu_=as<NumericVector>(modes["mu"]) ;
  NumericVector tau2_=as<NumericVector>(modes["tau2"]) ;
  IntegerVector nu0_=as<IntegerVector>(modes["nu0"]) ;
  NumericVector sigma2_=as<NumericVector>(modes["sigma2"]) ;
  NumericVector s20_=as<NumericVector>(modes["sigma2.0"]) ;
  NumericVector pstar = clone(p_) ;
  NumericVector mustar = clone(mu_) ;
  NumericVector tau2star = clone(tau2_) ;
  NumericVector thetastar = clone(theta_) ;
  NumericVector sigma2star = clone(sigma2_) ;
  NumericVector s20star = clone(s20_) ;
  IntegerVector nu0=clone(nu0_) ;
  double nu0star = nu0[0] ;
  
  NumericVector p_s20(S) ;

  double a = hypp.slot("a") ;
  double b = hypp.slot("b") ;  
  double a_k = a + 0.5*K*nu0star ;
  double b_k = 0.0;

  for (int k=0; k < K; k++) {
    b_k += 0.5*nu0star/sigma2star[k];
  }
  b_k += b ;
  p_s20 = dgamma(s20star, a_k, 1.0/b_k) ;
  return p_s20 ;
}
void graphConvert(SEXP graph_sexp, residualConnectivity::context::inputGraph& boostGraph, std::vector<residualConnectivity::context::vertexPosition>& vertexCoordinates)
{
	Rcpp::RObject graph = Rcpp::as<Rcpp::RObject>(graph_sexp);
	std::string className = Rcpp::as<std::string>(graph.attr("class"));
	Rcpp::NumericMatrix vertexCoordinates_matrix;
	if(className == "igraph")
	{
		Rcpp::Environment igraphEnv("package:igraph");
		Rcpp::Function isDirected = igraphEnv["is_directed"];
		if(Rcpp::as<bool>(isDirected(graph)))
		{
			throw std::runtime_error("Input `graph' must be undirected");
		}
		Rcpp::Function layoutAuto = igraphEnv["layout.auto"];
		vertexCoordinates_matrix = layoutAuto(graph);
		igraphConvert(graph_sexp, boostGraph);
	}
	else if(className == "graphNEL" || className == "graphAM")
	{
		Rcpp::S4 graphS4 = Rcpp::as<Rcpp::S4>(graph);
		Rcpp::S4 renderInfo = Rcpp::as<Rcpp::S4>(graphS4.slot("renderInfo"));
		Rcpp::List nodes = Rcpp::as<Rcpp::List>(renderInfo.slot("nodes"));
		Rcpp::Function length("length"), cbind("cbind");
		if(Rcpp::as<int>(length(nodes)) > 0)
		{
			vertexCoordinates_matrix = Rcpp::as<Rcpp::NumericMatrix>(cbind(nodes["nodeX"], nodes["nodeY"]));
		}
		if(className == "graphNEL") graphNELConvert(graph_sexp, boostGraph);
		else graphAMConvert(graph_sexp, boostGraph);
	}
	else
	{
		throw std::runtime_error("Input graph must have class \"igraph\", \"graphAM\" or \"graphNEL\"");
	}
	std::size_t nVertexCoordinates = vertexCoordinates_matrix.nrow();
	vertexCoordinates.clear();
	vertexCoordinates.reserve(nVertexCoordinates);
	for(std::size_t i = 0; i < nVertexCoordinates; i++)
	{
		vertexCoordinates.push_back(residualConnectivity::context::vertexPosition((residualConnectivity::context::vertexPosition::first_type)vertexCoordinates_matrix((int)i, 0), (residualConnectivity::context::vertexPosition::second_type)vertexCoordinates_matrix((int)i, 1)));
	}
}
// [[Rcpp::export]]
Rcpp::NumericVector p_nu0_reduced(Rcpp::S4 xmod) {
  RNGScope scope ;
  Rcpp::S4 model(xmod) ;
  Rcpp::S4 mcmcp = model.slot("mcmc.params") ;
  Rcpp::S4 chains = model.slot("mcmc.chains") ;
  Rcpp::S4 hypp = model.slot("hyperparams") ;
  List modes = model.slot("modes") ;
  //
  //
  NumericVector x = model.slot("data") ;    
  int K = hypp.slot("k") ;
  int S = mcmcp.slot("iter") ;  
  //
  NumericVector p_=as<NumericVector>(modes["mixprob"]) ;
  NumericVector theta_=as<NumericVector>(modes["theta"]) ;
  NumericVector mu_=as<NumericVector>(modes["mu"]) ;
  NumericVector tau2_=as<NumericVector>(modes["tau2"]) ;
  IntegerVector nu0_=as<IntegerVector>(modes["nu0"]) ;
  NumericVector sigma2_=as<NumericVector>(modes["sigma2"]) ;
  NumericVector pstar = clone(p_) ;
  NumericVector mustar = clone(mu_) ;
  NumericVector tau2star = clone(tau2_) ;
  NumericVector thetastar = clone(theta_) ;
  NumericVector sigma2star = clone(sigma2_) ;
  IntegerVector nu0=clone(nu0_) ;
  NumericVector p_nu0(S) ;
  int nu0star = nu0[0] ;

  NumericVector s20chain = chains.slot("sigma2.0") ;
  double betas = hypp.slot("beta") ;

  //
  // compute p(nu0*, ) from *normalized* probabilities
  //
  NumericVector d(100) ;  // 100 is the maximum allowed value for nu_0
  NumericVector lpnu0(100);
  double prec = 0.0 ;
  double lprec = 0.0 ;
  for(int k = 0; k < K; k++) prec += 1.0/sigma2star[k] ;
  for(int k = 0; k < K; k++) lprec += log(1.0/sigma2star[k]) ;
  d = seq_len(100) ;
  NumericVector y1(100) ;
  NumericVector y2(100) ;
  NumericVector y3(100) ;
  for(int s = 0; s < S; ++s) {
    y1 = K*(0.5*d*log(s20chain[s]*0.5*d) - lgamma(d*0.5)) ;
    y2 = (0.5*d - 1.0) * lprec ;
    y3 = d*(betas + 0.5*s20chain[s]*prec) ;
    lpnu0 =  y1 + y2 - y3 ;
    NumericVector prob(100) ;
    prob = exp(lpnu0) ; // - maxprob) ;
    prob = prob/sum(prob) ;  // this is now normalized
    p_nu0[s] = prob[nu0star] ;
  }
  return p_nu0 ;
}
예제 #20
0
// [[Rcpp::export]]
Rcpp::NumericVector p_theta_batch(Rcpp::S4 xmod) {
  RNGScope scope ;
  Rcpp::S4 model_(xmod) ;
  Rcpp::S4 model = clone(model_) ;
  Rcpp::S4 params=model.slot("mcmc.params") ;
  Rcpp::S4 chains(model.slot("mcmc.chains")) ;  
  int S = params.slot("iter") ;
  // Assume current values are the modes (in R, useModes(object) ensures this)
  // List modes = model.slot("modes") ;
  // NumericVector thetastar = as<NumericVector>(modes["theta"]) ;
  List modes = model.slot("modes") ;
  NumericMatrix theta_ = as<NumericMatrix>(modes["theta"]) ;
  NumericMatrix thetastar=clone(theta_) ;
  int K = thetastar.ncol() ;
  int B = thetastar.nrow() ;
  NumericVector p_theta(S) ;
  NumericMatrix muc = chains.slot("mu") ;
  NumericMatrix tau2c = chains.slot("tau2") ;
  NumericVector theta(1) ;
  NumericVector tmp(1) ;
  NumericVector d(1) ;
  double tau ;
  double mu ;  
  for(int s = 0; s < S; ++s){
    d = 1.0 ;
    for(int k = 0; k < K; ++k){
      tau = sqrt(tau2c(s, k)) ;
      mu = muc(s, k) ;
      for(int b = 0; b < B; ++b){
        theta[0] = thetastar(b, k) ;
        tmp = dnorm(theta, mu, tau) ;      
        d = d * tmp[0] ;
      }
    }
    p_theta[s] = d[0] ;
  }
  return p_theta ;
}
예제 #21
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
}
예제 #22
0
//[[Rcpp::export]]
SEXP cpp_lu(
	Rcpp::S4 xR,
	Rcpp::S4 dR) {

	const std::string theClass =  Rcpp::as<std::string>(xR.attr("class"));
	double logDet;

	if(theClass == "fvclMatrix") {
		logDet = cpp_luT<float>(xR, dR);
	} else if(theClass == "dvclMatrix") {
		logDet = cpp_luT<double>(xR, dR);
	} else {
		Rcpp::exception("unknown type detected for x");
		logDet = -99.9;
	}
	return(Rcpp::wrap(logDet));
}
// [[Rcpp::export]]
Rcpp::NumericVector p_tau_reduced(Rcpp::S4 xmod) {
  RNGScope scope ;
  Rcpp::S4 model(xmod) ;
  Rcpp::S4 mcmcp = model.slot("mcmc.params") ;
  Rcpp::S4 chains = model.slot("mcmc.chains") ;
  Rcpp::S4 hypp = model.slot("hyperparams") ;
  List modes = model.slot("modes") ;
  //
  //
  NumericVector x = model.slot("data") ;    
  int K = hypp.slot("k") ;
  int S = mcmcp.slot("iter") ;  
  int N = x.size() ;
  //
  NumericVector p_=as<NumericVector>(modes["mixprob"]) ;
  NumericVector theta_=as<NumericVector>(modes["theta"]) ;
  NumericVector mu_=as<NumericVector>(modes["mu"]) ;
  NumericVector tau2_=as<NumericVector>(modes["tau2"]) ;
  NumericVector pstar = clone(p_) ;
  NumericVector mustar = clone(mu_) ;
  NumericVector tau2star = clone(tau2_) ;
  NumericVector thetastar = clone(theta_) ;
  IntegerMatrix Z = chains.slot("z") ;
  IntegerVector zz(N) ;
  NumericVector p_tau(S) ;

  double m2_0 = hypp.slot("m2.0") ;
  double eta_0 = hypp.slot("eta.0") ;
  double eta_k = eta_0 + K ;
  NumericVector s2_k(1) ;
  for(int k = 0; k < K; k++) s2_k[0] += pow(thetastar[k] - mustar[0], 2.0) ;
  NumericVector m2_k(1) ;
  m2_k[0] = 1/eta_k * (eta_0 * m2_0 + s2_k[0]) ;
  //  NumericVector tmp(1) ;
  //  for(int s = 0; s < S; ++s) {
  //    tmp = dgamma(1.0/tau2star, 0.5 * eta_k, 1.0/(0.5 * eta_k * m2_k[0])) ;
  //    p_tau[s] = tmp ;
  //  }
  p_tau = dgamma(1.0/tau2star, 0.5 * eta_k, 1.0/(0.5 * eta_k * m2_k[0])) ;
  return p_tau ;
}
// [[Rcpp::export]]
Rcpp::NumericVector p_pmix_reduced(Rcpp::S4 xmod) {
  RNGScope scope ;
  Rcpp::S4 model(xmod) ;
  Rcpp::S4 mcmcp = model.slot("mcmc.params") ;
  Rcpp::S4 chains = model.slot("mcmc.chains") ;
  Rcpp::S4 hypp = model.slot("hyperparams") ;
  List modes = model.slot("modes") ;
  //
  //
  NumericVector x = model.slot("data") ;    
  int K = hypp.slot("k") ;
  int S = mcmcp.slot("iter") ;  
  int N = x.size() ;
  //
  NumericVector p_=as<NumericVector>(modes["mixprob"]) ;
  NumericVector pstar = clone(p_) ;
  NumericMatrix Z = chains.slot("z") ;
  NumericVector alpha = hypp.slot("alpha") ;
  NumericVector pmix(S) ;
  //
  // Run reduced Gibbs  -- theta,sigma2 fixed at modal ordinates
  //
  NumericVector h(N) ;
  NumericVector alpha_n(K) ;
  NumericVector tmp(1) ;
  for(int s=0; s < S; ++s){
    h = Z(s, _ ) ;    
    for(int k = 0 ; k < K; ++k){
      alpha_n[k] = sum(h == k+1) + alpha[k] ;
    }
    tmp = log_ddirichlet_(pstar, alpha_n) ;
    pmix[s] = exp(tmp[0]) ;
  }
  // return tmp ;
  return pmix ;
}
예제 #25
0
파일: predModules.cpp 프로젝트: rforge/lme4
    predModule::predModule(Rcpp::S4& xp)
	: d_coef(Rcpp::clone(SEXP(xp.slot("coef")))),
	  d_Vtr(                      d_coef.size()) {
    }
예제 #26
0
파일: predModules.cpp 프로젝트: rforge/lme4
    sPredModule::sPredModule(Rcpp::S4 xp, int n)
	: predModule(                  xp),
	  d_X(     Rcpp::S4(xp.slot("X"))),
	  d_fac(  Rcpp::S4(xp.slot("fac"))) {
	d_V = (CHM_SP)NULL;
    }
예제 #27
0
파일: predModules.cpp 프로젝트: rforge/lme4
    dPredModule::dPredModule(Rcpp::S4 xp, int n)
	: predModule(                  xp),
	  d_X(     Rcpp::S4(xp.slot("X"))),
	  d_V(            n,   d_X.ncol()),
	  d_fac( Rcpp::S4(xp.slot("fac"))) {
    }
예제 #28
0
//' rcpp_get_polygons
//'
//' Extracts all polygons from an overpass API query
//'
//' @param st Text contents of an overpass API query
//' @return A \code{SpatialLinesDataFrame} contains all polygons and associated data
// [[Rcpp::export]]
Rcpp::S4 rcpp_get_polygons (const std::string& st)
{
#ifdef DUMP_INPUT
    {
        std::ofstream dump ("./get-polygons.xml");
        if (dump.is_open())
        {
            dump.write (st.c_str(), st.size());
        }
    }
#endif

    XmlPolys xml (st);

    const std::map <osmid_t, Node>& nodes = xml.nodes ();
    const std::map <osmid_t, OneWay>& ways = xml.ways ();
    const std::vector <Relation>& rels = xml.relations ();

    int count = 0;
    float xmin = FLOAT_MAX, xmax = -FLOAT_MAX,
          ymin = FLOAT_MAX, ymax = -FLOAT_MAX;
    std::vector <float> lons, lats;
    std::unordered_set <std::string> idset; // see TODO below
    std::vector <std::string> colnames, rownames, polynames;
    std::set <std::string> varnames;
    Rcpp::List dimnames (0), dummy_list (0);
    Rcpp::NumericMatrix nmat (Rcpp::Dimension (0, 0));

    idset.clear ();

    colnames.push_back ("lon");
    colnames.push_back ("lat");
    varnames.insert ("name");
    // other varnames added below

    /*
     * NOTE: Nodes are first loaded into the 2 vectors of (lon, lat), and these
     * are then copied into nmat. This intermediate can be avoided by loading
     * directly into nmat using direct indexing rather than iterators, however
     * this does *NOT* make the routine any faster, and so the current version
     * which more safely uses iterators is kept instead.
     */

    Rcpp::Environment sp_env = Rcpp::Environment::namespace_env ("sp");
    Rcpp::Function Polygon = sp_env ["Polygon"];
    Rcpp::Language polygons_call ("new", "Polygons");
    Rcpp::S4 polygons;

    /*
     * Polygons are extracted from the XmlPolys class in three setps:
     *  1. Get the names of all polygons that are part of multipolygon relations
     *  2. Get the names of any remaining ways that are polygonal (start == end)
     *  3. From the resultant list, extract the actual polygonal ways
     *
     * NOTE: OSM polygons are stored as ways, and thus all objects in the class
     * xmlPolys are rightly referred to as ways. Here within this Rcpp function,
     * these are referred to as Polygons, but the iteration is over the actual
     * polygonal ways.
     */

    // Step#1
    std::set <osmid_t> the_ways; // Set will only insert unique values
    for (auto it = rels.begin (); it != rels.end (); ++it)
        for (auto itw = (*it).ways.begin (); itw != (*it).ways.end (); ++itw)
        {
            assert (ways.find (itw->first) != ways.end ());
            the_ways.insert (itw->first);
        }

    // Step#2
    //const std::map <osmid_t, OneWay>& ways = xml.ways ();
    for (auto it = ways.begin (); it != ways.end (); ++it)
    {
        if (the_ways.find ((*it).first) == the_ways.end ())
            if ((*it).second.nodes.begin () == (*it).second.nodes.end ())
                the_ways.insert ((*it).first);
    }
    // Step#2b - Erase any ways that contain no data (should not happen).
    for (auto it = the_ways.begin (); it != the_ways.end (); )
    {
        auto itw = ways.find (*it);
        if (itw->second.nodes.size () == 0)
            it = the_ways.erase (it);
        else
            ++it;
    }
    Rcpp::List polyList (the_ways.size ());

    // Step#3 - Extract and store the_ways
    for (auto it = the_ways.begin (); it != the_ways.end (); ++it)
    {
        auto itw = ways.find (*it);
        // Collect all unique keys
        std::for_each (itw->second.key_val.begin (),
                itw->second.key_val.end (),
                [&](const std::pair <std::string, std::string>& p)
                {
                    varnames.insert (p.first);
                });

        /*
         * The following lines check for duplicate way IDs -- which do very
         * occasionally occur -- and ensures unique values as required by 'sp'
         * through appending decimal digits to <osmid_t> OSM IDs.
         */
        std::string id = std::to_string (itw->first);
        int tempi = 0;
        while (idset.find (id) != idset.end ())
            id = std::to_string (itw->first) + "." + std::to_string (tempi++);
        idset.insert (id);
        polynames.push_back (id);

        // Then iterate over nodes of that way and store all lat-lons
        size_t n = itw->second.nodes.size ();
        lons.clear ();
        lats.clear ();
        rownames.clear ();
        lons.reserve (n);
        lats.reserve (n);
        rownames.reserve (n);
        for (auto itn = itw->second.nodes.begin ();
                itn != itw->second.nodes.end (); ++itn)
        {
            // TODO: Propoer exception handler
            assert (nodes.find (*itn) != nodes.end ());
            lons.push_back (nodes.find (*itn)->second.lon);
            lats.push_back (nodes.find (*itn)->second.lat);
            rownames.push_back (std::to_string (*itn));
        }

        xmin = std::min (xmin, *std::min_element (lons.begin(), lons.end()));
        xmax = std::max (xmax, *std::max_element (lons.begin(), lons.end()));
        ymin = std::min (ymin, *std::min_element (lats.begin(), lats.end()));
        ymax = std::max (ymax, *std::max_element (lats.begin(), lats.end()));

        nmat = Rcpp::NumericMatrix (Rcpp::Dimension (lons.size (), 2));
        std::copy (lons.begin (), lons.end (), nmat.begin ());
        std::copy (lats.begin (), lats.end (), nmat.begin () + lons.size ());

        // This only works with push_back, not with direct re-allocation
        dimnames.push_back (rownames);
        dimnames.push_back (colnames);
        nmat.attr ("dimnames") = dimnames;
        dimnames.erase (0, dimnames.size());

        //Rcpp::S4 poly = Rcpp::Language ("Polygon", nmat).eval ();
        Rcpp::S4 poly = Polygon (nmat);
        dummy_list.push_back (poly);
        polygons = polygons_call.eval ();
        polygons.slot ("Polygons") = dummy_list;
        polygons.slot ("ID") = id;
        polyList [count++] = polygons;

        dummy_list.erase (0);
    } // end for it over the_ways
    polyList.attr ("names") = polynames;

    // Store all key-val pairs in one massive DF
    int nrow = the_ways.size (), ncol = varnames.size ();
    Rcpp::CharacterVector kv_vec (nrow * ncol, Rcpp::CharacterVector::get_na ());
    int namecoli = std::distance (varnames.begin (), varnames.find ("name"));
    for (auto it = the_ways.begin (); it != the_ways.end (); ++it)
    {
        int rowi = std::distance (the_ways.begin (), it);
        auto itw = ways.find (*it);
        kv_vec (namecoli * nrow + rowi) = itw->second.name;
        for (auto kv_iter = itw->second.key_val.begin ();
                kv_iter != itw->second.key_val.end (); ++kv_iter)
        {
            const std::string& key = (*kv_iter).first;
            auto ni = varnames.find (key); // key must exist in varnames!
            int coli = std::distance (varnames.begin (), ni);
            kv_vec (coli * nrow + rowi) = (*kv_iter).second;
        }
    }

    Rcpp::Language sp_polys_call ("new", "SpatialPolygonsDataFrame");
    Rcpp::S4 sp_polys = sp_polys_call.eval ();
    sp_polys.slot ("polygons") = polyList;

    sp_polys.slot ("bbox") = rcpp_get_bbox (xmin, xmax, ymin, ymax);

    Rcpp::Language crs_call ("new", "CRS");
    Rcpp::S4 crs = crs_call.eval ();
    crs.slot ("projargs") = "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs +towgs84=0,0,0";
    sp_polys.slot ("proj4string") = crs;

    Rcpp::CharacterMatrix kv_mat (nrow, ncol, kv_vec.begin());
    Rcpp::DataFrame kv_df = kv_mat;
    kv_df.attr ("names") = varnames;
    sp_polys.slot ("data") = kv_df;

    return sp_polys;
}
예제 #29
0
/* This function specifically checks whether the observed data is consistent with the *pedigree*. It assumes that every observed value in the finals is already valid - That is, every observed value contained in the finals is also listed as a possibility in the hetData object
*/
void estimateRFCheckFunnels(Rcpp::IntegerMatrix finals, Rcpp::IntegerMatrix founders, Rcpp::List hetData, Rcpp::S4 pedigree, std::vector<int>& intercrossingGenerations, std::vector<std::string>& warnings, std::vector<std::string>& errors, std::vector<funnelType>& allFunnels, std::vector<funnelType>& lineFunnels)
{
	Rcpp::CharacterVector pedigreeLineNames = Rcpp::as<Rcpp::CharacterVector>(pedigree.slot("lineNames"));

	//We make a copy of the pedigree line names and sort it (otherwise the std::find relating to pedigreeLineNames is prohibitive)
	std::vector<pedigreeLineStruct> sortedLineNames;
	sortPedigreeLineNames(pedigreeLineNames, sortedLineNames);

	Rcpp::IntegerVector mother = Rcpp::as<Rcpp::IntegerVector>(pedigree.slot("mother"));
	Rcpp::IntegerVector father = Rcpp::as<Rcpp::IntegerVector>(pedigree.slot("father"));
	bool warnImproperFunnels = Rcpp::as<bool>(pedigree.slot("warnImproperFunnels"));

	Rcpp::CharacterVector finalNames = Rcpp::as<Rcpp::CharacterVector>(Rcpp::as<Rcpp::List>(finals.attr("dimnames"))[0]);
	Rcpp::CharacterVector markerNames = Rcpp::as<Rcpp::CharacterVector>(Rcpp::as<Rcpp::List>(finals.attr("dimnames"))[1]);
	int nFinals = finals.nrow(), nFounders = founders.nrow(), nMarkers = finals.ncol();

	if(nFounders != 2 && nFounders != 4 && nFounders != 8 && nFounders != 16)
	{
		throw std::runtime_error("Number of founders must be 2, 4, 8, or 16");
	}

	xMajorMatrix<int> foundersToMarkerAlleles(nFounders, nFounders, nMarkers, -1);
	for(int markerCounter = 0; markerCounter < nMarkers; markerCounter++)
	{
		Rcpp::IntegerMatrix currentMarkerHetData = hetData(markerCounter);
		for(int founderCounter1 = 0; founderCounter1 < nFounders; founderCounter1++)
		{
			for(int founderCounter2 = 0; founderCounter2 < nFounders; founderCounter2++)
			{
				int markerAllele1 = founders(founderCounter1, markerCounter);
				int markerAllele2 = founders(founderCounter2, markerCounter);
				for(int hetDataRowCounter = 0; hetDataRowCounter < currentMarkerHetData.nrow(); hetDataRowCounter++)
				{
					if(markerAllele1 == currentMarkerHetData(hetDataRowCounter, 0) && markerAllele2 == currentMarkerHetData(hetDataRowCounter, 1))
					{
						foundersToMarkerAlleles(founderCounter1, founderCounter2, markerCounter) = currentMarkerHetData(hetDataRowCounter, 2);
					}
				}
			}
		}
	}
	std::vector<long> individualsToCheckFunnels;
	for(long finalCounter = 0; finalCounter < nFinals; finalCounter++)
	{
		individualsToCheckFunnels.clear();
		std::string currentLineName = Rcpp::as<std::string>(finalNames(finalCounter));

		std::vector<pedigreeLineStruct>::iterator findLineName = std::lower_bound(sortedLineNames.begin(), sortedLineNames.end(), pedigreeLineStruct(currentLineName, -1));
		if(findLineName == sortedLineNames.end() || findLineName->lineName != currentLineName)
		{
			std::stringstream ss;
			ss << "Unable to find line number " << finalCounter << " named " << finalNames(finalCounter) << " in pedigree";
			throw std::runtime_error(ss.str().c_str());
		}
		int pedigreeRow = findLineName->index;
		//This vector lists all the founders that are ancestors of the current line. This may comprise any number - E.g. if we have an AIC line descended from funnels 1,2,1,2 and 2,3,2,3 then this vector is going it contain 1,2,3
		std::vector<int> representedFounders;
		if(intercrossingGenerations[finalCounter] == 0)
		{
			individualsToCheckFunnels.push_back(pedigreeRow);
		}
		else
		{
			try
			{
				getAICParentLines(mother, father, pedigreeRow, intercrossingGenerations[finalCounter], individualsToCheckFunnels);
			}
			catch(...)
			{
				std::stringstream ss;
				ss << "Error while attempting to trace intercrossing lines for line " << finalNames(finalCounter);
				errors.push_back(ss.str());
				goto nextLine;
			}
		}
		//Now we know the lines for which we need to check the funnels from the pedigree (note: We don't necessarily have genotype data for all of these, it's purely a pedigree check)
		//Fixed length arrays to store funnels. If we have less than 16 founders then part of this is garbage and we don't use that bit....
		funnelType funnel, copiedFunnel;
		for(std::vector<long>::iterator i = individualsToCheckFunnels.begin(); i != individualsToCheckFunnels.end(); i++)
		{
			try
			{
				getFunnel(*i, mother, father, &(funnel.val[0]), nFounders);
			}
			catch(...)
			{
				std::stringstream ss;
				ss << "Attempting to trace pedigree for line " << finalNames(finalCounter) << ": Unable to get funnel for line " << pedigreeLineNames(*i);
				errors.push_back(ss.str());
				goto nextLine;
			}
			//insert these founders into the vector containing all the represented founders
			representedFounders.insert(representedFounders.end(), &(funnel.val[0]), &(funnel.val[0]) + nFounders);
			//Copy the funnel 
			memcpy(&copiedFunnel, &funnel, sizeof(funnelType));
			std::sort(&(copiedFunnel.val[0]), &(copiedFunnel.val[0]) + nFounders);
			if(std::unique(&(copiedFunnel.val[0]), &(copiedFunnel.val[0]) + nFounders) != &(copiedFunnel.val[0]) + nFounders)
			{
				//If we have intercrossing generations then having repeated founders is an error. Otherwise if warnImproperFunnels is true it's still a warning.
				if(intercrossingGenerations[finalCounter] != 0 || warnImproperFunnels)
				{
					std::stringstream ss;
					ss << "Funnel for line " << pedigreeLineNames(*i) << " contained founders {" << funnel.val[0];
					if(nFounders == 2)
					{
						ss << ", " << funnel.val[1] << "}";
					}
					else if(nFounders == 4)
					{
						ss << ", " << funnel.val[1] << ", " << funnel.val[2] << ", " << funnel.val[3] << "}";
					}
					else if(nFounders == 8)
					{
						ss << ", " << funnel.val[1] << ", " << funnel.val[2] << ", " << funnel.val[3] << ", " << funnel.val[4] << ", " << funnel.val[5] << ", " << funnel.val[6] << ", " << funnel.val[7]<< "}";
					}
					else if (nFounders == 16)
					{
						ss << ", " << funnel.val[1] << ", " << funnel.val[2] << ", " << funnel.val[3] << ", " << funnel.val[4] << ", " << funnel.val[5] << ", " << funnel.val[6] << ", " << funnel.val[7] << ", " << funnel.val[8] << ", " << funnel.val[9] << ", " << funnel.val[10] << ", " << funnel.val[11] << ", " << funnel.val[12] << ", " << funnel.val[13] << ", " << funnel.val[14] << ", " << funnel.val[15] << "}";
					}
					//In this case it's an error
					if(intercrossingGenerations[finalCounter] != 0)
					{
						ss << ". Repeated founders are only allowed with zero generations of intercrossing";
						errors.push_back(ss.str());
					}
					//But if we have zero intercrossing generations then it's only a warning
					else
					{
						ss << ". Did you intend to use all " << nFounders << " founders?";
						warnings.push_back(ss.str());
					}
				}
			}
			allFunnels.push_back(funnel);
		}
		//remove duplicates in representedFounders
		std::sort(representedFounders.begin(), representedFounders.end());
		representedFounders.erase(std::unique(representedFounders.begin(), representedFounders.end()), representedFounders.end());
		//Try and check for inconsistent generations of selfing
		for(std::vector<int>::iterator i = representedFounders.begin(); i != representedFounders.end(); i++)
		{
			if(*i > nFounders)
			{
				std::stringstream ss;
				ss << "Error in pedigree for line number " << finalCounter << " named " << finalNames(finalCounter) << ". Inconsistent number of generations of intercrossing";
				errors.push_back(ss.str());
				goto nextLine;
			}
		}
		//Not having all the founders in the input funnels is more serious if it causes the observed marker data to be impossible. So check for this.
		for(int markerCounter = 0; markerCounter < nMarkers; markerCounter++)
		{
			bool okMarker = false;
			//If observed value is an NA then than's ok, continue
			int value = finals(finalCounter, markerCounter);
			if(value == NA_INTEGER) continue;

			for(std::vector<int>::iterator founderIterator1 = representedFounders.begin(); founderIterator1 != representedFounders.end(); founderIterator1++)
			{
				for(std::vector<int>::iterator founderIterator2 = representedFounders.begin(); founderIterator2 != representedFounders.end(); founderIterator2++)
				{
					//Note that founderIterator comes from representedFounders, which comes from getFunnel - Which returns values starting at 1, not 0. So we have to subtract one. 
					if(finals(finalCounter, markerCounter) == foundersToMarkerAlleles((*founderIterator1)-1, (*founderIterator2)-1, markerCounter))
					{
						okMarker = true;
						break;
					}
				}
			}
			if(!okMarker)
			{
				std::stringstream ss;
				ss << "Data for marker " << markerNames(markerCounter) << " is impossible for individual " << finalNames(finalCounter) << " with given pedigree";
				errors.push_back(ss.str());
				if(errors.size() > 1000) return;
				goto nextLine;
			}
		}
		//In this case individualsToCheckFunnels contains one element => getFunnel was only called once => we can reuse the funnel variable
		if(intercrossingGenerations[finalCounter] == 0)
		{
			orderFunnel(&(funnel.val[0]), nFounders);
			lineFunnels.push_back(funnel);
		}
		else
		{
			//Add a dummy value in lineFunnel
			for(int i = 0; i < 16; i++) funnel.val[i] = 0;
			lineFunnels.push_back(funnel);
		}
	nextLine:
		;
	}
}
예제 #30
0
void parse_gb_location(
    Rcpp::S4 &location,
    std::string &span,
    std::string &accession )
{
    // clean up possible whitespace
    span.erase(remove_if(begin(span), end(span), ::isspace), end(span));

    // initialise a BaseSpan
    BaseSpan bs;
    
    // initialise match results
    std::smatch m;
    
    // iterator over span
    std::string::const_iterator first = span.begin();
    std::string::const_iterator last = span.end();
  
    // test for a possibly complemented simple location
    try {
      if (std::regex_match(first, last, m, PCSL)) {
        
          parse_simple_span(bs, span, accession);
          
          // fill gbLocation@range
          // guarantied integer Matrix/two columns 
          IntegerMatrix range(1,2);
          range(0,0) = bs.range[0];
          range(0,1) = bs.range[1];
          location.slot("range") = range;
          
          // fill gbLocation@fuzzy
          // guarantied logical Matrix/two columns 
          LogicalMatrix fuzzy(1,2);
          fuzzy(0,0) = bs.fuzzy[0];
          fuzzy(0,1) = bs.fuzzy[1];
          location.slot("fuzzy") = fuzzy;
          
          location.slot("strand") = bs.strand;
          location.slot("accession") = bs.accession;
          location.slot("remote") = bs.remote;
          location.slot("type") = bs.type;
          
      // test for a possibly complemented compound location
      } else if (std::regex_match(first, last, m, PCCL)) {
          // test for complementary strand
          int strand(1);
          if (std::regex_search(first, last, m, COMPL)) {
              strand = -1;
          }  
          
          // get compound span
          std::regex_search(first, last, m, CL);
          first = m[0].first;
          last = m[0].second;  
          
          // get compound type
          std::regex_search(first, last, m, CMPND);
          std::string compound( m[0] );
          
          // get span strings
          std::regex_search(first, last, m, SLC);
          std::string span_str( m[0] );
          
          std::vector<std::string > spans;
          std::sregex_token_iterator
            first_it{begin(span_str), end(span_str), COMMA, -1},
            last_it;
          std::copy(first_it, last_it, std::back_inserter(spans));
          
          int nrows = spans.size();
          Rcpp::IntegerMatrix   rangeMat( nrows, 2 );
          Rcpp::LogicalMatrix   fuzzyMat( nrows, 2 );
          Rcpp::IntegerVector   strandVec(nrows);
          Rcpp::CharacterVector accessionVec(nrows);
          Rcpp::LogicalVector   remoteVec(nrows);
          Rcpp::CharacterVector typeVec(nrows);
            
          for (int i = 0; i < nrows; ++i) {
              std::string span = spans[i];
              parse_simple_span(bs, span, accession);
              
              // get positions
              rangeMat(i, 0) = bs.range[0];
              rangeMat(i, 1) = bs.range[1];
              // get fuzzy
              fuzzyMat(i, 0) = bs.fuzzy[0];
              fuzzyMat(i, 1) = bs.fuzzy[1];
              // get strand, accession, remote and type
              strandVec[i] = bs.strand;
              accessionVec[i] = bs.accession;
              remoteVec[i] = bs.remote;
              typeVec[i] = bs.type;
          }
          
          // if the whole span is complementary reset strandVec
          if (strand == -1) {
              for (int i = 0; i < nrows; ++i)
                  strandVec[i] = -1;
          }
          
          location.slot("range") = rangeMat;
          location.slot("fuzzy") = fuzzyMat;
          location.slot("strand") = strandVec;
          location.slot("compound") = compound;
          location.slot("accession") = accessionVec;
          location.slot("remote") = remoteVec;
          location.slot("type") = typeVec;
      } else {
        throw std::range_error("Cannot parse location descriptor.");
      }
    } catch (std::exception &ex) {
      forward_exception_to_r(ex);
    }
}