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