SEXP rgeos_geospoint2SpatialPoints(SEXP env, GEOSGeom geom, SEXP p4s, SEXP id, int n) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
int type = GEOSGeomTypeId_r(GEOShandle, geom);
if ( type != GEOS_POINT && type != GEOS_MULTIPOINT && type != GEOS_GEOMETRYCOLLECTION )
error("rgeos_geospoint2SpatialPoints: invalid geometry type");
int pc=0;
SEXP bbox, crdmat;
if (GEOSisEmpty_r(GEOShandle, geom))
error("rgeos_geospoint2SpatialPoints: empty point found");
//if (GEOSisEmpty_r(GEOShandle, geom)==0) {
PROTECT(bbox = rgeos_geom2bbox(env, geom)); pc++;
PROTECT(crdmat = rgeos_geospoint2crdMat(env, geom, id, n, type)); pc++;
//} else {
// bbox = R_NilValue;
// crdmat = R_NilValue;
//}
SEXP ans;
PROTECT(ans = NEW_OBJECT(MAKE_CLASS("SpatialPoints"))); pc++;
SET_SLOT(ans, install("coords"), crdmat);
SET_SLOT(ans, install("bbox"), bbox);
SET_SLOT(ans, install("proj4string"), p4s);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_miscfunc(SEXP env, SEXP obj, SEXP byid, p_miscfunc miscfunc) {
SEXP ans;
GEOSContextHandle_t GEOShandle = getContextHandle(env);
GEOSGeom geom = rgeos_convert_R2geos(env, obj);
int type = GEOSGeomTypeId_r(GEOShandle, geom);
int n = (LOGICAL_POINTER(byid)[0] && type == GEOS_GEOMETRYCOLLECTION) ?
GEOSGetNumGeometries_r(GEOShandle, geom) : 1;
int pc=0;
PROTECT(ans = NEW_NUMERIC(n)); pc++;
GEOSGeom curgeom = geom;
for(int i=0; i<n; i++) {
if ( n > 1) {
curgeom = (GEOSGeom) GEOSGetGeometryN_r(GEOShandle, geom, i);
if (curgeom == NULL) error("rgeos_miscfunc: unable to get subgeometries");
}
double val;
if (!miscfunc(GEOShandle, curgeom, &val))
error("rgeos_miscfunc: unable to calculate");
NUMERIC_POINTER(ans)[i] = val;
}
GEOSGeom_destroy_r(GEOShandle, geom);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_node(SEXP env, SEXP obj) {
SEXP ans, id;
int pc=0;
GEOSContextHandle_t GEOShandle = getContextHandle(env);
SEXP p4s = GET_SLOT(obj, install("proj4string"));
GEOSGeom geom = rgeos_convert_R2geos(env, obj);
// int type = GEOSGeomTypeId_r(GEOShandle, geom);
//Rprintf("type: %d, %s\n", type, GEOSGeomType_r(GEOShandle, geom));
GEOSGeom res = GEOSNode_r(GEOShandle, geom);
// type = GEOSGeomTypeId_r(GEOShandle, res);
int ng = GEOSGetNumGeometries_r(GEOShandle, res);
//Rprintf("ng: %d, type: %d, %s\n", ng, type, GEOSGeomType_r(GEOShandle, res));
char buf[BUFSIZ];
PROTECT(id = NEW_CHARACTER(ng)); pc++;
for (int i=0; i<ng; i++) {
sprintf(buf, "%d", i);
SET_STRING_ELT(id, i, COPY_TO_USER_STRING(buf));
}
GEOSGeom_destroy_r(GEOShandle, geom);
ans = rgeos_convert_geos2R(env, res, p4s, id);
UNPROTECT(pc);
return(ans);
}
// Return closest point to given distance within geometry.
// 'spgeom' must be a LineString
SEXP rgeos_interpolate(SEXP env, SEXP spgeom, SEXP d, SEXP normalized) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
GEOSGeom geom = rgeos_convert_R2geos(env, spgeom);
GEOSGeom res_geos;
double dist;
int nlines = length(GET_SLOT(spgeom, install("lines")));
if (nlines < 1) {
error("rgeos_project: invalid number of lines");
}
int n = LENGTH(d);
if (n < 1) {
error("rgeos_interpolate: invalid number of requested points");
}
int pc = 0;
SEXP crd;
PROTECT(crd = NEW_NUMERIC(n*2)); pc++;
double x;
double y;
SEXP ans;
// select interpolation function (normalized/unnormalized)
GEOSGeometry GEOS_DLL *(*interp_fun)(GEOSContextHandle_t,
const GEOSGeometry*,
double);
if (LOGICAL_POINTER(normalized)[0]) {
interp_fun = &GEOSInterpolateNormalized_r;
} else {
interp_fun = &GEOSInterpolate_r;
}
// interpolate points and store result in coord matrix
for (int i = 0; i < n; i++) {
dist = NUMERIC_POINTER(d)[i];
res_geos = (*interp_fun)(GEOShandle, geom, dist);
rgeos_Pt2xy(env, res_geos, &x, &y);
NUMERIC_POINTER(crd)[i] = x;
NUMERIC_POINTER(crd)[n+i] = y;
}
GEOSGeom_destroy_r(GEOShandle, geom);
GEOSGeom_destroy_r(GEOShandle, res_geos);
// return coordinates as matrix
PROTECT(ans = rgeos_formatcrdMat(crd, n)); pc++;
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_finish(SEXP env) {
GEOSContextHandle_t r = getContextHandle(env);
finishGEOS_r(r);
SEXP sxpHandle = findVarInFrame(env, install("GEOSptr"));
rgeos_finish_handle(sxpHandle);
return(R_NilValue);
}
// Return distance of points 'spppoints' projected on 'spgeom' from origin
// of 'spgeom'. Geometry 'spgeom' must be a lineal geometry
SEXP rgeos_project(SEXP env, SEXP spgeom, SEXP sppoint, SEXP normalized) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
GEOSGeom geom = rgeos_convert_R2geos(env, spgeom);
SEXP crds = GET_SLOT(sppoint, install("coords"));
SEXP dim = getAttrib(crds, install("dim"));
int nlines = length(GET_SLOT(spgeom, install("lines")));
if (nlines < 1) {
error("rgeos_project: invalid number of lines");
}
int n = INTEGER_POINTER(dim)[0];
if (n < 1) {
error("rgeos_project: invalid number of points");
}
int pc = 0;
SEXP ans;
PROTECT(ans = NEW_NUMERIC(n)); pc++;
GEOSGeom p;
// select projection function (normalized/unnormalized)
double GEOS_DLL (*proj_fun)(GEOSContextHandle_t,
const GEOSGeometry*,
const GEOSGeometry*);
if (LOGICAL_POINTER(normalized)[0]) {
proj_fun = &GEOSProjectNormalized_r;
} else {
proj_fun = &GEOSProject_r;
}
// project points to line geometry
for (int i = 0; i < n; i++) {
p = rgeos_xy2Pt(env,
NUMERIC_POINTER(crds)[i],
NUMERIC_POINTER(crds)[i+n]);
NUMERIC_POINTER(ans)[i] = (*proj_fun)(GEOShandle, geom, p);
}
GEOSGeom_destroy_r(GEOShandle, geom);
GEOSGeom_destroy_r(GEOShandle, p);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_polygonize(SEXP env, SEXP obj, SEXP id, SEXP p4s, SEXP cutEdges) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
int getCutEdges = LOGICAL_POINTER(cutEdges)[0];
int n = length(obj);
GEOSGeom *geoms = (GEOSGeom *) R_alloc((size_t) n, sizeof(GEOSGeom));
for(int i=0; i<n; i++) {
geoms[i] = rgeos_convert_R2geos(env, VECTOR_ELT(obj,i));
}
GEOSGeom res = (getCutEdges)
? GEOSPolygonizer_getCutEdges_r(GEOShandle, (const GEOSGeometry *const *) geoms, (unsigned int) n)
: GEOSPolygonize_r(GEOShandle, (const GEOSGeometry *const *) geoms, (unsigned int) n);
return( rgeos_convert_geos2R(env, res, p4s, id) );
}
SEXP rgeos_delaunaytriangulation(SEXP env, SEXP obj, SEXP tol,
SEXP onlyEdges) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
double tolerance = NUMERIC_POINTER(tol)[0];
int oE = INTEGER_POINTER(onlyEdges)[0];
int pc=0;
SEXP ans, id;
SEXP p4s = GET_SLOT(obj, install("proj4string"));
GEOSGeom geom = rgeos_convert_R2geos(env, obj);
GEOSGeom resgeom = GEOSDelaunayTriangulation_r(GEOShandle, geom,
tolerance, oE);
if (resgeom == NULL)
error("rgeos_delaunaytriangulation: unable to compute");
GEOSGeom_destroy_r(GEOShandle, geom);
// int type = GEOSGeomTypeId_r(GEOShandle, resgeom);
int ng = GEOSGetNumGeometries_r(GEOShandle, resgeom);
//Rprintf("ng: %d, type: %d, %s\n", ng, type, GEOSGeomType_r(GEOShandle, resgeom));
// FIXME convert type 5 to type 7
char buf[BUFSIZ];
PROTECT(id = NEW_CHARACTER(ng)); pc++;
for (int i=0; i<ng; i++) {
sprintf(buf, "%d", i);
SET_STRING_ELT(id, i, COPY_TO_USER_STRING(buf));
}
ans = rgeos_convert_geos2R(env, resgeom, p4s, id);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_topologyfunc(SEXP env, SEXP obj, SEXP id, SEXP byid, p_topofunc topofunc) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
SEXP p4s = GET_SLOT(obj, install("proj4string"));
GEOSGeom geom = rgeos_convert_R2geos(env, obj);
int type = GEOSGeomTypeId_r(GEOShandle, geom);
int n = 1;
if (LOGICAL_POINTER(byid)[0] && type == GEOS_GEOMETRYCOLLECTION)
n = GEOSGetNumGeometries_r(GEOShandle, geom);
if (n < 1) error("rgeos_topologyfunc: invalid number of geometries");
GEOSGeom *resgeoms = (GEOSGeom *) R_alloc((size_t) n, sizeof(GEOSGeom));
for(int i=0; i<n; i++) {
const GEOSGeometry *curgeom = (n > 1) ? (GEOSGeom) GEOSGetGeometryN_r(GEOShandle, geom, i)
: geom;
if (curgeom == NULL)
error("rgeos_topologyfunc: unable to get subgeometries");
if ( topofunc == GEOSUnionCascaded_r
&& GEOSGeomTypeId_r(GEOShandle, curgeom) == GEOS_POLYGON) {
resgeoms[i] = GEOSGeom_clone_r(GEOShandle, curgeom);
} else {
resgeoms[i] = topofunc(GEOShandle, curgeom);
if (resgeoms[i] == NULL)
error("rgeos_topologyfunc: unable to calculate");
}
}
GEOSGeom_destroy_r(GEOShandle, geom);
GEOSGeom res = (n == 1) ? resgeoms[0]
: GEOSGeom_createCollection_r(GEOShandle, GEOS_GEOMETRYCOLLECTION, resgeoms, (unsigned int) n);
return( rgeos_convert_geos2R(env, res, p4s, id) ); // releases res
}
SEXP rgeos_simplify(SEXP env, SEXP obj, SEXP tol, SEXP id, SEXP byid, SEXP topPres) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
SEXP p4s = GET_SLOT(obj, install("proj4string"));
GEOSGeom geom = rgeos_convert_R2geos(env, obj);
int type = GEOSGeomTypeId_r(GEOShandle, geom);
int preserve = LOGICAL_POINTER(topPres)[0];
double tolerance = NUMERIC_POINTER(tol)[0];
int n = 1;
if (LOGICAL_POINTER(byid)[0] && type == GEOS_GEOMETRYCOLLECTION)
n = GEOSGetNumGeometries_r(GEOShandle, geom);
if (n < 1) error("rgeos_simplify: invalid number of geometries");
GEOSGeom *resgeoms = (GEOSGeom *) R_alloc((size_t) n, sizeof(GEOSGeom));
for(int i=0; i<n; i++) {
const GEOSGeometry *curgeom = (n > 1) ? (GEOSGeom) GEOSGetGeometryN_r(GEOShandle, geom, i)
: geom;
if (curgeom == NULL)
error("rgeos_topologyfunc: unable to get subgeometries");
resgeoms[i] = (preserve)
? GEOSTopologyPreserveSimplify_r(GEOShandle, curgeom, tolerance)
: GEOSSimplify_r(GEOShandle, curgeom, tolerance);
}
GEOSGeom_destroy_r(GEOShandle, geom);
GEOSGeom res = (n == 1) ? resgeoms[0] :
GEOSGeom_createCollection_r(GEOShandle, GEOS_GEOMETRYCOLLECTION, resgeoms, (unsigned int) n);
return( rgeos_convert_geos2R(env, res, p4s, id) );
}
SEXP rgeos_poly_findInBox(SEXP env, SEXP pls, SEXP as_points) {
GEOSGeom *bbs;
int npls, i, j, jj, pc=0;
GEOSGeom GC, bb;
SEXP pl, bblist;
GEOSSTRtree *str;
int *icard, *ids, *oids;
int asPTS = LOGICAL_POINTER(as_points)[0];
GEOSContextHandle_t GEOShandle = getContextHandle(env);
str = (GEOSSTRtree *) GEOSSTRtree_create_r(GEOShandle, (size_t) 10);
npls = length(pls);
bbs = (GEOSGeom *) R_alloc((size_t) npls, sizeof(GEOSGeom));
ids = (int *) R_alloc((size_t) npls, sizeof(int));
UD.ids = (int *) R_alloc((size_t) npls, sizeof(int));
oids = (int *) R_alloc((size_t) npls, sizeof(int));
for (i=0; i<npls; i++) {
ids[i] = i;
pl = VECTOR_ELT(pls, i);
if (asPTS) {
if ((GC = rgeos_Polygons2MP(env, pl)) == NULL) {
error("rgeos_poly2nb: MP GC[%d] not created", i);
}
} else {
if ((GC = rgeos_Polygons2geospolygon(env, pl)) == NULL) {
error("rgeos_poly2nb: GC[%d] not created", i);
}
}
if ((bb = GEOSEnvelope_r(GEOShandle, GC)) == NULL) {
error("rgeos_poly2nb: envelope [%d] not created", i);
}
bbs[i] = bb;
GEOSSTRtree_insert_r(GEOShandle, str, bb, &(ids[i]));
// 110904 EJP
GEOSGeom_destroy_r(GEOShandle, GC);
}
icard = (int *) R_alloc((size_t) npls, sizeof(int));
PROTECT(bblist = NEW_LIST(npls-1)); pc++;
for (i=0; i<(npls-1); i++) {
UD.count = 0;
GEOSSTRtree_query_r(GEOShandle, str, bbs[i],
(GEOSQueryCallback) cb, &UD);
for (j=0, jj=0; j<UD.count; j++) if (UD.ids[j] > i) jj++;
icard[i] = jj;
if (icard[i] > 0) SET_VECTOR_ELT(bblist, i, NEW_INTEGER(icard[i]));
for (j=0, jj=0; j<UD.count; j++) {
if (icard[i] > 0 && UD.ids[j] > i) {
oids[jj] = UD.ids[j] + R_OFFSET;
jj++;
}
}
R_isort(oids, jj);
for (j=0; j<jj; j++) {
INTEGER_POINTER(VECTOR_ELT(bblist, i))[j] = oids[j];
}
}
for (i=0; i<npls; i++) {
GEOSSTRtree_remove_r(GEOShandle, str, bbs[i], &(ids[i]));
// 110904 EJP
GEOSGeom_destroy_r(GEOShandle, bbs[i]);
}
GEOSSTRtree_destroy_r(GEOShandle, str);
UNPROTECT(pc);
return(bblist);
}
SEXP rgeos_geospolygon2Polygons(SEXP env, GEOSGeom geom, SEXP ID) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
int pc=0;
int type = GEOSGeomTypeId_r(GEOShandle, geom);
int empty = GEOSisEmpty_r(GEOShandle, geom);
int ngeom = GEOSGetNumGeometries_r(GEOShandle, geom);
ngeom = ngeom ? ngeom : 1;
int npoly = 0;
for (int i=0; i<ngeom; i++) {
GEOSGeom GC = (type == GEOS_MULTIPOLYGON && !empty) ?
(GEOSGeometry *) GEOSGetGeometryN_r(GEOShandle, geom, i) :
geom;
int GCempty = GEOSisEmpty_r(GEOShandle, GC);
int GCpolys = (GCempty) ? 1 :
GEOSGetNumInteriorRings_r(GEOShandle, GC) + 1;
npoly += GCpolys;
}
SEXP polys;
PROTECT(polys = NEW_LIST(npoly)); pc++;
int *comm = (int *) R_alloc((size_t) npoly, sizeof(int));
int *po = (int *) R_alloc((size_t) npoly, sizeof(int));
double *areas = (double *) R_alloc((size_t) npoly, sizeof(double));
double totalarea = 0.0;
int k = 0;
for (int i=0; i<ngeom; i++) {
GEOSGeom GC = (type == GEOS_MULTIPOLYGON && !empty) ?
(GEOSGeometry *) GEOSGetGeometryN_r(GEOShandle, geom, i) :
geom;
if (GEOSisEmpty_r(GEOShandle, GC)) {
SEXP ringDir,area,labpt,hole;
PROTECT(ringDir = NEW_INTEGER(1));
INTEGER_POINTER(ringDir)[0] = 1;
PROTECT(labpt = NEW_NUMERIC(2));
NUMERIC_POINTER(labpt)[0] = NA_REAL;
NUMERIC_POINTER(labpt)[1] = NA_REAL;
PROTECT(area = NEW_NUMERIC(1));
NUMERIC_POINTER(area)[0] = 0.0;
PROTECT(hole = NEW_LOGICAL(1));
LOGICAL_POINTER(hole)[0] = TRUE;
SEXP poly;
PROTECT(poly = NEW_OBJECT(MAKE_CLASS("Polygon")));
SET_SLOT(poly, install("ringDir"), ringDir);
SET_SLOT(poly, install("labpt"), labpt);
SET_SLOT(poly, install("area"), area);
SET_SLOT(poly, install("hole"), hole);
SET_SLOT(poly, install("coords"), R_NilValue);
SET_VECTOR_ELT(polys, k, poly);
UNPROTECT(5);
comm[k] = 0;
areas[k] = 0;
po[k] = k + R_OFFSET;
// modified 131004 RSB
// https://stat.ethz.ch/pipermail/r-sig-geo/2013-October/019470.html
// warning("rgeos_geospolygon2Polygons: empty Polygons object");
error("rgeos_geospolygon2Polygons: empty Polygons object");
k++;
} else {
GEOSGeom lr = (GEOSGeometry *) GEOSGetExteriorRing_r(GEOShandle, GC);
if (lr == NULL)
error("rgeos_geospolygon2Polygons: exterior ring failure");
SET_VECTOR_ELT(polys, k, rgeos_geosring2Polygon(env, lr, FALSE));
comm[k] = 0;
areas[k] = NUMERIC_POINTER( GET_SLOT(VECTOR_ELT(polys,k), install("area")) )[0];
totalarea += areas[k];
po[k] = k + R_OFFSET;
int ownerk = k + R_OFFSET;
k++;
int nirs = GEOSGetNumInteriorRings_r(GEOShandle, GC);
for (int j=0; j<nirs; j++) {
lr = (GEOSGeometry *) GEOSGetInteriorRingN_r(GEOShandle, GC, j);
if (lr == NULL)
error("rgeos_geospolygon2Polygons: interior ring failure");
SET_VECTOR_ELT(polys, k, rgeos_geosring2Polygon(env, lr, TRUE));
comm[k] = ownerk;
areas[k] = NUMERIC_POINTER( GET_SLOT(VECTOR_ELT(polys,k), install("area")) )[0];
po[k] = k + R_OFFSET;
k++;
}
}
}
SEXP plotOrder;
PROTECT(plotOrder = NEW_INTEGER(npoly)); pc++;
revsort(areas, po, npoly);
for (int i=0; i<npoly; i++)
INTEGER_POINTER(plotOrder)[i] = po[i];
SEXP labpt = GET_SLOT(VECTOR_ELT(polys,po[0]-1), install("labpt"));
SEXP area;
PROTECT(area = NEW_NUMERIC(1)); pc++;
NUMERIC_POINTER(area)[0] = totalarea;
SEXP comment;
PROTECT(comment = NEW_CHARACTER(1)); pc++;
char *buf;
int nc;
nc = (int) (ceil(log10(npoly)+1.0))+1;
buf = (char *) R_alloc((size_t) (npoly*nc)+1, sizeof(char));
SP_PREFIX(comm2comment)(buf, (npoly*nc)+1, comm, npoly);
SET_STRING_ELT(comment, 0, mkChar((const char*) buf));
SEXP ans;
PROTECT(ans = NEW_OBJECT(MAKE_CLASS("Polygons"))); pc++;
SET_SLOT(ans, install("Polygons"), polys);
SET_SLOT(ans, install("plotOrder"), plotOrder);
SET_SLOT(ans, install("labpt"), labpt);
SET_SLOT(ans, install("ID"), ID);
SET_SLOT(ans, install("area"), area);
setAttrib(ans, install("comment"), comment);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_geosring2Polygon(SEXP env, GEOSGeom lr, int hole) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
int pc=0;
GEOSCoordSeq s = (GEOSCoordSequence *) GEOSGeom_getCoordSeq_r(GEOShandle, lr);
if (s == NULL)
error("rgeos_geosring2Polygon: CoordSeq failure");
unsigned int n;
if (GEOSCoordSeq_getSize_r(GEOShandle, s, &n) == 0)
error("rgeos_geosring2Polygon: CoordSeq failure");
// Get coordinates
SEXP crd;
PROTECT(crd = rgeos_crdMatFixDir(PROTECT(rgeos_CoordSeq2crdMat(env, s, FALSE, hole)), hole)); pc += 2;
// Calculate area
GEOSGeom p = GEOSGeom_createPolygon_r(GEOShandle,GEOSGeom_clone_r(GEOShandle,lr),NULL,0);
if (p == NULL)
error("rgeos_geosring2Polygon: unable to create polygon");
SEXP area;
PROTECT(area = NEW_NUMERIC(1)); pc++;
NUMERIC_POINTER(area)[0] = 0.0;
if (!GEOSArea_r(GEOShandle, p, NUMERIC_POINTER(area)))
error("rgeos_geosring2Polygon: area calculation failure");
// Calculate label position
SEXP labpt;
PROTECT(labpt = NEW_NUMERIC(2)); pc++;
GEOSGeom centroid = GEOSGetCentroid_r(GEOShandle, p);
double xc, yc;
rgeos_Pt2xy(env, centroid, &xc, &yc);
if (!R_FINITE(xc) || !R_FINITE(yc)) {
xc = 0.0;
yc = 0.0;
for(int i=0; i != n; i++) {
xc += NUMERIC_POINTER(crd)[i];
yc += NUMERIC_POINTER(crd)[(int) (n) +i];
}
xc /= n;
yc /= n;
}
NUMERIC_POINTER(labpt)[0] = xc;
NUMERIC_POINTER(labpt)[1] = yc;
GEOSGeom_destroy_r(GEOShandle, centroid);
GEOSGeom_destroy_r(GEOShandle, p);
// Get ring direction
SEXP ringDir;
PROTECT(ringDir = NEW_INTEGER(1)); pc++;
INTEGER_POINTER(ringDir)[0] = hole ? -1 : 1;
// Get hole status
SEXP Hole;
PROTECT(Hole = NEW_LOGICAL(1)); pc++;
LOGICAL_POINTER(Hole)[0] = hole;
SEXP ans;
PROTECT(ans = NEW_OBJECT(MAKE_CLASS("Polygon"))); pc++;
SET_SLOT(ans, install("ringDir"), ringDir);
SET_SLOT(ans, install("labpt"), labpt);
SET_SLOT(ans, install("area"), area);
SET_SLOT(ans, install("hole"), Hole);
SET_SLOT(ans, install("coords"), crd);
SEXP valid;
PROTECT(valid = SP_PREFIX(Polygon_validate_c)(ans)); pc++;
if (!isLogical(valid)) {
UNPROTECT(pc);
if (isString(valid))
error(CHAR(STRING_ELT(valid, 0)));
else
error("invalid Polygon object");
}
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_geosline2SpatialLines(SEXP env, GEOSGeom geom, SEXP p4s, SEXP idlist, int nlines) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
GEOSGeom curgeom;
GEOSGeom subgeom;
GEOSCoordSeq s;
int type = GEOSGeomTypeId_r(GEOShandle, geom);
if (type != GEOS_LINESTRING && type != GEOS_MULTILINESTRING &&
type != GEOS_LINEARRING && type != GEOS_GEOMETRYCOLLECTION ) {
error("rgeos_geosline2SpatialLines: invalid type");
}
if (nlines < 1) error("rgeos_geosline2SpatialLines: invalid number of geometries");
int pc=0;
if (nlines > length(idlist))
error("rgeos_geosline2SpatialLines: nlines > length(idlist)");
SEXP bbox, lines_list;
PROTECT(bbox = rgeos_geom2bbox(env, geom)); pc++;
PROTECT(lines_list = NEW_LIST(nlines)); pc++;
for(int j = 0; j < nlines; j++) {
curgeom = (type == GEOS_GEOMETRYCOLLECTION) ?
(GEOSGeom) GEOSGetGeometryN_r(GEOShandle, geom, j) :
geom;
if (curgeom == NULL)
error("rgeos_geosline2SpatialLines: unable to get geometry collection geometry");
int curtype = GEOSGeomTypeId_r(GEOShandle, curgeom);
int n = GEOSGetNumGeometries_r(GEOShandle, curgeom);
if (n == -1) error("rgeos_geosline2SpatialLines: invalid number of geometries in current geometry");
n = n ? n : 1;
SEXP line_list;
PROTECT(line_list = NEW_LIST(n));
for(int i = 0; i < n; i++) {
subgeom = (curtype == GEOS_MULTILINESTRING && !GEOSisEmpty_r(GEOShandle, curgeom)) ?
(GEOSGeom) GEOSGetGeometryN_r(GEOShandle, curgeom, i) :
curgeom;
if(subgeom == NULL) error("rgeos_geosline2SpatialLines: unable to get subgeometry");
SEXP crdmat;
if (GEOSisEmpty_r(GEOShandle, subgeom) == 0) {
s = (GEOSCoordSeq) GEOSGeom_getCoordSeq_r(GEOShandle, subgeom);
if (s == NULL)
error("rgeos_geosline2SpatialLines: unable to generate coordinate sequence");
PROTECT( crdmat = rgeos_CoordSeq2crdMat(env, s, FALSE, FALSE));
} else {
error("rgeos_geosline2SpatialLines: empty line found");
// PROTECT( crdmat = R_NilValue);
}
SEXP line;
PROTECT(line = NEW_OBJECT(MAKE_CLASS("Line")));
SET_SLOT(line, install("coords"), crdmat);
SET_VECTOR_ELT(line_list, i, line );
UNPROTECT(2);
}
SEXP lines;
PROTECT( lines = NEW_OBJECT(MAKE_CLASS("Lines")) );
SET_SLOT(lines, install("Lines"), line_list);
char idbuf[BUFSIZ];
strcpy(idbuf, CHAR( STRING_ELT(idlist, j) ));
SEXP id;
PROTECT( id = NEW_CHARACTER(1) );
SET_STRING_ELT(id, 0, COPY_TO_USER_STRING(idbuf));
SET_SLOT(lines, install("ID"), id);
SET_VECTOR_ELT( lines_list, j, lines );
UNPROTECT(3);
}
SEXP ans;
PROTECT(ans = NEW_OBJECT(MAKE_CLASS("SpatialLines"))); pc++;
SET_SLOT(ans, install("lines"), lines_list);
SET_SLOT(ans, install("bbox"), bbox);
SET_SLOT(ans, install("proj4string"), p4s);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_distancefunc(SEXP env, SEXP spgeom1, SEXP spgeom2, SEXP byid, p_distfunc distfunc) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
GEOSGeom geom1 = rgeos_convert_R2geos(env, spgeom1);
int type1 = GEOSGeomTypeId_r(GEOShandle, geom1);
GEOSGeom geom2;
int type2;
int sym_ans = FALSE;
if (spgeom2 == R_NilValue) {
sym_ans = TRUE;
geom2 = geom1;
type2 = GEOSGeomTypeId_r(GEOShandle, geom2);
} else {
geom2 = rgeos_convert_R2geos(env, spgeom2);
type2 = GEOSGeomTypeId_r(GEOShandle, geom2);
}
int m = (LOGICAL_POINTER(byid)[0] && type1 == GEOS_GEOMETRYCOLLECTION) ?
GEOSGetNumGeometries_r(GEOShandle, geom1) : 1;
int n = (LOGICAL_POINTER(byid)[1] && type2 == GEOS_GEOMETRYCOLLECTION) ?
GEOSGetNumGeometries_r(GEOShandle, geom2) : 1;
if (m == -1) error("rgeos_distancefunc: invalid number of subgeometries in geometry 1");
if (n == -1) error("rgeos_distancefunc: invalid number of subgeometries in geometry 2");
int pc=0;
SEXP ans;
PROTECT(ans = NEW_NUMERIC(m*n)); pc++;
GEOSGeom curgeom1 = geom1;
GEOSGeom curgeom2 = geom2;
for(int i=0; i<m; i++) {
if ( m > 1) {
curgeom1 = (GEOSGeom) GEOSGetGeometryN_r(GEOShandle, geom1, i);
if (curgeom1 == NULL)
error("rgeos_binpredfunc: unable to get subgeometries from geometry 1");
}
for(int j=0; j<n; j++) {
if(sym_ans && j > i)
break;
if ( n > 1) {
curgeom2 = (GEOSGeom) GEOSGetGeometryN_r(GEOShandle, geom2, j);
if (curgeom2 == NULL)
error("rgeos_binpredfunc: unable to get subgeometries from geometry 2");
}
double dist;
if (!distfunc(GEOShandle, curgeom1, curgeom2, &dist))
error("rgeos_distancefunc: unable to calculate distance");
NUMERIC_POINTER(ans)[n*i+j] = dist;
if (sym_ans) NUMERIC_POINTER(ans)[n*j+i] = dist;
}
}
if (LOGICAL_POINTER(byid)[0] || LOGICAL_POINTER(byid)[1]) {
SEXP dims;
PROTECT(dims = NEW_INTEGER(2)); pc++;
INTEGER_POINTER(dims)[0] = n;
INTEGER_POINTER(dims)[1] = m;
setAttrib(ans, R_DimSymbol, dims);
}
GEOSGeom_destroy_r(GEOShandle, geom1);
if (!sym_ans)
GEOSGeom_destroy_r(GEOShandle, geom2);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_geosring2SpatialRings(SEXP env, GEOSGeom geom, SEXP p4s, SEXP idlist, int nrings) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
int type = GEOSGeomTypeId_r(GEOShandle, geom);
if (type != GEOS_LINEARRING && type != GEOS_GEOMETRYCOLLECTION )
error("rgeos_geosring2SpatialRings: invalid type");
if (nrings < 1) error("rgeos_geosring2SpatialRings: invalid number of geometries");
int pc=0;
SEXP bbox, rings_list;
PROTECT(bbox = rgeos_geom2bbox(env, geom)); pc++;
PROTECT(rings_list = NEW_LIST(nrings)); pc++;
for(int j = 0; j < nrings; j++) {
GEOSGeom curgeom = (type == GEOS_GEOMETRYCOLLECTION) ?
(GEOSGeom) GEOSGetGeometryN_r(GEOShandle, geom, j) :
geom;
if (curgeom == NULL)
error("rgeos_geosring2SpatialRings: unable to get geometry collection geometry");
SEXP crdmat;
if (GEOSisEmpty_r(GEOShandle, curgeom) == 0) {
GEOSCoordSeq s = (GEOSCoordSeq) GEOSGeom_getCoordSeq_r(GEOShandle, curgeom);
if (s == NULL)
error("rgeos_geosring2SpatialRings: unable to generate coordinate sequence");
PROTECT(crdmat = rgeos_crdMatFixDir(PROTECT(rgeos_CoordSeq2crdMat(env, s, FALSE, FALSE)), FALSE)); pc += 2;
} else {
PROTECT( crdmat = R_NilValue); pc++;
}
SEXP ring;
PROTECT(ring = NEW_OBJECT(MAKE_CLASS("Ring"))); pc++;
SET_SLOT(ring, install("coords"), crdmat);
SEXP id;
PROTECT( id = NEW_CHARACTER(1) ); pc++;
char idbuf[BUFSIZ];
strcpy(idbuf, CHAR( STRING_ELT(idlist, j) ));
SET_STRING_ELT(id, 0, COPY_TO_USER_STRING(idbuf));
SET_SLOT(ring, install("ID"), id);
SET_VECTOR_ELT(rings_list, j, ring );
UNPROTECT(pc);
}
SEXP ans;
PROTECT(ans = NEW_OBJECT(MAKE_CLASS("SpatialRings"))); pc++;
SET_SLOT(ans, install("rings"), rings_list);
SET_SLOT(ans, install("bbox"), bbox);
SET_SLOT(ans, install("proj4string"), p4s);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_geospolygon2SpatialPolygons(SEXP env, GEOSGeom geom, SEXP p4s, SEXP IDs, int ng) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
int pc=0;
SEXP bbox, comment;
PROTECT(bbox = rgeos_geom2bbox(env, geom)); pc++;
int type = GEOSGeomTypeId_r(GEOShandle, geom);
int empty = GEOSisEmpty_r(GEOShandle, geom);
if (ng < 1)
error("rgeos_geospolygon2SpatialPolygons: invalid number of geometries");
if (ng > length(IDs))
error("rgeos_geospolygon2SpatialPolygons: ng > length(IDs)");
SEXP pls;
PROTECT(pls = NEW_LIST(ng)); pc++;
double *areas = (double *) R_alloc((size_t) ng, sizeof(double));
int *po = (int *) R_alloc((size_t) ng, sizeof(int));
for (int i=0; i<ng; i++) {
GEOSGeom GC = (type == GEOS_GEOMETRYCOLLECTION && !empty) ?
(GEOSGeometry *) GEOSGetGeometryN_r(GEOShandle, geom, i) :
geom;
if (GC == NULL)
error("rgeos_geospolygon2SpatialPolygons: unable to get subgeometry");
SEXP poly, ID;
PROTECT( ID = NEW_CHARACTER(1));
SET_STRING_ELT(ID,0,STRING_ELT(IDs, i));
PROTECT( poly = rgeos_geospolygon2Polygons(env, GC, ID) );
areas[i] = NUMERIC_POINTER(GET_SLOT(poly, install("area")))[0];
SET_VECTOR_ELT(pls, i, poly);
po[i] = i + R_OFFSET;
UNPROTECT(2);
}
revsort(areas, po, ng);
SEXP plotOrder;
PROTECT(plotOrder = NEW_INTEGER(ng)); pc++;
for (int i=0; i<ng; i++)
INTEGER_POINTER(plotOrder)[i] = po[i];
SEXP ans;
PROTECT(ans = NEW_OBJECT(MAKE_CLASS("SpatialPolygons"))); pc++;
SET_SLOT(ans, install("polygons"), pls);
SET_SLOT(ans, install("proj4string"), p4s);
SET_SLOT(ans, install("plotOrder"), plotOrder);
SET_SLOT(ans, install("bbox"), bbox);
// RSB 120417 add top-level comment that all member Polygons
// objects have comment set
PROTECT(comment = NEW_CHARACTER(1)); pc++;
SET_STRING_ELT(comment, 0, mkChar("TRUE"));
setAttrib(ans, install("comment"), comment);
UNPROTECT(pc);
return(ans);
}
SEXP rgeos_unary_STRtree_query(SEXP env, SEXP obj) {
GEOSGeom *bbs;
int nobj, i, j, jj, pc=0;
GEOSGeom GC, bb;
SEXP pl, bblist;
GEOSSTRtree *str;
int *icard, *ids, *oids;
char classbuf[BUFSIZ];
GEOSGeom (*rgeos_xx2MP)(SEXP, SEXP);
strcpy(classbuf, CHAR(STRING_ELT(GET_CLASS(VECTOR_ELT(obj, 0)), 0)));
if (!strncmp(classbuf, "Polygons", 8))
rgeos_xx2MP = rgeos_Polygons2MP;
else if (!strncmp(classbuf, "Lines", 5))
rgeos_xx2MP = rgeos_Lines2MP;
else if (!strncmp(classbuf, "Polygon", 7))
rgeos_xx2MP = rgeos_Polygon2MP;
else
error("rgeos_binary_STRtree_query: object class %s unknown", classbuf);
GEOSContextHandle_t GEOShandle = getContextHandle(env);
str = (GEOSSTRtree *) GEOSSTRtree_create_r(GEOShandle, (size_t) 10);
nobj = length(obj);
bbs = (GEOSGeom *) R_alloc((size_t) nobj, sizeof(GEOSGeom));
ids = (int *) R_alloc((size_t) nobj, sizeof(int));
UD.ids = (int *) R_alloc((size_t) nobj, sizeof(int));
oids = (int *) R_alloc((size_t) nobj, sizeof(int));
for (i=0; i<nobj; i++) {
ids[i] = i;
pl = VECTOR_ELT(obj, i);
GC = rgeos_xx2MP(env, pl);
if (GC == NULL) {
error("rgeos_unary_STRtree_query: MP GC[%d] not created", i);
}
if ((bb = GEOSEnvelope_r(GEOShandle, GC)) == NULL) {
error("rgeos_unary_STRtree_query: envelope [%d] not created", i);
}
bbs[i] = bb;
GEOSSTRtree_insert_r(GEOShandle, str, bb, &(ids[i]));
GEOSGeom_destroy_r(GEOShandle, GC);
// 110904 EJP
}
icard = (int *) R_alloc((size_t) nobj, sizeof(int));
PROTECT(bblist = NEW_LIST(nobj-1)); pc++;
for (i=0; i<(nobj-1); i++) {
UD.count = 0;
GEOSSTRtree_query_r(GEOShandle, str, bbs[i],
(GEOSQueryCallback) cb, &UD);
for (j=0, jj=0; j<UD.count; j++) if (UD.ids[j] > i) jj++;
icard[i] = jj;
if (icard[i] > 0) {
SET_VECTOR_ELT(bblist, i, NEW_INTEGER(icard[i]));
for (j=0, jj=0; j<UD.count; j++) {
if (UD.ids[j] > i) {
oids[jj] = UD.ids[j] + R_OFFSET;
jj++;
}
}
R_isort(oids, jj);
for (j=0; j<jj; j++) {
INTEGER_POINTER(VECTOR_ELT(bblist, i))[j] = oids[j];
}
}
}
for (i=0; i<nobj; i++) {
GEOSSTRtree_remove_r(GEOShandle, str, bbs[i], &(ids[i]));
// 110904 EJP
GEOSGeom_destroy_r(GEOShandle, bbs[i]);
}
GEOSSTRtree_destroy_r(GEOShandle, str);
UNPROTECT(pc);
return(bblist);
}
SEXP rgeos_binary_STRtree_query(SEXP env, SEXP obj1, SEXP obj2) {
GEOSGeom *bbs2;
int nobj1, nobj2, i, j, pc=0, isPts=FALSE;
GEOSGeom GC, GCpts=NULL, bb;
SEXP pl, bblist;
GEOSSTRtree *str;
int *icard, *ids, *oids;
char classbuf1[BUFSIZ], classbuf2[BUFSIZ];
GEOSGeom (*rgeos_xx2MP)(SEXP, SEXP);
strcpy(classbuf1, CHAR(STRING_ELT(GET_CLASS(VECTOR_ELT(obj1, 0)), 0)));
if (!strncmp(classbuf1, "Polygons", 8))
rgeos_xx2MP = rgeos_Polygons2MP;
else if (!strncmp(classbuf1, "Lines", 5))
rgeos_xx2MP = rgeos_Lines2MP;
else
error("rgeos_binary_STRtree_query: object class %s unknown", classbuf1);
GEOSContextHandle_t GEOShandle = getContextHandle(env);
str = (GEOSSTRtree *) GEOSSTRtree_create_r(GEOShandle, (size_t) 10);
nobj1 = length(obj1);
SEXP cl2 = GET_CLASS(obj2);
if (cl2 == R_NilValue) strcpy(classbuf2, "\0");
else strcpy(classbuf2, CHAR(STRING_ELT(cl2, 0)));
if ( !strcmp( classbuf2, "SpatialPoints") ||
!strcmp(classbuf2, "SpatialPointsDataFrame")) {
isPts = TRUE;
SEXP crds = GET_SLOT(obj2, install("coords"));
SEXP dim = getAttrib(crds, install("dim"));
nobj2 = INTEGER_POINTER(dim)[0];
} else {
nobj2 = length(obj2);
}
bbs2 = (GEOSGeom *) R_alloc((size_t) nobj2, sizeof(GEOSGeom));
ids = (int *) R_alloc((size_t) nobj1, sizeof(int));
UD.ids = (int *) R_alloc((size_t) nobj1, sizeof(int));
oids = (int *) R_alloc((size_t) nobj1, sizeof(int));
for (i=0; i<nobj1; i++) {
ids[i] = i;
pl = VECTOR_ELT(obj1, i);
GC = rgeos_xx2MP(env, pl);
if (GC == NULL) {
error("rgeos_binary_STRtree_query: MP GC[%d] not created", i);
}
if ((bb = GEOSEnvelope_r(GEOShandle, GC)) == NULL) {
error("rgeos_binary_STRtree_query: envelope [%d] not created", i);
}
GEOSGeom_destroy_r(GEOShandle, GC);
GEOSSTRtree_insert_r(GEOShandle, str, bb, &(ids[i]));
}
if (isPts) {
GCpts = rgeos_SpatialPoints2geospoint(env, obj2);
} else {
strcpy(classbuf2, CHAR(STRING_ELT(GET_CLASS(VECTOR_ELT(obj2, 0)), 0)));
if (!strncmp(classbuf2, "Polygons", 8))
rgeos_xx2MP = rgeos_Polygons2MP;
else if (!strncmp(classbuf2, "Lines", 5))
rgeos_xx2MP = rgeos_Lines2MP;
else
error("rgeos_binary_STRtree_query: object class %s unknown",
classbuf2);
}
for (i=0; i<nobj2; i++) {
if (isPts) {
GC = (GEOSGeom) GEOSGetGeometryN_r(GEOShandle, GCpts, i);
} else {
pl = VECTOR_ELT(obj2, i);
GC = rgeos_xx2MP(env, pl);
}
if (GC == NULL) {
error("rgeos_binary_STRtree_query: GC[%d] not created", i);
}
if ((bb = GEOSEnvelope_r(GEOShandle, GC)) == NULL) {
error("rgeos_binary_STRtree_query: envelope [%d] not created", i);
}
GEOSGeom_destroy_r(GEOShandle, GC);
// Rprintf("i: %d, bb %s\n", i, GEOSGeomType_r(GEOShandle, bb));
bbs2[i] = bb;
}
// 110904 EJP
icard = (int *) R_alloc((size_t) nobj2, sizeof(int));
PROTECT(bblist = NEW_LIST(nobj2)); pc++;
for (i=0; i<nobj2; i++) {
UD.count = 0;
GEOSSTRtree_query_r(GEOShandle, str, bbs2[i],
(GEOSQueryCallback) cb, &UD);
icard[i] = UD.count;
if (icard[i] > 0) {
SET_VECTOR_ELT(bblist, i, NEW_INTEGER(icard[i]));
for (j=0; j<UD.count; j++) {
oids[j] = UD.ids[j] + R_OFFSET;
}
R_isort(oids, UD.count);
for (j=0; j<UD.count; j++) {
INTEGER_POINTER(VECTOR_ELT(bblist, i))[j] = oids[j];
}
}
}
GEOSSTRtree_destroy_r(GEOShandle, str);
for (i=0; i<nobj2; i++) {
GEOSGeom_destroy_r(GEOShandle, bbs2[i]);
}
UNPROTECT(pc);
return(bblist);
}
SEXP rgeos_convert_geos2R(SEXP env, GEOSGeom geom, SEXP p4s, SEXP id) {
GEOSContextHandle_t GEOShandle = getContextHandle(env);
int type = GEOSGeomTypeId_r(GEOShandle, geom);
int ng = GEOSGetNumGeometries_r(GEOShandle, geom);
if (ng == -1) error("rgeos_convert_geos2R: invalid number of subgeometries");
if (type == GEOS_GEOMETRYCOLLECTION && ng==0 && GEOSisEmpty_r(GEOShandle,geom)) {
GEOSGeom_destroy_r(GEOShandle, geom);
return(R_NilValue);
}
ng = ng ? ng : 1; // Empty MULTI type geometries return size 0
int pc=0;
SEXP ans=NULL;
switch(type) { // Determine appropriate conversion for the collection
case -1:
error("rgeos_convert_geos2R: unknown geometry type");
break;
case GEOS_POINT:
case GEOS_MULTIPOINT:
PROTECT( ans = rgeos_geospoint2SpatialPoints(env, geom, p4s, id, ng) ); pc++;
break;
case GEOS_LINEARRING:
PROTECT( ans = rgeos_geosring2SpatialRings(env, geom, p4s, id, ng)); pc++;
break;
case GEOS_LINESTRING:
case GEOS_MULTILINESTRING:
PROTECT( ans = rgeos_geosline2SpatialLines(env, geom, p4s, id, 1) ); pc++;
break;
case GEOS_POLYGON:
case GEOS_MULTIPOLYGON:
PROTECT( ans = rgeos_geospolygon2SpatialPolygons(env, geom,p4s, id, 1) ); pc++;
break;
case GEOS_GEOMETRYCOLLECTION:
{
int gctypes[] = {0,0,0,0,0,0,0,0};
int gctypen[] = {0,0,0,0,0,0,0,0};
int n=0;
int *types = (int *) R_alloc((size_t) ng, sizeof(int));
for (int i=0; i<ng; i++) {
const GEOSGeometry *subgeom = GEOSGetGeometryN_r(GEOShandle, geom, i);
if (subgeom == NULL)
error("rgeos_convert_geos2R: unable to retrieve subgeometry");
int ns = GEOSGetNumGeometries_r(GEOShandle, subgeom);
if (ns == -1) error("rgeos_convert_geos2R: invalid number of geometries in subgeometry");
ns = ns ? ns : 1;
n += ns;
types[i] = GEOSGeomTypeId_r(GEOShandle, subgeom);
if (types[i] == GEOS_GEOMETRYCOLLECTION) {
Rprintf("output subgeometry %d, row.name: %s\n", i,
CHAR(STRING_ELT(id, i)));
for (int ii=0; ii<ns; ii++)
Rprintf("subsubgeometry %d: %s\n", ii,
GEOSGeomType_r(GEOShandle,
GEOSGetGeometryN_r(GEOShandle, subgeom, ii)));
error("Geometry collections may not contain other geometry collections");
}
gctypes[ types[i] ] += 1;
gctypen[ types[i] ] += ns;
}
int isPoint = gctypes[GEOS_POINT] + gctypes[GEOS_MULTIPOINT];
int isLine = gctypes[GEOS_LINESTRING] + gctypes[GEOS_MULTILINESTRING];
int isPoly = gctypes[GEOS_POLYGON] + gctypes[GEOS_MULTIPOLYGON];
int isRing = gctypes[GEOS_LINEARRING];
int isGC = gctypes[GEOS_GEOMETRYCOLLECTION];
if ( isPoint && !isLine && !isPoly && !isRing && !isGC ) {
PROTECT( ans = rgeos_geospoint2SpatialPoints(env, geom, p4s, id, n) ); pc++;
} else if ( isLine && !isPoint && !isPoly && !isRing && !isGC ) {
PROTECT( ans = rgeos_geosline2SpatialLines(env, geom, p4s, id, ng) ); pc++;
} else if ( isPoly && !isPoint && !isLine && !isRing && !isGC ) {
PROTECT( ans = rgeos_geospolygon2SpatialPolygons(env, geom, p4s,id, ng) ); pc++;
} else if ( isRing && !isPoint && !isLine && !isPoly && !isGC ) {
PROTECT( ans = rgeos_geosring2SpatialRings(env, geom, p4s, id, ng) ); pc++;
} else {
//Rprintf("isPoint: %d isLine: %d isPoly: %d isRing: %d isGC: %d\n",isPoint, isLine, isPoly, isRing, isGC);
int m = MAX(MAX(MAX(isPoint,isLine),isPoly),isRing);
if (length(id) < m) {
char buf[BUFSIZ];
PROTECT(id = NEW_CHARACTER(m)); pc++;
for (int i=0;i<m;i++) {
sprintf(buf,"%d",i);
SET_STRING_ELT(id, i, COPY_TO_USER_STRING(buf));
}
}
GEOSGeom *GCS[4];
GCS[0] = (GEOSGeom *) R_alloc((size_t) isPoint, sizeof(GEOSGeom));
GCS[1] = (GEOSGeom *) R_alloc((size_t) isLine, sizeof(GEOSGeom));
GCS[2] = (GEOSGeom *) R_alloc((size_t) isRing, sizeof(GEOSGeom));
GCS[3] = (GEOSGeom *) R_alloc((size_t) isPoly, sizeof(GEOSGeom));
SEXP ptID, lID, rID, pID;
PROTECT(ptID = NEW_CHARACTER(isPoint)); pc++;
PROTECT(lID = NEW_CHARACTER(isLine)); pc++;
PROTECT(rID = NEW_CHARACTER(isRing)); pc++;
PROTECT(pID = NEW_CHARACTER(isPoly)); pc++;
int typei[] = {0,0,0,0};
for (int i=0; i<ng; i++) {
const GEOSGeometry *subgeom = GEOSGetGeometryN_r(GEOShandle, geom, i);
if (subgeom == NULL)
error("rgeos_convert_geos2R: unable to retrieve subgeometry");
int j = -1;
SEXP cur_id=NULL;
if (types[i]==GEOS_POINT || types[i]==GEOS_MULTIPOINT) {
j=0;
cur_id=ptID;
} else if (types[i]==GEOS_LINESTRING || types[i]==GEOS_MULTILINESTRING) {
j=1;
cur_id=lID;
} else if (types[i]==GEOS_LINEARRING) {
j=2;
cur_id=rID;
} else if (types[i]==GEOS_POLYGON || types[i]==GEOS_MULTIPOLYGON) {
j=3;
cur_id=pID;
}
if (GCS[j] == NULL)
error("rgeos_convert_geos2R: GCS element is NULL (this should never happen).");
GCS[j][ typei[j] ] = GEOSGeom_clone_r(GEOShandle, subgeom);
SET_STRING_ELT(cur_id, typei[j], STRING_ELT(id,typei[j]));
typei[j]++;
}
SEXP points = R_NilValue;
SEXP lines = R_NilValue;
SEXP rings = R_NilValue;
SEXP polys = R_NilValue;
if (isPoint) {
GEOSGeom ptGC = GEOSGeom_createCollection_r(GEOShandle, GEOS_GEOMETRYCOLLECTION, GCS[0], (unsigned int) isPoint);
PROTECT( points = rgeos_convert_geos2R(env, ptGC, p4s, ptID) ); pc++;
}
if (isLine) {
GEOSGeom lGC = GEOSGeom_createCollection_r(GEOShandle, GEOS_GEOMETRYCOLLECTION, GCS[1], (unsigned int) isLine);
PROTECT( lines = rgeos_convert_geos2R(env, lGC, p4s, lID) ); pc++;
}
if (isRing) {
GEOSGeom rGC = GEOSGeom_createCollection_r(GEOShandle, GEOS_GEOMETRYCOLLECTION, GCS[2], (unsigned int) isRing);
PROTECT( rings = rgeos_convert_geos2R(env, rGC, p4s, rID) ); pc++;
}
if (isPoly) {
GEOSGeom pGC = GEOSGeom_createCollection_r(GEOShandle, GEOS_GEOMETRYCOLLECTION, GCS[3], (unsigned int) isPoly);
PROTECT( polys = rgeos_convert_geos2R(env, pGC, p4s, pID) ); pc++;
}
PROTECT(ans = NEW_OBJECT(MAKE_CLASS("SpatialCollections"))); pc++;
SET_SLOT(ans, install("proj4string"), p4s);
SET_SLOT(ans, install("pointobj"), points);
SET_SLOT(ans, install("lineobj"), lines);
SET_SLOT(ans, install("ringobj"), rings);
SET_SLOT(ans, install("polyobj"), polys);
SEXP plotOrder;
PROTECT(plotOrder = NEW_INTEGER(4)); pc++;
INTEGER_POINTER(plotOrder)[0] = 4;
INTEGER_POINTER(plotOrder)[1] = 3;
INTEGER_POINTER(plotOrder)[2] = 2;
INTEGER_POINTER(plotOrder)[3] = 1;
SET_SLOT(ans, install("plotOrder"), plotOrder);
SEXP bbox;
PROTECT(bbox = rgeos_geom2bbox(env, geom)); pc++;
SET_SLOT(ans, install("bbox"), bbox);
}
break;
}
default:
error("rgeos_convert_geos2R: Unknown geometry type");
}
GEOSGeom_destroy_r(GEOShandle, geom);
UNPROTECT(pc);
return(ans);
}