1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88
|
checkCRSequal = function(dots) {
if (length(dots) > 1) {
p1 = proj4string(dots[[1]])
res = unlist(lapply(dots[-1], function(x) identical(proj4string(x), p1)))
if (any(!res))
#if (!isTRUE(all.equal(proj4string(obj), proj4string(x))))
stop("coordinate reference systems differ")
}
}
makeUniqueIDs <- function(lst) {
ids = sapply(lst, function(i) slot(i, "ID"))
if (any(duplicated(ids))) {
ids <- make.unique(as.character(unlist(ids)), sep = "")
for (i in seq(along = ids))
lst[[i]]@ID = ids[i]
}
lst
}
rbind.SpatialPoints <- function(...) {
dots = list(...)
names(dots) <- NULL
checkCRSequal(dots)
SpatialPoints(do.call("rbind", lapply(list(...), coordinates)), CRS(proj4string(dots[[1]])))
}
rbind.SpatialPointsDataFrame <- function(...) {
dots = list(...)
names(dots) <- NULL # bugfix Clement Calenge 100417
sp = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPoints")))
df = do.call("rbind", lapply(dots, function(x) x@data))
SpatialPointsDataFrame(sp, df, coords.nrs = dots[[1]]@coords.nrs)
}
rbind.SpatialPixels = function(...) {
dots = list(...)
names(dots) <- NULL
sp = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPoints")))
gridded(sp) = T
sp
}
rbind.SpatialPixelsDataFrame = function(...) {
dots = list(...)
names(dots) <- NULL
sp = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPointsDataFrame")))
gridded(sp) = T
sp
}
rbind.SpatialPolygons = function(..., makeUniqueIDs = FALSE) {
dots = list(...)
names(dots) <- NULL
checkCRSequal(dots)
# checkIDSclash(dots)
pl = do.call("c", lapply(dots, function(x) slot(x, "polygons")))
if (makeUniqueIDs)
pl = makeUniqueIDs(pl)
SpatialPolygons(pl, proj4string = CRS(proj4string(dots[[1]])))
}
rbind.SpatialPolygonsDataFrame <- function(...) {
dots = list(...)
names(dots) <- NULL # bugfix Clement Calenge 100417
pl = do.call("rbind", lapply(dots, function(x) as(x, "SpatialPolygons")))
df = do.call("rbind", lapply(dots, function(x) x@data))
SpatialPolygonsDataFrame(pl, df)
}
rbind.SpatialLines = function(..., makeUniqueIDs = FALSE) {
dots = list(...)
names(dots) <- NULL
checkCRSequal(dots)
ll = do.call("c", lapply(dots, function(x) slot(x, "lines")))
if (makeUniqueIDs)
ll = makeUniqueIDs(ll)
SpatialLines(ll, proj4string = CRS(proj4string(dots[[1]])))
}
rbind.SpatialLinesDataFrame <- function(...) {
dots = list(...)
names(dots) <- NULL # bugfix Clement Calenge 100417
ll = do.call("rbind", lapply(dots, function(x) as(x, "SpatialLines")))
df = do.call("rbind", lapply(dots, function(x) x@data))
SpatialLinesDataFrame(ll, df)
}
|