Nothing
# Author: Robert J. Hijmans
# Date : November 2011
# Version 1.0
# Licence GPL v3
setMethod('aggregate', signature(x='SpatialPolygons'),
function(x, vars=NULL, sums=NULL, ...) {
if (! .hasSlot(x, 'data') ) {
hd <- FALSE
if (!is.null(vars)) {
if (length(vars) == length(x@polygons)) {
x <- SpatialPolygonsDataFrame(x, data=data.frame(ID=vars))
vars = 1
}
}
} else {
hd <- TRUE
}
if (isTRUE(is.null(vars))) {
if (version_GEOS0() < "3.3.0") {
x <- gUnionCascaded(x)
} else {
x <- gUnaryUnion(x)
}
if (hd) {
x <- SpatialPolygonsDataFrame(x, data=data.frame(ID=1))
}
return(x)
} else {
getVars <- function(v, cn) {
vl <- length(v)
v <- unique(v)
if (is.numeric(v)) {
v <- round(v)
v <- v[v>0 & v <= ncol(x@data)]
if (length(v) < 1) {
stop('invalid column numbers')
}
} else if (is.character(v)) {
v <- v[v %in% colnames(dat)]
if (length(v) < 1) {
stop('invalid column names')
}
}
v
}
dat <- x@data
cn <- colnames(dat)
v <- getVars(vars, cn)
dat <- dat[,v, drop=FALSE]
crs <- x@proj4string
dc <- apply(dat, 1, function(y) paste(as.character(y), collapse='_'))
dc <- data.frame(oid=1:length(dc), v=as.integer(as.factor(dc)))
id <- dc[!duplicated(dc$v), ,drop=FALSE]
id <- id[order(id$v), ]
dat <- dat[id[,1], ,drop=FALSE]
if (!is.null(sums)) {
out <- list()
for (i in 1:length(sums)) {
if (length(sums[[i]]) != 2) {
stop('argument "s" most of be list in which each element is a list of two (fun + varnames)')
}
fun = sums[[i]][[1]]
if (!is.function(fun)) {
if (is.character(fun)) {
if (tolower(fun[1]) == 'first') {
fun <- function(x) x[1]
} else if (tolower(fun[1]) == 'last') {
fun <- function(x) x[length(x)]
}
}
}
v <- getVars(sums[[i]][[2]], cn)
ag <- aggregate(x@data[,v,drop=FALSE], by=list(dc$v), FUN=fun)
out[[i]] <- ag[,-1,drop=FALSE]
}
out <- do.call(cbind, out)
dat <- cbind(dat, out)
}
if (version_GEOS0() < "3.3.0") {
x <- lapply(1:nrow(id), function(y) spChFIDs(gUnionCascaded(x[dc[dc$v==y,1],]), as.character(y)))
} else {
x <- lapply(1:nrow(id), function(y) spChFIDs(gUnaryUnion(x[dc[dc$v==y,1],]), as.character(y)))
}
x <- do.call(rbind, x)
x@proj4string <- crs
rownames(dat) <- as.character(id$v)
SpatialPolygonsDataFrame(x, data=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.