void SP_PREFIX(FindCG)( int n, tPointd *P, tPointd CG, double *Areasum2) { int i; double A2; /* Partial area sum */ tPointd Cent3; CG[0] = 0; CG[1] = 0; Areasum2[0] = 0; for (i = 1; i < n-1; i++) { SP_PREFIX(Centroid3)( P[0], P[i], P[i+1], Cent3 ); A2 = SP_PREFIX(Area2)( P[0], P[i], P[i+1]); CG[0] += A2 * Cent3[0]; CG[1] += A2 * Cent3[1]; Areasum2[0] += A2; } CG[0] /= 3 * Areasum2[0]; CG[1] /= 3 * Areasum2[0]; return; }
SEXP SP_PREFIX(SpatialPolygons_c)(SEXP pls, SEXP pO, SEXP p4s) { SEXP ans, bbox; int pc=0; PROTECT(ans = NEW_OBJECT(MAKE_CLASS("SpatialPolygons"))); pc++; SET_SLOT(ans, install("polygons"), pls); SET_SLOT(ans, install("proj4string"), p4s); if (pO == R_NilValue) { SET_SLOT(ans, install("plotOrder"), SP_PREFIX(SpatialPolygons_plotOrder_c)(pls)); } else { SET_SLOT(ans, install("plotOrder"), pO); } PROTECT(bbox = SP_PREFIX(bboxCalcR_c(pls))); pc++; SET_SLOT(ans, install("bbox"), bbox); UNPROTECT(pc); return(ans); }
void SP_PREFIX(spRFindCG_c)( SEXP n, SEXP coords, double *xc, double *yc, double *area ) { int i, nn; tPointd *P; tPointd CG; double Areasum2; nn = INTEGER_POINTER(n)[0]; P = (tPointd *) R_alloc((size_t) nn, sizeof(tPointd)); for (i=0; i<nn; i++) { P[i][0] = NUMERIC_POINTER(coords)[i]; P[i][1] = NUMERIC_POINTER(coords)[i+nn]; } SP_PREFIX(FindCG)(nn, P, CG, &Areasum2); xc[0] = CG[0]; yc[0] = CG[1]; area[0] = Areasum2/2; return; }
SEXP SP_PREFIX(Polygon_c)(SEXP coords, SEXP n, SEXP ihole) { SEXP SPans, labpt, Area, ringDir, hole; double area, xc, yc; double *x, *y; int pc=0, rev=FALSE; int i, ii, nn=INTEGER_POINTER(n)[0]; SEXP valid; for (i=0; i<nn; i++) { if(!R_FINITE(NUMERIC_POINTER(coords)[i])) error("non-finite x coordinate"); if(!R_FINITE(NUMERIC_POINTER(coords)[i+nn])) error("non-finite y coordinate"); } SP_PREFIX(spRFindCG_c)(n, coords, &xc, &yc, &area); if (fabs(area) < DOUBLE_EPS) { if (!R_FINITE(xc) || !R_FINITE(xc)) { if (nn == 1) { xc = NUMERIC_POINTER(coords)[0]; yc = NUMERIC_POINTER(coords)[1]; } else if (nn == 2) { xc = (NUMERIC_POINTER(coords)[0]+NUMERIC_POINTER(coords)[1])/2.0; yc = (NUMERIC_POINTER(coords)[2]+NUMERIC_POINTER(coords)[3])/2.0; } else if (nn > 2) { xc = (NUMERIC_POINTER(coords)[0] + NUMERIC_POINTER(coords)[(nn-1)])/2.0; yc = (NUMERIC_POINTER(coords)[nn] + NUMERIC_POINTER(coords)[nn+(nn-1)])/2.0; } } } PROTECT(SPans = NEW_OBJECT(MAKE_CLASS("Polygon"))); pc++; PROTECT(ringDir = NEW_INTEGER(1)); pc++; INTEGER_POINTER(ringDir)[0] = (area > 0.0) ? -1 : 1; // -1 cw hole, 1 ccw not-hole /* RSB 100126 fixing hole assumption thanks to Javier Munoz for report */ if (INTEGER_POINTER(ihole)[0] == NA_INTEGER) { // trust ring direction if (INTEGER_POINTER(ringDir)[0] == 1) { INTEGER_POINTER(ihole)[0] = 0; } else if (INTEGER_POINTER(ringDir)[0] == -1) { INTEGER_POINTER(ihole)[0] = 1; } } else { // trust hole if (INTEGER_POINTER(ihole)[0] == 1 && INTEGER_POINTER(ringDir)[0] == 1) { rev = TRUE; INTEGER_POINTER(ringDir)[0] = -1; } if (INTEGER_POINTER(ihole)[0] == 0 && INTEGER_POINTER(ringDir)[0] == -1) { rev = TRUE; INTEGER_POINTER(ringDir)[0] = 1; } } PROTECT(hole = NEW_LOGICAL(1)); pc++; if (INTEGER_POINTER(ihole)[0] == 1) LOGICAL_POINTER(hole)[0] = TRUE; else LOGICAL_POINTER(hole)[0] = FALSE; if (rev) { x = (double *) R_alloc((size_t) nn, sizeof(double)); y = (double *) R_alloc((size_t) nn, sizeof(double)); for (i=0; i<nn; i++) { x[i] = NUMERIC_POINTER(coords)[i]; y[i] = NUMERIC_POINTER(coords)[i+nn]; } for (i=0; i<nn; i++) { ii = (nn-1)-i; NUMERIC_POINTER(coords)[ii] = x[i]; NUMERIC_POINTER(coords)[ii+nn] = y[i]; } } SET_SLOT(SPans, install("coords"), coords); PROTECT(labpt = NEW_NUMERIC(2)); pc++; NUMERIC_POINTER(labpt)[0] = xc; NUMERIC_POINTER(labpt)[1] = yc; SET_SLOT(SPans, install("labpt"), labpt); PROTECT(Area = NEW_NUMERIC(1)); pc++; NUMERIC_POINTER(Area)[0] = fabs(area); SET_SLOT(SPans, install("area"), Area); SET_SLOT(SPans, install("hole"), hole); SET_SLOT(SPans, install("ringDir"), ringDir); PROTECT(valid = SP_PREFIX(Polygon_validate_c)(SPans)); pc++; if (!isLogical(valid)) { UNPROTECT(pc); if (isString(valid)) error(CHAR(STRING_ELT(valid, 0))); else error("invalid Polygon object"); } UNPROTECT(pc); return(SPans); }
SEXP SP_PREFIX(Polygons_c)(SEXP pls, SEXP ID) { SEXP ans, labpt, Area, plotOrder, crds, pl, n, hole; int nps, i, pc=0, sumholes; double *areas, *areaseps, fuzz; int *po, *holes; SEXP valid; nps = length(pls); fuzz = R_pow(DOUBLE_EPS, (2.0/3.0)); areas = (double *) R_alloc((size_t) nps, sizeof(double)); areaseps = (double *) R_alloc((size_t) nps, sizeof(double)); holes = (int *) R_alloc((size_t) nps, sizeof(int)); for (i=0, sumholes=0; i<nps; i++) { areas[i] = NUMERIC_POINTER(GET_SLOT(VECTOR_ELT(pls, i), install("area")))[0]; holes[i] = LOGICAL_POINTER(GET_SLOT(VECTOR_ELT(pls, i), install("hole")))[0]; areaseps[i] = holes[i] ? areas[i] + fuzz : areas[i]; sumholes += holes[i]; } po = (int *) R_alloc((size_t) nps, sizeof(int)); if (nps > 1) { for (i=0; i<nps; i++) po[i] = i + R_OFFSET; revsort(areaseps, po, nps); } else { po[0] = 1; } if (sumholes == nps) { crds = GET_SLOT(VECTOR_ELT(pls, (po[0] - R_OFFSET)), install("coords")); PROTECT(n = NEW_INTEGER(1)); pc++; INTEGER_POINTER(n)[0] = INTEGER_POINTER(getAttrib(crds, R_DimSymbol))[0]; PROTECT(hole = NEW_LOGICAL(1)); pc++; LOGICAL_POINTER(hole)[0] = FALSE; pl = SP_PREFIX(Polygon_c)(crds, n, hole); /* bug 100417 Patrick Giraudoux */ holes[po[0] - R_OFFSET] = LOGICAL_POINTER(hole)[0]; SET_VECTOR_ELT(pls, (po[0] - R_OFFSET), pl); } PROTECT(ans = NEW_OBJECT(MAKE_CLASS("Polygons"))); pc++; SET_SLOT(ans, install("Polygons"), pls); SET_SLOT(ans, install("ID"), ID); PROTECT(Area = NEW_NUMERIC(1)); pc++; NUMERIC_POINTER(Area)[0] = 0.0; for (i=0; i<nps; i++) { NUMERIC_POINTER(Area)[0] += holes[i] ? 0.0 : fabs(areas[i]); } SET_SLOT(ans, install("area"), Area); PROTECT(plotOrder = NEW_INTEGER(nps)); pc++; for (i=0; i<nps; i++) INTEGER_POINTER(plotOrder)[i] = po[i]; SET_SLOT(ans, install("plotOrder"), plotOrder); PROTECT(labpt = NEW_NUMERIC(2)); pc++; NUMERIC_POINTER(labpt)[0] = NUMERIC_POINTER(GET_SLOT(VECTOR_ELT(pls, (po[0]-1)), install("labpt")))[0]; NUMERIC_POINTER(labpt)[1] = NUMERIC_POINTER(GET_SLOT(VECTOR_ELT(pls, (po[0]-1)), install("labpt")))[1]; SET_SLOT(ans, install("labpt"), labpt); PROTECT(valid = SP_PREFIX(Polygons_validate_c)(ans)); pc++; if (!isLogical(valid)) { UNPROTECT(pc); if (isString(valid)) error(CHAR(STRING_ELT(valid, 0))); else error("invalid Polygons object"); } 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_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); }