-
Notifications
You must be signed in to change notification settings - Fork 20
/
Copy pathalign_move.R
116 lines (107 loc) · 5.95 KB
/
align_move.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
#' Align movement data
#'
#' This function aligns movement data to a uniform time scale with a uniform temporal resolution throughout the complete movement sequence.
#' This prepares the provided movement data to be interpretable by \code{\link{frames_spatial}}, which necessitates a uniform time scale and
#' a consistent, unique temporal resolution for all moving individuals to turn recording times into frame times.
#'
#' @inheritParams frames_spatial
#' @param m \code{move} or \code{moveStack}, which is allowed to contain irregular timestamps and diverging temporal resolutions to be aligned (see \code{\link{df2move}} to convert a \code{data.frame} to a \code{move} object).
#' @param res either numeric, representing the temporal resolution, to which \code{m} should be aligned to (see argument \code{unit}), or character:
#' \itemize{
#' \item \code{"minimum"} to use the smallest temporal resolution of \code{m} (default)
#' \item \code{"maximum"} to use the largest temporal resolution of \code{m}
#' \item \code{"mean"} to use the rounded average temporal resolution of \code{m}
#' }
#' @param unit character, temporal unit of \code{res}. Either \code{"secs"}, \code{"mins"}, \code{"hours"}, \code{"days"}. No effect, if \code{res} is not defined.
#' @param spaceMethod character, either \code{"euclidean"}, \code{"greatcircle"} or \code{"rhumbline"}, indicating the interpolation function to be used to interpolate locations of \code{m} to the aligned time scale. Interpolation is performed using \code{move::interpolateTime}.
#' @param ... deprecated arguments including \code{digit}.
#'
#' @return Aligned \code{move} or \code{moveStack}, ready to be used with \code{\link{frames_spatial}}-
#' @author Jakob Schwalb-Willmann
#'
#' @importFrom move timestamps timeLag interpolateTime moveStack move split namesIndiv
#' @importFrom lubridate second<- minute<- hour<- day<-
#'
#' @seealso \code{\link{df2move}} \code{\link{frames_spatial}} \code{\link{frames_graph}}
#'
#' @examples
#' library(moveVis)
#' library(move)
#' data("move_data")
#'
#' # the tracks in move_data have irregular timestamps and sampling rates.
#' # print unique timestamps and timeLag
#' unique(timestamps(move_data))
#' unique(unlist(timeLag(move_data, units = "secs")))
#'
#' # use align_move to correct move_data to a uniform time scale and lag using interpolation.
#' # resolution of 4 minutes:
#' m <- align_move(m = move_data, res = 4, unit = "mins")
#' unique(unlist(timeLag(m, units = "mins")))
#'
#' # resolution of 1 hour:
#' m <- align_move(move_data, res = 1, unit = "hours")
#' unique(unlist(timeLag(m, units = "hours")))
#'
#' # resolution of 15 seconds:
#' m <- align_move(move_data, res = 15, unit = "secs")
#' unique(unlist(timeLag(m, units = "secs")))
#'
#' @export
align_move <- function(m, res = "minimum", unit = NA, spaceMethod = "greatcircle", ..., verbose = TRUE){
# deprecated arguments
extras <- list(...)
if("digit" %in% names(extras)) out("Argument 'digit' is deprecated. See ?align_move for details.", type = 2)
## check m and spaceMethod
if(inherits(verbose, "logical")) options(moveVis.verbose = verbose)
if(!inherits(m, c("Move", "MoveStack"))) out("Argument 'm' must be of class 'Move' or 'MoveStack'.", type = 3)
m.length <- if(inherits(m, "MoveStack")) sapply(split(m), length) else length(m)
if(any(m.length < 2)) out(paste0("Individual track(s) ", paste0(which(m.length < 2), collapse = ", "), " of 'm' consist(s) of less than 2 locations only. A minimum of 2 locations per indvidual track is required for alignment."), type = 3)
## check resolution and define resolution
if(is.na(unit)) unit_ <- "secs" else unit_ <- unit
if(all(!c(inherits(res, "numeric"), inherits(res, "character")))) out("Argument 'res' must either be numeric or one of c('min', 'max', 'mean').", type = 3)
if(any(res == "min", res == "minimum")) res <- min(unique(unlist(timeLag(m, unit_))))
if(any(res == "max", res == "maximum")) res <- max(unique(unlist(timeLag(m, unit_))))
if(res == "mean") res <- round(mean(unique(unlist(timeLag(m, unit_)))))
res <- as.difftime(res, units = unit_)
# recalc unit
if(is.na(unit)){
if(all(res >= 60, res < 3600)) unit <- "mins"
if(all(res >= 3600, res < 86400)) unit <- "hours"
if(res >= 86400) unit <- "days"
res <- `units<-`(res, unit)
}
out(paste0("Temporal resolution of ", round(as.numeric(res), digits = 2), " [", units(res), "] is used to align trajectories."))
# calculate time shoulders and full target timestamps
ts <- timestamps(m)
ts.shoulder <- list(min(ts), max(ts))
if(unit != "secs"){
set.fun <- list("mins" = `second<-`, "hours" = `minute<-`, "days" = `hour<-`)
set.fun <- set.fun[1:match(unit, names(set.fun))]
ts.shoulder <- lapply(ts.shoulder, function(x){
for(i in 1:length(set.fun)) x <- set.fun[[i]](x, value = 0)
return(x)
})
}
ts.target <- seq.POSIXt(ts.shoulder[[1]], ts.shoulder[[2]], by = res)
# calculate new timestamps per trajectory
m.indi <- if(inherits(m, "MoveStack")) split(m) else list(m)
ts.m <- lapply(m.indi, timestamps)
ts.t <- lapply(ts.m, function(x) ts.target[ts.target >= min(x) & ts.target <= max(x)])
# check whether resolution fits data
i.finer <- which(sapply(ts.t, function(x) length(x) == 0))
if(length(i.finer) > 0){
if(length(i.finer) == length(m.indi)){
out("The temporal coverage of all trajectories of 'm' is shorter than the specified resolution. You may want to choose a finer resolution.", type = 3)
} else{
out(paste0("The full temporal coverage of at least one trajectory is shorter than the specified resolution. You may want to choose a finer resolution.\nTrajectories that are excluded: '", paste0(namesIndiv(m)[i.finer], collapse = "', '"), "'"), type = 2)
}
m.indi <- m.indi[-i.finer]
ts.t <- ts.t[-i.finer]
}
# interpolate
m <- quiet(moveStack(mapply(x = m.indi, y = ts.t, function(x, y) interpolateTime(x, y, spaceMethod))))
m[,c("x", "y")] <- m@coords
m[,"time"] <- timestamps(m)
return(m)
}