Nothing
#' 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)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.