Exemple #1
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;
}
Exemple #2
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();
    }
}
Exemple #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();
    }
}
// [[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;
}
Exemple #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 ;
 }
Exemple #6
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;
}
Exemple #7
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;
}
Exemple #8
0
// [[Rcpp::export]]
Rcpp::List CPL_geos_op2(std::string op, Rcpp::List sfcx, Rcpp::List sfcy) {

	GEOSContextHandle_t hGEOSCtxt = CPL_geos_init();
	std::vector<GEOSGeom> x = geometries_from_sfc(hGEOSCtxt, sfcx);
	std::vector<GEOSGeom> y = geometries_from_sfc(hGEOSCtxt, sfcy);
	std::vector<GEOSGeom> out(x.size() * y.size());

	size_t n = 0;
	if (op == "intersection") {
		for (size_t i = 0; i < y.size(); i++)
			for (size_t j = 0; j < x.size(); j++)
				out[i * x.size() + j] = chkNULLcnt(hGEOSCtxt, GEOSIntersection_r(hGEOSCtxt, x[j], y[i]), &n);
	} else if (op == "union") {
		for (size_t i = 0; i < y.size(); i++)
			for (size_t j = 0; j < x.size(); j++)
				out[i * x.size() + j] = chkNULLcnt(hGEOSCtxt, GEOSUnion_r(hGEOSCtxt, x[j], y[i]), &n);
	} else if (op == "difference") {
		for (size_t i = 0; i < y.size(); i++)
			for (size_t j = 0; j < x.size(); j++)
				out[i * x.size() + j] = chkNULLcnt(hGEOSCtxt, GEOSDifference_r(hGEOSCtxt, x[j], y[i]), &n);
	} else if (op == "sym_difference") {
		for (size_t i = 0; i < y.size(); i++)
			for (size_t j = 0; j < x.size(); j++)
				out[i * x.size() + j] = chkNULLcnt(hGEOSCtxt, GEOSSymDifference_r(hGEOSCtxt, x[j], y[i]), &n);
	} else 
		throw std::invalid_argument("invalid operation"); // would leak g, g0 and out
	// clean up x and y:
	for (size_t i = 0; i < x.size(); i++)
		GEOSGeom_destroy_r(hGEOSCtxt, x[i]);
	for (size_t i = 0; i < y.size(); i++)
		GEOSGeom_destroy_r(hGEOSCtxt, y[i]);
	// trim results back to non-empty geometries:
	std::vector<GEOSGeom> out2(n);
	Rcpp::NumericMatrix m(n, 2); // and a set of 1-based indices to x and y
	size_t k = 0, l = 0;
	for (size_t i = 0; i < y.size(); i++) {
		for (size_t j = 0; j < x.size(); j++) {
			l = i * x.size() + j;
			if (!chk_(GEOSisEmpty_r(hGEOSCtxt, out[l]))) { // keep:
				out2[k] = out[l];
				m(k, 0) = j + 1;
				m(k, 1) = i + 1;
				k++;
				if (k > n)
					throw std::range_error("invalid k");
			} else // discard:
				GEOSGeom_destroy_r(hGEOSCtxt, out[l]);
		}
	}
	if (k != n)
		throw std::range_error("invalid k (2)");

	Rcpp::List ret(sfc_from_geometry(hGEOSCtxt, out2)); // destroys out2
	CPL_geos_finish(hGEOSCtxt);
	ret.attr("crs") = sfcx.attr("crs");
	ret.attr("idx") = m;
	return ret;
}
Exemple #9
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 ;
 }
