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); }