Пример #1
0
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");


}
Пример #2
0
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");


}
Пример #3
0
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();
    }
}
Пример #4
0
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";
}
Пример #5
0
 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 ;
 }
Пример #6
0
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;
}
Пример #7
0
// [[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;
}
Пример #8
0
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;
}
Пример #9
0
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;
}
Пример #11
0
Rcpp::List jaspResults::getKeepList()
{
	Rcpp::List keep = getPlotPathsForKeep();
	keep.push_front(std::string(_saveResultsHere));
	keep.push_front(_relativePathKeep);

	return keep;
}
Пример #12
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
}
Пример #13
0
 // 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 ;
 }
Пример #14
0
Файл: geos.cpp Проект: edzer/sfr
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;
}
Пример #16
0
//' 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;
}
Пример #18
0
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
}
Пример #19
0
Файл: geos.cpp Проект: edzer/sfr
// [[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;
}
Пример #20
0
// [[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;
}
Пример #21
0
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) ;
}
Пример #22
0
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() );

}
Пример #23
0
// [[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; 
} 
Пример #24
0
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();
}
Пример #25
0
// [[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;
}
Пример #26
0
//' 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;
}
Пример #27
0
// [[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;
}
Пример #29
0
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;
}
Пример #30
0
//[[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);
}