Exemple #10
0
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;
}
Exemple #11
0
// [[Rcpp::export]]
Rcpp::List CPL_gdal_linestring_sample(Rcpp::List sfc, Rcpp::List distLst) {
	if (sfc.size() != distLst.size())
		throw std::invalid_argument("sfc and dist should have equal length");
	std::vector<OGRGeometry *> g = ogr_from_sfc(sfc, NULL);
	std::vector<OGRGeometry *> out(g.size());
	for (size_t i = 0; i < g.size(); i++) {
		OGRGeometryCollection *gc = new OGRGeometryCollection;
		Rcpp::NumericVector dists = distLst[i];
		for (size_t j = 0; j < dists.size(); j++) {
			OGRPoint *poPoint  = new OGRPoint;
			((OGRLineString *) g[i])->Value(dists[j], poPoint);
			gc->addGeometry(poPoint);
		}
		out[i] = OGRGeometryFactory::forceToMultiPoint(gc);
	}
	Rcpp::List ret = sfc_from_ogr(out, true);
	ret.attr("crs") = sfc.attr("crs");
	return ret;
}
Exemple #12
0
// [[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;
}
	bool isUndirectedGraphNEL(SEXP graph_sexp)
	{
		Rcpp::S4 graph_s4;
		try
		{
			graph_s4 = Rcpp::as<Rcpp::S4>(graph_sexp);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Input graph must be an S4 object");
		}
		if(Rcpp::as<std::string>(graph_s4.attr("class")) != "graphNEL")
		{
			throw std::runtime_error("Input graph must have class graphNEL");
		}
		
		Rcpp::RObject nodes_obj;
		try
		{
			nodes_obj = Rcpp::as<Rcpp::RObject>(graph_s4.slot("nodes"));
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Error extracting slot nodes");
		}

		Rcpp::RObject edges_obj;
		try
		{
			edges_obj = Rcpp::as<Rcpp::RObject>(graph_s4.slot("edgeL"));
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Error extracting slot edgeL");
		}

		Rcpp::CharacterVector nodeNames;
		try
		{
			nodeNames = Rcpp::as<Rcpp::CharacterVector>(nodes_obj);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Slot nodes of input graph must be a character vector");
		}
		{
			std::vector<std::string> uniqueNodeNames = Rcpp::as<std::vector<std::string> >(nodeNames);
			std::sort(uniqueNodeNames.begin(), uniqueNodeNames.end());
			uniqueNodeNames.erase(std::unique(uniqueNodeNames.begin(), uniqueNodeNames.end()), uniqueNodeNames.end());
			if((std::size_t)uniqueNodeNames.size() != (std::size_t)nodeNames.size())
			{
				throw std::runtime_error("Node names of input graph were not unique");
			}
		}
		int nVertices = nodeNames.size();

		Rcpp::List edges_list;
		try
		{
			edges_list = Rcpp::as<Rcpp::List>(edges_obj);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Slot edgeL of input graph must be a list");
		}
		Rcpp::CharacterVector edges_list_names = Rcpp::as<Rcpp::CharacterVector>(edges_list.attr("names"));

		Context::inputGraph graphRef = Context::inputGraph(nVertices);
		for(int i = 0; i < edges_list.size(); i++)
		{
			int nodeIndex = std::distance(nodeNames.begin(), std::find(nodeNames.begin(), nodeNames.end(), edges_list_names(i)));
			Rcpp::List subList;
			Rcpp::CharacterVector subListNames;
			try
			{
				subList = Rcpp::as<Rcpp::List>(edges_list(i));
				subListNames = Rcpp::as<Rcpp::CharacterVector>(subList.attr("names"));
			}
			catch(Rcpp::not_compatible&)
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			if(std::find(subListNames.begin(), subListNames.end(), "edges") == subListNames.end())
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			Rcpp::NumericVector targetIndicesThisNode;
			try
			{
				targetIndicesThisNode = Rcpp::as<Rcpp::NumericVector>(subList("edges"));
			}
			catch(Rcpp::not_compatible&)
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			for(int j = 0; j < targetIndicesThisNode.size(); j++)
			{
				boost::add_edge((std::size_t)nodeIndex, (std::size_t)((int)targetIndicesThisNode(j)-1), graphRef);
			}
		}
		Context::inputGraph::edge_iterator current, end;
		boost::tie(current, end) = boost::edges(graphRef);
		for(; current != end; current++)
		{
			int source = boost::source(*current, graphRef), target = boost::target(*current, graphRef);
			if(!boost::edge(target, source, graphRef).second)
			{
				return false;
			}
		}
		return true;
	}
