Nothing
# Author: Robert J. Hijmans
# Date : November 2011
# Version 1.0
# Licence GPL v3
if (!isGeneric("combine")) {
setGeneric("combine", function(x, y, ...)
standardGeneric("combine"))
}
setMethod('combine', signature(x='SpatialPolygons', y='SpatialPolygons'),
function(x, y, ..., keepnames=FALSE) {
x <- list(x, y, ...)
rwn <- lapply(x, row.names)
i <- sapply(rwn, length) > 0
if (!all(i)) {
if (!any(i)) {
return(x[[1]])
}
x <- x[i]
if (length(x) == 1) {
return( x[[1]] )
}
}
ln <- sapply(rwn, length)
rnu <- raster:::.uniqueNames(unlist(rwn))
end <- cumsum(ln)
start <- c(0, end[-length(end)]) + 1
for (i in 1:length(x)) {
if (keepnames) {
if (! all(rnu[start[i]:end[i]] == rwn[[i]]) ) {
row.names(x[[i]]) <- rnu[start[i]:end[i]]
}
} else {
row.names(x[[i]]) <- as.character(start[i]:end[i])
}
}
cls <- sapply(x, class)
if (all(cls == 'SpatialPolygons')) {
return( do.call( rbind, x))
}
if (all(cls == 'SpatialPolygonsDataFrame')) {
dat <- lapply( x, function(x) { slot(x, 'data') } )
dat <- do.call(.frbind, dat)
x <- sapply(x, function(y) as(y, 'SpatialPolygons'))
x <- do.call( rbind, x)
rownames(dat) <- row.names(x)
return( SpatialPolygonsDataFrame(x, dat) )
}
dat <- NULL
# dataFound <- FALSE
for (i in 1:length(x)) {
if (.hasSlot(x[[i]], 'data')) {
# dataFound <- TRUE
if (is.null(dat)) {
dat <- x[[i]]@data
} else {
dat <- .frbind(dat, x[[i]]@data)
}
} else {
if ( is.null(dat)) {
dat <- data.frame()
dat[1:length(x[[i]]@polygons),] <- NA
rownames(dat) <- row.names(x[[i]])
} else {
dat[(nrow(dat)+1):(nrow(dat)+nrow(x[[i]]@coords)),] <- NA
}
}
}
# if (! dataFound ) { return( do.call(rbind, x) ) }
x <- sapply(x, function(x) as(x, 'SpatialPolygons'))
x <- do.call(rbind, x)
SpatialPolygonsDataFrame(x, dat)
}
)
setMethod('combine', signature(x='SpatialLines', y='SpatialLines'),
function(x, y, ..., keepnames=FALSE) {
x <- list(x, y, ...)
rwn <- lapply(x, row.names)
i <- sapply(rwn, length) > 0
if (!all(i)) {
if (!any(i)) {
return(x[[1]])
}
x <- x[i]
if (length(x) == 1) {
return( x[[1]] )
}
}
ln <- sapply(rwn, length)
rnu <- raster:::.uniqueNames(unlist(rwn))
end <- cumsum(ln)
start <- c(0, end[-length(end)]) + 1
for (i in 1:length(x)) {
if (keepnames) {
if (! all(rnu[start[i]:end[i]] == rwn[[i]]) ) {
row.names(x[[i]]) <- rnu[start[i]:end[i]]
}
} else {
row.names(x[[i]]) <- as.character(start[i]:end[i])
}
}
cls <- sapply(x, class)
if (all(cls == 'SpatialLines')) {
return( do.call( rbind, x))
}
if (all(cls == 'SpatialLinesDataFrame')) {
dat <- lapply( x, function(x) { slot(x, 'data') } )
dat <- do.call(.frbind, dat)
x <- sapply(x, function(y) as(y, 'SpatialLines'))
x <- do.call( rbind, x)
rownames(dat) <- row.names(x)
return( SpatialLinesDataFrame(x, dat) )
}
dat <- NULL
# dataFound <- FALSE
for (i in 1:length(x)) {
if (.hasSlot(x[[i]], 'data')) {
# dataFound <- TRUE
if (is.null(dat)) {
dat <- x[[i]]@data
} else {
dat <- .frbind(dat, x[[i]]@data)
}
} else {
if ( is.null(dat)) {
dat <- data.frame()
dat[1:length(x[[i]]@lines),] <- NA
rownames(dat) <- row.names(x[[i]])
} else {
dat[(nrow(dat)+1):(nrow(dat)+nrow(x[[i]]@coords)),] <- NA
}
}
}
# if (! dataFound ) { return( do.call(rbind, x) ) }
x <- sapply(x, function(x) as(x, 'SpatialLines'))
x <- do.call(rbind, x)
SpatialLinesDataFrame(x, dat)
}
)
setMethod('combine', signature(x='SpatialPoints', y='SpatialPoints'),
function(x, y, ..., keepnames=FALSE) {
x <- list(x, y, ...)
rwn <- lapply(x, row.names)
i <- sapply(rwn, length) > 0
if (!all(i)) {
if (!any(i)) {
return(x[[1]])
}
x <- x[i]
if (length(x) == 1) {
return( x[[1]] )
}
}
ln <- sapply(rwn, length)
rnu <- raster:::.uniqueNames(unlist(rwn))
end <- cumsum(ln)
start <- c(0, end[-length(end)]) + 1
for (i in 1:length(x)) {
if (keepnames) {
if (! all(rnu[start[i]:end[i]] == rwn[[i]]) ) {
row.names(x[[i]]) <- rnu[start[i]:end[i]]
}
} else {
row.names(x[[i]]) <- as.character(start[i]:end[i])
}
}
cls <- sapply(x, class)
if (all(cls == 'SpatialPoints')) {
return( do.call( rbind, x))
}
if (all(cls == 'SpatialPointsDataFrame')) {
dat <- lapply( x, function(x) { slot(x, 'data') } )
dat <- do.call(.frbind, dat)
x <- sapply(x, function(y) as(y, 'SpatialPoints'))
x <- do.call( rbind, x)
rownames(dat) <- row.names(x)
return( SpatialPointsDataFrame(x, dat) )
}
dat <- NULL
for (i in 1:length(x)) {
if (.hasSlot(x[[i]], 'data')) {
if (is.null(dat)) {
dat <- x[[i]]@data
} else {
dat <- .frbind(dat, x[[i]]@data)
}
} else {
if ( is.null(dat)) {
dat <- data.frame()
dat[1:nrow(x[[i]]@coords),] <- NA
rownames(dat) <- row.names(x[[i]])
} else {
dat[(nrow(dat)+1):(nrow(dat)+nrow(x[[i]]@coords)),] <- NA
}
}
}
# if (! dataFound ) { return( do.call(rbind, x) ) }
x <- sapply(x, function(x) as(x, 'SpatialPoints'))
x <- do.call(rbind, x)
SpatialPoinsDataFrame(x, dat)
}
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.