void NormalVarianceMixtureBaseError::initFromList(Rcpp::List const &init_list) { if(init_list.containsElementNamed("sigma")) sigma = Rcpp::as < double >( init_list["sigma"]); else sigma = 1.; npars += 1; if(init_list.containsElementNamed("common_V")) common_V = Rcpp::as < int >( init_list["common_V"]); else common_V = 0; int i = 0; if( init_list.containsElementNamed("Vs" )){ Rcpp::List Vs_list = init_list["Vs"]; Vs.resize(Vs_list.length()); for( Rcpp::List::iterator it = Vs_list.begin(); it != Vs_list.end(); ++it ) { Vs[i++] = Rcpp::as < Eigen::VectorXd >( it[0]); } }else throw("in NormalVarianceMixtureBaseError::initFromList Vs must be set! \n"); }
void IGMeasurementError::initFromList(Rcpp::List const &init_list) { NormalVarianceMixtureBaseError::initFromList(init_list); if(init_list.containsElementNamed("nu")) nu = Rcpp::as < double >( init_list["nu"]); else nu = 1.; EV = 1.; // not true it is the mode is alpha/(alpha - 1) EiV = 1.; npars += 1; digamma_nu = Digamma(nu); trigamma_nu = Trigamma(nu); int i = 0; if( init_list.containsElementNamed("Vs" )){ Rcpp::List Vs_list = init_list["Vs"]; Vs.resize(Vs_list.length()); for( Rcpp::List::iterator it = Vs_list.begin(); it != Vs_list.end(); ++it ) { Vs[i++] = Rcpp::as < Eigen::VectorXd >( it[0]); } }else throw("in IGMeasurementError::initFromList Vs must be set! \n"); }
void RSim::setTimeSeries(SEXP v, const string &obj_name) { Ptr<SerializableBase> ts; if(Rf_isMatrix(v)) { Rcpp::List tsl; tsl["values"] = v; tsl.attr("class") = "TimeSeries"; ts = RProto::convertFromR<SerializableBase>(tsl); } else { try { ts = RProto::convertFromR<SerializableBase>(v); } catch(...) { ERR("Expecting matrix with values or TimeSeries list object\n"); } } auto slice = Factory::inst().getObjectsSlice(obj_name); for(auto it=slice.first; it != slice.second; ++it) { Factory::inst().getObject(it)->setAsInput( ts ); } net->spikesList().info = ts.as<TimeSeries>()->info; for(auto &n: neurons) { n.ref().initInternal(); } }
void ScoreGaussL0PenScatter::setData(Rcpp::List& data) { std::vector<int>::iterator vi; //uint i; // Cast preprocessed data from R list dout.level(2) << "Casting preprocessed data...\n"; _dataCount = Rcpp::as<std::vector<int> >(data["data.count"]); dout.level(3) << "# samples per vertex: " << _dataCount << "\n"; _totalDataCount = Rcpp::as<uint>(data["total.data.count"]); dout.level(3) << "Total # samples: " << _totalDataCount << "\n"; Rcpp::List scatter = data["scatter"]; Rcpp::NumericMatrix scatterMat; _disjointScatterMatrices.resize(scatter.size()); dout.level(3) << "# disjoint scatter matrices: " << scatter.size() << "\n"; for (R_len_t i = 0; i < scatter.size(); ++i) { scatterMat = Rcpp::NumericMatrix((SEXP)(scatter[i])); _disjointScatterMatrices[i] = arma::mat(scatterMat.begin(), scatterMat.nrow(), scatterMat.ncol(), false); } // Cast index of scatter matrices, adjust R indexing convention to C++ std::vector<int> scatterIndex = Rcpp::as<std::vector<int> >(data["scatter.index"]); for (std::size_t i = 0; i < scatterIndex.size(); ++i) _scatterMatrices[i] = &(_disjointScatterMatrices[scatterIndex[i] - 1]); // Cast lambda: penalty constant _lambda = Rcpp::as<double>(data["lambda"]); dout.level(3) << "Penalty parameter lambda: " << _lambda << "\n"; // Check whether an intercept should be calculated _allowIntercept = Rcpp::as<bool>(data["intercept"]); dout.level(3) << "Include intercept: " << _allowIntercept << "\n"; }
SEXP stack_trace__impl( const char *file, int line) { const size_t max_depth = 100; size_t stack_depth; void *stack_addrs[max_depth]; char **stack_strings; stack_depth = backtrace(stack_addrs, max_depth); stack_strings = backtrace_symbols(stack_addrs, stack_depth); std::string current_line ; Rcpp::CharacterVector res( stack_depth - 1) ; std::transform( stack_strings + 1, stack_strings + stack_depth, res.begin(), demangler_one ) ; free(stack_strings); // malloc()ed by backtrace_symbols Rcpp::List trace = Rcpp::List::create( Rcpp::Named( "file" ) = file, Rcpp::Named( "line" ) = line, Rcpp::Named( "stack" ) = res ) ; trace.attr("class") = "Rcpp_stack_trace" ; return trace ; }
Rcpp::List MetaData::save () const /* * Save meta data into R list. * * Format: * [[0]] ---- Number of variables * [[1]] ---- Index of target variable * [[2]] ---- Target variable name * [[3]] ---- Variable name vector * [[4]] ---- Variable type vector * [[5]] ---- Discrete variable value list */ { Rcpp::List meta_data; meta_data[NVARS] = Rcpp::wrap(nvars_); meta_data[VAR_NAMES] = Rcpp::wrap(var_names_); meta_data[VAR_TYPES] = Rcpp::wrap(var_types_); Rcpp::List valuenames; for (val_name_map::const_iterator iter = val_names_.begin(); iter != val_names_.end(); ++iter) { Rcpp::List vn; vn.push_back(iter->first); vn.push_back(iter->second); valuenames.push_back(vn); } meta_data[VAL_NAMES] = Rcpp::wrap(valuenames); return meta_data; }
// [[Rcpp::export]] Rcpp::List mlist2clist(Rcpp::List mlist, int nthreads=1){ if (mlist.length()==0) Rcpp::stop("empty list is invalid"); int ncounts, nmarks, nbins = -1; std::vector<std::string> foo; listcubedim(mlist, &nbins, &ncounts, &nmarks, foo); Rcpp::List newdnames(2); newdnames[0] = mlist.attr("names"); //allocate storage Rcpp::List clist(ncounts); for (int c = 0; c < ncounts; ++c){ Rcpp::IntegerMatrix mat(nmarks, nbins); if (!Rf_isNull(newdnames[0])) mat.attr("dimnames") = newdnames; clist[c] = mat; } //copy data #pragma omp parallel for num_threads(nthreads) collapse(2) for (int c = 0; c < ncounts; ++c){ for (int mark = 0; mark < nmarks; ++mark){ Vec<int> col = Mat<int>((SEXP)mlist[mark]).getCol(c); MatRow<int> row = Mat<int>((SEXP)clist[c]).getRow(mark); for (int bin = 0; bin < nbins; ++bin){ row[bin] = col[bin]; } } } return clist; }
std::vector<OGRGeometry *> ogr_from_sfc(Rcpp::List sfc, OGRSpatialReference **sref) { Rcpp::List wkblst = CPL_write_wkb(sfc, false); std::vector<OGRGeometry *> g(sfc.length()); OGRSpatialReference *local_srs = NULL; Rcpp::List crs = sfc.attr("crs"); Rcpp::IntegerVector epsg(1); epsg[0] = crs["epsg"]; Rcpp::String p4s = crs["proj4string"]; if (p4s != NA_STRING) { Rcpp::CharacterVector cv = crs["proj4string"]; local_srs = new OGRSpatialReference; OGRErr err = local_srs->importFromProj4(cv[0]); if (err != 0) { local_srs->Release(); // #nocov handle_error(err); // #nocov } } for (int i = 0; i < wkblst.length(); i++) { Rcpp::RawVector r = wkblst[i]; OGRErr err = OGRGeometryFactory::createFromWkb(&(r[0]), local_srs, &(g[i]), r.length(), wkbVariantIso); if (err != 0) { if (local_srs != NULL) // #nocov local_srs->Release(); // #nocov handle_error(err); // #nocov } } if (sref != NULL) *sref = local_srs; // return and release later, or else if (local_srs != NULL) local_srs->Release(); // release now return g; }
void RSim::setInputSpikes(const Rcpp::List &l, const string &obj_name) { Ptr<SerializableBase> sp_l; if(l.containsElementNamed("values")) { sp_l = RProto::convertFromR<SerializableBase>(l); } else { try { Rcpp::List sl; sl["values"] = l; sl.attr("class") = "SpikesList"; sp_l = RProto::convertFromR<SerializableBase>(sl); } catch (...) { ERR("Expecting list with spike times of neurons or SpikesList list object\n"); } } auto slice = Factory::inst().getObjectsSlice(obj_name); for(auto it=slice.first; it != slice.second; ++it) { Factory::inst().getObject(it)->setAsInput( sp_l ); } net->spikesList().info = sp_l.as<SpikesList>()->info; for(auto &n: neurons) { n.ref().initInternal(); } }
SEXP getKernelWorkGroupInfo(SEXP sKernel, SEXP sDeviceID){ resetError("ROpenCL::getKernelWorkGroupInfo"); Rcpp::XPtr<cl_kernel> kernel(sKernel); Rcpp::XPtr<cl_device_id> deviceID(sDeviceID); size_t sval; size_t sizes[3]; cl_ulong ulval; Rcpp::List result; #ifdef CL_KERNEL_WORK_GROUP_SIZE /* size_t */ sval = 0; if (!logError( clGetKernelWorkGroupInfo(*kernel, *deviceID, CL_KERNEL_WORK_GROUP_SIZE, sizeof(sval), &sval, NULL) )) { result["CL_KERNEL_WORK_GROUP_SIZE"] = Rcpp::wrap(sval); } #endif #ifdef CL_KERNEL_COMPILE_WORK_GROUP_SIZE /* 3x size_t */ sizes[0] = sizes[1] = sizes[2] = 0; if (!logError( clGetKernelWorkGroupInfo(*kernel, *deviceID, CL_KERNEL_COMPILE_WORK_GROUP_SIZE, 3*sizeof(size_t), &sizes, NULL) )) { Rcpp::List wgs; wgs.push_back(Rcpp::wrap(sizes[0])); wgs.push_back(Rcpp::wrap(sizes[1])); wgs.push_back(Rcpp::wrap(sizes[2])); result["CL_KERNEL_COMPILE_WORK_GROUP_SIZE"] = Rcpp::wrap(wgs); } #endif #ifdef CL_KERNEL_LOCAL_MEM_SIZE /* ulong */ ulval = 0; if (!logError( clGetKernelWorkGroupInfo(*kernel, *deviceID, CL_KERNEL_LOCAL_MEM_SIZE, sizeof(ulval), &ulval, NULL) )) { result["CL_KERNEL_LOCAL_MEM_SIZE"] = Rcpp::wrap(ulval); } #endif #ifdef CL_KERNEL_PREFERRED_WORK_GROUP_SIZE_MULTIPLE /* size_t */ sval = 0; if (!logError( clGetKernelWorkGroupInfo(*kernel, *deviceID, CL_KERNEL_PREFERRED_WORK_GROUP_SIZE_MULTIPLE, sizeof(sval), &sval, NULL) )) { result["CL_KERNEL_PREFERRED_WORK_GROUP_SIZE_MULTIPLE"] = Rcpp::wrap(sval); } #endif #ifdef CL_KERNEL_PRIVATE_MEM_SIZE /* ulong */ ulval = 0; if (!logError( clGetKernelWorkGroupInfo(*kernel, *deviceID, CL_KERNEL_PRIVATE_MEM_SIZE, sizeof(ulval), &ulval, NULL) )) { result["CL_KERNEL_PRIVATE_MEM_SIZE"] = Rcpp::wrap(ulval); } #endif //#ifdef CL_KERNEL_GLOBAL_WORK_SIZE /* 3x size_t */ TODO FIX THIS /* sizes[0] = sizes[1] = sizes[2] = 0; if (!logError( clGetKernelWorkGroupInfo(*kernel, *deviceID, CL_KERNEL_GLOBAL_WORK_SIZE, 3*sizeof(size_t), &sizes, NULL) )) { Rcpp::List gws; gws.push_back(Rcpp::wrap(sizes[0])); gws.push_back(Rcpp::wrap(sizes[1])); gws.push_back(Rcpp::wrap(sizes[2])); result["CL_KERNEL_GLOBAL_WORK_SIZE"] = Rcpp::wrap(gws); } */ //#endif PRINTONERROR(); return result; }
Rcpp::List jaspResults::getKeepList() { Rcpp::List keep = getPlotPathsForKeep(); keep.push_front(std::string(_saveResultsHere)); keep.push_front(_relativePathKeep); return keep; }
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 }
// Simpler version for Windows and *BSD SEXP stack_trace__impl( const char* file, int line ){ Rcpp::List trace = Rcpp::List::create( Rcpp::Named( "file" ) = file, Rcpp::Named( "line" ) = line, Rcpp::Named( "stack" ) = "C++ stack not available on this system" ) ; trace.attr("class") = "Rcpp_stack_trace" ; return trace ; }
std::vector<GEOSGeom> geometries_from_sfc(GEOSContextHandle_t hGEOSCtxt, Rcpp::List sfc) { double precision = sfc.attr("precision"); Rcpp::List wkblst = CPL_write_wkb(sfc, false, native_endian(), "XY", precision); std::vector<GEOSGeom> g(sfc.size()); for (int i = 0; i < sfc.size(); i++) { Rcpp::RawVector r = wkblst[i]; g[i] = GEOSGeomFromWKB_buf_r(hGEOSCtxt, &(r[0]), r.size()); } return g; }
static Rcpp::List getDeviceFPConfigAsList(cl_device_fp_config flags) { Rcpp::List list; #ifdef CL_FP_DENORM if (flags & CL_FP_DENORM) list.push_back(Rcpp::wrap("CL_FP_DENORM")); #endif #ifdef CL_FP_INF_NAN if (flags & CL_FP_INF_NAN) list.push_back(Rcpp::wrap("CL_FP_INF_NAN")); #endif #ifdef CL_FP_ROUND_TO_NEAREST if (flags & CL_FP_ROUND_TO_NEAREST) list.push_back(Rcpp::wrap("CL_FP_ROUND_TO_NEAREST")); #endif #ifdef CL_FP_ROUND_TO_ZERO if (flags & CL_FP_ROUND_TO_ZERO) list.push_back(Rcpp::wrap("CL_FP_ROUND_TO_ZERO")); #endif #ifdef CL_FP_ROUND_TO_INF if (flags & CL_FP_ROUND_TO_INF) list.push_back(Rcpp::wrap("CL_FP_ROUND_TO_INF")); #endif #ifdef CL_FP_FMA if (flags & CL_FP_FMA) list.push_back(Rcpp::wrap("CL_FP_FMA")); #endif #ifdef CL_FP_SOFT_FLOAT if (flags & CL_FP_SOFT_FLOAT) list.push_back(Rcpp::wrap("CL_FP_SOFT_FLOAT")); #endif #ifdef CL_FP_CORRECTLY_ROUNDED_DIVIDE_SQRT if (flags & CL_FP_CORRECTLY_ROUNDED_DIVIDE_SQRT) list.push_back(Rcpp::wrap("CL_FP_CORRECTLY_ROUNDED_DIVIDE_SQRT")); #endif return list; }
//' rcpp_neutral_hotspots //' //' Implements neutral model in two dimensions //' //' @param nbs An \code{spdep} \code{nb} object listing all neighbours of each //' point. //' @param wts Weighting factors for each neighbour; must have same length as //' nbs. //' @param nbsi List of matrices as returned from \code{get_nbsi}. each element //' of which contains the i-th nearest neighbour to each point. //' @param alpha Strength of spatial autocorrelation //' @param sd0 Standard deviation of truncated normal distribution used to model //' environmental variation (with mean of 1) //' @param log_scale If TRUE, raw hotspot values are log-transformed //' @param niters Number of iterations of spatial autocorrelation //' @param ac_type Character string specifying type of aucorrelation //' (\code{moran}, \code{geary}, or code{getis-ord}). //' //' @return A vector of simulated values of same size as \code{nbs}. //' // [[Rcpp::export]] Rcpp::NumericMatrix rcpp_neutral_hotspots (Rcpp::List nbs, Rcpp::List wts, Rcpp::List nbsi, double alpha, double sd0, bool log_scale, int niters, std::string ac_type) { const int size = nbs.size (); int indx; double wtsum, tempd; Rcpp::NumericMatrix tempmat; Rcpp::NumericVector z1 = rcpp_trunc_ndist (size, sd0); Rcpp::NumericVector z2 (size), nbs_to, nbs_from, nbs_n, ac; // Spatial autocorrelation for (int i=0; i<niters; i++) { std::fill (z2.begin (), z2.end (), 0.0); for (int j=0; j<nbsi.size (); j++) { tempmat = Rcpp::as <Rcpp::NumericMatrix> (nbsi (j)); nbs_to = tempmat (Rcpp::_, 0); nbs_from = tempmat (Rcpp::_, 1); nbs_n = tempmat (Rcpp::_, 2); // Note that nbs are 1-indexed for (int k=0; k<nbs_to.size (); k++) { z2 (nbs_to (k) - 1) += ((1.0 - alpha) * z1 (nbs_to (k) - 1) + alpha * z1 (nbs_from (k) - 1)) / (double) nbs_n (k); } } // end for j over nbsi std::copy (z2.begin (), z2.end (), z1.begin ()); } // end for i over niters if (log_scale) { // negative values sometimes arise for alpha < 0, but scale is // arbitrary, so re-scaled here to ensure all values are > 0 z1 = 1.0 + z1 - (double) Rcpp::min (z1); z1 = log10 (z1); } ac = rcpp_ac_stats (z1, nbs, wts, ac_type); std::sort (z1.begin (), z1.end (), std::greater<double> ()); z1 = (z1 - (double) Rcpp::min (z1)) / ((double) Rcpp::max (z1) - (double) Rcpp::min (z1)); Rcpp::NumericMatrix result (size, 2); result (Rcpp::_, 0) = z1; result (Rcpp::_, 1) = ac; Rcpp::colnames (result) = Rcpp::CharacterVector::create ("y", "ac"); return result; }
static Rcpp::List getDeviceMemCacheTypeAsList(cl_device_mem_cache_type flags) { Rcpp::List list; #ifdef CL_READ_ONLY_CACHE if (flags & CL_READ_ONLY_CACHE) list.push_back(Rcpp::wrap("CL_READ_ONLY_CACHE")); #endif #ifdef CL_READ_WRITE_CACHE if (flags & CL_READ_WRITE_CACHE) list.push_back(Rcpp::wrap("CL_READ_WRITE_CACHE")); #endif return list; }
Rcpp::List Commit::parent_list() { BEGIN_RCPP Rcpp::List v; unsigned int c = parent_count(); for (int i=0; i<c; ++i) { v.push_back(parent(i)); } return v; END_RCPP }
// [[Rcpp::export]] Rcpp::List CPL_geos_op(std::string op, Rcpp::List sfc, double bufferDist = 0.0, int nQuadSegs = 30, double dTolerance = 0.0, bool preserveTopology = false, int bOnlyEdges = 1, double dfMaxLength = 0.0) { GEOSContextHandle_t hGEOSCtxt = CPL_geos_init(); std::vector<GEOSGeom> g = geometries_from_sfc(hGEOSCtxt, sfc); std::vector<GEOSGeom> out(sfc.length()); if (op == "buffer") { for (size_t i = 0; i < g.size(); i++) out[i] = chkNULL(GEOSBuffer_r(hGEOSCtxt, g[i], bufferDist, nQuadSegs)); } else if (op == "boundary") { for (size_t i = 0; i < g.size(); i++) out[i] = chkNULL(GEOSBoundary_r(hGEOSCtxt, g[i])); } else if (op == "convex_hull") { for (size_t i = 0; i < g.size(); i++) out[i] = chkNULL(GEOSConvexHull_r(hGEOSCtxt, g[i])); } else if (op == "union_cascaded") { for (size_t i = 0; i < g.size(); i++) out[i] = chkNULL(GEOSUnionCascaded_r(hGEOSCtxt, g[i])); } else if (op == "simplify") { for (size_t i = 0; i < g.size(); i++) out[i] = preserveTopology ? chkNULL(GEOSTopologyPreserveSimplify_r(hGEOSCtxt, g[i], dTolerance)) : chkNULL(GEOSSimplify_r(hGEOSCtxt, g[i], dTolerance)); } else if (op == "linemerge") { for (size_t i = 0; i < g.size(); i++) out[i] = chkNULL(GEOSLineMerge_r(hGEOSCtxt, g[i])); } else if (op == "polygonize") { for (size_t i = 0; i < g.size(); i++) out[i] = chkNULL(GEOSPolygonize_r(hGEOSCtxt, &(g[i]), 1)); // xxx } else if (op == "centroid") { for (size_t i = 0; i < g.size(); i++) { out[i] = chkNULL(GEOSGetCentroid_r(hGEOSCtxt, g[i])); } } else #if GEOS_VERSION_MAJOR >= 3 && GEOS_VERSION_MINOR >= 4 if (op == "triangulate") { for (size_t i = 0; i < g.size(); i++) out[i] = chkNULL(GEOSDelaunayTriangulation_r(hGEOSCtxt, g[i], dTolerance, bOnlyEdges)); } else #endif throw std::invalid_argument("invalid operation"); // would leak g and out for (size_t i = 0; i < g.size(); i++) GEOSGeom_destroy_r(hGEOSCtxt, g[i]); Rcpp::List ret(sfc_from_geometry(hGEOSCtxt, out)); // destroys out CPL_geos_finish(hGEOSCtxt); ret.attr("crs") = sfc.attr("crs"); return ret; }
// [[Rcpp::export]] Rcpp::List CPL_gdal_segmentize(Rcpp::List sfc, double dfMaxLength = 0.0) { if (dfMaxLength <= 0.0) throw std::invalid_argument("argument dfMaxLength should be positive\n"); std::vector<OGRGeometry *> g = ogr_from_sfc(sfc, NULL); for (size_t i = 0; i < g.size(); i++) g[i]->segmentize(dfMaxLength); Rcpp::List ret = sfc_from_ogr(g, true); ret.attr("crs") = sfc.attr("crs"); return ret; }
void RcppSArray::from_dict_list(Rcpp::List lst) { std::vector<flexible_type> f_vec(lst.size()); for (size_t i = 0; i < lst.size(); i++) { Rcpp::XPtr<rcpp_dict> ptr((SEXP)lst[i]); rcpp_dict d = *ptr.get() ; flex_dict f_dict; for(auto imap: d) { f_dict.push_back(std::make_pair(imap.first, imap.second)) ; } f_vec[i] = f_dict; } sarray = gl_sarray(f_vec) ; }
void parseDataFrame(SEXP dataFrameObj, vector<Feature>& dataMatrix, vector<string>& sampleHeaders) { Rcpp::DataFrame df(dataFrameObj); //Rcpp::CharacterVector colNames = df.attr("names"); //Rcpp::CharacterVector rowNames = df.attr("row.names"); vector<string> featureHeaders = df.attr("names"); vector<string> foo = df.attr("row.names"); sampleHeaders = foo; dataMatrix.resize( 0 ); //cout << "nf = " << featureHeaders.size() << endl; //cout << "ns = " << sampleHeaders.size() << endl; // Read one column of information, which in this case is assumed to be one sample for ( size_t i = 0; i < featureHeaders.size(); ++i ) { Rcpp::List vec = df[i]; assert(vec.length() == sampleHeaders.size() ); //cout << " " << foo[0] << flush; //cout << " df[" << i << "].length() = " << vec.length() << endl; if ( featureHeaders[i].substr(0,2) != "N:" ) { vector<string> sVec(sampleHeaders.size()); for ( size_t j = 0; j < sampleHeaders.size(); ++j ) { //cout << Rcpp::as<string>(vec[j]) << endl; sVec[j] = Rcpp::as<string>(vec[j]); } if ( featureHeaders[i].substr(0,2) == "T:" ) { bool doHash = true; dataMatrix.push_back( Feature(sVec,featureHeaders[i],doHash) ); } else { dataMatrix.push_back( Feature(sVec,featureHeaders[i]) ); } } else { vector<num_t> sVec(sampleHeaders.size()); for ( size_t j = 0; j < sampleHeaders.size(); ++j ) { sVec[j] = Rcpp::as<num_t>(vec[j]); } dataMatrix.push_back( Feature(sVec,featureHeaders[i]) ); } // cout << "df[" << j << "," << i << "] = " << Rcpp::as<num_t>(vec[j]) << endl; // } } assert( dataMatrix.size() == featureHeaders.size() ); }
// [[Rcpp::export]] Rcpp::IntegerMatrix PredictBoardCombine ( const Rcpp::IntegerMatrix& input_board, const Rcpp::List& prob_dists_5by5, const Rcpp::List& prob_dists_3by3, const unsigned int delta = 1 ) { // ::::::::NOTE:::::: // using R indexing conventions for delta using namespace Rcpp; const unsigned int nrow = gol_board_nrow; const unsigned int ncol = gol_board_ncol; // get correct distributions Rcpp::String delta_index = "d" + Rcpp::toString(delta); const NumericVector& prob_5by5 = prob_dists_5by5[delta_index]; const NumericVector& prob_3by3 = prob_dists_3by3[delta_index]; bool bad_list = (prob_dists_5by5.size() != 5 || prob_dists_3by3.size() !=5); if(bad_list) { Rcpp::stop("[PredictBoard] prob_dist list must be size 5"); } // prod dists for a given delta //const Rcpp::NumericVector probs_5by5 = Rcpp::as<Rcpp::NumericVector>(prob_dists[delta-1 ]); //const Rcpp::NumericVector probs_3by3 = Rcpp::as<Rcpp::NumericVector>(prob_dists[delta-1+num_deltas]); Rcpp::IntegerMatrix prediction(nrow, ncol); for( int i = 0; i < nrow; i++) { for( int j = 0; j < ncol; j++) { const unsigned int tag5 = GetTag<5>(input_board, i,j); double prob = prob_5by5[tag5]; if( prob < 0 && prob > -.9) { const unsigned int tag3 = GetTag<3>(input_board, i,j); double prob = prob_3by3[tag3]; } prediction(i,j) = (prob > 0.5? 1 : 0); } } return prediction; }
void constMatrix::initFromList(Rcpp::List const & init_list) { npars = 1; std::vector<std::string> check_names = {"Q","loc", "h"}; check_Rcpplist(init_list, check_names, "constMatrix::initFromList"); Q = Rcpp::as<Eigen::SparseMatrix<double,0,int> >(init_list["Q"]); d = Q.rows(); int nIter = Rcpp::as<double>(init_list["nIter"]); tauVec.resize(nIter+1); npars = 0; v.setZero(1); m.resize(1,1); tau = 1.; if(init_list.containsElementNamed("tau")) tau = Rcpp::as<double >( init_list["tau"]); Q *= tau; dtau = 0.; ddtau = 0.; counter = 0; tauVec[counter] = tau; counter++; loc = Rcpp::as< Eigen::VectorXd >(init_list["loc"]); h = Rcpp::as< Eigen::VectorXd >(init_list["h"]); h_average = h.sum() / h.size(); m_loc = loc.minCoeff(); }
// [[Rcpp::export]] Rcpp::List clist2mlist(Rcpp::List clist, int nthreads=1){ if (clist.length()==0) Rcpp::stop("empty list is invalid"); int ncounts, nmarks, nbins = -1; std::vector<std::string> rnames; listcubedim(clist, &nmarks, &nbins, &ncounts, rnames); //allocate storage Rcpp::List mlist(nmarks); for (int mark = 0; mark < nmarks; ++mark){ mlist[mark] = Rcpp::IntegerMatrix(nbins, ncounts); } if (rnames.size() > 0) mlist.attr("names") = rnames; //copy data #pragma omp parallel for num_threads(nthreads) collapse(2) for (int c = 0; c < ncounts; ++c){ for (int mark = 0; mark < nmarks; ++mark){ MatRow<int> row = Mat<int>((SEXP)clist[c]).getRow(mark); Vec<int> col = Mat<int>((SEXP)mlist[mark]).getCol(c); for (int bin = 0; bin < nbins; ++bin){ col[bin] = row[bin]; } } } return mlist; }
//' rcpp_neutral_hotspots_ntests //' //' Performs repeated neutral tests to yield average distributions of both //' hotspot values and spatial autocorrelation statistics. //' //' @param nbs An \code{spdep} \code{nb} object listing all neighbours of each //' point. //' @param wts Weighting factors for each neighbour; must have same length as //' nbs. //' @param nbsi List of matrices as returned from \code{get_nbsi}. each element //' of which contains the i-th nearest neighbour to each point. //' @param alpha Strength of spatial autocorrelation //' @param sd0 Standard deviation of truncated normal distribution used to model //' environmental variation (with mean of 1) //' @param nt Number of successive layers of temporal and spatial autocorrelation //' used to generate final modelled values //' @param ntests Number of tests used to obtain average values //' @param ac_type Character string specifying type of aucorrelation //' (\code{moran}, \code{geary}, or code{getis-ord}). //' //' @return A matrix of dimension (size, 2), with first column containing //' sorted and re-scaled hotspot values, and second column containing sorted and //' re-scaled spatial autocorrelation statistics. //' // [[Rcpp::export]] Rcpp::NumericMatrix rcpp_neutral_hotspots_ntests (Rcpp::List nbs, Rcpp::List wts, Rcpp::List nbsi, double alpha, double sd0, int niters, std::string ac_type, bool log_scale, int ntests) { const int size = nbs.size (); Rcpp::NumericMatrix hs1; Rcpp::NumericVector z (size), z1 (size), ac (size), ac1 (size); std::fill (ac.begin (), ac.end (), 0.0); std::fill (z.begin (), z.end (), 0.0); for (int n=0; n<ntests; n++) { hs1 = rcpp_neutral_hotspots (nbs, wts, nbsi, alpha, sd0, log_scale, niters, ac_type); z += hs1 (Rcpp::_, 0); ac += hs1 (Rcpp::_, 1); } Rcpp::NumericMatrix result (size, 2); result (Rcpp::_, 0) = z / (double) ntests; result (Rcpp::_, 1) = ac / (double) ntests; Rcpp::colnames (result) = Rcpp::CharacterVector::create ("z", "ac"); return result; }
// [[Rcpp::export]] Rcpp::List cpp_Relaxed_RIT(Rcpp::List const& datas,Rcpp::NumericVector const& theta, Rcpp::LogicalVector const& factor,double epsilon_cont,double epsilon_cat,int n_trees, int depth,int branch,int min_inter_sz,double radius,bool es){ unordered_map<string,Interaction> res; // Transform types vector<bool> cFactor = Rcpp::as<vector<bool> >(factor); vector<double> c_theta = Rcpp::as<vector<double> >(theta); for(int c=0;c<datas.size();++c){// Iterate over classes Rcpp::DataFrame class_data = Rcpp::as<Rcpp::DataFrame>(datas[c]); Generator gen = create_PRNG(class_data); for(int t=0;t<n_trees;++t){// Iterate over n_trees //Rcpp::Rcout << "Tree " << t << " of class " << c << endl; tree(res,datas,c,c_theta,cFactor,epsilon_cont,epsilon_cat,depth,min_inter_sz,branch,gen,radius,es); Rcpp::checkUserInterrupt(); } } // Transform to R type Rcpp::List ret(res.size()); Rcpp::CharacterVector keys(res.size()); int i = 0; for(auto& kv : res){ keys[i] = kv.first; ret[i] = kv.second.as_List(datas); i++; } ret.names() = keys; return ret; }
SEXP getPlatformInfo(SEXP sPlatformID){ resetError("ROpenCL::getPlatformInfo"); static char cBuffer[1024]; Rcpp::XPtr<cl_platform_id> platformID(sPlatformID); std::string str; Rcpp::List result; #ifdef CL_PLATFORM_PROFILE /* TODO CHECK THIS IS STRING RETURN VALUE */ cBuffer[0] = '\0'; logError( clGetPlatformInfo(*platformID, CL_PLATFORM_PROFILE, sizeof(cBuffer), cBuffer, NULL) ); str = cBuffer; result["CL_PLATFORM_PROFILE"] = Rcpp::wrap(str); #endif #ifdef CL_PLATFORM_VERSION cBuffer[0] = '\0'; logError( clGetPlatformInfo(*platformID, CL_PLATFORM_VERSION, sizeof(cBuffer), cBuffer, NULL) ); str = cBuffer; result["CL_PLATFORM_VERSION"] = Rcpp::wrap(str); #endif #ifdef CL_PLATFORM_NAME cBuffer[0] = '\0'; logError( clGetPlatformInfo (*platformID, CL_PLATFORM_NAME, sizeof(cBuffer), cBuffer, NULL) ); str = cBuffer; result["CL_PLATFORM_NAME"] = Rcpp::wrap(str); #endif #ifdef CL_PLATFORM_VENDOR cBuffer[0] = '\0'; logError( clGetPlatformInfo(*platformID, CL_PLATFORM_VENDOR, sizeof(cBuffer), cBuffer, NULL) ); str = cBuffer; result["CL_PLATFORM_VENDOR"] = Rcpp::wrap(str); #endif #ifdef CL_PLATFORM_EXTENSIONS cBuffer[0] = '\0'; logError( clGetPlatformInfo(*platformID, CL_PLATFORM_EXTENSIONS, sizeof(cBuffer), cBuffer, NULL) ); str = cBuffer; std::string word; std::stringstream ss(str); // Insert the string into a stream Rcpp::List extensions; while (ss >> word) { // Fetch next word from stream extensions.push_back(Rcpp::wrap(word)); } result["CL_PLATFORM_EXTENSIONS"] = Rcpp::wrap(extensions); #endif PRINTONERROR(); return result; }
Rcpp::List sfc_from_ogr(std::vector<OGRGeometry *> g, bool destroy = false) { Rcpp::List lst(g.size()); Rcpp::List crs = get_crs(g.size() && g[0] != NULL ? g[0]->getSpatialReference() : NULL); for (size_t i = 0; i < g.size(); i++) { if (g[i] == NULL) Rcpp::stop("NULL error in sfc_from_ogr"); // #nocov Rcpp::RawVector raw(g[i]->WkbSize()); handle_error(g[i]->exportToWkb(wkbNDR, &(raw[0]), wkbVariantIso)); lst[i] = raw; if (destroy) OGRGeometryFactory::destroyGeometry(g[i]); } Rcpp::List ret = CPL_read_wkb(lst, false, false); ret.attr("crs") = crs; ret.attr("class") = "sfc"; return ret; }
//[[Rcpp::export]] SEXP CPP_seg(Rcpp::List data, Rcpp::List dataC, int minReadsRegion, int minLregion, int minReads, int step, int width, int maxStep, int minDist, int verbose){ //minReadsRegion : The min number of reads for a region to be kept as candidate //minLregion : The min size of a region //minReads : The min number of reads for a window to be included in a region //step : The step for the sliding window //width : Half the length of the sliding window //maxStep : Used in callRegionsL //minDist : in PING, when reads are too close to the center of the windows, they are not counted in the window score //verbose : Print debug values if(verbose>1){ cout<<"step = "<<step<<endl; cout<<"maxStep = "<<maxStep<<endl; cout<<"width = "<<width<<endl; cout<<"minReads = "<<minReads<<endl; cout<<"minLregion = "<<minLregion<<endl; } string chr; vector<string> chrs = data.names(); Rcpp::List ret(data.size()); for(int i=0; i < data.size(); i++){ chr = chrs[i]; if(verbose>1){ cout<<"Processing chromosome "<<chr<<endl; } //access sub list Rcpp::List dataList = data[chr]; Rcpp::List contList = dataC[chr]; //R to c++ vectors std::vector<int> yF = Rcpp::as<std::vector<int> >(dataList["F"]); std::vector<int> yR = Rcpp::as<std::vector<int> >(dataList["R"]); std::vector<int> contF = Rcpp::as<std::vector<int> >(contList["F"]); std::vector<int> contR = Rcpp::as<std::vector<int> >(contList["R"]); ret[i] = seg_chr(yF, yR, contF, contR, minReadsRegion, minLregion, minReads, step, width, maxStep, minDist, verbose); } for(int j=0; j<data.size(); j++){ } Rcpp::Language new_segReadsList("new", "segReadsList"); Rcpp::S4 returnVal(new_segReadsList.eval()); returnVal.slot("List") = ret; return(returnVal); }