tests/tracks.R

In trajectories: Classes and Methods for Trajectory Data

Sys.setenv(TZ = "Europe/Berlin")
# Load required libraries.

library(sp)
library(spacetime)
library(trajectories)

# Create test objects. Do not change! Changes to the test objects are likely to
# have an impact on the test results. It is primarily validated against class
# and dimension. However, the test functions check for the first dimension only,
# since, in the majority of cases, a deviation of the second is not necessarily
# associated with a regression.

# t0 = as.POSIXct(as.Date("2013-09-30", tz = "CET"))
t0 = as.POSIXct("2013-09-30 02:00:00", tz = "Europe/Berlin")

set.seed(13531) # make sure rbind generates identical sequences on reproduction

# Person A, track 1.

x = c(7, 6, 5, 5, 4, 3, 3)
y = c(7, 7, 6, 5, 5, 6, 7)
n = length(x)
t = t0 + cumsum(runif(n) * 60)
crs = CRS("+proj=longlat +datum=WGS84")
stidf = STIDF(SpatialPoints(cbind(x, y), crs), t, data.frame(co2 = rnorm(n)))
A1 = Track(stidf)

# Person A, track 2.

x = c(7, 6, 6, 7, 7)
y = c(6, 5, 4, 4, 3)
n = length(x)
t = max(t) + cumsum(runif(n) * 60)
stidf = STIDF(SpatialPoints(cbind(x, y), crs), t, data.frame(co2 = rnorm(n)))
A2 = Track(stidf)

# Tracks for person A.

A = Tracks(list(A1 = A1, A2 = A2))

# Person B, track 1.

x = c(2, 2, 1, 1, 2, 3)
y = c(5, 4, 3, 2, 2, 3)
n = length(x)
t = max(t) + cumsum(runif(n) * 60)
stidf = STIDF(SpatialPoints(cbind(x, y), crs), t, data.frame(co2 = rnorm(n)))
B1 = Track(stidf)

# Person B, track 2.

x = c(3, 3, 4, 3, 3, 4)
y = c(5, 4, 3, 2, 1, 1)
n = length(x)
t = max(t) + cumsum(runif(n) * 60)
stidf = STIDF(SpatialPoints(cbind(x, y), crs), t, data.frame(co2 = rnorm(n)))
B2 = Track(stidf)

# Tracks for person B.

B = Tracks(list(B1 = B1, B2 = B2))

# Tracks collection.

Tr = TracksCollection(list(A = A, B = B))

all = list(A1, A2, B1, B2, A, B, Tr)

# Test methods.

checkClass = function(list, class) {
	stopifnot(all(sapply(list, function(x) class(x)[1] == class)))
}

checkDim = function(list, dim) {
	for(i in seq_along(list)) {
		element = list[[i]]
		if(class(element)[1] %in% c("data.frame", "xts", "STIDF", "SpatialPointsDataFrame"))
			stopifnot(dim(element)[1] == dim[i])
		else if(class(element)[1] == "Line")
			stopifnot(dim(element@coords)[1] == dim[i])
		else if(class(element)[1] == "Lines")
			# For simplification purposes, the number of Line elements (= number
			# of Tracks) is validated.
			stopifnot(length(element@Lines) == dim[i])
		else if(class(element)[1] %in% c("SpatialLines", "SpatialLinesDataFrame"))
			# For simplification purposes, the sum of the number of Line
			# elements (= total number of Tracks) is validated.
			stopifnot(sum(sapply(element@lines, function(x) length(x@Lines))) == dim[i])
		else
			warning(paste("Validation against dimension of class '", class(element)[1], "' is not yet supported.", sep = ""))	
	}
}

# Check coercion to segments.

res = lapply(all, function(x) as(x, "segments"))
checkClass(res, "data.frame")
dim = c(6, 4, 5, 5, 10, 10, 20)
checkDim(res, dim)

# Check coercion to data frame.

res = lapply(all, function(x) as(x, "data.frame"))
checkClass(res, "data.frame")
dim = c(7, 5, 6, 6, 14, 14, 28)
checkDim(res, dim)

# Check coercion to Line, Lines, SpatialLines and SpatialLinesDataFrame.

res = lapply(all[1:4], function(x) as(x, "Line"))
checkClass(res, "Line")
dim = c(7, 5, 6, 6)
checkDim(res, dim)

res = lapply(all[1:6], function(x) as(x, "Lines"))
checkClass(res, "Lines")
dim = c(1, 1, 1, 1, 2, 2)
checkDim(res, dim)

res = lapply(all, function(x) as(x, "SpatialLines"))
checkClass(res, "SpatialLines")
dim = c(1, 1, 1, 1, 2, 2, 4)
checkDim(res, dim)

res = lapply(all[5:length(all)], function(x) as(x, "SpatialLinesDataFrame"))
checkClass(res, "SpatialLinesDataFrame")
dim = c(2, 2, 4)
checkDim(res, dim)

# Check coercion to xts.

res = lapply(all, function(x) as(x, "xts"))
checkClass(res, "xts")
dim = c(7, 5, 6, 6, 12, 12, 24)
checkDim(res, dim)

# Check coercion to STIDF.

res = lapply(all, function(x) as(x, "STIDF"))
checkClass(res, "STIDF")
dim = c(7, 5, 6, 6, 12, 12, 24)
checkDim(res, dim)

# Check coercion to SpatialPointsDataFrame.

res = lapply(all, function(x) as(x, "SpatialPointsDataFrame"))
checkClass(res, "SpatialPointsDataFrame")
dim = c(7, 5, 6, 6, 12, 12, 24)
checkDim(res, dim)

# Check proj4string methods.

# stopifnot(all(sapply(all, function(x) proj4string(x) == "+proj=longlat +ellps=WGS84")))

# Check coordnames methods.

stopifnot(all(sapply(all, function(x) coordnames(x) == c("x", "y"))))

# Check stbox methods.

lapply(all, function(x) stbox(x))

# Check generalize methods.

if (require(sf)) {
lapply(all, function(x) generalize(x, max, timeInterval = "2 min"))
lapply(all, function(x) generalize(x, distance = 200))
lapply(all, function(x) generalize(x, min, n = 2))
lapply(all, function(x) generalize(x, timeInterval = "3 min", tol = 2))
lapply(all, function(x) generalize(x, n = 3, toPoints = TRUE))
}

# Check selection methods.

stopifnot(class(Tr[1:2])[1] == "TracksCollection")
stopifnot(class(Tr[2])[1] == "Tracks")
stopifnot(class(Tr[2][1])[1] == "Track")
stopifnot(class(Tr[list(1:2, 2:3)])[1] == "TracksCollection")
stopifnot(class(Tr[list(integer(0), 2:3)])[1] == "Tracks")
stopifnot(class(Tr[list(integer(0), 2)])[1] == "Track")
stopifnot(class(Tr[list(1:2, 2:3), drop = FALSE])[1] == "TracksCollection")
stopifnot(class(Tr[list(integer(0), 2:3), drop = FALSE])[1] == "TracksCollection")
stopifnot(class(Tr[list(integer(0), 2), drop = FALSE])[1] == "TracksCollection")
stopifnot(class(Tr[, "distance"]) == "TracksCollection")

lapply(all, function(x) x[["co2"]])
lapply(all, function(x) x[["co2"]] = x[["co2"]] / 1000)
lapply(all, function(x) x$distance)
lapply(all, function(x) x$distance = x$distance * 1000)