Example #1
0
File: gdal.cpp Project: rundel/sfr
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;
}
Example #2
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;
}
Example #3
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;
}
Example #4
0
File: geos.cpp Project: edzer/sfr
// [[Rcpp::export]]
Rcpp::LogicalVector CPL_geos_is_simple(Rcpp::List sfc) { 
	GEOSContextHandle_t hGEOSCtxt = CPL_geos_init();
	Rcpp::LogicalVector out(sfc.length());
	std::vector<GEOSGeom> g = geometries_from_sfc(hGEOSCtxt, sfc);
	for (size_t i = 0; i < g.size(); i++) {
		out[i] = chk_(GEOSisSimple_r(hGEOSCtxt, g[i]));
		GEOSGeom_destroy_r(hGEOSCtxt, g[i]);
	}
	CPL_geos_finish(hGEOSCtxt);
	return out;
}
Example #5
0
// [[Rcpp::export]]
Rcpp::IntegerVector CPL_gdal_dimension(Rcpp::List sfc, bool NA_if_empty = true) {
	std::vector<OGRGeometry *> g = ogr_from_sfc(sfc, NULL);
	Rcpp::IntegerVector out(sfc.length());
	for (size_t i = 0; i < g.size(); i++) {
		out[i] = g[i]->getDimension();
		if (NA_if_empty && g[i]->IsEmpty())
			out[i] = NA_INTEGER;
		delete g[i];
	}
	return out;
}
Example #6
0
File: geos.cpp Project: 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;
}
Example #7
0
// [[Rcpp::export]]
Rcpp::NumericVector CPL_area(Rcpp::List sfc) { 
	std::vector<OGRGeometry *> g = ogr_from_sfc(sfc, NULL);
	Rcpp::NumericVector out(sfc.length());
	for (size_t i = 0; i < g.size(); i++) {
		if (g[i]->getDimension() == 2) {
			OGRSurface *a = (OGRSurface *) g[i];
			out[i] = a->get_Area();
		} else
			out[i] = 0.0;
		delete g[i];
	}
	return out;
}
Example #8
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() );

}
Example #9
0
// [[Rcpp::export]]
Rcpp::NumericVector CPL_length(Rcpp::List sfc) { 
	std::vector<OGRGeometry *> g = ogr_from_sfc(sfc, NULL);
	Rcpp::NumericVector out(sfc.length());
	for (size_t i = 0; i < g.size(); i++) {
		OGRwkbGeometryType gt = OGR_GT_Flatten(g[i]->getGeometryType());
		if (gt == wkbLineString || gt == wkbCircularString || gt == wkbCompoundCurve || gt == wkbCurve) {
			OGRCurve *a = (OGRCurve *) g[i];
			out[i] = a->get_Length();
		} else {
			OGRGeometryCollection *a = (OGRGeometryCollection *) g[i];
			out[i] = a->get_Length();
		}
		delete g[i];
	}
	return out;
}
Example #10
0
SEXP collapsedList(Rcpp::List ll) {
    if (ll.length() == 0) return R_NilValue;
    Rcpp::List::iterator it = ll.begin(); 
    switch(TYPEOF(*it)) {
        case REALSXP: {
            Rcpp::NumericVector v(ll.begin(), ll.end());
            Rcpp::RObject ro = ll[0];
            if (ro.hasAttribute("class")) {
                Rcpp::CharacterVector cv = ro.attr("class");
                if ((cv.size() == 1) && std::string(cv[0]) == "Date") {
                    Rcpp::DateVector dv(v);
                    return dv;
                }
                if ((cv.size() == 2) && std::string(cv[1]) == "POSIXt") {
                    Rcpp::DatetimeVector dtv(v);
                    return dtv;
                }
            }
            return v;
            break;              // not reached ...
        }
        case INTSXP: {
            Rcpp::IntegerVector v(ll.begin(), ll.end());
            return v;
            break;              // not reached ...
        }
        case LGLSXP: {
            Rcpp::LogicalVector v(ll.begin(), ll.end());
            return v;
            break;              // not reached ...
        }
        case STRSXP: {              // minor code smell that this is different :-/
            int n = ll.size();
            Rcpp::CharacterVector v(n);
            for (int i=0; i<n; i++) {
                std::string s = Rcpp::as<std::string>(ll[i]);
                v[i] = s;
            }
            return v;
            break;              // not reached ...
        }
    }
    return ll;
}
Example #11
0
File: geos.cpp Project: edzer/sfr
// [[Rcpp::export]]
Rcpp::List CPL_geos_binop(Rcpp::List sfc0, Rcpp::List sfc1, std::string op, double par = 0.0, 
		bool sparse = true) {

	GEOSContextHandle_t hGEOSCtxt = CPL_geos_init();

	std::vector<GEOSGeom> gmv0 = geometries_from_sfc(hGEOSCtxt, sfc0);
	std::vector<GEOSGeom> gmv1 = geometries_from_sfc(hGEOSCtxt, sfc1);

	Rcpp::List ret_list;

	using namespace Rcpp; // so that later on the (i,_) works
	if (op == "relate") { // character return matrix:
		Rcpp::CharacterVector out(sfc0.length() * sfc1.length());
		for (int i = 0; i < sfc0.length(); i++)
			for (int j = 0; j < sfc1.length(); j++) {
				char *cp = GEOSRelate_r(hGEOSCtxt, gmv0[i], gmv1[j]);
				if (cp == NULL)
					throw std::range_error("GEOS error in GEOSRelate_r");
				out[j * sfc0.length() + i] = cp;
				GEOSFree_r(hGEOSCtxt, cp);
			}
		out.attr("dim") = get_dim(sfc0.length(), sfc1.length());
		ret_list = Rcpp::List::create(out);
	} else if (op == "distance") { // return double matrix:
		Rcpp::NumericMatrix out(sfc0.length(), sfc1.length());
		for (size_t i = 0; i < gmv0.size(); i++)
			for (size_t j = 0; j < gmv1.size(); j++) {
				double dist = -1.0;
				if (GEOSDistance_r(hGEOSCtxt, gmv0[i], gmv1[j], &dist) == 0)
					throw std::range_error("GEOS error in GEOSDistance_r");
				out(i,j) = dist;
			}
		ret_list = Rcpp::List::create(out);
	} else {
		// other cases: boolean return matrix, either dense or sparse
		Rcpp::LogicalMatrix densemat;
		if (! sparse)  // allocate:
			densemat = Rcpp::LogicalMatrix(sfc0.length(), sfc1.length());
		Rcpp::List sparsemat(sfc0.length());
		for (int i = 0; i < sfc0.length(); i++) { // row
		// TODO: speed up contains, containsproperly, covers, and intersects with prepared geometry i
			Rcpp::LogicalVector rowi(sfc1.length()); 
			if (op == "intersects")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSIntersects_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "disjoint")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSDisjoint_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "touches")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSTouches_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "crosses")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSCrosses_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "within")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSWithin_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "contains")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSContains_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "overlaps")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSOverlaps_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "equals")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSEquals_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "covers")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSCovers_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "covered_by")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSCoveredBy_r(hGEOSCtxt, gmv0[i], gmv1[j]));
			else if (op == "equals_exact")
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = chk_(GEOSEqualsExact_r(hGEOSCtxt, gmv0[i], gmv1[j], par));
			/* else if (op == "is_within_distance") ==>> no C interface??
				for (int j = 0; j < sfc1.length(); j++) 
					rowi(j) = gmv0[i]->isWithinDistance(gmv1[j].get(), par);
			*/
			else
				throw std::range_error("wrong value for op"); // unlikely to happen unless user wants to
			if (! sparse)
				densemat(i,_) = rowi;
			else
				sparsemat[i] = get_which(rowi);
		}
		if (sparse)
			ret_list = sparsemat;
		else
			ret_list = Rcpp::List::create(densemat);
	}
	for (size_t i = 0; i < gmv0.size(); i++)
		GEOSGeom_destroy_r(hGEOSCtxt, gmv0[i]);
	for (size_t i = 0; i < gmv1.size(); i++)
		GEOSGeom_destroy_r(hGEOSCtxt, gmv1[i]);
	CPL_geos_finish(hGEOSCtxt);
	return ret_list;
}
Example #12
0
//' 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;
}