https://github.com/cran/spacetime
Raw File
Tip revision: c93f373f662058fb9290fc44219339dfb712d2fb authored by Edzer Pebesma on 15 November 2011, 06:50:00 UTC
version 0.5-7
Tip revision: c93f373
stplot.R
if (!isGeneric("stplot"))
	setGeneric("stplot", function(obj, ...)
		standardGeneric("stplot"))

stplot.STFDF = function(obj, names.attr = as.character(index(obj@time)),
		..., as.table = TRUE, at, cuts = 15, 
		animate = 0, mode = "xy", scaleX = 0, 
		auto.key = TRUE, key.space = "right") {
	ind = sp.ID = NULL # keep R CMD check happy in R 2.13 
    z = names(obj@data)[1]
	if (missing(at))
		at = seq(min(obj[[z]], na.rm = TRUE), max(obj[[z]], na.rm = TRUE), 
			length.out = cuts + 1)
	if (mode == "ts") { # multiple time series
		if (length(names(obj@data)) > 1) # , stack, add | which.var
			xyplot(values ~ time | ind, stack(obj), groups = sp.ID, 
				type = 'l',auto.key = auto.key, as.table = as.table, ...)
		else
			xyplot(as.formula(paste(z, "~", "time")), 
				as.data.frame(obj), groups = sp.ID, 
				type = 'l',auto.key = auto.key, as.table = as.table, ...)
	} else if (mode == "tp") { # time series in multiple panels
    	if (ncol(obj@data) == 1)
			xyplot(as.formula(paste(z, "~ time | sp.ID")), 
				as.data.frame(obj), type = 'l', auto.key = auto.key, 
				key.space = key.space, as.table = as.table, ...)
		else {
			n = names(obj@data)
			df = as.data.frame(obj)
			st = stack(df, n) # values ~ ind
			st$time = df$time
			st$sp.ID = df$sp.ID
			xyplot(as.formula(paste("values ~ time | sp.ID")), 
				st, type = 'l', groups = ind,
				key.space = key.space, auto.key = auto.key, 
				as.table = as.table, ...)
		}
	} else if (mode == "xt") { # space-time cross section == Hovmoeller
		dots = list(...)
		scales = dots$scales
		if (is.null(scales))
			scales = list(draw=TRUE)
		else
			scales$draw = TRUE
		s = sp:::longlat.scales(obj@sp, scales, xlim = bbox(obj@sp)[1,], ylim = bbox(obj@sp)[2,])
		cn = coordnames(obj@sp)
		if (scaleX == 1) {
			scales["x"] = s["x"]
			f = as.formula(paste(z, "~", cn[1], "+ time"))
		} else if (scaleX == 2) {
			scales["x"] = s["y"]
			f = as.formula(paste(z, "~", cn[2], "+ time"))
		} else
			f = as.formula(paste(z, "~ sp.ID + time"))
		dots$scales = scales
		dots = append(list(f, as.data.frame(obj), at = at,
			cuts = cuts, as.table = as.table), dots)
		do.call(levelplot, dots)
	} else { # multiple spplots: panel for each time step.
    	form = as.formula(paste(z, "~ time"))
    	sp = geometry(obj@sp)
    	df = data.frame(unstack(as.data.frame(obj), form))
		x = addAttrToGeom(sp, df, match.ID=FALSE)
		## OR:
		## x = as(obj, "Spatial")
		## x@data = data.frame(x@data) # cripples column names
		if (animate > 0) {
			i = 0
			while (TRUE) {
				i = i + 1
				if (i > ncol(df)) 
					i = 1
				print(spplot(x[,i], main = names.attr[i], at = at, 
					as.table = as.table, auto.key = auto.key, 
					key.space = key.space, ...))
				Sys.sleep(animate)
			}
		} else
			spplot(x, names.attr = names.attr, as.table = as.table, at = at,
				cuts = cuts, auto.key = auto.key, key.space = key.space, ...)
	}
}

#stplot.STIDF = function(obj, names.attr = index(obj@time), ...)
#	stplot(as(obj, "STFDF"), names.attr = names.attr, ...)

panel.stpointsplot = function(x, y, col, sp.layout, ...) {
    sp:::sp.panel.layout(sp.layout, panel.number())
	panel.xyplot(x, y, col = col, ...)
}

stplot.STIDF = function(obj, names.attr = NULL, ..., 
		as.table = TRUE, by = c("time", "burst", "id"), 
		scales = list(draw=FALSE), xlab = NULL, ylab = NULL, 
		type = 'p', number = 6, overlap = 0, asp,
		col = 1, panel = panel.stpointsplot, sp.layout = NULL) {
	f =  paste(rev(coordnames(obj@sp)), collapse=" ~ ")
	by = by[1]
	f = paste(f, "|", by)
	if (missing(asp))
		asp = mapasp(obj@sp)
	obj = as.data.frame(obj)
	if (is.numeric(number) && number > 1)
		obj$time = equal.count(obj$time, number = number, overlap = overlap)
	xyplot(as.formula(f), obj, asp = asp, type = type,
		as.table = as.table, scales = scales, xlab = xlab, ylab = ylab, 
		panel = panel, sp.layout = sp.layout, ...)
}


setMethod("stplot", signature("STFDF"),  stplot.STFDF)

setMethod("stplot", signature("STSDF"), stplot.STIDF)

setMethod("stplot", signature("STIDF"), stplot.STIDF)

setMethod("stplot", signature("STIDFtraj"),
	function(obj, ..., names.attr = NULL, by = "burst", type = 'l')
		stplot.STIDF(obj, names.attr = names.attr, by = by, type = type, ...)
)

stackST = function(x, select, ...) {
	nc = ncol(x@data)
	df = stack(x@data)
	g = as.data.frame(geometry(x))
	gf = do.call(rbind, lapply(1:nc, function(x) g))
	data.frame(gf, df)
}
stack.STFDF = stackST
stack.STSDF = stackST
stack.STIDF = stackST
back to top