Exemple #14
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;
}
	void convertGraphNEL(SEXP graph_sexp, context::inputGraph& graphRef)
	{
		Rcpp::S4 graph_s4;
		try
		{
			graph_s4 = Rcpp::as<Rcpp::S4>(graph_sexp);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Input graph must be an S4 object");
		}
		if(Rcpp::as<std::string>(graph_s4.attr("class")) != "graphNEL")
		{
			throw std::runtime_error("Input graph must have class graphNEL");
		}
		
		Rcpp::RObject nodes_obj;
		try
		{
			nodes_obj = Rcpp::as<Rcpp::RObject>(graph_s4.slot("nodes"));
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Error extracting slot nodes");
		}

		Rcpp::RObject edges_obj;
		try
		{
			edges_obj = Rcpp::as<Rcpp::RObject>(graph_s4.slot("edgeL"));
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Error extracting slot edgeL");
		}

		Rcpp::CharacterVector nodeNames;
		try
		{
			nodeNames = Rcpp::as<Rcpp::CharacterVector>(nodes_obj);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Slot nodes of input graph must be a character vector");
		}
		{
			std::vector<std::string> uniqueNodeNames = Rcpp::as<std::vector<std::string> >(nodeNames);
			std::sort(uniqueNodeNames.begin(), uniqueNodeNames.end());
			uniqueNodeNames.erase(std::unique(uniqueNodeNames.begin(), uniqueNodeNames.end()), uniqueNodeNames.end());
			if((std::size_t)uniqueNodeNames.size() != (std::size_t)nodeNames.size())
			{
				throw std::runtime_error("Node names of input graph were not unique");
			}
		}
		int nVertices = nodeNames.size();

		Rcpp::List edges_list;
		try
		{
			edges_list = Rcpp::as<Rcpp::List>(edges_obj);
		}
		catch(Rcpp::not_compatible&)
		{
			throw std::runtime_error("Slot edgeL of input graph must be a list");
		}
		Rcpp::CharacterVector edges_list_names = Rcpp::as<Rcpp::CharacterVector>(edges_list.attr("names"));

		graphRef = context::inputGraph(nVertices);
		int edgeIndexCounter = 0;
		for(int i = 0; i < edges_list.size(); i++)
		{
			int nodeIndex = std::distance(nodeNames.begin(), std::find(nodeNames.begin(), nodeNames.end(), edges_list_names(i)));
			Rcpp::List subList;
			Rcpp::CharacterVector subListNames;
			try
			{
				subList = Rcpp::as<Rcpp::List>(edges_list(i));
				subListNames = Rcpp::as<Rcpp::CharacterVector>(subList.attr("names"));
			}
			catch(Rcpp::not_compatible&)
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			if(std::find(subListNames.begin(), subListNames.end(), "edges") == subListNames.end())
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			Rcpp::NumericVector targetIndicesThisNode;
			try
			{
				targetIndicesThisNode = Rcpp::as<Rcpp::NumericVector>(subList("edges"));
			}
			catch(Rcpp::not_compatible&)
			{
				throw std::runtime_error("Slot edgeL of input graph had an invalid format");
			}
			for(int j = 0; j < targetIndicesThisNode.size(); j++)
			{
				boost::add_edge((std::size_t)nodeIndex, (std::size_t)((int)targetIndicesThisNode(j)-1), edgeIndexCounter, graphRef);
				edgeIndexCounter++;
			}
		}
	}
