/
spatialize.R
238 lines (220 loc) · 8.03 KB
/
spatialize.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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
#' Length normalize trajectories.
#'
#' Re-represent each trajectory spatially using a constant number of points so
#' that adjacent points on the trajectory become equidistant to each other.
#'
#' \code{mt_length_normalize} is used to emphasize the trajectories' shape.
#' Usually, the vast majority of points of a raw or a time-normalized trajectory
#' lie close to the start and end point. \code{mt_length_normalize}
#' re-distributes these points so that the spatial distribution is uniform
#' across the entire trajectory. \code{mt_length_normalize} is mainly used to
#' improve the results of clustering (in particular \link{mt_cluster}) and
#' visualization.
#'
#' @inheritParams mt_time_normalize
#' @param dimensions a character string specifying which trajectory variables
#' should be used. Can be of length 2 or 3 for two-dimensional or
#' three-dimensional data.
#' @param n_points an integer or vector of integers specifying the number of
#' points used to represent the spatially rescaled trajectories. If a single
#' integer is provided, the number of points will be constant across
#' trajectories. Alternatively, a vector of integers can provided that specify
#' the number of points for each trajectory individually.
#'
#' @return A mousetrap data object (see \link{mt_example}) with an additional
#' array (by default called \code{ln_trajectories}) containing the length
#' normalized trajectories. If a trajectory array was provided directly as
#' \code{data}, only the length normalized trajectories will be returned.
#'
#' @examples
#' KH2017 <- mt_length_normalize(data=KH2017,
#' dimensions = c('xpos','ypos'),
#' n_points = 20)
#'
#' @author
#' Dirk U. Wulff
#'
#' Jonas M. B. Haslbeck
#'
#' Pascal J. Kieslich
#'
#' @export
mt_length_normalize <- function(
data,
use = 'trajectories',
dimensions = c('xpos', 'ypos'),
save_as = 'ln_trajectories',
n_points = 20
){
# Extract trajectories
trajectories <- extract_data(data,use)
# Tests
if (!length(dimensions) %in% c(2,3)) {
stop('Dimensions must of length 2 or 3.')
}
if (!all(dimensions %in% dimnames(trajectories)[[3]])) {
stop('Not all dimensions exist.')
}
# Length normalize trajectories
if (length(dimensions) == 2) {
if (nrow(trajectories) == 1) {
# Cover special case of single trajectory
dim_1 <- matrix(trajectories[,,dimensions[1]], nrow=1)
dim_2 <- matrix(trajectories[,,dimensions[2]], nrow=1)
} else {
dim_1 <- trajectories[,,dimensions[1]]
dim_2 <- trajectories[,,dimensions[2]]
}
spatialized_trajectories <- spatializeArray(dim_1, dim_2, n_points)
} else if (length(dimensions) == 3) {
if (nrow(trajectories) == 1) {
# Cover special case of single trajectory
dim_1 <- matrix(trajectories[,,dimensions[1]],nrow=1)
dim_2 <- matrix(trajectories[,,dimensions[2]],nrow=1)
dim_3 <- matrix(trajectories[,,dimensions[3]],nrow=1)
} else {
dim_1 <- trajectories[,,dimensions[1]]
dim_2 <- trajectories[,,dimensions[2]]
dim_3 <- trajectories[,,dimensions[3]]
}
spatialized_trajectories <- spatializeArray3d(dim_1, dim_2, dim_3, n_points)
}
# create new trajectory array
result <- array(
dim=c(
dim(trajectories)[1],
max(n_points),
length(dimensions)
),
dimnames=list(dimnames(trajectories)[[1]], NULL, dimensions)
)
# add rescaled to new trajectories and set NAs
for (i in 1:length(spatialized_trajectories)) {
tmp_traj <- spatialized_trajectories[[i]]
tmp_traj[tmp_traj == -10000] <- NA
result[,,i] <- tmp_traj
}
# return data
return(create_results(data=data, results=result, use=use, save_as=save_as))
}
#' Spatialize trajectories.
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' Re-represent each trajectory spatially using a constant number of points so
#' that adjacent points on the trajectory become equidistant to each other.
#' Please note that this function is \strong{deprecated} and that
#' \link{mt_length_normalize} should be used instead.
#'
#' @details
#' \code{mt_spatialize} is used to emphasize the trajectories' shape. Usually,
#' the vast majority of points of a raw or a time-normalized trajectory lie
#' close to the start and end point. \code{mt_spatialize} re-distributes these
#' points so that the spatial distribution is uniform across the entire
#' trajectory. \code{mt_spatialize} is mainly used to improve the results of
#' clustering (in particular \link{mt_cluster}) and visualization.
#'
#' @inheritParams mt_length_normalize
#'
#' @return A mousetrap data object (see \link{mt_example}) with an additional
#' array containing the spatialized trajectories. If a trajectory array was
#' provided directly as \code{data}, only the spatialized trajectories will be
#' returned.
#'
#' @examples
#' \dontrun{
#' KH2017 <- mt_spatialize(data=KH2017,
#' dimensions = c('xpos','ypos'),
#' n_points = 20)
#' }
#'
#' @author
#' Dirk U. Wulff
#'
#' Jonas M. B. Haslbeck
#'
#' @export
mt_spatialize <- function(data,
use = 'trajectories',
dimensions = c('xpos', 'ypos'),
save_as = 'sp_trajectories',
n_points = 20
){
.Deprecated("mt_length_normalize")
if(save_as == "sp_trajectories"){
warning(
"The save_as argument in mt_spatialize has been left at sp_trajectories. ",
"Please note that, due to the replacement of mt_spatialize with mt_length_normalize, ",
"functions working with length normalized trajectories will now ",
" - by default (if the use argument is not specified explicitly) - ",
"expect them to be called ln_trajectories instead of sp_trajectories."
)
}
return(
mt_length_normalize(
data = data, use = use, dimensions = dimensions,
save_as = save_as, n_points = n_points
)
)
}
# Spatialize trajectories to long (internal function)
mt_spatialize_tolong <- function(data,
use='trajectories',
dimensions=c('xpos','ypos'),
n_points=20
){
# Extract trajectories
trajectories <- extract_data(data, use)
# Tests
if (!length(dimensions) %in% c(2,3,4)) {
stop('Dimensions must of length 2, 3, or 4.')
}
if (!all(dimensions %in% dimnames(trajectories)[[3]])) {
stop('Not all dimensions exist.')
}
# Spatialize trajectories
if (length(dimensions) == 2) {
if (nrow(trajectories) == 1) {
# Cover special case of single trajectory
dim_1 <- matrix(trajectories[,,dimensions[1]], nrow=1)
dim_2 <- matrix(trajectories[,,dimensions[2]], nrow=1)
} else {
dim_1 <- trajectories[,,dimensions[1]]
dim_2 <- trajectories[,,dimensions[2]]
}
spatialized_trajectories <- spatializeArrayToLong(dim_1, dim_2, n_points)
} else if (length(dimensions) == 3) {
if (nrow(trajectories) == 1) {
# Cover special case of single trajectory
dim_1 <- matrix(trajectories[,,dimensions[1]],nrow=1)
dim_2 <- matrix(trajectories[,,dimensions[2]],nrow=1)
dim_3 <- matrix(trajectories[,,dimensions[3]],nrow=1)
} else {
dim_1 <- trajectories[,,dimensions[1]]
dim_2 <- trajectories[,,dimensions[2]]
dim_3 <- trajectories[,,dimensions[3]]
}
spatialized_trajectories <- spatializeArrayToLong3d(
dim_1, dim_2, dim_3, n_points
)
} else if (length(dimensions) == 4) {
if (nrow(trajectories) == 1) {
# Cover special case of single trajectory
dim_1 <- matrix(trajectories[,,dimensions[1]],nrow=1)
dim_2 <- matrix(trajectories[,,dimensions[2]],nrow=1)
dim_3 <- matrix(trajectories[,,dimensions[3]],nrow=1)
dim_4 <- matrix(trajectories[,,dimensions[4]],nrow=1)
} else {
dim_1 <- trajectories[,,dimensions[1]]
dim_2 <- trajectories[,,dimensions[2]]
dim_3 <- trajectories[,,dimensions[3]]
dim_4 <- trajectories[,,dimensions[4]]
}
spatialized_trajectories <- spatializeArrayToLong4d(
dim_1, dim_2, dim_3, dim_4, n_points
)
}
# Return data
return(spatialized_trajectories)
}