# from sp: .index2list = function(x, returnList) { if (returnList) { l = lapply(1:length(x), function(x) { integer(0) }) notNA = !is.na(x) l[notNA] = x[notNA] l } else x } over.xts = function(x, y, returnList = FALSE, fn = NULL, ...) { ix = index(x) iy = index(y) if (returnList) { # get all matches: tm = timeMatch(ix, iy, returnList = TRUE) stopifnot(is.null(fn)) lapply(tm, function(P) { y[P, drop=FALSE] }) } else { tm = timeMatch(ix, iy, returnList = FALSE) if (is.null(fn)) { # get first match: if (any(is.na(tm))) { # will lead to error, because [.xts doesn't handle NA's nas = which(is.na(tm)) tm[nas] = nas y[nas,] = NA } y[tm,] } else { l = lapply(tm, function(P) { apply(y[P, drop=FALSE], 2, fn, ...) }) ret = do.call(rbind, l) xts(ret, ix) } } } setMethod("over", signature(x = "xts", y = "xts"), over.xts) # y = STF: over.STF.STF = function(x, y, returnList = FALSE, fn = NULL, ...) { if (returnList) { space.index = over(x@sp, y@sp, returnList = TRUE) time.index = timeMatch(x, y, returnList = TRUE) n = length(y@sp) lst = vector("list", length(space.index) * length(time.index)) k = 1 for (i in seq(along = time.index)) { for (j in seq(along = space.index)) { nj = length(space.index[[j]]) if (length(time.index[[i]]) == 0 || length(space.index[[j]]) == 0) lst[[k]] = integer(0) else lst[[k]] = rep((time.index[[i]] - 1) * n, each = nj) + space.index[[j]] k = k + 1 } } lst } else { space.index = over(x@sp, y@sp) time.index = rep(timeMatch(x, y), each = length(space.index)) # compute the index of x in y as y is STF: (time.index - 1) * length(y@sp) + space.index # space.index gets recycled } } setMethod("over", signature(x = "STF", y = "STF"), over.STF.STF) over.STS.STF = function(x, y, returnList = FALSE, fn = NULL, ...) { space.index = over(x@sp, y@sp)[x@index[,1]] time.index = timeMatch(x, y)[x@index[,2]] # compute the index of x in y as y is STF: idx = (time.index - 1) * length(y@sp) + space.index .index2list(idx, returnList) } setMethod("over", signature(x = "STS", y = "STF"), over.STS.STF) over.STI.STF = function(x, y, returnList = FALSE, fn = NULL, ...) { #if (returnList) warning("returnList not supported yet") space.index = over(x@sp, y@sp) time.index = timeMatch(x, y, returnList) # compute the index of x in y as y is STF: idx = (unlist(time.index) - 1) * length(y@sp) + unlist(space.index) .index2list(idx, returnList) } setMethod("over", signature(x = "STI", y = "STF"), over.STI.STF) # y = STI: over.STF.STI = function(x, y, returnList = FALSE, fn = NULL, ...) over(as(x, "STS"), y, returnList = returnList, fn=fn, ...) setMethod("over", signature(x = "STF", y = "STI"), over.STF.STI) over.STS.STI = function(x, y, returnList = FALSE, fn = NULL, ...) over(as(x, "STI"), y, returnList = returnList, fn=fn, ...) setMethod("over", signature(x = "STS", y = "STI"), over.STS.STI) over.STI.STI = function(x, y, returnList = FALSE, fn = NULL, ...) { #if (returnList) warning("returnList not fully supported yet") lst = list(index(x@time), index(y@time), returnList = TRUE) if (any(x@endTime > as.POSIXct(index(x@time)))) lst[["end.x"]] = x@endTime if (any(y@endTime > as.POSIXct(index(y@time)))) lst[["end.y"]] = y@endTime #print(lst) time.index = do.call(timeMatch, lst) #print(time.index) ret = lapply(1:length(time.index), function(i) { ti = time.index[[i]] # the x[i] matching y entry indices if (length(ti) > 0) over(x@sp[i,], y@sp[ti,], returnList = TRUE)[[1]] + (ti - 1) else integer(0) }) if (! returnList) ret = unlist(lapply(ret, function(x) { x[1] })) ret } setMethod("over", signature(x = "STI", y = "STI"), over.STI.STI) # y = STS: over.ST.STS = function(x, y, returnList = FALSE, fn = NULL, ...) { if (returnList) warning("returnList not fully supported yet") ret = over(x, STF(y@sp, y@time), returnList = returnList, fn = fn) ix.sts = (y@index[,2] - 1) * length(y@sp) + y@index[,1] ix.stf = rep(as.integer(NA), nrow(y@time) * length(y@sp)) ix.stf[ix.sts] = 1:nrow(y@index) ix.stf[ret] } setMethod("over", signature(x = "ST", y = "STS"), over.ST.STS) overDFGenericST = function(x, y, returnList = FALSE, fn = NULL, ...) { stopifnot(identical(proj4string(x),proj4string(y))) if (is.null(fn) && !returnList) { r = over(x, geometry(y), returnList = FALSE) ret = y@data[r,,drop=FALSE] } else { r = over(x, geometry(y), returnList = TRUE) ret = sp:::.overDF(r, y@data, length(x), returnList, fn, ...) } if (!returnList) row.names(ret) = row.names(x) ret } setMethod("over", signature(x = "STF", y = "STFDF"), overDFGenericST) setMethod("over", signature(x = "STS", y = "STFDF"), overDFGenericST) setMethod("over", signature(x = "STI", y = "STFDF"), overDFGenericST) setMethod("over", signature(x = "STF", y = "STSDF"), overDFGenericST) setMethod("over", signature(x = "STS", y = "STSDF"), overDFGenericST) setMethod("over", signature(x = "STI", y = "STSDF"), overDFGenericST) setMethod("over", signature(x = "STF", y = "STIDF"), overDFGenericST) setMethod("over", signature(x = "STS", y = "STIDF"), overDFGenericST) setMethod("over", signature(x = "STI", y = "STIDF"), overDFGenericST)