// [[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 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();
}
}
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;
}
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 ;
}
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;
}
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]]
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;
}
// 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;
}
// [[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;
}
// [[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;
}
//' 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;
}
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]);
}
}
