R Under development (unstable) (2023-11-23 r85618 ucrt) -- "Unsuffered Consequences" Copyright (C) 2023 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > 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)) [[1]] x y time min 3 5 2013-09-30 02:00:53 max 7 7 2013-09-30 02:03:48 [[2]] x y time min 6 3 2013-09-30 02:04:31 max 7 6 2013-09-30 02:05:56 [[3]] x y time min 1 2 2013-09-30 02:06:55 max 3 5 2013-09-30 02:09:27 [[4]] x y time min 3 1 2013-09-30 02:10:17 max 4 5 2013-09-30 02:12:59 [[5]] x y time min 3 3 2013-09-30 02:00:53 max 7 7 2013-09-30 02:05:56 [[6]] x y time min 1 1 2013-09-30 02:06:55 max 4 5 2013-09-30 02:12:59 [[7]] x y time min 1 1 2013-09-30 02:00:53 max 7 7 2013-09-30 02:12:59 > > # 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)) + } Loading required package: sf Linking to GEOS 3.11.2, GDAL 3.7.2, PROJ 9.3.0; sf_use_s2() is TRUE [[1]] An object of class Track 3points bbox: min max x 3 6 y 5 7 Time period: [2013-09-30 02:01:49.743664, 2013-09-30 02:03:48.804025] [[2]] An object of class Track 2points bbox: min max x 6 7 y 4 5 Time period: [2013-09-30 02:04:33.462773, 2013-09-30 02:05:56.054574] [[3]] An object of class Track 3points bbox: min max x 1 2 y 2 4 Time period: [2013-09-30 02:08:20.897476, 2013-09-30 02:09:27.381415] [[4]] An object of class Track 3points bbox: min max x 3 3 y 1 4 Time period: [2013-09-30 02:11:29.97318, 2013-09-30 02:12:59.06224] [[5]] An object of class Tracks 2 tracks followed by a single object [[6]] An object of class Tracks 2 tracks followed by a single object [[7]] An object of class TracksCollection 2 collection of tracks followed by 2 object > > # 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"]]) [[1]] [1] -0.5988002 -0.6794795 0.4364652 1.2466625 -2.0245238 -0.4248704 -2.3812027 [[2]] [1] 1.03262405 0.63755528 0.02566888 1.32257163 -0.90427121 [[3]] [1] -0.7946147 -1.2639775 1.8426784 -0.4272418 1.3647296 -0.4282315 [[4]] [1] -0.061455364 -0.470094988 -0.001423917 0.365838125 -0.625699562 [6] 0.010112330 [[5]] A11 A12 A13 A14 A15 A16 -0.59880018 -0.67947950 0.43646517 1.24666248 -2.02452379 -0.42487036 A17 A21 A22 A23 A24 A25 -2.38120267 1.03262405 0.63755528 0.02566888 1.32257163 -0.90427121 [[6]] B11 B12 B13 B14 B15 B16 -0.794614695 -1.263977494 1.842678392 -0.427241809 1.364729615 -0.428231510 B21 B22 B23 B24 B25 B26 -0.061455364 -0.470094988 -0.001423917 0.365838125 -0.625699562 0.010112330 [[7]] A.A11 A.A12 A.A13 A.A14 A.A15 A.A16 -0.598800184 -0.679479501 0.436465169 1.246662479 -2.024523794 -0.424870356 A.A17 A.A21 A.A22 A.A23 A.A24 A.A25 -2.381202667 1.032624055 0.637555279 0.025668883 1.322571629 -0.904271209 B.B11 B.B12 B.B13 B.B14 B.B15 B.B16 -0.794614695 -1.263977494 1.842678392 -0.427241809 1.364729615 -0.428231510 B.B21 B.B22 B.B23 B.B24 B.B25 B.B26 -0.061455364 -0.470094988 -0.001423917 0.365838125 -0.625699562 0.010112330 > lapply(all, function(x) x[["co2"]] = x[["co2"]] / 1000) [[1]] [1] -0.0005988002 -0.0006794795 0.0004364652 0.0012466625 -0.0020245238 [6] -0.0004248704 -0.0023812027 [[2]] [1] 1.032624e-03 6.375553e-04 2.566888e-05 1.322572e-03 -9.042712e-04 [[3]] [1] -0.0007946147 -0.0012639775 0.0018426784 -0.0004272418 0.0013647296 [6] -0.0004282315 [[4]] [1] -6.145536e-05 -4.700950e-04 -1.423917e-06 3.658381e-04 -6.256996e-04 [6] 1.011233e-05 [[5]] A11 A12 A13 A14 A15 -5.988002e-04 -6.794795e-04 4.364652e-04 1.246662e-03 -2.024524e-03 A16 A17 A21 A22 A23 -4.248704e-04 -2.381203e-03 1.032624e-03 6.375553e-04 2.566888e-05 A24 A25 1.322572e-03 -9.042712e-04 [[6]] B11 B12 B13 B14 B15 -7.946147e-04 -1.263977e-03 1.842678e-03 -4.272418e-04 1.364730e-03 B16 B21 B22 B23 B24 -4.282315e-04 -6.145536e-05 -4.700950e-04 -1.423917e-06 3.658381e-04 B25 B26 -6.256996e-04 1.011233e-05 [[7]] A.A11 A.A12 A.A13 A.A14 A.A15 -5.988002e-04 -6.794795e-04 4.364652e-04 1.246662e-03 -2.024524e-03 A.A16 A.A17 A.A21 A.A22 A.A23 -4.248704e-04 -2.381203e-03 1.032624e-03 6.375553e-04 2.566888e-05 A.A24 A.A25 B.B11 B.B12 B.B13 1.322572e-03 -9.042712e-04 -7.946147e-04 -1.263977e-03 1.842678e-03 B.B14 B.B15 B.B16 B.B21 B.B22 -4.272418e-04 1.364730e-03 -4.282315e-04 -6.145536e-05 -4.700950e-04 B.B23 B.B24 B.B25 B.B26 -1.423917e-06 3.658381e-04 -6.256996e-04 1.011233e-05 > lapply(all, function(x) x$distance) [[1]] [1] 110495.2 156407.3 110583.3 110898.7 156547.2 110587.4 [[2]] [1] 156547.2 110579.9 111050.1 110577.2 [[3]] [1] 110579.9 156757.4 110575.2 111252.1 156827.6 [[4]] [1] 110579.9 156757.4 156827.6 110573.8 111302.6 [[5]] A11 A12 A13 A14 A15 A16 A21 A22 110495.2 156407.3 110583.3 110898.7 156547.2 110587.4 156547.2 110579.9 A23 A24 111050.1 110577.2 [[6]] B11 B12 B13 B14 B15 B21 B22 B23 110579.9 156757.4 110575.2 111252.1 156827.6 110579.9 156757.4 156827.6 B24 B25 110573.8 111302.6 [[7]] A.A11 A.A12 A.A13 A.A14 A.A15 A.A16 A.A21 A.A22 110495.2 156407.3 110583.3 110898.7 156547.2 110587.4 156547.2 110579.9 A.A23 A.A24 B.B11 B.B12 B.B13 B.B14 B.B15 B.B21 111050.1 110577.2 110579.9 156757.4 110575.2 111252.1 156827.6 110579.9 B.B22 B.B23 B.B24 B.B25 156757.4 156827.6 110573.8 111302.6 > lapply(all, function(x) x$distance = x$distance * 1000) [[1]] [1] 110495213 156407339 110583338 110898700 156547208 110587401 [[2]] [1] 156547208 110579945 111050127 110577226 [[3]] [1] 110579945 156757406 110575183 111252131 156827576 [[4]] [1] 110579945 156757406 156827576 110573820 111302650 [[5]] A11 A12 A13 A14 A15 A16 A21 A22 110495213 156407339 110583338 110898700 156547208 110587401 156547208 110579945 A23 A24 111050127 110577226 [[6]] B11 B12 B13 B14 B15 B21 B22 B23 110579945 156757406 110575183 111252131 156827576 110579945 156757406 156827576 B24 B25 110573820 111302650 [[7]] A.A11 A.A12 A.A13 A.A14 A.A15 A.A16 A.A21 A.A22 110495213 156407339 110583338 110898700 156547208 110587401 156547208 110579945 A.A23 A.A24 B.B11 B.B12 B.B13 B.B14 B.B15 B.B21 111050127 110577226 110579945 156757406 110575183 111252131 156827576 110579945 B.B22 B.B23 B.B24 B.B25 156757406 156827576 110573820 111302650 Warning messages: 1: In .local(x, i, j = j, ..., value) : replacing distance in connections slot 2: In .local(x, i, j = j, ..., value) : replacing distance in connections slot 3: In .local(x, i, j = j, ..., value) : replacing distance in connections slot 4: In .local(x, i, j = j, ..., value) : replacing distance in connections slot > > proc.time() user system elapsed 3.79 0.34 4.14