//' rcpp_lines_as_network
//'
//' Return OSM data in Simple Features format
//'
//' @param sf_lines An sf collection of LINESTRING objects
//' @param pr Rcpp::DataFrame containing the weighting profile
//'
//' @return Rcpp::List objects of OSM data
//'
//' @noRd
// [[Rcpp::export]]
Rcpp::List rcpp_lines_as_network (const Rcpp::List &sf_lines,
        Rcpp::DataFrame pr)
{
    std::map <std::string, float> profile;
    Rcpp::StringVector hw = pr [1];
    Rcpp::NumericVector val = pr [2];
    for (int i = 0; i != hw.size (); i ++)
        profile.insert (std::make_pair (std::string (hw [i]), val [i]));

    Rcpp::CharacterVector nms = sf_lines.attr ("names");
    if (nms [nms.size () - 1] != "geometry")
        throw std::runtime_error ("sf_lines have no geometry component");
    if (nms [0] != "osm_id")
        throw std::runtime_error ("sf_lines have no osm_id component");
    int one_way_index = -1;
    int one_way_bicycle_index = -1;
    int highway_index = -1;
    for (int i = 0; i < nms.size (); i++)
    {
        if (nms [i] == "oneway")
            one_way_index = i;
        if (nms [i] == "oneway.bicycle")
            one_way_bicycle_index = i;
        if (nms [i] == "highway")
            highway_index = i;
    }
    Rcpp::CharacterVector ow = NULL;
    Rcpp::CharacterVector owb = NULL;
    Rcpp::CharacterVector highway = NULL;
    if (one_way_index >= 0)
        ow = sf_lines [one_way_index];
    if (one_way_bicycle_index >= 0)
        owb = sf_lines [one_way_bicycle_index];
    if (highway_index >= 0)
        highway = sf_lines [highway_index];
    if (ow.size () > 0)
    {
        if (ow.size () == owb.size ())
        {
            for (unsigned i = 0; i != ow.size (); ++ i)
                if (ow [i] == "NA" && owb [i] != "NA")
                    ow [i] = owb [i];
        } else if (owb.size () > ow.size ())
            ow = owb;
    }

    Rcpp::List geoms = sf_lines [nms.size () - 1];
    std::vector<bool> isOneWay (geoms.length ());
    std::fill (isOneWay.begin (), isOneWay.end (), false);
    // Get dimension of matrix
    size_t nrows = 0;
    int ngeoms = 0;
    for (auto g = geoms.begin (); g != geoms.end (); ++g)
    {
        // Rcpp uses an internal proxy iterator here, NOT a direct copy
        Rcpp::NumericMatrix gi = (*g);
        int rows = gi.nrow () - 1;
        nrows += rows;
        if (ngeoms < ow.size ())
        {
            if (!(ow [ngeoms] == "yes" || ow [ngeoms] == "-1"))
            {
                nrows += rows;
                isOneWay [ngeoms] = true;
            }
        }
        ngeoms ++;
    }

    Rcpp::NumericMatrix nmat = Rcpp::NumericMatrix (Rcpp::Dimension (nrows, 6));
    Rcpp::CharacterMatrix idmat = Rcpp::CharacterMatrix (Rcpp::Dimension (nrows,
                3));

    nrows = 0;
    ngeoms = 0;
    int fake_id = 0;
    for (auto g = geoms.begin (); g != geoms.end (); ++ g)
    {
        Rcpp::NumericMatrix gi = (*g);
        std::string hway = std::string (highway [ngeoms]);
        float hw_factor = profile [hway];
        if (hw_factor == 0.0) hw_factor = 1e-5;
        hw_factor = 1.0 / hw_factor;

        Rcpp::List ginames = gi.attr ("dimnames");
        Rcpp::CharacterVector rnms;
        if (ginames.length () > 0)
            rnms = ginames [0];
        else
        {
            rnms = Rcpp::CharacterVector (gi.nrow ());
            for (int i = 0; i < gi.nrow (); i ++)
                rnms [i] = fake_id ++;
        }
        if (rnms.size () != gi.nrow ())
            throw std::runtime_error ("geom size differs from rownames");

        for (int i = 1; i < gi.nrow (); i ++)
        {
            float d = haversine (gi (i-1, 0), gi (i-1, 1), gi (i, 0),
                    gi (i, 1));
            nmat (nrows, 0) = gi (i-1, 0);
            nmat (nrows, 1) = gi (i-1, 1);
            nmat (nrows, 2) = gi (i, 0);
            nmat (nrows, 3) = gi (i, 1);
            nmat (nrows, 4) = d;
            nmat (nrows, 5) = d * hw_factor;
            idmat (nrows, 0) = rnms (i-1);
            idmat (nrows, 1) = rnms (i);
            idmat (nrows, 2) = hway;
            nrows ++;
            if (isOneWay [ngeoms])
            {
                nmat (nrows, 0) = gi (i, 0);
                nmat (nrows, 1) = gi (i, 1);
                nmat (nrows, 2) = gi (i-1, 0);
                nmat (nrows, 3) = gi (i-1, 1);
                nmat (nrows, 4) = d;
                nmat (nrows, 5) = d * hw_factor;
                idmat (nrows, 0) = rnms (i);
                idmat (nrows, 1) = rnms (i-1);
                idmat (nrows, 2) = hway;
                nrows ++;
            }
        }
        ngeoms ++;
    }

    Rcpp::List res (2);
    res [0] = nmat;
    res [1] = idmat;

    return res;
}
Exemple #17
0
void asSDmap(sd_map& out, Rcpp::List x) {
  Rcpp::CharacterVector names = x.attr("names");
  for(int i=0; i < x.size(); i++) {
    out[std::string(names[i])] = Rcpp::as<double>(x[i]);
  }
}