point.in.polygon = function(point.x, point.y, pol.x, pol.y,
mode.checked=FALSE) {
if (mode.checked) res <- .Call(R_point_in_polygon_sp, point.x,
point.y, pol.x, pol.y)
else res <- .Call(R_point_in_polygon_sp, as.numeric(point.x),
as.numeric(point.y), as.numeric(pol.x), as.numeric(pol.y))
res
}
pointsInPolygon = function(pts, Polygon,
mode.checked=FALSE) {
pts = coordinates(pts)
cc = slot(Polygon, "coords")
point.in.polygon(pts[,1], pts[,2], cc[,1], cc[,2],
mode.checked=mode.checked)
}
pointsInPolygons = function(pts, Polygons, #which = FALSE,
mode.checked=FALSE) {
rings = slot(Polygons, "Polygons")
res = matrix(unlist(lapply(rings, function(x, pts)
pointsInPolygon(pts, x, mode.checked=mode.checked),
pts = pts)), ncol=length(rings))
res <- res > 0
# holes <- sapply(rings, function(y) slot(y, "hole"))
# areas <- sapply(rings, function(x) slot(x, "area"))
# if (any(holes) && any(res[,holes])) {
# holerows <- which(res[,holes,drop=FALSE], arr.ind=TRUE)[,1]
# odd <- rowSums(res[holerows,,drop=FALSE])%%2 != 0
# for (i in seq(along = holerows)) {
# in_p <- which.min(areas[res[holerows[i],,drop=FALSE]])
# res[holerows[i],] <- FALSE
# if (odd[i]) res[holerows[i], in_p] <- TRUE
# }
# res[,holes] <- FALSE
# }
# revised 100716
ret <- rowSums(res) %% 2 != 0
# ret <- apply(res, 1, any)
# if (which) {
# reta <- integer(length(ret))
# for (i in seq(along = ret)) {
# if (ret[i]) reta[i] <- which(res[i,])
# else reta[i] <- as.integer(NA)
# }
# ret <- reta
# }
ret
}
pointsInSpatialPolygons0 = function(pts, SpPolygons) {
sr = slot(SpPolygons, "polygons")
res = lapply(sr, function(x, pts) pointsInPolygons(pts, x), pts = pts)
#ret = rep(as.numeric(NA), nrow(coordinates(pts)))
#for (i in seq(along = res))
# ret[res[[i]] > 0] = i
#apply(do.call(rbind, res), 2, which)
do.call(rbind, res)
}
pointsInSpatialPolygons = function(pts, SpPolygons, returnList = FALSE) {
pls = slot(SpPolygons, "polygons")
lb <- lapply(pls, function(x) as.double(bbox(x)))
cpts <- coordinates(pts)
storage.mode(cpts) <- "double"
mode.checked <- storage.mode(cpts) == "double"
cand <- .Call(tList, .Call(pointsInBox, lb, cpts[,1], cpts[,2]),
as.integer(length(pls)))
# rm(cand0)
# gc(verbose=FALSE)
res <- pointsInPolys2(pls, cand, cpts, mode.checked=mode.checked,
returnList = returnList)
res
}
pointsInPolys2 <- function(pls, cand, pts, mode.checked=FALSE,
returnList = FALSE) {
n <- nrow(pts)
if (returnList)
#res = sapply(1:length(pls), function(x) integer(0))
res <- rep.int(list(integer()), length(pls))
else
res <- rep(as.integer(NA), n)
# print(cand)
for (i in seq_along(cand)) {
candi <- cand[[i]]
if (length(candi) > 0) {
ptsi <- pts[candi,,drop=FALSE]
ret <- pointsInPolygons(ptsi, pls[[i]], mode.checked=mode.checked)
#for (j in seq(along=candi)) {
# jj <- candi[j]
# if (is.na(res[jj]))
# res[jj] <- ifelse(ret[j], i, as.integer(NA))
#}
if (returnList)
res[[i]] = candi[ret]
else
res[candi[ret]] = i
}
}
res
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.