sftime/0000755000176200001440000000000014214573071011545 5ustar liggesuserssftime/NAMESPACE0000644000176200001440000000212614214420161012754 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$<-",sftime) S3method("[",sftime) S3method("[[<-",sftime) S3method("st_time<-",sf) S3method("st_time<-",sftime) S3method(cbind,sftime) S3method(plot,sftime) S3method(print,sftime) S3method(rbind,sftime) S3method(st_as_sftime,ST) S3method(st_as_sftime,Track) S3method(st_as_sftime,Tracks) S3method(st_as_sftime,TracksCollection) S3method(st_as_sftime,data.frame) S3method(st_as_sftime,sf) S3method(st_as_sftime,sftime) S3method(st_as_sftime,stars) S3method(st_cast,sftime) S3method(st_crop,sftime) S3method(st_difference,sftime) S3method(st_drop_geometry,sftime) S3method(st_filter,sftime) S3method(st_intersection,sftime) S3method(st_join,sftime) S3method(st_sym_difference,sftime) S3method(st_time,sftime) S3method(st_union,sftime) S3method(transform,sftime) export("st_time<-") export(is_sortable) export(st_as_sftime) export(st_drop_time) export(st_set_time) export(st_sftime) export(st_time) import(sf) importFrom(graphics,plot) importFrom(methods,as) importFrom(methods,slotNames) importFrom(utils,methods) sftime/man/0000755000176200001440000000000014213634240012313 5ustar liggesuserssftime/man/print.sftime.Rd0000644000176200001440000000136114214417514015231 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sftime.R \name{print.sftime} \alias{print.sftime} \title{Prints an \code{sftime} object} \usage{ \method{print}{sftime}(x, ..., n = getOption("sf_max_print", default = 10)) } \arguments{ \item{x}{An object of class \code{sftime}.} \item{...}{Currently unused arguments, for compatibility.} \item{n}{Numeric value; maximum number of printed elements.} } \value{ \code{x} (invisible). } \description{ Prints an \code{sftime} object } \examples{ g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1))) tc <- Sys.time() + 1:5 x <- st_sftime(a = 1:5, g, time = tc) print(x) print(x[0, ]) } sftime/man/bind.Rd0000644000176200001440000000467314214417514013534 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/bind.R \name{bind} \alias{bind} \alias{rbind.sftime} \alias{cbind.sftime} \title{Bind rows (features) of \code{sftime} objects} \usage{ \method{rbind}{sftime}(..., deparse.level = 1) \method{cbind}{sftime}(..., deparse.level = 1, sf_column_name = NULL, tc_column_name = NULL) } \arguments{ \item{...}{Objects to bind; note that for the \code{rbind} and \code{cbind} methods, all objects have to be of class \code{sftime}; see \code{\link{dotsMethods}}.} \item{deparse.level}{An integer value; see \code{\link{rbind}}.} \item{sf_column_name}{Character value; specifies the active geometry column; passed on to \code{\link{st_sftime}}.} \item{tc_column_name}{Character value; specifies active time column; passed on to \code{\link{st_sftime}}.} } \value{ \code{rbind} combines all \code{sftime} objects in \code{...} row-wise and returns the combined \code{sftime} object. \code{cbind} combines all \code{sftime} objects in \code{...} column-wise and returns the combined \code{sftime} object. When called with multiple \code{sftime} objects warns about multiple time and geometry columns present when the time and geometry columns to use are not specified by using arguments \code{tc_column_name} and \code{sf_column_name}; see also \link{st_sftime}. } \description{ Bind rows (features) of \code{sftime} objects Bind columns (variables) of \code{sftime} objects } \details{ Both \code{rbind} and \code{cbind} have non-standard method dispatch (see \link[base]{cbind}): the \code{rbind} or \code{cbind} method for \code{sftime} objects is only called when all arguments to be combined are of class \code{sftime}. If you need to \code{cbind} e.g. a \code{data.frame} to an \code{sf}, use \code{\link{data.frame}} directly and use \code{\link{st_sftime}} on its result, or use \code{\link[dplyr:bind]{bind_cols}}; see examples. } \examples{ g1 <- st_sfc(st_point(1:2)) x1 <- st_sftime(a = 3, geometry = g1, time = Sys.time()) g2 <- st_sfc(st_point(c(4, 6))) x2 <- st_sftime(a = 4, geometry = g2, time = Sys.time()) rbind(x1, x2) # works because both tc1 and tc2 have the same class \dontrun{ st_time(x2) <- 1 rbind(x1, x2) # error because both tc1 and tc2 do not have the same class } cbind(x1, x2) if (require(dplyr)) dplyr::bind_cols(x1, x2) df <- data.frame(x = 3) st_sftime(data.frame(x1, df)) } sftime/man/geos_binary_ops.Rd0000644000176200001440000000542614213634240015773 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-transformers.R \name{geos_binary_ops} \alias{geos_binary_ops} \alias{st_intersection.sftime} \alias{st_difference.sftime} \alias{st_sym_difference.sftime} \title{Geometric operations on pairs of simple feature geometry sets (including \code{sftime} objects)} \usage{ \method{st_intersection}{sftime}(x, y, ...) \method{st_difference}{sftime}(x, y, ...) \method{st_sym_difference}{sftime}(x, y, ...) } \arguments{ \item{x}{object of class \code{sftime}, \code{sf}, \code{sfc} or \code{sfg}.} \item{y}{object of class \code{sftime}, \code{sf}, \code{sfc} or \code{sfg}.} \item{...}{See \code{\link[sf:geos_binary_ops]{geos_binary_ops}}.} } \value{ The intersection, difference or symmetric difference between two sets of geometries. The returned object has the same class as that of the first argument (\code{x}) with the non-empty geometries resulting from applying the operation to all geometry pairs in \code{x} and \code{y}. In case \code{x} is of class \code{sf} or \code{sftime}, the matching attributes of the original object(s) are added. The \code{sfc} geometry list-column returned carries an attribute \code{idx}, which is an \code{n}-by-2 matrix with every row the index of the corresponding entries of \code{x} and \code{y}, respectively. } \description{ Geometric operations on pairs of simple feature geometry sets (including \code{sftime} objects) Intersection Difference } \details{ \code{st_intersection}: When called with a missing \code{y}, the \code{sftime} method for \code{st_intersection} returns an \code{sftime} object with attributes taken from the contributing feature with lowest index; two fields are added: \describe{ \item{\code{n.overlaps}}{The number of overlapping features in \code{x}.} \item{\code{origins}}{A list-column with indexes of all overlapping features.} } \code{st_difference}: When \code{st_difference} is called with a single argument, overlapping areas are erased from geometries that are indexed at greater numbers in the argument to \code{x}; geometries that are empty or contained fully inside geometries with higher priority are removed entirely. } \examples{ g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1))) tc <- Sys.time() + 1:5 x1 <- st_sftime(a = 1:5, g, time = tc) x2 <- st_buffer(x1, dist = 1) ## intersection # only x provided (no y) plot(st_intersection(x2)) # with arguments x and y provided plot(st_intersection(x2, x1)) ## difference # only x provided (no y) plot(st_difference(x2)) # with arguments x and y provided plot(st_difference(x2, x1)) ## symmetric difference plot(st_sym_difference(x1, x2)) } sftime/man/st_as_sftime.Rd0000644000176200001440000001167514214420161015270 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sftime.R \name{st_as_sftime} \alias{st_as_sftime} \alias{st_as_sftime.ST} \alias{st_as_sftime.Track} \alias{st_as_sftime.Tracks} \alias{st_as_sftime.TracksCollection} \alias{st_as_sftime.sftime} \alias{st_as_sftime.sf} \alias{st_as_sftime.stars} \alias{st_as_sftime.data.frame} \title{Convert a foreign object to an \code{sftime} object} \usage{ st_as_sftime(x, ...) \method{st_as_sftime}{ST}(x, ...) \method{st_as_sftime}{Track}(x, ...) \method{st_as_sftime}{Tracks}(x, ...) \method{st_as_sftime}{TracksCollection}(x, ...) \method{st_as_sftime}{sftime}(x, ...) \method{st_as_sftime}{sf}(x, ..., time_column_name = NULL) \method{st_as_sftime}{stars}(x, ..., long = TRUE, time_column_name = NULL) \method{st_as_sftime}{data.frame}( x, ..., agr = NA_agr_, coords, wkt, dim = "XYZ", remove = TRUE, na.fail = TRUE, sf_column_name = NULL, time_column_name = NULL, time_column_last = FALSE ) } \arguments{ \item{x}{An object to be converted into an object of class \code{\link[=st_sftime]{sftime}}.} \item{...}{Further arguments passed to methods.} \item{time_column_name}{A character value; name of the active time column. In case there is more than one and \code{time_column_name} is \code{NULL}, the first one is taken.} \item{long}{A logical value; See \code{\link[stars:st_as_sf]{st_as_sf}}. Typically, \code{long} should be set to \code{TRUE} since time information typically is a dimension of a stars object.} \item{agr}{A character vector; see details section of \code{\link{st_sf}}.} \item{coords}{In case of point data: names or numbers of the numeric columns holding coordinates.} \item{wkt}{The name or number of the character column that holds WKT encoded geometries.} \item{dim}{Passed on to \code{\link{st_point}} (only when argument \code{coords} is given).} \item{remove}{A logical value; when \code{coords} or \code{wkt} is given, remove these columns from code{data.frame}?} \item{na.fail}{A logical value; if \code{TRUE}, raise an error if coordinates contain missing values.} \item{sf_column_name}{A character value; name of the active list-column with simple feature geometries; in case there is more than one and \code{sf_column_name} is \code{NULL}, the first one is taken.} \item{time_column_last}{A logical value; if \code{TRUE}, the active time column is always put last, otherwise column order is left unmodified. If both \code{sfc_last} and \code{time_column_last} are \code{TRUE}, the active time column is put last.} } \value{ \code{x} converted to an \code{sftime} object. \code{st_as_sftime.Tracks} furthermore adds a column \code{track_name} with the names of the \code{tracks} slot of the input \code{Tracks} object. \code{st_as_sftime.TracksCollection} furthermore adds the columns \code{tracks_name} with the names of the \code{tracksCollection} slot and \code{track_name} with the names of the \code{tracks} slot of the input \code{Tracks} object. } \description{ Convert a foreign object to an \code{sftime} object } \examples{ # modified from spacetime: library(sp) library(spacetime) sp <- cbind(x = c(0,0,1), y = c(0,1,1)) row.names(sp) <- paste("point", 1:nrow(sp), sep="") sp <- SpatialPoints(sp) time <- as.POSIXct("2010-08-05") + 3600 * (10:12) x <- STI(sp, time) st_as_sftime(x) # convert a Track object from package trajectories to an sftime object library(trajectories) x1_Track <- trajectories::rTrack(n = 100) x1_Track@data$speed <- sort(rnorm(length(x1_Track))) x1_sftime <- st_as_sftime(x1_Track) # convert a Tracks object from package trajectories to an sftime object x2_Tracks <- trajectories::rTracks(m = 6) x2_sftime <- st_as_sftime(x2_Tracks) # convert a TracksCollection object from package trajectories to an sftime object x3_TracksCollection <- trajectories::rTracksCollection(p = 2, m = 3, n = 50) x3_sftime <- st_as_sftime(x3_TracksCollection) # convert an sftime object to an sftime object st_as_sftime(x3_sftime) # convert an sf object to an sftime object g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1))) x4_sf <- st_sf(a = 1:5, g, time = Sys.time() + 1:5) x4_sftime <- st_as_sftime(x4_sf) # convert a Tracks object from package trajectories to an sftime object x5_stars <- stars::read_stars(system.file("nc/bcsd_obs_1999.nc", package = "stars")) x5_sftime <- st_as_sftime(x5_stars, time_column_name = "time") # this requires some thought to not accidentally drop time dimensions. For # example, setting `merge = TRUE` will drop the time dimension and thus throw # an error: \dontrun{ x5_sftime <- st_as_sftime(x5_stars, merge = TRUE, time_column_name = "time") } # convert a data frame to an sftime object x5_df <- data.frame(a = 1:5, g, time = Sys.time() + 1:5, stringsAsFactors = FALSE) x5_sftime <- st_as_sftime(x5_df) } sftime/man/plot.sftime.Rd0000644000176200001440000000224114214417514015051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R \name{plot.sftime} \alias{plot.sftime} \alias{plot} \title{Plots an \code{sftime} object} \usage{ \method{plot}{sftime}(x, y, ..., number = 6, tcuts) } \arguments{ \item{x}{The \code{\link[=st_sftime]{sftime}} object to be plotted.} \item{y}{A character value; The variable name to be plotted; if missing, the first variable is plotted.} \item{...}{Additional arguments; Passed on to \code{\link[sf:plot]{plot.sf}}.} \item{number}{A numeric value; The number of panels to be plotted, cannot be larger than the number of timestamps; ignored when \code{tcuts} is provided.} \item{tcuts}{predefined temporal ranges assigned to each map; if missing, will be determined as equal spans according to \code{number}.} } \value{ Returns \code{NULL} and creates as side effect a plot for \code{x}. } \description{ \code{plot.sftime} } \examples{ set.seed(123) coords <- matrix(runif(100), ncol = 2) g <- st_sfc(lapply(1:50, function(i) st_point(coords[i, ]) )) sft <- st_sftime(a = 1:50, g, time = as.POSIXct("2020-09-01 00:00:00") + 0:49 * 3600 * 6) plot(sft) } sftime/man/st_time.Rd0000644000176200001440000000505014214417514014252 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/st_time.R \name{st_time} \alias{st_time} \alias{st_time<-} \alias{st_time.sftime} \alias{st_time<-.sf} \alias{st_time<-.sftime} \alias{st_set_time} \alias{st_drop_time} \title{Get, set, or replace time information} \usage{ st_time(obj, ...) st_time(x, ...) <- value \method{st_time}{sftime}(obj, ...) \method{st_time}{sf}(x, ..., time_column_name = "time") <- value \method{st_time}{sftime}(x, ...) <- value st_set_time(x, value, ...) st_drop_time(x) } \arguments{ \item{obj}{An object of class \code{sftime}.} \item{...}{Additional arguments; Ignored.} \item{x}{An object of class \code{sftime} or \code{sf}.} \item{value}{An object for which \code{\link{is_sortable}} returns \code{TRUE} or an object of class \code{character}, or \code{NULL}.} \item{time_column_name}{Character value; The name of the column to set as active time column in \code{x}.} } \value{ \code{st_time} returns the content of the active time column of an \code{sftime} object. Assigning an object for which \code{\link{is_sortable}} returns \code{TRUE} to an \code{sf} object creates an \code{\link[=st_sftime]{sftime}} object. Assigning an object for which \code{\link{is_sortable}} returns \code{TRUE} to an \code{sftime} object replaces the active time column by this object. } \description{ Get, set, or replace time information } \details{ In case \code{value} is character and \code{x} is of class \code{sftime}, the active time column (as indicated by attribute \code{time_column}) is set to \code{x[[value]]}. The replacement function applied to \code{sftime} objects will overwrite the active time column, if \code{value} is \code{NULL}, it will remove it and coerce \code{x} to an \code{sftime} object. \code{st_drop_time} drops the time column of its argument, and reclasses it accordingly. } \examples{ # from sftime object g <- st_sfc(st_point(1:2)) time <- Sys.time() x <- st_sftime(a = 3, g, time = time) st_time(x) ## assign a vector with time information # to sf object x <- st_sf(a = 3, g) st_time(x) <- time x # to sftime object x <- st_sftime(a = 3, g, time = time) st_time(x) <- Sys.time() ## remove time column from sftime object st_time(x) <- NULL ## pipe-friendly # assign time column to sf object x <- st_sf(a = 3, g) x <- st_set_time(x, time) # remove time column from sftime object st_set_time(x, NULL) ## drop time column and class # same as x <- st_set_time(x, NULL) st_drop_time(x) } sftime/man/st_crop.sftime.Rd0000644000176200001440000000215714214417514015552 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/crop.R \name{st_crop.sftime} \alias{st_crop.sftime} \title{Crop an \code{sftime} object to a specific rectangle} \usage{ \method{st_crop}{sftime}(x, y, ...) } \arguments{ \item{x}{An object of class \code{sftime}.} \item{y}{A numeric vector with named elements \code{xmin}, \code{ymin}, \code{xmax} and \code{ymax}, or an object of class \code{bbox}, or an object for which there is an \code{\link[sf:st_bbox]{st_bbox}} method to convert it to a \code{bbox} object.} \item{...}{Additional arguments; Ignored.} } \value{ \code{x} cropped using \code{y}. } \description{ Crop an \code{sftime} object to a specific rectangle } \details{ See \code{\link[sf:st_crop]{st_crop}}. } \examples{ # modified from sf: box <- c(xmin = 0, ymin = 0, xmax = 1, ymax = 1) pol <- sf::st_sfc(sf::st_buffer(sf::st_point(c(0.5, 0.5)), 0.6)) pol_sftime <- st_sftime(a = 1, geom = pol, time = Sys.time() + 1:2 * 1000) pol_sftime_cropped <- sf::st_crop(pol_sftime, sf::st_bbox(box)) class(pol_sftime_cropped) plot(pol_sftime_cropped) } sftime/man/geos_combine.Rd0000644000176200001440000000273114213634240015236 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/geom-transformers.R \name{geos_combine} \alias{geos_combine} \alias{st_union.sftime} \title{Combine or union feature geometries (including \code{sftime} objects)} \usage{ \method{st_union}{sftime}(x, y, ..., by_feature = FALSE, is_coverage = FALSE) } \arguments{ \item{x}{An object of class \code{sftime}, \code{sf}, \code{sfc} or \code{sfg}.} \item{y}{An object of class \code{sftime}, \code{sf}, \code{sfc} or \code{sfg} (optional).} \item{...}{See \code{\link[sf:geos_combine]{geos_combine}}.} \item{by_feature}{See \code{\link[sf:geos_combine]{geos_combine}}.} \item{is_coverage}{See \code{\link[sf:geos_combine]{geos_combine}}.} } \value{ If \code{y} is missing, \code{st_union(x)} returns a single geometry with resolved boundaries, else the geometries for all unioned pairs of \code{x[i]} and \code{y[j]}. } \description{ Combine or union feature geometries (including \code{sftime} objects) } \details{ See \code{\link[sf:geos_combine]{geos_combine}}. } \examples{ # union simple features in an sftime object g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1))) tc <- Sys.time() + 1:5 x <- st_sftime(a = 1:5, g, time = tc) # only x provided (no y) plot(st_union(st_buffer(x, dist = 1))) # with arguments x and y provided plot(st_union(st_buffer(x, dist = 1), st_buffer(x, dist = 0.5)), "a") } sftime/man/transform.sftime.Rd0000644000176200001440000000201014214417514016100 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sftime.R \name{transform.sftime} \alias{transform.sftime} \title{Transform method for \code{sftime} objects} \usage{ \method{transform}{sftime}(`_data`, ...) } \arguments{ \item{_data}{An object of class \code{\link[=st_sftime]{sftime}}.} \item{...}{Further arguments of the form new_variable=expression} } \value{ \code{_data} (an \code{sftime object}) with modified attribute values (columns). } \description{ Can be used to create or modify attribute variables; for transforming geometries see \code{\link[sf]{st_transform}}, and all other functions starting with \code{st_}. } \examples{ # create an sftime object g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1))) x <- data.frame(a = 1:5, g, time = Sys.time() + 1:5, stringsAsFactors = FALSE) x_sftime <- st_as_sftime(x) x_sftime # modify values in column a transform(x_sftime, a = rev(a)) } sftime/man/tidyverse.Rd0000644000176200001440000003560014214417514014630 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/join.R, R/tidyverse.R \name{tidyverse} \alias{tidyverse} \alias{inner_join.sftime} \alias{left_join.sftime} \alias{right_join.sftime} \alias{full_join.sftime} \alias{semi_join.sftime} \alias{anti_join.sftime} \alias{filter.sftime} \alias{arrange.sftime} \alias{group_by.sftime} \alias{ungroup.sftime} \alias{rowwise.sftime} \alias{mutate.sftime} \alias{transmute.sftime} \alias{select.sftime} \alias{rename.sftime} \alias{slice.sftime} \alias{summarise.sftime} \alias{summarize.sftime} \alias{distinct.sftime} \alias{gather.sftime} \alias{pivot_longer.sftime} \alias{spread.sftime} \alias{sample_n.sftime} \alias{sample_frac.sftime} \alias{nest.sftime} \alias{unnest.sftime} \alias{separate.sftime} \alias{unite.sftime} \alias{separate_rows.sftime} \title{'tidyverse' methods for \code{sftime} objects} \usage{ inner_join.sftime(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) left_join.sftime(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) right_join.sftime(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) full_join.sftime(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) semi_join.sftime(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) anti_join.sftime(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) filter.sftime(.data, ..., .dots) arrange.sftime(.data, ..., .dots) group_by.sftime(.data, ..., add = FALSE) ungroup.sftime(.data, ...) rowwise.sftime(.data, ...) mutate.sftime(.data, ..., .dots) transmute.sftime(.data, ..., .dots) select.sftime(.data, ...) rename.sftime(.data, ...) slice.sftime(.data, ..., .dots) summarise.sftime(.data, ..., .dots, do_union = TRUE, is_coverage = FALSE) summarize.sftime(.data, ..., .dots, do_union = TRUE, is_coverage = FALSE) distinct.sftime(.data, ..., .keep_all = FALSE) \method{gather}{sftime}( data, key, value, ..., na.rm = FALSE, convert = FALSE, factor_key = FALSE ) \method{pivot_longer}{sftime}( data, cols, names_to = "name", names_prefix = NULL, names_sep = NULL, names_pattern = NULL, names_ptypes = NULL, names_transform = NULL, names_repair = "check_unique", values_to = "value", values_drop_na = FALSE, values_ptypes = NULL, values_transform = NULL, ... ) \method{spread}{sftime}(data, key, value, fill = NA, convert = FALSE, drop = TRUE, sep = NULL) sample_n.sftime( tbl, size, replace = FALSE, weight = NULL, .env = parent.frame() ) sample_frac.sftime( tbl, size = 1, replace = FALSE, weight = NULL, .env = parent.frame() ) \method{nest}{sftime}(.data, ...) \method{unnest}{sftime}(data, ..., .preserve = NULL) \method{separate}{sftime}( data, col, into, sep = "[^[:alnum:]]+", remove = TRUE, convert = FALSE, extra = "warn", fill = "warn", ... ) \method{unite}{sftime}(data, col, ..., sep = "_", remove = TRUE) \method{separate_rows}{sftime}(data, ..., sep = "[^[:alnum:]]+", convert = FALSE) } \arguments{ \item{x}{An object of class \code{sftime}.} \item{y}{A pair of data frames, data frame extensions (e.g. a tibble), or lazy data frames (e.g. from dbplyr or dtplyr). See \emph{Methods}, below, for more details.} \item{by}{A character vector of variables to join by. If \code{NULL}, the default, \verb{*_join()} will perform a natural join, using all variables in common across \code{x} and \code{y}. A message lists the variables so that you can check they're correct; suppress the message by supplying \code{by} explicitly. To join by different variables on \code{x} and \code{y}, use a named vector. For example, \code{by = c("a" = "b")} will match \code{x$a} to \code{y$b}. To join by multiple variables, use a vector with length > 1. For example, \code{by = c("a", "b")} will match \code{x$a} to \code{y$a} and \code{x$b} to \code{y$b}. Use a named vector to match different variables in \code{x} and \code{y}. For example, \code{by = c("a" = "b", "c" = "d")} will match \code{x$a} to \code{y$b} and \code{x$c} to \code{y$d}. To perform a cross-join, generating all combinations of \code{x} and \code{y}, use \code{by = character()}.} \item{copy}{If \code{x} and \code{y} are not from the same data source, and \code{copy} is \code{TRUE}, then \code{y} will be copied into the same src as \code{x}. This allows you to join tables across srcs, but it is a potentially expensive operation so you must opt into it.} \item{suffix}{If there are non-joined duplicate variables in \code{x} and \code{y}, these suffixes will be added to the output to disambiguate them. Should be a character vector of length 2.} \item{...}{other arguments} \item{.data}{An object of class \code{stime}.} \item{.dots}{see corresponding function in package \code{dplyr}} \item{add}{see corresponding function in dplyr} \item{do_union}{logical; in case \code{summary} does not create a geometry column, should geometries be created by unioning using \link[sf]{st_union}, or simply by combining using \link[sf]{st_combine}? Using \link[sf]{st_union} resolves internal boundaries, but in case of unioning points, this will likely change the order of the points; see Details.} \item{is_coverage}{logical; if \code{do_union} is \code{TRUE}, use an optimized algorithm for features that form a polygonal coverage (have no overlaps)} \item{.keep_all}{see corresponding function in dplyr} \item{data}{see original function docs} \item{key}{see original function docs} \item{value}{see original function docs} \item{na.rm}{see original function docs} \item{convert}{see \link[tidyr]{separate_rows}} \item{factor_key}{see original function docs} \item{cols}{<\code{\link[tidyr:tidyr_tidy_select]{tidy-select}}> Columns to pivot into longer format.} \item{names_to}{A string specifying the name of the column to create from the data stored in the column names of \code{data}. Can be a character vector, creating multiple columns, if \code{names_sep} or \code{names_pattern} is provided. In this case, there are two special values you can take advantage of: \itemize{ \item \code{NA} will discard that component of the name. \item \code{.value} indicates that component of the name defines the name of the column containing the cell values, overriding \code{values_to}. }} \item{names_prefix}{A regular expression used to remove matching text from the start of each variable name.} \item{names_sep}{If \code{names_to} contains multiple values, these arguments control how the column name is broken up. \code{names_sep} takes the same specification as \code{\link[tidyr:separate]{separate()}}, and can either be a numeric vector (specifying positions to break on), or a single string (specifying a regular expression to split on). \code{names_pattern} takes the same specification as \code{\link[tidyr:extract]{extract()}}, a regular expression containing matching groups (\verb{()}). If these arguments do not give you enough control, use \code{pivot_longer_spec()} to create a spec object and process manually as needed.} \item{names_pattern}{If \code{names_to} contains multiple values, these arguments control how the column name is broken up. \code{names_sep} takes the same specification as \code{\link[tidyr:separate]{separate()}}, and can either be a numeric vector (specifying positions to break on), or a single string (specifying a regular expression to split on). \code{names_pattern} takes the same specification as \code{\link[tidyr:extract]{extract()}}, a regular expression containing matching groups (\verb{()}). If these arguments do not give you enough control, use \code{pivot_longer_spec()} to create a spec object and process manually as needed.} \item{names_ptypes}{A list of column name-prototype pairs. A prototype (or ptype for short) is a zero-length vector (like \code{integer()} or \code{numeric()}) that defines the type, class, and attributes of a vector. Use these arguments to confirm that the created columns are the types that you expect. If not specified, the type of the columns generated from \code{names_to} will be character, and the type of the variables generated from \code{values_to} will be the common type of the input columns used to generate them.} \item{names_transform}{A list of column name-function pairs. Use these arguments if you need to change the type of specific columns. For example, \code{names_transform = list(week = as.integer)} would convert a character week variable to an integer.} \item{names_repair}{What happens if the output has invalid column names? The default, \code{"check_unique"} is to error if the columns are duplicated. Use \code{"minimal"} to allow duplicates in the output, or \code{"unique"} to de-duplicated by adding numeric suffixes. See \code{\link[vctrs:vec_as_names]{vctrs::vec_as_names()}} for more options.} \item{values_to}{A string specifying the name of the column to create from the data stored in cell values. If \code{names_to} is a character containing the special \code{.value} sentinel, this value will be ignored, and the name of the value column will be derived from part of the existing column names.} \item{values_drop_na}{If \code{TRUE}, will drop rows that contain only \code{NA}s in the \code{value_to} column. This effectively converts explicit missing values to implicit missing values, and should generally be used only when missing values in \code{data} were created by its structure.} \item{values_ptypes}{A list of column name-prototype pairs. A prototype (or ptype for short) is a zero-length vector (like \code{integer()} or \code{numeric()}) that defines the type, class, and attributes of a vector. Use these arguments to confirm that the created columns are the types that you expect. If not specified, the type of the columns generated from \code{names_to} will be character, and the type of the variables generated from \code{values_to} will be the common type of the input columns used to generate them.} \item{values_transform}{A list of column name-function pairs. Use these arguments if you need to change the type of specific columns. For example, \code{names_transform = list(week = as.integer)} would convert a character week variable to an integer.} \item{fill}{see original function docs} \item{drop}{see original function docs} \item{sep}{see \link[tidyr]{separate_rows}} \item{tbl}{see original function docs} \item{size}{see original function docs} \item{replace}{see original function docs} \item{weight}{see original function docs} \item{.env}{see original function docs} \item{.preserve}{see \link[tidyr:nest]{unnest}} \item{col}{see \link[tidyr]{separate}} \item{into}{see \link[tidyr]{separate}} \item{remove}{see \link[tidyr]{separate}} \item{extra}{see \link[tidyr]{separate}} } \value{ \itemize{ \item For \code{_join} methods: An object of class \code{sftime} representing the joining result of \code{x} and \code{y}. See \code{\link[dplyr]{mutate-joins}}. \item For \code{filter}: See \code{\link[dplyr]{filter}}. \item For \code{arrange}: See \code{\link[dplyr]{arrange}}. \item For \code{group_by} and \code{ungroup}: A grouped \code{sftime} object. See \code{\link[dplyr]{arrange}}. \item For \code{rowwise}: An \code{sftime} object. See \code{\link[dplyr]{rowwise}}. \item For \code{mutate} and \code{transmute}: See \code{\link[dplyr]{mutate}}. \item For \code{select}: See \code{\link[dplyr]{select}}. If the active time column is not explicitly selected, a \code{sf} object is returned. \item For \code{rename}: See \code{\link[dplyr]{rename}}. \item For \code{slice}: See \code{\link[dplyr]{slice}}. \item For \code{summarize} and \code{summarise}: See \code{\link[dplyr]{summarise}}. \item For \code{distinct}: See \code{\link[dplyr]{distinct}}. \item For \code{gather}: See \code{\link[tidyr]{gather}}. } } \description{ 'tidyverse' methods for \code{sftime} objects. Geometries are sticky, use \code{\link{as.data.frame}} to let \code{dplyr}'s own methods drop them. Use these methods without the \code{.sftime} suffix and after loading the 'tidyverse' package with the generic (or after loading package 'tidyverse'). } \examples{ g1 <- st_sfc(st_point(1:2), st_point(c(5, 8)), st_point(c(2, 9))) x1 <- st_sftime(a = 1:3, geometry = g1, time = Sys.time()) g2 <- st_sfc(st_point(c(4, 6)), st_point(c(4, 6)), st_point(c(4, 6))) x2 <- st_sftime(a = 2:4, geometry = g2, time = Sys.time()) library(dplyr) ## inner_join inner_join(x1, as.data.frame(x2), by = "a") # note: the active time column is # time.x and the active geometry column geometry.x inner_join(x2, as.data.frame(x1), by = "a") ## left_join left_join(x1, as.data.frame(x2), by = "a") left_join(x2, as.data.frame(x1), by = "a") ## right_join right_join(x1, as.data.frame(x2), by = "a") right_join(x2, as.data.frame(x1), by = "a") ## full_join full_join(x1, as.data.frame(x2), by = "a") full_join(x2, as.data.frame(x1), by = "a") ## semi_join semi_join(x1, as.data.frame(x2), by = "a") semi_join(x2, as.data.frame(x1), by = "a") ## anti_join anti_join(x1, as.data.frame(x2), by = "a") anti_join(x2, as.data.frame(x1), by = "a") ## filter filter(x1, a <= 2) ## arrange arrange(x1, dplyr::desc(a)) ## group_by group_by(x1, time) ## ungroup ungroup(group_by(x1, time)) ## rowwise x1 \%>\% mutate(a1 = 5:7) \%>\% rowwise() \%>\% mutate(a2 = mean(a, a1)) ## mutate x1 \%>\% mutate(a1 = 5:7) ## transmute x1 \%>\% transmute(a1 = 5:7) ## select x1 \%>\% select(-time) \%>\% select(geometry) ## rename x1 \%>\% rename(a1 = a) ## slice x1 \%>\% slice(1:2) ## summarise x1 \%>\% summarise(time = mean(time)) x1 \%>\% summarize(time = mean(time)) ## distinct x1 \%>\% distinct(geometry) ## gather library(tidyr) x1 \%>\% mutate(a1 = 5:7) \%>\% gather(key = "variable", value = "value", a, a1) ## pivot_longer x1 \%>\% mutate(a1 = 5:7) \%>\% pivot_longer(cols = c("a", "a1"), names_to = "variable", values_to = "value") ## spread x1 \%>\% mutate(a1 = 5:7) \%>\% gather(key = "variable", value = "value", a, a1) \%>\% spread(key = "variable", value = "value") ## sample_n set.seed(234) x1 \%>\% sample_n(size = 10, replace = TRUE) ## sample_frac x1 \%>\% sample_frac(size = 10, replace = TRUE) \%>\% sample_frac(size = 0.1, replace = FALSE) ## nest x1 \%>\% nest(a1 = -time) ## unnest x1 \%>\% mutate(a1 = list(1, c(1, 2), 5)) \%>\% unnest(a1) ## separate x1 \%>\% mutate(x = c(NA, "a.b", "a.d")) \%>\% separate(x, c("A", "B")) ## unite x1 \%>\% mutate(x = c(NA, "a.b", "a.d")) \%>\% separate(x, c("A", "B")) \%>\% unite(x, c("A", "B")) ## separate_rows x1 \%>\% mutate(z = c("1", "2,3,4", "5,6")) \%>\% separate_rows(z, convert = TRUE) } sftime/man/st_join.Rd0000644000176200001440000000624014213634240014251 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/join.R \name{st_join} \alias{st_join} \alias{st_join.sftime} \alias{st_filter.sftime} \title{Spatial join, spatial filter for \code{sftime} objects} \usage{ \method{st_join}{sftime}( x, y, join = st_intersects, ..., suffix = c(".x", ".y"), left = TRUE, largest = FALSE ) \method{st_filter}{sftime}(x, y, ..., .predicate = st_intersects) } \arguments{ \item{x}{An object of class \code{sftime} or \code{sf}.} \item{y}{An object of class \code{sftime} or \code{sf}.} \item{join}{A geometry predicate function with the same profile as \code{\link[sf:geos_binary_pred]{st_intersects}}; see details.} \item{...}{for \code{st_join}: arguments passed on to the \code{join} function or to \code{st_intersection} when \code{largest} is \code{TRUE}; for \code{st_filter} arguments passed on to the \code{.predicate} function, e.g. \code{prepared}, or a pattern for \link[sf]{st_relate}} \item{suffix}{length 2 character vector; see \link[base]{merge}} \item{left}{logical; if \code{TRUE} return the left join, otherwise an inner join; see details. see also \link[dplyr:mutate-joins]{left_join}} \item{largest}{logical; if \code{TRUE}, return \code{x} features augmented with the fields of \code{y} that have the largest overlap with each of the features of \code{x}; see https://github.com/r-spatial/sf/issues/578} \item{.predicate}{A geometry predicate function with the same profile as \code{\link[sf:geos_binary_pred]{st_intersects}}; see details.} } \value{ An object of class \code{sftime}, joined based on geometry. } \description{ Spatial join, spatial filter for \code{sftime} objects } \details{ Alternative values for argument \code{join} are: \itemize{ \item \link[sf:geos_binary_pred]{st_contains_properly} \item \link[sf:geos_binary_pred]{st_contains} \item \link[sf:geos_binary_pred]{st_covered_by} \item \link[sf:geos_binary_pred]{st_covers} \item \link[sf:geos_binary_pred]{st_crosses} \item \link[sf:geos_binary_pred]{st_disjoint} \item \link[sf:geos_binary_pred]{st_equals_exact} \item \link[sf:geos_binary_pred]{st_equals} \item \link[sf:geos_binary_pred]{st_is_within_distance} \item \link[sf:geos_binary_pred]{st_nearest_feature} \item \link[sf:geos_binary_pred]{st_overlaps} \item \link[sf:geos_binary_pred]{st_touches} \item \link[sf:geos_binary_pred]{st_within} \item any user-defined function of the same profile as the above } A left join returns all records of the \code{x} object with \code{y} fields for non-matched records filled with \code{NA} values; an inner join returns only records that spatially match. } \examples{ g1 <- st_sfc(st_point(c(1,1)), st_point(c(2,2)), st_point(c(3,3))) x1 <- st_sftime(a = 1:3, geometry = g1, time = Sys.time()) g2 <- st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3))) x2 <- st_sftime(a = 11:14, geometry = g2, time = Sys.time()) ## st_join # left spatial join with st_intersects st_join(x1, x2) # inner spatial join with st_intersects st_join(x1, x2, left = FALSE) ## st_filter st_filter(x1, x2) st_filter(x2, x1) } sftime/man/st_cast.Rd0000644000176200001440000000220014213634240014234 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/st_cast.R \name{st_cast} \alias{st_cast} \alias{st_cast.sftime} \title{Cast geometry to another type: either simplify, or cast explicitly} \usage{ \method{st_cast}{sftime}(x, to, ..., warn = TRUE, do_split = TRUE) } \arguments{ \item{x}{An object of class \code{sftime}.} \item{to}{character; target type, if missing, simplification is tried; when \code{x} is of type \code{sfg} (i.e., a single geometry) then \code{to} needs to be specified.} \item{...}{ignored} \item{warn}{logical; if \code{TRUE}, warn if attributes are assigned to sub-geometries} \item{do_split}{logical; if \code{TRUE}, allow splitting of geometries in sub-geometries} } \value{ \code{x} with changed geometry type. } \description{ Cast geometry to another type: either simplify, or cast explicitly } \examples{ # cast from POINT to LINESTRING g <- st_sfc(st_point(1:2), st_point(c(2, 4))) time <- Sys.time() x <- st_sftime(a = 3:4, g, time = time) \%>\% dplyr::group_by(time) \%>\% dplyr::summarize(do_union = TRUE) \%>\% st_cast(to = "LINESTRING") } sftime/man/is_sortable.Rd0000644000176200001440000000163514213634240015115 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sftime.R \name{is_sortable} \alias{is_sortable} \title{Checks whether a vector or list is sortable} \usage{ is_sortable(x) } \arguments{ \item{x}{The object to check.} } \value{ \code{TRUE} if \code{x} passes the check, else \code{FALSE}. } \description{ Checks whether a vector or list is sortable. This is the condition for a vector to be usable as time column in a \code{sftime} object. } \details{ Checks whether the provided object can be handled by \code{\link{order}}. A couple of basic types are whitelisted. However, custom types can be defined when they provide a dedicated generic to \link{xtfrm}. Note that a \code{list} can only be sorted with \link{atomic} values. See the examples below for a template. } \examples{ x <- Sys.time() + 5:1 * 3600 * 24 sort(x) is_sortable(x) } \keyword{internal} sftime/man/st_geometry.Rd0000644000176200001440000000145014214417514015147 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/st_geometry.R \name{st_geometry} \alias{st_geometry} \alias{st_drop_geometry.sftime} \title{Drops the geometry column of \code{sftime} objects} \usage{ \method{st_drop_geometry}{sftime}(x, ...) } \arguments{ \item{x}{An \code{sftime} object.} \item{...}{ignored} } \value{ \code{x} without geometry column and without \code{sftime} and \code{sf} class. } \description{ Drops the geometry column of an \code{sftime} object. This will also drop the \code{sftime} class attribute and \code{time_column} attribute. } \examples{ # dropping the geometry column will also drop the `sftime` class: g <- st_sfc(st_point(1:2)) time <- Sys.time() x <- st_sftime(a = 3, g, time = time) st_drop_geometry(x) } sftime/man/st_sftime.Rd0000644000176200001440000001233414213634240014602 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/sftime.R \name{st_sftime} \alias{st_sftime} \alias{[.sftime} \alias{[[<-.sftime} \alias{$<-.sftime} \title{Construct an \code{sftime} object from all its components} \usage{ st_sftime( ..., agr = sf::NA_agr_, row.names, stringsAsFactors = TRUE, crs, precision, sf_column_name = NULL, time_column_name = NULL, check_ring_dir = FALSE, sfc_last = TRUE, time_column_last = TRUE ) \method{[}{sftime}(x, i, j, ..., drop = FALSE, op = sf::st_intersects) \method{[[}{sftime}(x, i) <- value \method{$}{sftime}(x, i) <- value } \arguments{ \item{...}{Column elements to be binded into an \code{sftime} object or a single \code{list} or \code{data.frame} with such columns. At least one of these columns shall be a geometry list-column of class \code{sfc} and one shall be a time column (to be specified with \code{time_column_name}).} \item{agr}{A character vector; see details below.} \item{row.names}{row.names for the created \code{sf} object.} \item{stringsAsFactors}{A logical value; see \code{\link[sf]{st_read}}.} \item{crs}{Coordinate reference system, something suitable as input to \code{\link[sf]{st_crs}}.} \item{precision}{A numeric value; see \code{\link[sf]{st_as_binary}}.} \item{sf_column_name}{A character value; name of the active list-column with simple feature geometries; in case there is more than one and \code{sf_column_name} is \code{NULL}, the first one is taken.} \item{time_column_name}{A character value; name of the active time column. In case \code{time_column_name} is \code{NULL}, the first \code{\link{POSIXct}} column is taken. If there is no \code{POSIXct} column, the first \code{\link{Date}} column is taken.} \item{check_ring_dir}{A logical value; see \code{\link[sf]{st_read}}.} \item{sfc_last}{A logical value; if \code{TRUE}, \code{sfc} columns are always put last, otherwise column order is left unmodified.} \item{time_column_last}{A logical value; if \code{TRUE}, the active time column is always put last, otherwise column order is left unmodified. If both \code{sfc_last} and \code{time_column_last} are \code{TRUE}, the active time column is put last.} \item{x}{An object of class \code{sf}.} \item{i}{Record selection, see \link{[.data.frame}} \item{j}{Variable selection, see \link{[.data.frame}} \item{drop}{A logical value, default \code{FALSE}; if \code{TRUE} drop the geometry column and return a \code{data.frame}, else make the geometry sticky and return an \code{sf} object.} \item{op}{A function; geometrical binary predicate function to apply when \code{i} is a simple feature object.} \item{value}{An object to insert into \code{x}.} } \value{ \code{st_sftime}: An object of class \code{sftime}. Returned objects for subsetting functions: \code{[.sf} will return a \code{data.frame} or vector if the geometry column (of class \code{sfc}) is dropped (\code{drop=TRUE}), an \code{sfc} object if only the geometry column is selected, and otherwise return an \code{sftime} object. } \description{ Construct an \code{sftime} object from all its components } \details{ See also \link{[.data.frame}; for \code{[.sftime} \code{...} arguments are passed to \code{op}. } \examples{ ## construction with an sfc object library(sf) g <- st_sfc(st_point(1:2)) tc <- Sys.time() st_sftime(a = 3, g, time = tc) ## construction with an sf object \dontrun{ st_sftime(st_sf(a = 3, g), time = tc) # error, because if ... contains a data.frame-like object, no other objects # may be passed through ... . Instead, add the time column before. } st_sftime(st_sf(a = 3, g, time = tc)) ## Subsetting g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1))) tc <- Sys.time() + 1:5 x <- st_sftime(a = 1:5, g, time = tc) # rows x[1, ] class(x[1, ]) x[x$a < 3, ] class(x[x$a < 3, ]) # columns x[, 1] class(x[, 1]) # drops time column as for ordinary data.frame subsetting, # keeps geometry column of sf object x[, 3] class(x[, 3]) # keeps time column because it is explicitly selected, # keeps geometry column of sf object, returns an sftime object x[, 3, drop = TRUE] class(x[, 3, drop = TRUE]) # if the geometry column is dropped, not only the # sf class is dropped, but also the sftime class x["a"] class(x["a"]) # Time columns are not sticky: If a column is selected by a # character vector and this does not contain the active time column, the time # column is dropped. x[c("a", "time")] class(x[c("a", "time")]) # keeps the time column # with sf or sftime object pol = st_sfc(st_polygon(list(cbind(c(0,2,2,0,0),c(0,0,2,2,0))))) h = st_sf(r = 5, pol) x[h, ] class(x[h, ]) # returns sftime object h[x, ] class(h[x, ]) # returns sf object ## Assigning values to columns # assigning new values to a non-time column x[["a"]] <- 5:1 class(x) # assigning allowed new values to the time column x[["time"]] <- Sys.time() + 1:5 class(x) # assigning new values to the time column which invalidate the time column x[["time"]] <- list(letters[1:2]) class(x) # assigning new values with `$` x$time <- Sys.time() + 1:5 class(x) } sftime/DESCRIPTION0000644000176200001440000000356414214573071013263 0ustar liggesusersPackage: sftime Title: Classes and Methods for Simple Feature Objects that Have a Time Column Description: Classes and methods for spatial objects that have a registered time column, in particular for irregular spatiotemporal data. The time column can be of any type, but needs to be ordinal. Regularly laid out spatiotemporal data (vector or raster data cubes) are handled by package 'stars'. Version: 0.2-0 Depends: sf (>= 1.0.7) Imports: methods Suggests: knitr, spacetime, rmarkdown, dplyr (>= 0.8-3), trajectories (>= 0.2.2), stars, ncmeta, tidyr, ggplot2, magrittr, sp, rlang Authors@R: c(person(given = "Henning", family = "Teickner", role = c("aut", "cre", "cph"), email = "henning.teickner@uni-muenster.de", comment = c(ORCID = "0000-0002-3993-1182")), person(given = "Edzer", family = "Pebesma", role = c("aut", "cph"), email = "edzer.pebesma@uni-muenster.de", comment = c(ORCID = "0000-0001-8049-7069")), person(given = "Benedikt", family = "Graeler", role = c("aut", "cph"), email = "b.graeler@52north.org", comment = c(ORCID = "0000-0001-5443-4304"))) License: Apache License Type: Package Encoding: UTF-8 VignetteBuilder: knitr RoxygenNote: 7.1.2 Collate: sftime.R init.R join.R plot.R st_cast.R st_geometry.R st_time.R tidyverse.R bind.R crop.R geom-transformers.R NeedsCompilation: no Packaged: 2022-03-16 18:31:04 UTC; henni Author: Henning Teickner [aut, cre, cph] (), Edzer Pebesma [aut, cph] (), Benedikt Graeler [aut, cph] () Maintainer: Henning Teickner Repository: CRAN Date/Publication: 2022-03-17 08:50:01 UTC sftime/build/0000755000176200001440000000000014214426347012647 5ustar liggesuserssftime/build/vignette.rds0000644000176200001440000000032114214426347015202 0ustar liggesusersb```b`a`d`b2 1#PHsd妠Ɉy委&d)+@T(A t0X",LHXsS4楀a>"5lP5,n90{C2K7(1 棸(\^P7@btr$$%Ssftime/tests/0000755000176200001440000000000014213634240012702 5ustar liggesuserssftime/tests/basic.R0000644000176200001440000000407014213634240014107 0ustar liggesuserslibrary(sftime) set.seed(13531) ##### checks on tc #### ## popular POSIXct #tc <- st_tc(as.POSIXct("2020-09-01 08:00:00")-0:3*3600*24) #tc #tc[1] #order(tc) #sort(tc)[1] # ## custom interval class ## utility functions #as.character.interval <- function(x) { # paste0("[", x[1], ", ", x[2], "]") #} # #print.interval<- function(x) { # cat("Interval:", as.character(x)) #} # #'[.intervals' <- function(x, i) { # sx <- unclass(x)[i] # class(sx) <- "intervals" # sx #} # ## time interval definition #i1 <- c(5.3,12) #class(i1) <- "interval" #i2 <- c(3.1,6) #class(i2) <- "interval" #i3 <- c(1.4,2.9) #class(i3) <- "interval" #i4 <- c(1,2) #class(i4) <- "interval" # #intrvls <- list(i1, i2, i3, i4) #class(intrvls) <- "intervals" # ## provide dedicated generic to xtfrm for class intervals #xtfrm.intervals <- function(is) sapply(is, xtfrm) # ## different sort definitions: ## - sort by centre #xtfrm.interval <- function(i) mean(i) # #tc <- st_tc(intrvls) #tc #tc[1] #order(tc) #sort(tc)[1] # ## - sort by end #xtfrm.interval <- function(i) i[2] #tc <- st_tc(intrvls) #tc #tc[1] #order(tc) #sort(tc)[1] # ## - sort by start #xtfrm.interval <- function(i) i[1] # #tc <- st_tc(intrvls) #tc #tc[1] #order(tc) #sort(tc)[1] # #### sftime construction #### library(sf) coords <- matrix(runif(100), ncol = 2) g = st_sfc(lapply(1:50, function(i) st_point(coords[i,]) )) sft <- st_sftime(a = 1:50, g, time = as.POSIXct("2020-09-01 00:00:00")+0:49*3600*6) # coercion library(spacetime) example(STI) sft <- st_as_sftime(stidf) sft plot(sft, pch=12) ## custom interval scenario #intrvls <- lapply(1:12, function(i) { # iv <- runif(1)+c(0,runif(1)) # class(iv) <- "interval" # iv #}) # #class(intrvls) <- "intervals" #intrvls <- intrvls[order(intrvls)] # #tc_intrvls <- st_tc(intrvls) #sft_intrvls <- sft ## sft_intrvls$time <- tc_intrvls # does not work yet because class attribute order is changed, as discussed in https://github.com/r-spatial/sf/issues/1852 # ## plot(sft_intrvls, number=4, pch=12) sftime/tests/basic.Rout.save0000644000176200001440000001165014213634240015576 0ustar liggesusers R version 4.1.2 (2021-11-01) -- "Bird Hippie" Copyright (C) 2021 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) 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. > library(sftime) Loading required package: sf Linking to GEOS 3.10.1, GDAL 3.4.0, PROJ 8.2.0; sf_use_s2() is TRUE > set.seed(13531) > > ##### checks on tc #### > ## popular POSIXct > #tc <- st_tc(as.POSIXct("2020-09-01 08:00:00")-0:3*3600*24) > #tc > #tc[1] > #order(tc) > #sort(tc)[1] > # > ## custom interval class > ## utility functions > #as.character.interval <- function(x) { > # paste0("[", x[1], ", ", x[2], "]") > #} > # > #print.interval<- function(x) { > # cat("Interval:", as.character(x)) > #} > # > #'[.intervals' <- function(x, i) { > # sx <- unclass(x)[i] > # class(sx) <- "intervals" > # sx > #} > # > ## time interval definition > #i1 <- c(5.3,12) > #class(i1) <- "interval" > #i2 <- c(3.1,6) > #class(i2) <- "interval" > #i3 <- c(1.4,2.9) > #class(i3) <- "interval" > #i4 <- c(1,2) > #class(i4) <- "interval" > # > #intrvls <- list(i1, i2, i3, i4) > #class(intrvls) <- "intervals" > # > ## provide dedicated generic to xtfrm for class intervals > #xtfrm.intervals <- function(is) sapply(is, xtfrm) > # > ## different sort definitions: > ## - sort by centre > #xtfrm.interval <- function(i) mean(i) > # > #tc <- st_tc(intrvls) > #tc > #tc[1] > #order(tc) > #sort(tc)[1] > # > ## - sort by end > #xtfrm.interval <- function(i) i[2] > #tc <- st_tc(intrvls) > #tc > #tc[1] > #order(tc) > #sort(tc)[1] > # > ## - sort by start > #xtfrm.interval <- function(i) i[1] > # > #tc <- st_tc(intrvls) > #tc > #tc[1] > #order(tc) > #sort(tc)[1] > # > > #### sftime construction #### > library(sf) > coords <- matrix(runif(100), ncol = 2) > g = st_sfc(lapply(1:50, function(i) st_point(coords[i,]) )) > > sft <- st_sftime(a = 1:50, g, time = as.POSIXct("2020-09-01 00:00:00")+0:49*3600*6) > > # coercion > library(spacetime) > example(STI) STI> sp = cbind(x = c(0,0,1), y = c(0,1,1)) STI> row.names(sp) = paste("point", 1:nrow(sp), sep="") STI> library(sp) STI> sp = SpatialPoints(sp) STI> time = as.POSIXct("2010-08-05")+3600*(10:13) STI> m = c(10,20,30) # means for each of the 3 point locations STI> mydata = rnorm(length(sp)*length(time),mean=rep(m, 4)) STI> IDs = paste("ID",1:length(mydata)) STI> mydata = data.frame(values = signif(mydata,3), ID=IDs) STI> stidf = as(STFDF(sp, time, mydata), "STIDF") STI> stidf[1:2,] An object of class "STIDF" Slot "data": values ID 1 10.4 ID 1 2 19.1 ID 2 Slot "sp": SpatialPoints: x y point1 0 0 point2 0 1 Coordinate Reference System (CRS) arguments: NA Slot "time": timeIndex 2010-08-05 10:00:00 1 2010-08-05 10:00:00 1 Slot "endTime": [1] "2010-08-05 11:00:00 CEST" "2010-08-05 11:00:00 CEST" STI> all.equal(stidf, stidf[stidf,]) [1] TRUE > > sft <- st_as_sftime(stidf) > sft Spatiotemporal feature collection with 12 features and 2 fields Geometry type: POINT Dimension: XY Bounding box: xmin: 0 ymin: 0 xmax: 1 ymax: 1 CRS: NA Time column with class: 'POSIXt'. Ranging from 2010-08-05 10:00:00 to 2010-08-05 13:00:00. First 10 features: values ID st_as_sfc.x.sp. time 1 10.4 ID 1 POINT (0 0) 2010-08-05 10:00:00 2 19.1 ID 2 POINT (0 1) 2010-08-05 10:00:00 3 30.5 ID 3 POINT (1 1) 2010-08-05 10:00:00 4 10.2 ID 4 POINT (0 0) 2010-08-05 11:00:00 5 20.7 ID 5 POINT (0 1) 2010-08-05 11:00:00 6 30.8 ID 6 POINT (1 1) 2010-08-05 11:00:00 7 8.8 ID 7 POINT (0 0) 2010-08-05 12:00:00 8 19.0 ID 8 POINT (0 1) 2010-08-05 12:00:00 9 27.7 ID 9 POINT (1 1) 2010-08-05 12:00:00 10 9.6 ID 10 POINT (0 0) 2010-08-05 13:00:00 > > plot(sft, pch=12) [INFO] Fewer time stamps in the data than asked for; argument 'number' set to: 4 > > ## custom interval scenario > #intrvls <- lapply(1:12, function(i) { > # iv <- runif(1)+c(0,runif(1)) > # class(iv) <- "interval" > # iv > #}) > # > #class(intrvls) <- "intervals" > #intrvls <- intrvls[order(intrvls)] > # > #tc_intrvls <- st_tc(intrvls) > #sft_intrvls <- sft > ## sft_intrvls$time <- tc_intrvls # does not work yet because class attribute order is changed, as discussed in https://github.com/r-spatial/sf/issues/1852 > # > ## plot(sft_intrvls, number=4, pch=12) > > proc.time() user system elapsed 1.501 0.089 1.581 sftime/vignettes/0000755000176200001440000000000014214426350013552 5ustar liggesuserssftime/vignettes/sftime.Rmd0000644000176200001440000003022714213634240015507 0ustar liggesusers--- title: "Introduction to sftime" author: "Benedikt Gräler, Edzer Pebesma" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Introduction to sftime} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` The package `sftime` extends package `sf` to store and handle spatiotemporal data. To this end, `sftime` introduces a dedicated time column that stores the temporal information alongside the simple features column of an `sf` object. The time column can consists of any collection of a class that allows to be sorted - reflecting the native order of time. Besides well-known time classes such as `Date` or `POSIXct`, it also allows for custom class definitions that come with the necessary methods to make sorting work (we will see a example below). This vignette briefly explains and illustrates the ideas and decisions behind the implementation of `sftime`. ```{r packages} # load required packages library(sftime) library(sf) library(stars) library(spacetime) library(ggplot2) library(tidyr) library(magrittr) ``` ## The `sftime` class An `sftime` object is an `sf` object with an additional time column that contains the temporal information alongside the simple features column. This allows it to handle irregular and regular temporal information. For spatiotemporal data with regular temporal data (raster or vector data cubes: data where each geometry is observed at the same set of time instances), package `stars` is developed as a powerful alternative (e.g. time series of remote sensing imagery, regular measurements of entire measurement network). `sftime` fills the gap for data where arbitrary combinations of geometry and time occur, including irregularly collected sensor data or (spatiotemporal) point pattern data. `sftime` objects can be constructed directly from `sfc` objects by combining them with a vector representing temporal information: ```{r sftime-class-1} # example sfc object x_sfc <- sf::st_sfc( sf::st_point(1:2), sf::st_point(c(1,3)), sf::st_point(2:3), sf::st_point(c(2,1)) ) # create an sftime object directly from x_sfc x_sftime1 <- sftime::st_sftime(a = 1:4, x_sfc, time = Sys.time()- 0:3 * 3600 * 24) # first create the sf object and from this the sftime object x_sf <- sf::st_sf(a = 1:4, x_sfc, time = x_sftime1$time) x_sftime2 <- sftime::st_sftime(x_sf) x_sftime3 <- sftime::st_as_sftime(x_sf) # alernative option identical(x_sftime1, x_sftime2) identical(x_sftime1, x_sftime3) x_sftime1 ``` Methods for `sftime` objects are: ```{r sftime-class-2} methods(class = "sftime") ``` Methods for `sf` objects which are not listed above work also for `sftime` objects. ## Functions to get or set the time column of an `sftime` object Functions to get or set the time column of an `sftime` object are: ```{r time-column-1} # get the values from the time column st_time(x_sftime1) x_sftime1$time # alternative way # set the values in the time column st_time(x_sftime1) <- Sys.time() st_time(x_sftime1) # drop the time column to convert an sftime object to an sf object st_drop_time(x_sftime1) x_sftime1 # add a time column to an sf object converts it to an sftime object st_time(x_sftime1, time_column_name = "time") <- Sys.time() class(x_sftime1) # These can also be used with pipes x_sftime1 <- x_sftime1 %>% st_drop_time() %>% st_set_time(Sys.time(), time_column_name = "time") ``` ## Conversion to class `sftime` sftime supports coercion to `sftime` objects from the following classes (grouped according to packages): - sf: sf - stars: stars - spacetime: STI, STIDF - trajectories: Track, Tracks, TracksCollection - sftrack: sftrack, sftraj **Conversion from `sf` objects:** ```{r} # define the geometry column g <- st_sfc( st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1)) ) # crate sf object x4_sf <- st_sf(a = 1:5, g, time = Sys.time() + 1:5) # convert to sftime x4_sftime <- st_as_sftime(x4_sf) class(x4_sftime) ``` **Conversion from `stars` objects:** ```{r} # load sample data x5_stars <- stars::read_ncdf(system.file("nc/bcsd_obs_1999.nc", package = "stars"), var = c("pr", "tas")) # convert to sftime x5_sftime <- st_as_sftime(x5_stars, time_column_name = "time") ``` `st_as_sftime.stars` is a wrapper around `st_as_sf.stars`. As a consequence, some dimensions of the `stars` object can be dropped during conversion. Temporal information in `stars` objects are typically stored as dimension of an attribute. Therefore, some argument settings to `st_as_sftime` can drop the dimension with temporal information and therefore throw an error. For example, setting `merge = TRUE` drops dimension `time` and therefore conversion fails. Similarly, setting `long = FALSE` returns the attribute values in a wide format, where each column is a time point: ```{r, error = TRUE} # failed conversion to sftime x5_sftime <- st_as_sftime(x5_stars, merge = TRUE, time_column_name = "time") x5_sftime <- st_as_sftime(x5_stars, long = FALSE, time_column_name = "time") ``` **Conversion from `spacetime` objects** ```{r} # get sample data example(STI, package = "spacetime") class(stidf) # conversion to sftime x1_sftime <- st_as_sftime(stidf) ``` **Conversion from `Track`, `Tracks`, `TracksCollections` objects (trajectories package)** ```{r} # get a sample TracksCollection x2_TracksCollection <- trajectories::rTracksCollection(p = 2, m = 3, n = 40) # convert to sftime x2_TracksCollection_sftime <- st_as_sftime(x2_TracksCollection) x2_Tracks_sftime <- st_as_sftime(x2_TracksCollection@tracksCollection[[1]]) x2_Track_sftime <- st_as_sftime(x2_TracksCollection@tracksCollection[[1]]@tracks[[1]]) ``` ## Subsetting Different subsetting methods exist for `sftime` objects. Since `sftime` objects are built on top of `sf` objects, all subsetting methods for `sf` objects also work for `sftime` objects. Above (section [The `sftime` class]), the method to subset the time column was introduced: ```{r} st_time(x_sftime1) ``` Other subsetting functions work as for `sf` objects, e.g. selecting rows by row indices returns the specified rows. A key difference is that the active time column of an `sftime` object is not sticky --- in contrast to the active simple feature column in `sf` objects. Therefore, the active time column of an `sftime` object always has to be selected explicitly. If omitted, the subset will simplify to an `sf` objects without the active time column: ```{r} # selecting rows and columns (works just as for sf objects) x_sftime1[1, ] x_sftime1[, 3] # beware: the time column is not sticky. If omitted, the subset becomes an sf object class(x_sftime1[, 1]) class(x_sftime1["a"]) # the same x_sftime1[, 1] # to retain the time column and an sftime object, explicitly select the time column during subsetting: class(x_sftime1[, c(1, 3)]) class(x_sftime1[c("a", "time")]) # the same ``` ## Plotting For quick plotting, a plot method exists for `sftime` objects, which plots longitude-latitude coordinates and colors simple features according to values of a specified variable. Different panels are plotted for different time intervals which can be specified. Simple feature geometries might be overlaid several times when multiple observations fall in the same time interval. This is similar to `stplot()` from package spacetime with `mode = "xy"`: ```{r plotting-plot.sftime-1, fig.width=7} coords <- matrix(runif(100), ncol = 2) g <- sf::st_sfc(lapply(1:50, function(i) st_point(coords[i, ]) )) x_sftime4 <- st_sftime( a = 1:200, b = rnorm(200), id_object = as.factor(rep(1:4,each=50)), geometry = g, time = as.POSIXct("2020-09-01 00:00:00") + 0:49 * 3600 * 6 ) plot(x_sftime4, key.pos = 4) ``` The plotting method internally uses the `plot` method for `sf` objects. This makes it possible to customize plot appearance using the arguments of `plot.sf()`, for example: ```{r plotting-plot.sftime-2, fig.width=7} plot(x_sftime4, number = 10, max.plot = 10, key.pos = 4) ``` To create customized plots or plots which have different variables on plot axes than longitude and latitude, we recommend using ggplot2. For example, the plot method output can be mimicked by: ```{r plotting-ggplot-1, fig.width=7} library(ggplot2) ggplot() + geom_sf(data = x_sftime4, aes(color = b)) + facet_wrap(~ cut_number(time, n = 6)) + theme( panel.spacing.x = unit(4, "mm"), panel.spacing.y = unit(4, "mm") ) ``` This strategy can also be used to create other plots, for example plotting the id of entities over time (similar to `stplot()` with `mode = "xt"`): ```{r plotting-ggplot-2, fig.width=7} ggplot(x_sftime4) + geom_point(aes(y = id_object, x = time, color = b)) ``` Or for plotting time series of values of all variables with different panels for each entity (location) defined via a categorical variable (similar to `stplot()` with `mode = "tp"`): ```{r plotting-ggplot-3, fig.width=7} x_sftime4 %>% tidyr::pivot_longer(cols = c("a", "b"), names_to = "variable", values_to = "value") %>% ggplot() + geom_path(aes(y = value, x = time, color = variable)) + facet_wrap(~ id_object) ``` Or for plotting time series of values of all variables for all entities defined via a categorical variable with different panels for each variable (similar to `stplot()` with `mode = "ts"`): ```{r plotting-ggplot-4, fig.width=7} x_sftime4 %>% tidyr::pivot_longer(cols = c("a", "b"), names_to = "variable", values_to = "value") %>% ggplot() + geom_path(aes(y = value, x = time, color = id_object)) + facet_wrap(~ variable, scales = "free_y") ``` ## User-defined time columns The time column is a special column of the underlying sf object which defines time information (timestamps and temporal ordering) alongside the simple features column of an sf object. Common time representations in R (e.g. `POSIXct`, `POSIXlt`, `Date`, `yearmon`, `yearqtr`) are allowed, as well as optional user-defined types. Let us look at a simple example where we define a time column based on `POSIXct` ```{r, eval=TRUE} (tc <- as.POSIXct("2020-09-01 08:00:00")-0:3*3600*24) ``` The ordering is not altered upon construction (as in some other representations). If a different order is required, the `order` function and `sort` method can be applied to the time column: ```{r} tc order(tc) sort(tc) ``` In some applications it might be useful to have more complex temporal information such as intervals of different length. The following example is also meant as template for other user-defined classes which could be used to build the time column of the sftime class. At first, we will need a few helper functions: ```{r} # utility functions as.character.interval <- function(x) { paste0("[", x[1], ", ", x[2], "]") } print.interval <- function(x, ...) { cat("Interval:", as.character(x), "\n") } #'[.intervals' <- function(x, i) { # sx <- unclass(x)[i] # class(sx) <- "intervals" # sx #} ``` Now, we can define the different intervals used to represent our temporal information: ```{r} # time interval definition i1 <- c(5.3,12) class(i1) <- "interval" i2 <- c(3.1,6) class(i2) <- "interval" i3 <- c(1.4,6.9) class(i3) <- "interval" i4 <- c(1,21) class(i4) <- "interval" intrvls <- structure(list(i1, i2, i3, i4), class = "Intervals") # provide dedicated generic to xtfrm for class intervals ``` The advantage is to be able to define different sorting approaches: ```{r} xtfrm.Intervals <- function(x) sapply(x, mean) # - sort by centre (tc <- intrvls) order(tc) sort(tc)[1] ``` ```{r} # - sort by end xtfrm.Intervals <- function(x) sapply(x, max) (tc <- intrvls) order(tc) sort(tc)[1] ``` ```{r} # - sort by start xtfrm.Intervals <- function(x) sapply(x, min) tc <- intrvls order(tc) sort(tc)[1] ``` Based on the sorting procedure (begin, centre or end of the interval), the smallest element (each last line) and the order of the time column changes. sftime/R/0000755000176200001440000000000014213634240011741 5ustar liggesuserssftime/R/geom-transformers.R0000644000176200001440000001100114213634240015527 0ustar liggesusers#' Geometric operations on pairs of simple feature geometry sets (including \code{sftime} objects) #' #' @name geos_binary_ops #' @param x object of class \code{sftime}, \code{sf}, \code{sfc} or \code{sfg}. #' @param y object of class \code{sftime}, \code{sf}, \code{sfc} or \code{sfg}. #' @param ... See \code{\link[sf:geos_binary_ops]{geos_binary_ops}}. #' @return The intersection, difference or symmetric difference between two sets #' of geometries. #' The returned object has the same class as that of the first argument #' (\code{x}) with the non-empty geometries resulting from applying the #' operation to all geometry pairs in \code{x} and \code{y}. In case \code{x} #' is of class \code{sf} or \code{sftime}, the matching attributes of the #' original object(s) are added. The \code{sfc} geometry list-column returned #' carries an attribute \code{idx}, which is an \code{n}-by-2 matrix with every #' row the index of the corresponding entries of \code{x} and \code{y}, #' respectively. #' #' @examples #' g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), #' st_point(c(2, 1)), st_point(c(3, 1))) #' tc <- Sys.time() + 1:5 #' x1 <- st_sftime(a = 1:5, g, time = tc) #' x2 <- st_buffer(x1, dist = 1) #' NULL #' Intersection #' @name geos_binary_ops #' @details \code{st_intersection}: When called with a missing \code{y}, the #' \code{sftime} method for \code{st_intersection} returns an \code{sftime} #' object with attributes taken from the contributing feature with lowest index; #' two fields are added: #' \describe{ #' \item{\code{n.overlaps}}{The number of overlapping features in \code{x}.} #' \item{\code{origins}}{A list-column with indexes of all overlapping #' features.} #' } #' #' @examples #' ## intersection #' #' # only x provided (no y) #' plot(st_intersection(x2)) #' #' # with arguments x and y provided #' plot(st_intersection(x2, x1)) #' #' @export st_intersection.sftime <- function(x, y, ...) { time_column_name <- attr(x, "time_column") reclass_sftime(NextMethod(), time_column_name = time_column_name) } #' Difference #' @name geos_binary_ops #' @details \code{st_difference}: When \code{st_difference} is called with a #' single argument, overlapping areas are erased from geometries that are #' indexed at greater numbers in the argument to \code{x}; geometries that are #' empty or contained fully inside geometries with higher priority are removed #' entirely. #' #' @examples #' ## difference #' #' # only x provided (no y) #' plot(st_difference(x2)) #' #' # with arguments x and y provided #' plot(st_difference(x2, x1)) #' #' @export st_difference.sftime <- function(x, y, ...) { time_column_name <- attr(x, "time_column") reclass_sftime(NextMethod(), time_column_name = time_column_name) } #' @name geos_binary_ops #' @examples #' ## symmetric difference #' plot(st_sym_difference(x1, x2)) #' #' @export st_sym_difference.sftime <- function(x, y, ...) { time_column_name <- attr(x, "time_column") reclass_sftime(NextMethod(), time_column_name = time_column_name) } #' Combine or union feature geometries (including \code{sftime} objects) #' #' @name geos_combine #' @param x An object of class \code{sftime}, \code{sf}, \code{sfc} or #' \code{sfg}. #' @param y An object of class \code{sftime}, \code{sf}, \code{sfc} or #' \code{sfg} (optional). #' @param by_feature See \code{\link[sf:geos_combine]{geos_combine}}. #' @param is_coverage See \code{\link[sf:geos_combine]{geos_combine}}. #' @param ... See \code{\link[sf:geos_combine]{geos_combine}}. #' @return If \code{y} is missing, \code{st_union(x)} returns a single geometry #' with resolved boundaries, else the geometries for all unioned pairs of #' \code{x[i]} and \code{y[j]}. #' @details #' See \code{\link[sf:geos_combine]{geos_combine}}. #' #' @examples #' # union simple features in an sftime object #' g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), #' st_point(c(2, 1)), st_point(c(3, 1))) #' tc <- Sys.time() + 1:5 #' x <- st_sftime(a = 1:5, g, time = tc) #' #' # only x provided (no y) #' plot(st_union(st_buffer(x, dist = 1))) #' #' # with arguments x and y provided #' plot(st_union(st_buffer(x, dist = 1), st_buffer(x, dist = 0.5)), "a") #' #' @export st_union.sftime <- function(x, y, ..., by_feature = FALSE, is_coverage = FALSE) { time_column_name <- attr(x, "time_column") reclass_sftime(NextMethod(), time_column_name = time_column_name) } sftime/R/join.R0000644000176200001440000001373314214414511013030 0ustar liggesusers#' Helper function to adjust class and attributes of \code{sftime} objects when joining #' #' @param x An object to be reclassed to the \code{\link[=st_sftime]{sftime}} #' class. #' @param time_colmn_name A character value; name of the original active time #' column in \code{x} before joining. #' @param suffix_x A character value representing the suffix to add to the name #' of the time column in the \code{time_column} attribute when name repair #' during joining changed the name of the time column. #' #' @return \code{x} as \code{sftime} object with adjusted \code{time_column} #' attribute. #' #' @keywords internal #' @noRd sftime_join <- function(x, time_column_name, suffix_x = ".x") { if (!(time_column_name %in% names(x))) { time_column_name <- paste0(time_column_name, suffix_x) stopifnot(time_column_name %in% names(x)) } st_as_sftime(x, time_column_name = time_column_name) } ## Tidyverse joins (see also tidyverse.R) #' @name tidyverse #' @examples #' g1 <- st_sfc(st_point(1:2), st_point(c(5, 8)), st_point(c(2, 9))) #' x1 <- st_sftime(a = 1:3, geometry = g1, time = Sys.time()) #' #' g2 <- st_sfc(st_point(c(4, 6)), st_point(c(4, 6)), st_point(c(4, 6))) #' x2 <- st_sftime(a = 2:4, geometry = g2, time = Sys.time()) #' #' library(dplyr) #' #' ## inner_join #' inner_join(x1, as.data.frame(x2), by = "a") # note: the active time column is #' # time.x and the active geometry column geometry.x #' #' inner_join(x2, as.data.frame(x1), by = "a") #' inner_join.sftime <- function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { sftime_join(NextMethod(), time_column_name = attr(x, "time_column"), suffix_x = suffix[[1]]) } #' @name tidyverse #' @examples #' ## left_join #' left_join(x1, as.data.frame(x2), by = "a") #' #' left_join(x2, as.data.frame(x1), by = "a") #' left_join.sftime <- function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { sftime_join(NextMethod(), time_column_name = attr(x, "time_column"), suffix_x = suffix[[1]]) } #' @name tidyverse #' @examples #' ## right_join #' right_join(x1, as.data.frame(x2), by = "a") #' #' right_join(x2, as.data.frame(x1), by = "a") #' right_join.sftime <- function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { sftime_join(NextMethod(), time_column_name = attr(x, "time_column"), suffix_x = suffix[[1]]) } #' @name tidyverse #' @examples #' ## full_join #' full_join(x1, as.data.frame(x2), by = "a") #' #' full_join(x2, as.data.frame(x1), by = "a") #' full_join.sftime <- function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { sftime_join(NextMethod(), time_column_name = attr(x, "time_column"), suffix_x = suffix[[1]]) } #' @name tidyverse #' @examples #' ## semi_join #' semi_join(x1, as.data.frame(x2), by = "a") #' #' semi_join(x2, as.data.frame(x1), by = "a") #' semi_join.sftime <- function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { sftime_join(NextMethod(), time_column_name = attr(x, "time_column"), suffix_x = suffix[[1]]) } #' @name tidyverse #' @examples #' ## anti_join #' anti_join(x1, as.data.frame(x2), by = "a") #' #' anti_join(x2, as.data.frame(x1), by = "a") #' anti_join.sftime <- function(x, y, by = NULL, copy = FALSE, suffix = c(".x", ".y"), ...) { sftime_join(NextMethod(), time_column_name = attr(x, "time_column"), suffix_x = suffix[[1]]) } #' Spatial join, spatial filter for \code{sftime} objects #' #' @name st_join #' @param x An object of class \code{sftime} or \code{sf}. #' @param y An object of class \code{sftime} or \code{sf}. #' @param join A geometry predicate function with the same profile as #' \code{\link[sf:geos_binary_pred]{st_intersects}}; see details. #' @inheritParams sf::st_join #' @return An object of class \code{sftime}, joined based on geometry. #' @details Alternative values for argument \code{join} are: #' \itemize{ #' \item \link[sf:geos_binary_pred]{st_contains_properly} #' \item \link[sf:geos_binary_pred]{st_contains} #' \item \link[sf:geos_binary_pred]{st_covered_by} #' \item \link[sf:geos_binary_pred]{st_covers} #' \item \link[sf:geos_binary_pred]{st_crosses} #' \item \link[sf:geos_binary_pred]{st_disjoint} #' \item \link[sf:geos_binary_pred]{st_equals_exact} #' \item \link[sf:geos_binary_pred]{st_equals} #' \item \link[sf:geos_binary_pred]{st_is_within_distance} #' \item \link[sf:geos_binary_pred]{st_nearest_feature} #' \item \link[sf:geos_binary_pred]{st_overlaps} #' \item \link[sf:geos_binary_pred]{st_touches} #' \item \link[sf:geos_binary_pred]{st_within} #' \item any user-defined function of the same profile as the above #' } #' A left join returns all records of the \code{x} object with \code{y} fields #' for non-matched records filled with \code{NA} values; an inner join returns #' only records that spatially match. #' #' @examples #' g1 <- st_sfc(st_point(c(1,1)), st_point(c(2,2)), st_point(c(3,3))) #' x1 <- st_sftime(a = 1:3, geometry = g1, time = Sys.time()) #' #' g2 <- st_sfc(st_point(c(10,10)), st_point(c(2,2)), st_point(c(2,2)), st_point(c(3,3))) #' x2 <- st_sftime(a = 11:14, geometry = g2, time = Sys.time()) #' #' ## st_join #' #' # left spatial join with st_intersects #' st_join(x1, x2) #' #' # inner spatial join with st_intersects #' st_join(x1, x2, left = FALSE) #' #' @export st_join.sftime <- function(x, y, join = st_intersects, ..., suffix = c(".x", ".y"), left = TRUE, largest = FALSE) { sftime_join(NextMethod(), time_column_name = attr(x, "time_column"), suffix_x = suffix[[1]]) } #' @name st_join #' @param .predicate A geometry predicate function with the same profile as #' \code{\link[sf:geos_binary_pred]{st_intersects}}; see details. #' @examples #' ## st_filter #' #' st_filter(x1, x2) #' st_filter(x2, x1) #' #' @export st_filter.sftime <- function(x, y, ..., .predicate = st_intersects) { reclass_sftime(NextMethod(), time_column_name = attr(x, "time_column")) }sftime/R/sftime.R0000644000176200001440000005446014214420406013362 0ustar liggesusers#### construction #### #' Checks whether a vector or list is sortable #' #' Checks whether a vector or list is sortable. This is the condition for a #' vector to be usable as time column in a \code{sftime} object. #' #' @name is_sortable #' @param x The object to check. #' @return \code{TRUE} if \code{x} passes the check, else \code{FALSE}. #' @keywords internal #' #' @details Checks whether the provided object can be handled by #' \code{\link{order}}. A couple of basic types are whitelisted. However, custom #' types can be defined when they provide a dedicated generic to \link{xtfrm}. #' Note that a \code{list} can only be sorted with \link{atomic} values. See the #' examples below for a template. #' #' @examples #' x <- Sys.time() + 5:1 * 3600 * 24 #' sort(x) #' is_sortable(x) #' #' @importFrom utils methods #' @export is_sortable <- function(x) { # can x be sorted? # sort.default checks 'is.object(x)' and uses 'order' to subset and sort the object # lists and vectors are no objects, sort then uses sort.int which can only handle atomic values # Examples: # x <- Sys.time() + 5:1 * 3600*24 # x <- yearmon(2020+c(5:0)/12) # x <- yearqtr(2020+c(5:0)/4) # x <- factor(LETTERS[sample(26, replace = T)], levels=LETTERS[sample(26)]) # sort(x) # order(x) # class(x) any(vapply(class(x), function(y) y %in% c("integer", "numeric", "POSIXct", "POSIXlt", "Date", "yearmon", "yearqtr", "factor"), TRUE)) || # have a list of wellknown exceptions any(vapply(class(x), function(y) paste("xtfrm", y, sep=".") %in% methods(class = y), TRUE)) # check for function 'xtfrm.[CLASSNAME]' which is used by 'order' which in turn is used by sort.default } #' Construct an \code{sftime} object from all its components #' #' @param ... Column elements to be binded into an \code{sftime} object or a #' single \code{list} or \code{data.frame} with such columns. At least one of #' these columns shall be a geometry list-column of class \code{sfc} and one #' shall be a time column (to be specified with \code{time_column_name}). #' @param crs Coordinate reference system, something suitable as input to #' \code{\link[sf]{st_crs}}. #' @param agr A character vector; see details below. #' @param row.names row.names for the created \code{sf} object. #' @param stringsAsFactors A logical value; see #' \code{\link[sf]{st_read}}. #' @param precision A numeric value; see #' \code{\link[sf]{st_as_binary}}. #' @param sf_column_name A character value; name of the active list-column with #' simple feature geometries; in case there is more than one and #' \code{sf_column_name} is \code{NULL}, the first one is taken. #' @param time_column_name A character value; name of the active #' time column. In case \code{time_column_name} is \code{NULL}, the first #' \code{\link{POSIXct}} column is taken. If there is no \code{POSIXct} column, #' the first \code{\link{Date}} column is taken. #' @param sfc_last A logical value; if \code{TRUE}, \code{sfc} columns are #' always put last, otherwise column order is left unmodified. #' @param time_column_last A logical value; if \code{TRUE}, the active time column is #' always put last, otherwise column order is left unmodified. If both \code{sfc_last} #' and \code{time_column_last} are \code{TRUE}, the active time column is put last. #' @param check_ring_dir A logical value; see \code{\link[sf]{st_read}}. #' #' @return \code{st_sftime}: An object of class \code{sftime}. #' @examples #' ## construction with an sfc object #' library(sf) #' g <- st_sfc(st_point(1:2)) #' tc <- Sys.time() #' st_sftime(a = 3, g, time = tc) #' #' ## construction with an sf object #' \dontrun{ #' st_sftime(st_sf(a = 3, g), time = tc) #' # error, because if ... contains a data.frame-like object, no other objects #' # may be passed through ... . Instead, add the time column before. #' } #' #' st_sftime(st_sf(a = 3, g, time = tc)) #' #' @export st_sftime <- function(..., agr = sf::NA_agr_, row.names, stringsAsFactors = TRUE, crs, precision, sf_column_name = NULL, time_column_name = NULL, check_ring_dir = FALSE, sfc_last = TRUE, time_column_last = TRUE) { # checks stopifnot(is.null(time_column_name) || (is.character(time_column_name) && length(time_column_name) == 1)) stopifnot(is.logical(time_column_last) && length(time_column_last) == 1) # pass to sf::st_sf to get sf object x <- list(...) res <- sf::st_sf(..., agr = agr, row.names = row.names, stringsAsFactors = stringsAsFactors, crs = crs, precision = precision, sf_column_name = sf_column_name, sfc_last = sfc_last) # get info on active time column (modified from sf) if(!is.null(time_column_name)) { # time column manually specified stopifnot(time_column_name %in% colnames(res)) stopifnot(is_sortable(res[[time_column_name]])) res_time_column <- match(time_column_name, colnames(res)) res_time_column_name <- time_column_name } else { #search for POSIXct and Date columns # search time column(s) all_time_column_names <- NULL all_time_columns <- vapply(res, function(x) inherits(x, "POSIXct"), TRUE) if(!any(all_time_columns)) { all_time_columns <- vapply(res, function(x) inherits(x, "Date"), TRUE) } if(!any(all_time_columns)) stop("No time column found.") all_time_columns <- which(unlist(all_time_columns)) res_time_column <- all_time_columns[[1L]] res_time_column_name <- names(all_time_columns)[[1L]] } # sort time column if(time_column_last) { res_only_time_column <- sf::st_drop_geometry(res[, res_time_column])[, 1, drop = TRUE] res <- res[, -res_time_column] res[, res_time_column_name] <- res_only_time_column res <- sf::st_sf(res, agr = agr, row.names = row.names, stringsAsFactors = stringsAsFactors, crs = crs, precision = precision, sf_column_name = sf_column_name, sfc_last = FALSE) } # add attributes attr(res, "time_column") <- res_time_column_name if(!inherits(res, "sftime")) class(res) <- c("sftime", class(res)) res } #' Helper function for reclassing \code{sftime} objects #' #' Reclasses \code{sftime} objects to the correct new class after modification. #' Checks if the \code{sftime} object (the active time column) gets invalidated. #' If so, the \code{sftime} class is dropped. If not, the object is reclassed to #' an \code{sftime} object. #' #' @param x An object to be reclassed to the \code{\link[=st_sftime]{sftime}} class. #' @param time_colmn_name A character value; name of the active time column. #' @return \code{x} as \code{sftime} object if the column indicated by #' \code{time_colmn_name} is a valid time column (\code{\link{is_sortable}}) and #' \code{x} without \code{time_column} attribute if not. #' #' @keywords internal #' @noRd reclass_sftime <- function(x, time_column_name) { if(! time_column_name %in% colnames(x) || ! inherits(x, "sf")) { structure(x, class = setdiff(class(x), "sftime"), time_column = NULL) } else { structure(x, class = c("sftime", setdiff(class(x), "sftime")), time_column = time_column_name) } } #### subsetting #### #' @name st_sftime #' @param x An object of class \code{sf}. #' @param i Record selection, see \link{[.data.frame} #' @param j Variable selection, see \link{[.data.frame} #' @param drop A logical value, default \code{FALSE}; if \code{TRUE} drop the #' geometry column and return a \code{data.frame}, else make the geometry sticky #' and return an \code{sf} object. #' @param op A function; geometrical binary predicate function to apply when #' \code{i} is a simple feature object. #' @details See also \link{[.data.frame}; for \code{[.sftime} \code{...} #' arguments are passed to \code{op}. #' @return Returned objects for subsetting functions: \code{[.sf} will return a #' \code{data.frame} or vector if the geometry column (of class \code{sfc}) is #' dropped (\code{drop=TRUE}), an \code{sfc} object if only the geometry column #' is selected, and otherwise return an \code{sftime} object. #' @examples #' ## Subsetting #' g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), #' st_point(c(2, 1)), st_point(c(3, 1))) #' tc <- Sys.time() + 1:5 #' x <- st_sftime(a = 1:5, g, time = tc) #' #' # rows #' x[1, ] #' class(x[1, ]) #' #' x[x$a < 3, ] #' class(x[x$a < 3, ]) #' #' # columns #' x[, 1] #' class(x[, 1]) # drops time column as for ordinary data.frame subsetting, #' # keeps geometry column of sf object #' #' x[, 3] #' class(x[, 3]) # keeps time column because it is explicitly selected, #' # keeps geometry column of sf object, returns an sftime object #' #' x[, 3, drop = TRUE] #' class(x[, 3, drop = TRUE]) # if the geometry column is dropped, not only the #' # sf class is dropped, but also the sftime class #' #' x["a"] #' class(x["a"]) # Time columns are not sticky: If a column is selected by a #' # character vector and this does not contain the active time column, the time #' # column is dropped. #' #' x[c("a", "time")] #' class(x[c("a", "time")]) # keeps the time column #' #' # with sf or sftime object #' pol = st_sfc(st_polygon(list(cbind(c(0,2,2,0,0),c(0,0,2,2,0))))) #' h = st_sf(r = 5, pol) #' #' x[h, ] #' class(x[h, ]) # returns sftime object #' #' h[x, ] #' class(h[x, ]) # returns sf object #' #' @export "[.sftime" <- function(x, i, j, ..., drop = FALSE, op = sf::st_intersects) { # retain info on time column time_column <- attr(x, "time_column") # perform subsetting for sf object if((!missing(j) && !drop && ((is.character(j) && any(j == time_column)) || (is.numeric(j) && any(colnames(x)[j] == time_column)))) || !missing(i) && !drop && ((is.character(i)) && any(i == time_column) || is.numeric(i) || is.logical(i))) { structure(NextMethod(), class = class(x), time_column = time_column) } else { x <- structure(x, class = setdiff(class(x), "sftime"), time_column = NULL) NextMethod() } # ---todo: what to do when i is an sftime object: match also time info } #' @name st_sftime #' @param value An object to insert into \code{x}. #' @examples #' ## Assigning values to columns #' #' # assigning new values to a non-time column #' x[["a"]] <- 5:1 #' class(x) #' #' # assigning allowed new values to the time column #' x[["time"]] <- Sys.time() + 1:5 #' class(x) #' #' # assigning new values to the time column which invalidate the time column #' x[["time"]] <- list(letters[1:2]) #' class(x) #' #' @export "[[<-.sftime" <- function(x, i, value) { time_column_name <- attr(x, "time_column") reclass_sftime(NextMethod(), time_column_name = time_column_name) } #' @name st_sftime #' @examples #' # assigning new values with `$` #' x$time <- Sys.time() + 1:5 #' class(x) #' #' @export "$<-.sftime" = function(x, i, value) { structure(NextMethod(), class = c("sftime", setdiff(class(x), "sftime"))) } #### printing #### #' Helper function to print time columns when printing an \code{sftime} object #' #' @noRd #' @keywords internal #' @param x A time column from a \code{\link[=st_sftime]{sftime}} object. #' @param n An integer value; The first \code{n} elements of \code{x} to print. #' @param print_number_features A logical value; whether the number of features #' shall be printed (\code{TRUE}) or not (\code{FALSE}). #' #' @return \code{x} (invisible). print_time_column <- function(x, n = 5L, print_number_features = FALSE) { stopifnot(is.logical(print_number_features) && length(print_number_features) == 1) stopifnot(is.integer(n) && length(n) == 1) ord <- order(x) if(length(x) != 0) { x_min <- x[[ord[[1]]]] x_max <- x[[ord[[length(ord)]]]] } else { x_min <- x_max <- NA } x_class <- class(x) x_is_value <- length(x) == 1 cat(paste0("Time column with ", ifelse(!print_number_features, "", paste0(length(x), ifelse(x_is_value, " feature of ", " features, each of "))), ifelse(length(x_class) == 2, "class", "classes"), ": \'", paste0(x_class[-1], collapse="\', \'"), "\'.\n", ifelse(x_is_value, paste0("Representing ", x_min, ".\n" ), paste0("Ranging from ", x_min, " to ", x_max, ".\n" )))) for(i in seq_len(min(n, length(x)))) { ret <- x[[i]] class(ret) <- setdiff(class(ret), "tc") message(ret) } invisible(x) } #' Prints an \code{sftime} object #' #' @param x An object of class \code{sftime}. #' @param ... Currently unused arguments, for compatibility. #' @param n Numeric value; maximum number of printed elements. #' #' @return \code{x} (invisible). #' @examples #' g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), #' st_point(c(2, 1)), st_point(c(3, 1))) #' tc <- Sys.time() + 1:5 #' x <- st_sftime(a = 1:5, g, time = tc) #' print(x) #' print(x[0, ]) #' #' @export print.sftime <- function(x, ..., n = getOption("sf_max_print", default = 10)) { geoms <- which(vapply(x, function(col) inherits(col, "sfc"), TRUE)) nf <- length(x) - length(geoms) - 1 app <- paste("and", nf, ifelse(nf == 1, "field", "fields")) if (any(!is.na(st_agr(x)))) { su = summary(st_agr(x)) summ = paste(paste(su, names(su)), collapse = ", ") app <- paste0(app, "\n", "Attribute-geometry relationship: ", summ) } if (length(geoms) > 1) app <- paste0(app, "\n", "Active geometry column: ", attr(x, "sf_column")) print(st_geometry(x), n = 0, what = "Spatiotemporal feature collection with", append = app) # temporal information print_time_column(x[, attr(x, "time_column"), drop = TRUE], n = 0L, print_number_features = FALSE) if(n > 0) { if (inherits(x, "tbl_df")) { x_print <- x class(x_print) <- setdiff(class(x_print), c("sftime", "sf")) print(x_print) } else { y <- x if(nrow(y) > n) { cat(paste("First", n, "features:\n")) y <- x[seq_len(n), , drop = FALSE] } print.data.frame(y, ...) } } invisible(x) } #### coercion #### #' Convert a foreign object to an \code{sftime} object #' #' @name st_as_sftime #' @param x An object to be converted into an object of class #' \code{\link[=st_sftime]{sftime}}. #' @param ... Further arguments passed to methods. #' #' @return \code{x} converted to an \code{sftime} object. #' #' @export #' @importFrom methods slotNames as st_as_sftime = function(x, ...) UseMethod("st_as_sftime") #' @name st_as_sftime #' @examples #' # modified from spacetime: #' library(sp) #' library(spacetime) #' #' sp <- cbind(x = c(0,0,1), y = c(0,1,1)) #' row.names(sp) <- paste("point", 1:nrow(sp), sep="") #' sp <- SpatialPoints(sp) #' time <- as.POSIXct("2010-08-05") + 3600 * (10:12) #' x <- STI(sp, time) #' #' st_as_sftime(x) #' #' @export st_as_sftime.ST <- function(x, ...) { has_data <- "data" %in% slotNames(x) if (!inherits(x, "STI")) { if (has_data) x <- as(x, "STIDF") else x <- as(x, "STI") } times <- as.POSIXct(attr(x@time, "index"), origin = "1970-01-01") if (has_data) st_sftime(x@data, st_as_sfc(x@sp), time = times) else st_sftime(st_as_sfc(x@sp), time = times) } #' @name st_as_sftime #' @examples #' # convert a Track object from package trajectories to an sftime object #' library(trajectories) #' x1_Track <- trajectories::rTrack(n = 100) #' x1_Track@data$speed <- sort(rnorm(length(x1_Track))) #' x1_sftime <- st_as_sftime(x1_Track) #' #' @export st_as_sftime.Track <- function(x, ...) { has_data <- "data" %in% slotNames(x) if (has_data) x <- as(x, "STIDF") else x <- as(x, "STI") st_as_sftime(x) } #' @name st_as_sftime #' @return \code{st_as_sftime.Tracks} furthermore adds a column #' \code{track_name} with the names of the \code{tracks} slot of the input #' \code{Tracks} object. #' #' @examples #' # convert a Tracks object from package trajectories to an sftime object #' x2_Tracks <- trajectories::rTracks(m = 6) #' x2_sftime <- st_as_sftime(x2_Tracks) #' #' @export st_as_sftime.Tracks <- function(x, ...) { track_name <- unlist(lapply(seq_along(x@tracks), function(i) rep(names(x@tracks)[[i]], x@tracksData$n[[i]]))) cbind(st_as_sftime(as(x, "STIDF")), track_name = track_name) } #' @name st_as_sftime #' @return \code{st_as_sftime.TracksCollection} furthermore adds the columns #' \code{tracks_name} with the names of the \code{tracksCollection} slot and #' \code{track_name} with the names of the \code{tracks} slot of the input #' \code{Tracks} object. #' #' @examples #' # convert a TracksCollection object from package trajectories to an sftime object #' x3_TracksCollection <- trajectories::rTracksCollection(p = 2, m = 3, n = 50) #' x3_sftime <- st_as_sftime(x3_TracksCollection) #' #' @export st_as_sftime.TracksCollection <- function(x, ...) { track_names <- do.call(rbind, lapply(seq_along(x@tracksCollection), function(i) { n <- sum(x@tracksCollection[[i]]@tracksData$n) track_i <- x@tracksCollection[[i]] data.frame( tracks_name = rep(names(x@tracksCollection)[[i]], n), track_name = unlist(lapply(seq_along(track_i@tracks), function(j) rep(names(track_i@tracks)[[j]], track_i@tracksData$n[[j]]))), stringsAsFactors = FALSE ) })) cbind(st_as_sftime(as(x, "STIDF")), track_names) } #' @name st_as_sftime #' @examples #' # convert an sftime object to an sftime object #' st_as_sftime(x3_sftime) #' #' @export st_as_sftime.sftime <- function(x, ...) x #' @name st_as_sftime #' @param time_column_name A character value; name of the active time column. In #' case there is more than one and \code{time_column_name} is \code{NULL}, the #' first one is taken. #' @examples #' # convert an sf object to an sftime object #' g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), #' st_point(c(2, 1)), st_point(c(3, 1))) #' x4_sf <- st_sf(a = 1:5, g, time = Sys.time() + 1:5) #' x4_sftime <- st_as_sftime(x4_sf) #' #' @export st_as_sftime.sf <- function(x, ..., time_column_name = NULL) { st_sftime(x, ..., time_column_name = time_column_name) } #' @name st_as_sftime #' @param long A logical value; See \code{\link[stars:st_as_sf]{st_as_sf}}. #' Typically, \code{long} should be set to \code{TRUE} since time information #' typically is a dimension of a \code{stars} object. #' @examples #' # convert a Tracks object from package trajectories to an sftime object #' x5_stars <- stars::read_stars(system.file("nc/bcsd_obs_1999.nc", package = "stars")) #' x5_sftime <- st_as_sftime(x5_stars, time_column_name = "time") #' #' # this requires some thought to not accidentally drop time dimensions. For #' # example, setting `merge = TRUE` will drop the time dimension and thus throw #' # an error: #' \dontrun{ #' x5_sftime <- st_as_sftime(x5_stars, merge = TRUE, time_column_name = "time") #' } #' #' @export st_as_sftime.stars <- function(x, ..., long = TRUE, time_column_name = NULL) { res <- sf::st_as_sf(x, ..., long = long) if(!time_column_name %in% colnames(res)) stop("`time_column_name` is not a column in the converted object.") st_sftime(res, time_column_name = time_column_name) } #' @name st_as_sftime #' @param agr A character vector; see the details section of \code{\link{st_sf}}. #' @param coords In case of point data: names or numbers of the numeric columns #' holding coordinates. #' @param wkt The name or number of the character column that holds WKT encoded #' geometries. #' @param dim Passed on to \code{\link{st_point}} (only when argument #' \code{coords} is given). #' @param remove A logical value; when \code{coords} or \code{wkt} is given, #' remove these columns from \code{x}? #' @param na.fail A logical value; if \code{TRUE}, raise an error if coordinates #' contain missing values. #' @inheritParams st_sftime #' @examples #' # convert a data frame to an sftime object #' x5_df <- #' data.frame(a = 1:5, g, time = Sys.time() + 1:5, stringsAsFactors = FALSE) #' x5_sftime <- st_as_sftime(x5_df) #' #' @export st_as_sftime.data.frame <- function(x, ..., agr = NA_agr_, coords, wkt, dim = "XYZ", remove = TRUE, na.fail = TRUE, sf_column_name = NULL, time_column_name = NULL, time_column_last = FALSE) { st_sftime( sf::st_as_sf( x, ..., agr = agr, coords = coords, wkt = wkt, dim = dim, remove = remove, na.fail = na.fail, sf_column_name = sf_column_name ), time_column_name = time_column_name, time_column_last = time_column_last ) } #### transform attributes #### #' Transform method for \code{sftime} objects #' #' Can be used to create or modify attribute variables; for transforming #' geometries see \code{\link[sf]{st_transform}}, and all other functions starting with #' \code{st_}. #' #' @param _data An object of class \code{\link[=st_sftime]{sftime}}. #' @inheritParams sf::transform.sf #' #' @return \code{_data} (an \code{sftime object}) with modified attribute values #' (columns). #' #' @examples #' # create an sftime object #' g <- st_sfc(st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), #' st_point(c(2, 1)), st_point(c(3, 1))) #' x <- #' data.frame(a = 1:5, g, time = Sys.time() + 1:5, stringsAsFactors = FALSE) #' x_sftime <- st_as_sftime(x) #' x_sftime #' #' # modify values in column a #' transform(x_sftime, a = rev(a)) #' #' @export transform.sftime <- function (`_data`, ...) { reclass_sftime(NextMethod(), time_column_name = attr(`_data`, "time_column")) } sftime/R/init.R0000644000176200001440000000504114213634240013027 0ustar liggesusers#' @import sf NULL # from: https://github.com/cran/sf/blob/master/R/tidyverse.R: # from: https://github.com/tidyverse/hms/blob/master/R/zzz.R # Thu Apr 19 10:53:24 CEST 2018 register_s3_method <- function(pkg, generic, class, fun = NULL) { stopifnot(is.character(pkg), length(pkg) == 1) stopifnot(is.character(generic), length(generic) == 1) stopifnot(is.character(class), length(class) == 1) if (is.null(fun)) { fun <- get(paste0(generic, ".", class), envir = parent.frame()) } else { stopifnot(is.function(fun)) } if (pkg %in% loadedNamespaces()) { registerS3method(generic, class, fun, envir = asNamespace(pkg)) } # Always register hook in case package is later unloaded & reloaded setHook( packageEvent(pkg, "onLoad"), function(...) { registerS3method(generic, class, fun, envir = asNamespace(pkg)) } ) } register_all_s3_methods <- function() { # tidyverse joins register_s3_method("dplyr", "inner_join", "sftime") register_s3_method("dplyr", "left_join", "sftime") register_s3_method("dplyr", "right_join", "sftime") register_s3_method("dplyr", "full_join", "sftime") register_s3_method("dplyr", "semi_join", "sftime") register_s3_method("dplyr", "anti_join", "sftime") register_s3_method("dplyr", "filter", "sftime") register_s3_method("dplyr", "arrange", "sftime") register_s3_method("dplyr", "distinct", "sftime") register_s3_method("dplyr", "group_by", "sftime") register_s3_method("dplyr", "mutate", "sftime") register_s3_method("dplyr", "rename", "sftime") register_s3_method("dplyr", "rowwise", "sftime") register_s3_method("dplyr", "sample_frac", "sftime") register_s3_method("dplyr", "sample_n", "sftime") register_s3_method("dplyr", "select", "sftime") register_s3_method("dplyr", "slice", "sftime") register_s3_method("dplyr", "summarise", "sftime") register_s3_method("dplyr", "summarize", "sftime") register_s3_method("dplyr", "transmute", "sftime") register_s3_method("dplyr", "ungroup", "sftime") register_s3_method("tidyr", "gather", "sftime") register_s3_method("tidyr", "pivot_longer", "sftime") register_s3_method("tidyr", "spread", "sftime") register_s3_method("tidyr", "nest", "sftime") register_s3_method("tidyr", "separate", "sftime") register_s3_method("tidyr", "separate_rows", "sftime") register_s3_method("tidyr", "unite", "sftime") register_s3_method("tidyr", "unnest", "sftime") } .onLoad <- function(libname, pkgname) { register_all_s3_methods() }sftime/R/crop.R0000644000176200001440000000200714214414361013027 0ustar liggesusers#' Crop an \code{sftime} object to a specific rectangle #' #' @param x An object of class \code{sftime}. #' @param y A numeric vector with named elements \code{xmin}, \code{ymin}, #' \code{xmax} and \code{ymax}, or an object of class \code{bbox}, or an object #' for which there is an \code{\link[sf:st_bbox]{st_bbox}} method to convert it #' to a \code{bbox} object. #' @param ... Additional arguments; Ignored. #' @return \code{x} cropped using \code{y}. #' @details #' See \code{\link[sf:st_crop]{st_crop}}. #' @examples #' # modified from sf: #' box <- c(xmin = 0, ymin = 0, xmax = 1, ymax = 1) #' pol <- sf::st_sfc(sf::st_buffer(sf::st_point(c(0.5, 0.5)), 0.6)) #' pol_sftime <- st_sftime(a = 1, geom = pol, time = Sys.time() + 1:2 * 1000) #' #' pol_sftime_cropped <- sf::st_crop(pol_sftime, sf::st_bbox(box)) #' #' class(pol_sftime_cropped) #' plot(pol_sftime_cropped) #' @export st_crop.sftime <- function(x, y, ...) { reclass_sftime(NextMethod(), time_column_name = attr(x, "time_column")) }sftime/R/bind.R0000644000176200001440000000627114214414341013005 0ustar liggesusers#' Bind rows (features) of \code{sftime} objects #' #' @name bind #' @param ... Objects to bind; note that for the \code{rbind} and \code{cbind} #' methods, all objects have to be of class \code{sftime}; see #' \code{\link{dotsMethods}}. #' @param deparse.level An integer value; see \code{\link{rbind}}. #' @return \code{rbind} combines all \code{sftime} objects in \code{...} #' row-wise and returns the combined \code{sftime} object. #' @details Both \code{rbind} and \code{cbind} have non-standard method dispatch #' (see \link[base]{cbind}): the \code{rbind} or \code{cbind} method for #' \code{sftime} objects is only called when all arguments to be combined are of #' class \code{sftime}. #' @export #' @examples #' g1 <- st_sfc(st_point(1:2)) #' x1 <- st_sftime(a = 3, geometry = g1, time = Sys.time()) #' #' g2 <- st_sfc(st_point(c(4, 6))) #' x2 <- st_sftime(a = 4, geometry = g2, time = Sys.time()) #' #' rbind(x1, x2) # works because both tc1 and tc2 have the same class #' #' \dontrun{ #' st_time(x2) <- 1 #' rbind(x1, x2) # error because both tc1 and tc2 do not have the same class #' } #' rbind.sftime <- function(..., deparse.level = 1) { dots <- list(...) dots <- dots[!sapply(dots, is.null)] stopifnot(vapply(dots, inherits, "sftime", FUN.VALUE = TRUE)) tc0 <- class(st_time(dots[[1]])) if (length(dots) > 1L) { # check all time columns are equal... equal_tc <- vapply(dots[-1L], function(x) identical(tc0, class(st_time(x))), TRUE) if (!all(equal_tc)) stop("Arguments have different time column classes", call. = FALSE) } nr <- sapply(dots, NROW) tc_column <- if (any(nr > 0)) attr(dots[[ which(nr > 0)[1] ]], "tc_column") else NULL st_sftime(do.call(rbind, lapply(dots, function(x) structure(x, class = setdiff(class(x), "sftime")))), time_column_name = tc_column) } #' Bind columns (variables) of \code{sftime} objects #' #' @name bind #' @param sf_column_name Character value; specifies the active geometry column; #' passed on to \code{\link{st_sftime}}. #' @param tc_column_name Character value; specifies active time column; passed #' on to \code{\link{st_sftime}}. #' @return \code{cbind} combines all \code{sftime} objects in \code{...} #' column-wise and returns the combined \code{sftime} object. When called with #' multiple \code{sftime} objects warns about multiple time and geometry columns #' present when the time and geometry columns to use are not specified by using #' arguments \code{tc_column_name} and \code{sf_column_name}; see also #' \link{st_sftime}. #' @export #' @details If you need to \code{cbind} e.g. a \code{data.frame} to an \code{sf}, #' use \code{\link{data.frame}} directly and use \code{\link{st_sftime}} on its #' result, or use \code{\link[dplyr:bind]{bind_cols}}; see examples. #' @examples #' cbind(x1, x2) #' #' if (require(dplyr)) #' dplyr::bind_cols(x1, x2) #' #' df <- data.frame(x = 3) #' st_sftime(data.frame(x1, df)) #' cbind.sftime = function(..., deparse.level = 1, sf_column_name = NULL, tc_column_name = NULL) { st_sftime(data.frame(...), sf_column_name = sf_column_name, time_column_name = tc_column_name) } sftime/R/plot.R0000644000176200001440000000516714214416540013055 0ustar liggesusers#' Plots an \code{sftime} object #' #' \code{plot.sftime} #' #' @aliases plot #' @param x The \code{\link[=st_sftime]{sftime}} object to be plotted. #' @param y A character value; The variable name to be plotted; if missing, the #' first variable is plotted. #' @param ... Additional arguments; Passed on to \code{\link[sf:plot]{plot.sf}}. #' @param number A numeric value; The number of panels to be plotted, cannot be #' larger than the number of timestamps; ignored when \code{tcuts} is provided. #' @param tcuts predefined temporal ranges assigned to each map; if missing, #' will be determined as equal spans according to \code{number}. #' #' @importFrom graphics plot #' #' @return Returns \code{NULL} and creates as side effect a plot for \code{x}. #' @examples #' set.seed(123) #' coords <- matrix(runif(100), ncol = 2) #' g <- st_sfc(lapply(1:50, function(i) st_point(coords[i, ]) )) #' sft <- st_sftime(a = 1:50, g, time = as.POSIXct("2020-09-01 00:00:00") + 0:49 * 3600 * 6) #' #' plot(sft) #' #' @export plot.sftime <- function(x, y, ..., number = 6, tcuts) { if (missing(y)) y <- colnames(x)[[1]] stopifnot(y %in% colnames(x)) ts <- st_time(x) if(any(is.na(ts))) { message("[INFO] there are ", sum(is.na(ts)), " `NA` values in the active time column of `x`. These rows are dropped.") } x <- x[!is.na(ts), ] ts <- st_time(x) if (missing(tcuts)) { ts_ord <- order(ts) ts_fac <- tryCatch(as.factor(ts[ts_ord]), error = function(e) e) if (inherits(ts_fac, "error")) { ts_fac <- factor( as.character(ts[ts_ord]), levels = unique(as.character(ts[ts_ord])), ordered = TRUE ) } ts_nlv <- length(levels(ts_fac)) if (number > ts_nlv) { number <- ts_nlv message("[INFO] Fewer time stamps in the data than asked for; argument 'number' set to: ", ts_nlv) } tcuts <- seq(1, ts_nlv, length.out = number + 1) timeclass <- findInterval(as.numeric(ts_fac), tcuts, rightmost.closed = TRUE) } else { number <- length(tcuts) - 1 timeclass <- findInterval(ts, tcuts, rightmost.closed = TRUE) } d_ord <- as.data.frame(x)[order(ts), y, drop = FALSE] data <- d_ord if (number > 1) { for (i in 2:number) { data <- cbind(data, d_ord[, 1]) data[timeclass != i, i] = NA if (i == number) data[timeclass != 1, 1] <- NA # deal with first time class } } names(data) <- ts_fac[!duplicated(timeclass)] d <- sf::st_sf(data, geometry = sf::st_geometry(x)) plot(d, ...) NULL }sftime/R/tidyverse.R0000644000176200001440000002103014214417342014101 0ustar liggesusers# Tidyverse methods (See also join.R) #' 'tidyverse' methods for \code{sftime} objects #' #' 'tidyverse' methods for \code{sftime} objects. Geometries are sticky, use #' \code{\link{as.data.frame}} to let \code{dplyr}'s own methods drop them. Use #' these methods without the \code{.sftime} suffix and after loading the #' 'tidyverse' package with the generic (or after loading package 'tidyverse'). #' @name tidyverse #' @inheritParams sf::tidyverse #' @inheritParams tidyr::pivot_longer #' @param x An object of class \code{sftime}. #' @param .data An object of class \code{stime}. #' @return #' \itemize{ #' \item For \code{_join} methods: An object of class \code{sftime} #' representing the joining result of \code{x} and \code{y}. See #' \code{\link[dplyr]{mutate-joins}}. #' \item For \code{filter}: See \code{\link[dplyr]{filter}}. #' \item For \code{arrange}: See \code{\link[dplyr]{arrange}}. #' \item For \code{group_by} and \code{ungroup}: A grouped \code{sftime} #' object. See \code{\link[dplyr]{arrange}}. #' \item For \code{rowwise}: An \code{sftime} object. See #' \code{\link[dplyr]{rowwise}}. #' \item For \code{mutate} and \code{transmute}: See #' \code{\link[dplyr]{mutate}}. #' \item For \code{select}: See \code{\link[dplyr]{select}}. If the active #' time column is not explicitly selected, a \code{sf} object is returned. #' \item For \code{rename}: See \code{\link[dplyr]{rename}}. #' \item For \code{slice}: See \code{\link[dplyr]{slice}}. #' \item For \code{summarize} and \code{summarise}: See #' \code{\link[dplyr]{summarise}}. #' \item For \code{distinct}: See \code{\link[dplyr]{distinct}}. #' \item For \code{gather}: See \code{\link[tidyr]{gather}}. #' } #' NULL #' @rdname tidyverse #' @examples #' ## filter #' filter(x1, a <= 2) #' filter.sftime <- function(.data, ..., .dots) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## arrange #' arrange(x1, dplyr::desc(a)) #' arrange.sftime <- function(.data, ..., .dots) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## group_by #' group_by(x1, time) #' group_by.sftime <- function(.data, ..., add = FALSE) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## ungroup #' ungroup(group_by(x1, time)) #' ungroup.sftime <- function(.data, ...) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## rowwise #' x1 %>% #' mutate(a1 = 5:7) %>% #' rowwise() %>% #' mutate(a2 = mean(a, a1)) #' rowwise.sftime <- function(.data, ...) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## mutate #' x1 %>% #' mutate(a1 = 5:7) #' mutate.sftime <- function(.data, ..., .dots) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## transmute #' x1 %>% #' transmute(a1 = 5:7) #' transmute.sftime <- function(.data, ..., .dots) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## select #' x1 %>% #' select(-time) %>% #' select(geometry) #' select.sftime <- function(.data, ...) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## rename #' x1 %>% #' rename(a1 = a) #' rename.sftime <- function(.data, ...) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## slice #' x1 %>% #' slice(1:2) #' slice.sftime <- function(.data, ..., .dots) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## summarise #' x1 %>% #' summarise(time = mean(time)) #' #' x1 %>% #' summarize(time = mean(time)) #' summarise.sftime <- function(.data, ..., .dots, do_union = TRUE, is_coverage = FALSE) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse summarize.sftime <- summarise.sftime #' @rdname tidyverse #' @examples #' ## distinct #' x1 %>% #' distinct(geometry) #' distinct.sftime <- function(.data, ..., .keep_all = FALSE) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @rdname tidyverse #' @examples #' ## gather #' library(tidyr) #' x1 %>% #' mutate(a1 = 5:7) %>% #' gather(key = "variable", value = "value", a, a1) #' gather.sftime <- function(data, key, value, ..., na.rm = FALSE, convert = FALSE, factor_key = FALSE) { reclass_sftime(NextMethod(), time_column_name = attr(data, "time_column")) } #' @rdname tidyverse #' @examples #' ## pivot_longer #' x1 %>% #' mutate(a1 = 5:7) %>% #' pivot_longer(cols = c("a", "a1"), names_to = "variable", values_to = "value") #' pivot_longer.sftime <- function (data, cols, names_to = "name", names_prefix = NULL, names_sep = NULL, names_pattern = NULL, names_ptypes = NULL, names_transform = NULL, names_repair = "check_unique", values_to = "value", values_drop_na = FALSE, values_ptypes = NULL, values_transform = NULL, ...) { reclass_sftime(NextMethod(), time_column_name = attr(data, "time_column")) } #' @rdname tidyverse #' @examples #' ## spread #' x1 %>% #' mutate(a1 = 5:7) %>% #' gather(key = "variable", value = "value", a, a1) %>% #' spread(key = "variable", value = "value") #' spread.sftime <- function(data, key, value, fill = NA, convert = FALSE, drop = TRUE, sep = NULL) { reclass_sftime(NextMethod(), time_column_name = attr(data, "time_column")) } #' @rdname tidyverse #' @examples #' ## sample_n #' set.seed(234) #' x1 %>% #' sample_n(size = 10, replace = TRUE) #' sample_n.sftime <- function(tbl, size, replace = FALSE, weight = NULL, .env = parent.frame()) { reclass_sftime(NextMethod(), time_column_name = attr(tbl, "time_column")) } #' @rdname tidyverse #' @examples #' ## sample_frac #' x1 %>% #' sample_frac(size = 10, replace = TRUE) %>% #' sample_frac(size = 0.1, replace = FALSE) #' sample_frac.sftime <- function(tbl, size = 1, replace = FALSE, weight = NULL, .env = parent.frame()) { reclass_sftime(NextMethod(), time_column_name = attr(tbl, "time_column")) } #' @rdname tidyverse #' @examples #' ## nest #' x1 %>% #' nest(a1 = -time) #' nest.sftime <- function (.data, ...) { reclass_sftime(NextMethod(), time_column_name = attr(.data, "time_column")) } #' @name tidyverse #' @examples #' ## unnest #' x1 %>% #' mutate(a1 = list(1, c(1, 2), 5)) %>% #' unnest(a1) #' unnest.sftime = function(data, ..., .preserve = NULL) { reclass_sftime(NextMethod(), time_column_name = attr(data, "time_column")) } #' @rdname tidyverse #' @examples #' ## separate #' x1 %>% #' mutate(x = c(NA, "a.b", "a.d")) %>% #' separate(x, c("A", "B")) #' separate.sftime <- function(data, col, into, sep = "[^[:alnum:]]+", remove = TRUE, convert = FALSE, extra = "warn", fill = "warn", ...) { time_column_name <- attr(data, "time_column") class(data) <- setdiff(class(data), "sftime") # modified from sftime (tidyverse.R) if (!requireNamespace("rlang", quietly = TRUE)) stop("rlang required: install first?") col <- rlang::enquo(col) res <- tidyr::separate(data, !!col, into = into, sep = sep, remove = remove, convert = convert, extra = extra, fill = fill, ...) reclass_sftime(res, time_column_name = time_column_name) } #' @name tidyverse #' @examples #' ## unite #' x1 %>% #' mutate(x = c(NA, "a.b", "a.d")) %>% #' separate(x, c("A", "B")) %>% #' unite(x, c("A", "B")) #' unite.sftime <- function(data, col, ..., sep = "_", remove = TRUE) { reclass_sftime(NextMethod(), time_column_name = attr(data, "time_column")) } #' @rdname tidyverse #' @examples #' ## separate_rows #' x1 %>% #' mutate(z = c("1", "2,3,4", "5,6")) %>% #' separate_rows(z, convert = TRUE) #' separate_rows.sftime <- function(data, ..., sep = "[^[:alnum:]]+", convert = FALSE) { reclass_sftime(NextMethod(), time_column_name = attr(data, "time_column")) } sftime/R/st_cast.R0000644000176200001440000000121114213634240013517 0ustar liggesusers#' Cast geometry to another type: either simplify, or cast explicitly #' #' @name st_cast #' @inheritParams sf::st_cast #' @param x An object of class \code{sftime}. #' @return \code{x} with changed geometry type. #' @examples #' # cast from POINT to LINESTRING #' g <- st_sfc(st_point(1:2), st_point(c(2, 4))) #' time <- Sys.time() #' x <- #' st_sftime(a = 3:4, g, time = time) %>% #' dplyr::group_by(time) %>% #' dplyr::summarize(do_union = TRUE) %>% #' st_cast(to = "LINESTRING") #' @export st_cast.sftime <- function(x, to, ..., warn = TRUE, do_split = TRUE) { reclass_sftime(NextMethod(), attr(x, "time_column")) }sftime/R/st_time.R0000644000176200001440000001010214214417251013524 0ustar liggesusers#' Get, set, or replace time information #' #' @param obj An object of class \code{sftime}. #' @param x An object of class \code{sftime} or \code{sf}. #' @param ... Additional arguments; Ignored. #' @param time_column_name Character value; The name of the column to set as #' active time column in \code{x}. #' @param value An object for which \code{\link{is_sortable}} returns #' \code{TRUE} or an object of class \code{character}, or \code{NULL}. #' #' @details In case \code{value} is character and \code{x} is of class #' \code{sftime}, the active time column (as indicated by attribute #' \code{time_column}) is set to \code{x[[value]]}. #' #' The replacement function applied to \code{sftime} objects will overwrite the #' active time column, if \code{value} is \code{NULL}, it will remove it and #' coerce \code{x} to an \code{sftime} object. #' #' @return \code{st_time} returns the content of the active time column of an #' \code{sftime} object. #' Assigning an object for which \code{\link{is_sortable}} returns \code{TRUE} #' to an \code{sf} object creates an \code{\link[=st_sftime]{sftime}} object. #' Assigning an object for which \code{\link{is_sortable}} returns \code{TRUE} #' to an \code{sftime} object replaces the active time column by this object. #' @export st_time <- function(obj, ...) UseMethod("st_time") #' @rdname st_time #' @export `st_time<-` = function(x, ..., value) UseMethod("st_time<-") #' @rdname st_time #' @export #' @examples #' # from sftime object #' g <- st_sfc(st_point(1:2)) #' time <- Sys.time() #' x <- st_sftime(a = 3, g, time = time) #' st_time(x) #' st_time.sftime <- function(obj, ...) { ret <- obj[[attr(obj, "time_column")]] if (!is_sortable(ret)) # corrupt! stop('attr(obj, "time_column") does not point to a time column.\nDid you rename it, without setting st_time(obj) <- "newname"?') ret } #' @rdname st_time #' @export #' @examples #' ## assign a vector with time information #' #' # to sf object #' x <- st_sf(a = 3, g) #' st_time(x) <- time #' x #' `st_time<-.sf` <- function(x, ..., time_column_name = "time", value) { stopifnot(is_sortable(value)) stopifnot(is.character(time_column_name) && length(time_column_name) == 1) x[[time_column_name]] <- value st_sftime(x, time_column_name = time_column_name) } #' @rdname st_time #' @export #' @examples #' # to sftime object #' x <- st_sftime(a = 3, g, time = time) #' st_time(x) <- Sys.time() #' #' ## remove time column from sftime object #' st_time(x) <- NULL #' `st_time<-.sftime` = function(x, ..., value) { if (! is.null(value)) { stopifnot(is_sortable(value) || is.character(value)) if (inherits(value, "tc")) stopifnot(nrow(x) == length(value)) if (is.character(value)) stopifnot(inherits(x[[value]], "tc")) } if (! is.null(value) && is.character(value)) {# set flag to another column: #---todo: when removing the tc class, it will not be possible to use as time column a character vector or a class derived from a character vector stopifnot(length(value) == 1) attr(x, "time_column") <- value } else {# replace, remove, or set list-column x[[attr(x, "time_column")]] <- value } if (is.null(value)) structure(x, time_column = NULL, class = setdiff(class(x), "sftime")) else st_as_sftime(x) } #' @rdname st_time #' @export #' @examples #' ## pipe-friendly #' #' # assign time column to sf object #' x <- st_sf(a = 3, g) #' x <- st_set_time(x, time) #' #' # remove time column from sftime object #' st_set_time(x, NULL) #' st_set_time <- function(x, value, ...) { st_time(x, ...) <- value x } #' @rdname st_time #' @export #' @details \code{st_drop_time} drops the time column of its argument, and #' reclasses it accordingly. #' @examples #' ## drop time column and class #' #' # same as x <- st_set_time(x, NULL) #' st_drop_time(x) #' st_drop_time = function(x) { if (!inherits(x, "sftime")) stop("`st_drop_time` only works with objects of class sftime") st_set_time(x, NULL) }sftime/R/st_geometry.R0000644000176200001440000000134714214416624014437 0ustar liggesusers#' Drops the geometry column of \code{sftime} objects #' #' Drops the geometry column of an \code{sftime} object. This will also drop #' the \code{sftime} class attribute and \code{time_column} attribute. #' #' @name st_geometry #' @inheritParams sf::st_drop_geometry #' @param x An \code{sftime} object. #' @return \code{x} without geometry column and without \code{sftime} and #' \code{sf} class. #' @examples #' # dropping the geometry column will also drop the `sftime` class: #' g <- st_sfc(st_point(1:2)) #' time <- Sys.time() #' x <- st_sftime(a = 3, g, time = time) #' st_drop_geometry(x) #' #' @export st_drop_geometry.sftime <- function(x, ...) { class(x) <- setdiff(class(x), "sftime") NextMethod() }sftime/NEWS.md0000644000176200001440000000005614213634240012637 0ustar liggesusers# version 0.2-0 * initial CRAN submission sftime/MD50000644000176200001440000000340614214573071012060 0ustar liggesusers86697837629b8a5b9638ffe36fbb00f5 *DESCRIPTION b33d5bed090cf85968f3a69f94565149 *NAMESPACE 6bd5e212853a2b7b6b9eef73913819f0 *NEWS.md 274b6abbb02de404b19deeea9174a4b7 *R/bind.R 6dfd1450c9352dc97fe8f49ea1493c61 *R/crop.R 25b20df90a96179bca3f806b9af97fb4 *R/geom-transformers.R 6c25a0292daf2a9871f861b7c53df113 *R/init.R f84a8aa8cb4d3a94cbdc14b36d0cbf09 *R/join.R 46b6f4a5f9fa063460f91ab2809ede3f *R/plot.R 4098cc19816d9b198509888a138a55d7 *R/sftime.R d9042f28673028de92c47d600db7734f *R/st_cast.R 4c9acf1fe7556d4d8881496295ed35a5 *R/st_geometry.R 43547c5a49b11a6e6104886a06095d86 *R/st_time.R f53fe0993a54bf8e1199c5118f02849e *R/tidyverse.R 904a00396a339db917a4aa280e7c7cdd *build/vignette.rds d728664a20e663654041475bf66754ce *inst/doc/sftime.R 90978516bb7e936cbb5182c1e262f573 *inst/doc/sftime.Rmd 6a3ede84fd5dcb58d2ee5bffe663e5e3 *inst/doc/sftime.html 09bfb1a7b41772f0b818f41bf3570a9b *man/bind.Rd 4d71d1e9e969f7107bdbc868732b65f0 *man/geos_binary_ops.Rd 4df88399afb67be8c01378b4eb29c6e9 *man/geos_combine.Rd 581e32b3b47b09c48a7fb4bdf18fe189 *man/is_sortable.Rd 515ffee52acc35b73566496b75ca10f4 *man/plot.sftime.Rd b48c77fb32e5aeb031586161ee519502 *man/print.sftime.Rd efaab00d7baab9e3ae30939e8653d2b7 *man/st_as_sftime.Rd 76a1d634e420ab3d12f4407cb4695404 *man/st_cast.Rd 221b70c311258ed336de9ca511fe12e0 *man/st_crop.sftime.Rd 2463cc2de6f85298a0a327df5d28c01f *man/st_geometry.Rd b4abc940ae8ac92d001b69099cf0694b *man/st_join.Rd e2054d9e4a46158c54f16f7e6c8dbd31 *man/st_sftime.Rd 5ca4dc7e4171be5cf91ef79ca5ab9a8e *man/st_time.Rd 4f256cd91e87f0012c0df1b5ddd4e499 *man/tidyverse.Rd a794b7e9aec9216e70a1d80c464f8eed *man/transform.sftime.Rd 6a694f123c278139e3aef3138d2f7188 *tests/basic.R b574c6a154921ebecfb723c61e630a50 *tests/basic.Rout.save 90978516bb7e936cbb5182c1e262f573 *vignettes/sftime.Rmd sftime/inst/0000755000176200001440000000000014214426347012525 5ustar liggesuserssftime/inst/doc/0000755000176200001440000000000014214426347013272 5ustar liggesuserssftime/inst/doc/sftime.Rmd0000644000176200001440000003022714213634240015221 0ustar liggesusers--- title: "Introduction to sftime" author: "Benedikt Gräler, Edzer Pebesma" date: "`r Sys.Date()`" output: rmarkdown::html_vignette vignette: > %\VignetteIndexEntry{Introduction to sftime} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} --- ```{r setup, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ``` The package `sftime` extends package `sf` to store and handle spatiotemporal data. To this end, `sftime` introduces a dedicated time column that stores the temporal information alongside the simple features column of an `sf` object. The time column can consists of any collection of a class that allows to be sorted - reflecting the native order of time. Besides well-known time classes such as `Date` or `POSIXct`, it also allows for custom class definitions that come with the necessary methods to make sorting work (we will see a example below). This vignette briefly explains and illustrates the ideas and decisions behind the implementation of `sftime`. ```{r packages} # load required packages library(sftime) library(sf) library(stars) library(spacetime) library(ggplot2) library(tidyr) library(magrittr) ``` ## The `sftime` class An `sftime` object is an `sf` object with an additional time column that contains the temporal information alongside the simple features column. This allows it to handle irregular and regular temporal information. For spatiotemporal data with regular temporal data (raster or vector data cubes: data where each geometry is observed at the same set of time instances), package `stars` is developed as a powerful alternative (e.g. time series of remote sensing imagery, regular measurements of entire measurement network). `sftime` fills the gap for data where arbitrary combinations of geometry and time occur, including irregularly collected sensor data or (spatiotemporal) point pattern data. `sftime` objects can be constructed directly from `sfc` objects by combining them with a vector representing temporal information: ```{r sftime-class-1} # example sfc object x_sfc <- sf::st_sfc( sf::st_point(1:2), sf::st_point(c(1,3)), sf::st_point(2:3), sf::st_point(c(2,1)) ) # create an sftime object directly from x_sfc x_sftime1 <- sftime::st_sftime(a = 1:4, x_sfc, time = Sys.time()- 0:3 * 3600 * 24) # first create the sf object and from this the sftime object x_sf <- sf::st_sf(a = 1:4, x_sfc, time = x_sftime1$time) x_sftime2 <- sftime::st_sftime(x_sf) x_sftime3 <- sftime::st_as_sftime(x_sf) # alernative option identical(x_sftime1, x_sftime2) identical(x_sftime1, x_sftime3) x_sftime1 ``` Methods for `sftime` objects are: ```{r sftime-class-2} methods(class = "sftime") ``` Methods for `sf` objects which are not listed above work also for `sftime` objects. ## Functions to get or set the time column of an `sftime` object Functions to get or set the time column of an `sftime` object are: ```{r time-column-1} # get the values from the time column st_time(x_sftime1) x_sftime1$time # alternative way # set the values in the time column st_time(x_sftime1) <- Sys.time() st_time(x_sftime1) # drop the time column to convert an sftime object to an sf object st_drop_time(x_sftime1) x_sftime1 # add a time column to an sf object converts it to an sftime object st_time(x_sftime1, time_column_name = "time") <- Sys.time() class(x_sftime1) # These can also be used with pipes x_sftime1 <- x_sftime1 %>% st_drop_time() %>% st_set_time(Sys.time(), time_column_name = "time") ``` ## Conversion to class `sftime` sftime supports coercion to `sftime` objects from the following classes (grouped according to packages): - sf: sf - stars: stars - spacetime: STI, STIDF - trajectories: Track, Tracks, TracksCollection - sftrack: sftrack, sftraj **Conversion from `sf` objects:** ```{r} # define the geometry column g <- st_sfc( st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1)) ) # crate sf object x4_sf <- st_sf(a = 1:5, g, time = Sys.time() + 1:5) # convert to sftime x4_sftime <- st_as_sftime(x4_sf) class(x4_sftime) ``` **Conversion from `stars` objects:** ```{r} # load sample data x5_stars <- stars::read_ncdf(system.file("nc/bcsd_obs_1999.nc", package = "stars"), var = c("pr", "tas")) # convert to sftime x5_sftime <- st_as_sftime(x5_stars, time_column_name = "time") ``` `st_as_sftime.stars` is a wrapper around `st_as_sf.stars`. As a consequence, some dimensions of the `stars` object can be dropped during conversion. Temporal information in `stars` objects are typically stored as dimension of an attribute. Therefore, some argument settings to `st_as_sftime` can drop the dimension with temporal information and therefore throw an error. For example, setting `merge = TRUE` drops dimension `time` and therefore conversion fails. Similarly, setting `long = FALSE` returns the attribute values in a wide format, where each column is a time point: ```{r, error = TRUE} # failed conversion to sftime x5_sftime <- st_as_sftime(x5_stars, merge = TRUE, time_column_name = "time") x5_sftime <- st_as_sftime(x5_stars, long = FALSE, time_column_name = "time") ``` **Conversion from `spacetime` objects** ```{r} # get sample data example(STI, package = "spacetime") class(stidf) # conversion to sftime x1_sftime <- st_as_sftime(stidf) ``` **Conversion from `Track`, `Tracks`, `TracksCollections` objects (trajectories package)** ```{r} # get a sample TracksCollection x2_TracksCollection <- trajectories::rTracksCollection(p = 2, m = 3, n = 40) # convert to sftime x2_TracksCollection_sftime <- st_as_sftime(x2_TracksCollection) x2_Tracks_sftime <- st_as_sftime(x2_TracksCollection@tracksCollection[[1]]) x2_Track_sftime <- st_as_sftime(x2_TracksCollection@tracksCollection[[1]]@tracks[[1]]) ``` ## Subsetting Different subsetting methods exist for `sftime` objects. Since `sftime` objects are built on top of `sf` objects, all subsetting methods for `sf` objects also work for `sftime` objects. Above (section [The `sftime` class]), the method to subset the time column was introduced: ```{r} st_time(x_sftime1) ``` Other subsetting functions work as for `sf` objects, e.g. selecting rows by row indices returns the specified rows. A key difference is that the active time column of an `sftime` object is not sticky --- in contrast to the active simple feature column in `sf` objects. Therefore, the active time column of an `sftime` object always has to be selected explicitly. If omitted, the subset will simplify to an `sf` objects without the active time column: ```{r} # selecting rows and columns (works just as for sf objects) x_sftime1[1, ] x_sftime1[, 3] # beware: the time column is not sticky. If omitted, the subset becomes an sf object class(x_sftime1[, 1]) class(x_sftime1["a"]) # the same x_sftime1[, 1] # to retain the time column and an sftime object, explicitly select the time column during subsetting: class(x_sftime1[, c(1, 3)]) class(x_sftime1[c("a", "time")]) # the same ``` ## Plotting For quick plotting, a plot method exists for `sftime` objects, which plots longitude-latitude coordinates and colors simple features according to values of a specified variable. Different panels are plotted for different time intervals which can be specified. Simple feature geometries might be overlaid several times when multiple observations fall in the same time interval. This is similar to `stplot()` from package spacetime with `mode = "xy"`: ```{r plotting-plot.sftime-1, fig.width=7} coords <- matrix(runif(100), ncol = 2) g <- sf::st_sfc(lapply(1:50, function(i) st_point(coords[i, ]) )) x_sftime4 <- st_sftime( a = 1:200, b = rnorm(200), id_object = as.factor(rep(1:4,each=50)), geometry = g, time = as.POSIXct("2020-09-01 00:00:00") + 0:49 * 3600 * 6 ) plot(x_sftime4, key.pos = 4) ``` The plotting method internally uses the `plot` method for `sf` objects. This makes it possible to customize plot appearance using the arguments of `plot.sf()`, for example: ```{r plotting-plot.sftime-2, fig.width=7} plot(x_sftime4, number = 10, max.plot = 10, key.pos = 4) ``` To create customized plots or plots which have different variables on plot axes than longitude and latitude, we recommend using ggplot2. For example, the plot method output can be mimicked by: ```{r plotting-ggplot-1, fig.width=7} library(ggplot2) ggplot() + geom_sf(data = x_sftime4, aes(color = b)) + facet_wrap(~ cut_number(time, n = 6)) + theme( panel.spacing.x = unit(4, "mm"), panel.spacing.y = unit(4, "mm") ) ``` This strategy can also be used to create other plots, for example plotting the id of entities over time (similar to `stplot()` with `mode = "xt"`): ```{r plotting-ggplot-2, fig.width=7} ggplot(x_sftime4) + geom_point(aes(y = id_object, x = time, color = b)) ``` Or for plotting time series of values of all variables with different panels for each entity (location) defined via a categorical variable (similar to `stplot()` with `mode = "tp"`): ```{r plotting-ggplot-3, fig.width=7} x_sftime4 %>% tidyr::pivot_longer(cols = c("a", "b"), names_to = "variable", values_to = "value") %>% ggplot() + geom_path(aes(y = value, x = time, color = variable)) + facet_wrap(~ id_object) ``` Or for plotting time series of values of all variables for all entities defined via a categorical variable with different panels for each variable (similar to `stplot()` with `mode = "ts"`): ```{r plotting-ggplot-4, fig.width=7} x_sftime4 %>% tidyr::pivot_longer(cols = c("a", "b"), names_to = "variable", values_to = "value") %>% ggplot() + geom_path(aes(y = value, x = time, color = id_object)) + facet_wrap(~ variable, scales = "free_y") ``` ## User-defined time columns The time column is a special column of the underlying sf object which defines time information (timestamps and temporal ordering) alongside the simple features column of an sf object. Common time representations in R (e.g. `POSIXct`, `POSIXlt`, `Date`, `yearmon`, `yearqtr`) are allowed, as well as optional user-defined types. Let us look at a simple example where we define a time column based on `POSIXct` ```{r, eval=TRUE} (tc <- as.POSIXct("2020-09-01 08:00:00")-0:3*3600*24) ``` The ordering is not altered upon construction (as in some other representations). If a different order is required, the `order` function and `sort` method can be applied to the time column: ```{r} tc order(tc) sort(tc) ``` In some applications it might be useful to have more complex temporal information such as intervals of different length. The following example is also meant as template for other user-defined classes which could be used to build the time column of the sftime class. At first, we will need a few helper functions: ```{r} # utility functions as.character.interval <- function(x) { paste0("[", x[1], ", ", x[2], "]") } print.interval <- function(x, ...) { cat("Interval:", as.character(x), "\n") } #'[.intervals' <- function(x, i) { # sx <- unclass(x)[i] # class(sx) <- "intervals" # sx #} ``` Now, we can define the different intervals used to represent our temporal information: ```{r} # time interval definition i1 <- c(5.3,12) class(i1) <- "interval" i2 <- c(3.1,6) class(i2) <- "interval" i3 <- c(1.4,6.9) class(i3) <- "interval" i4 <- c(1,21) class(i4) <- "interval" intrvls <- structure(list(i1, i2, i3, i4), class = "Intervals") # provide dedicated generic to xtfrm for class intervals ``` The advantage is to be able to define different sorting approaches: ```{r} xtfrm.Intervals <- function(x) sapply(x, mean) # - sort by centre (tc <- intrvls) order(tc) sort(tc)[1] ``` ```{r} # - sort by end xtfrm.Intervals <- function(x) sapply(x, max) (tc <- intrvls) order(tc) sort(tc)[1] ``` ```{r} # - sort by start xtfrm.Intervals <- function(x) sapply(x, min) tc <- intrvls order(tc) sort(tc)[1] ``` Based on the sorting procedure (begin, centre or end of the interval), the smallest element (each last line) and the order of the time column changes. sftime/inst/doc/sftime.R0000644000176200001440000001623614214426347014714 0ustar liggesusers## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----packages----------------------------------------------------------------- # load required packages library(sftime) library(sf) library(stars) library(spacetime) library(ggplot2) library(tidyr) library(magrittr) ## ----sftime-class-1----------------------------------------------------------- # example sfc object x_sfc <- sf::st_sfc( sf::st_point(1:2), sf::st_point(c(1,3)), sf::st_point(2:3), sf::st_point(c(2,1)) ) # create an sftime object directly from x_sfc x_sftime1 <- sftime::st_sftime(a = 1:4, x_sfc, time = Sys.time()- 0:3 * 3600 * 24) # first create the sf object and from this the sftime object x_sf <- sf::st_sf(a = 1:4, x_sfc, time = x_sftime1$time) x_sftime2 <- sftime::st_sftime(x_sf) x_sftime3 <- sftime::st_as_sftime(x_sf) # alernative option identical(x_sftime1, x_sftime2) identical(x_sftime1, x_sftime3) x_sftime1 ## ----sftime-class-2----------------------------------------------------------- methods(class = "sftime") ## ----time-column-1------------------------------------------------------------ # get the values from the time column st_time(x_sftime1) x_sftime1$time # alternative way # set the values in the time column st_time(x_sftime1) <- Sys.time() st_time(x_sftime1) # drop the time column to convert an sftime object to an sf object st_drop_time(x_sftime1) x_sftime1 # add a time column to an sf object converts it to an sftime object st_time(x_sftime1, time_column_name = "time") <- Sys.time() class(x_sftime1) # These can also be used with pipes x_sftime1 <- x_sftime1 %>% st_drop_time() %>% st_set_time(Sys.time(), time_column_name = "time") ## ----------------------------------------------------------------------------- # define the geometry column g <- st_sfc( st_point(c(1, 2)), st_point(c(1, 3)), st_point(c(2, 3)), st_point(c(2, 1)), st_point(c(3, 1)) ) # crate sf object x4_sf <- st_sf(a = 1:5, g, time = Sys.time() + 1:5) # convert to sftime x4_sftime <- st_as_sftime(x4_sf) class(x4_sftime) ## ----------------------------------------------------------------------------- # load sample data x5_stars <- stars::read_ncdf(system.file("nc/bcsd_obs_1999.nc", package = "stars"), var = c("pr", "tas")) # convert to sftime x5_sftime <- st_as_sftime(x5_stars, time_column_name = "time") ## ---- error = TRUE------------------------------------------------------------ # failed conversion to sftime x5_sftime <- st_as_sftime(x5_stars, merge = TRUE, time_column_name = "time") x5_sftime <- st_as_sftime(x5_stars, long = FALSE, time_column_name = "time") ## ----------------------------------------------------------------------------- # get sample data example(STI, package = "spacetime") class(stidf) # conversion to sftime x1_sftime <- st_as_sftime(stidf) ## ----------------------------------------------------------------------------- # get a sample TracksCollection x2_TracksCollection <- trajectories::rTracksCollection(p = 2, m = 3, n = 40) # convert to sftime x2_TracksCollection_sftime <- st_as_sftime(x2_TracksCollection) x2_Tracks_sftime <- st_as_sftime(x2_TracksCollection@tracksCollection[[1]]) x2_Track_sftime <- st_as_sftime(x2_TracksCollection@tracksCollection[[1]]@tracks[[1]]) ## ----------------------------------------------------------------------------- st_time(x_sftime1) ## ----------------------------------------------------------------------------- # selecting rows and columns (works just as for sf objects) x_sftime1[1, ] x_sftime1[, 3] # beware: the time column is not sticky. If omitted, the subset becomes an sf object class(x_sftime1[, 1]) class(x_sftime1["a"]) # the same x_sftime1[, 1] # to retain the time column and an sftime object, explicitly select the time column during subsetting: class(x_sftime1[, c(1, 3)]) class(x_sftime1[c("a", "time")]) # the same ## ----plotting-plot.sftime-1, fig.width=7-------------------------------------- coords <- matrix(runif(100), ncol = 2) g <- sf::st_sfc(lapply(1:50, function(i) st_point(coords[i, ]) )) x_sftime4 <- st_sftime( a = 1:200, b = rnorm(200), id_object = as.factor(rep(1:4,each=50)), geometry = g, time = as.POSIXct("2020-09-01 00:00:00") + 0:49 * 3600 * 6 ) plot(x_sftime4, key.pos = 4) ## ----plotting-plot.sftime-2, fig.width=7-------------------------------------- plot(x_sftime4, number = 10, max.plot = 10, key.pos = 4) ## ----plotting-ggplot-1, fig.width=7------------------------------------------- library(ggplot2) ggplot() + geom_sf(data = x_sftime4, aes(color = b)) + facet_wrap(~ cut_number(time, n = 6)) + theme( panel.spacing.x = unit(4, "mm"), panel.spacing.y = unit(4, "mm") ) ## ----plotting-ggplot-2, fig.width=7------------------------------------------- ggplot(x_sftime4) + geom_point(aes(y = id_object, x = time, color = b)) ## ----plotting-ggplot-3, fig.width=7------------------------------------------- x_sftime4 %>% tidyr::pivot_longer(cols = c("a", "b"), names_to = "variable", values_to = "value") %>% ggplot() + geom_path(aes(y = value, x = time, color = variable)) + facet_wrap(~ id_object) ## ----plotting-ggplot-4, fig.width=7------------------------------------------- x_sftime4 %>% tidyr::pivot_longer(cols = c("a", "b"), names_to = "variable", values_to = "value") %>% ggplot() + geom_path(aes(y = value, x = time, color = id_object)) + facet_wrap(~ variable, scales = "free_y") ## ---- eval=TRUE--------------------------------------------------------------- (tc <- as.POSIXct("2020-09-01 08:00:00")-0:3*3600*24) ## ----------------------------------------------------------------------------- tc order(tc) sort(tc) ## ----------------------------------------------------------------------------- # utility functions as.character.interval <- function(x) { paste0("[", x[1], ", ", x[2], "]") } print.interval <- function(x, ...) { cat("Interval:", as.character(x), "\n") } #'[.intervals' <- function(x, i) { # sx <- unclass(x)[i] # class(sx) <- "intervals" # sx #} ## ----------------------------------------------------------------------------- # time interval definition i1 <- c(5.3,12) class(i1) <- "interval" i2 <- c(3.1,6) class(i2) <- "interval" i3 <- c(1.4,6.9) class(i3) <- "interval" i4 <- c(1,21) class(i4) <- "interval" intrvls <- structure(list(i1, i2, i3, i4), class = "Intervals") # provide dedicated generic to xtfrm for class intervals ## ----------------------------------------------------------------------------- xtfrm.Intervals <- function(x) sapply(x, mean) # - sort by centre (tc <- intrvls) order(tc) sort(tc)[1] ## ----------------------------------------------------------------------------- # - sort by end xtfrm.Intervals <- function(x) sapply(x, max) (tc <- intrvls) order(tc) sort(tc)[1] ## ----------------------------------------------------------------------------- # - sort by start xtfrm.Intervals <- function(x) sapply(x, min) tc <- intrvls order(tc) sort(tc)[1] sftime/inst/doc/sftime.html0000644000176200001440000035673614214426347015473 0ustar liggesusers Introduction to sftime

Introduction to sftime

Benedikt Gräler, Edzer Pebesma

2022-03-16

The package sftime extends package sf to store and handle spatiotemporal data. To this end, sftime introduces a dedicated time column that stores the temporal information alongside the simple features column of an sf object.

The time column can consists of any collection of a class that allows to be sorted - reflecting the native order of time. Besides well-known time classes such as Date or POSIXct, it also allows for custom class definitions that come with the necessary methods to make sorting work (we will see a example below).

This vignette briefly explains and illustrates the ideas and decisions behind the implementation of sftime.

# load required packages
library(sftime)
#> Loading required package: sf
#> Warning: package 'sf' was built under R version 4.0.5
#> Linking to GEOS 3.9.1, GDAL 3.2.1, PROJ 7.2.1; sf_use_s2() is TRUE
library(sf)
library(stars)
#> Warning: package 'stars' was built under R version 4.0.5
#> Loading required package: abind
library(spacetime)
#> Warning: package 'spacetime' was built under R version 4.0.5
library(ggplot2)
#> Warning: package 'ggplot2' was built under R version 4.0.2
library(tidyr)
library(magrittr)
#> 
#> Attaching package: 'magrittr'
#> The following object is masked from 'package:tidyr':
#> 
#>     extract

The sftime class

An sftime object is an sf object with an additional time column that contains the temporal information alongside the simple features column. This allows it to handle irregular and regular temporal information.

For spatiotemporal data with regular temporal data (raster or vector data cubes: data where each geometry is observed at the same set of time instances), package stars is developed as a powerful alternative (e.g. time series of remote sensing imagery, regular measurements of entire measurement network). sftime fills the gap for data where arbitrary combinations of geometry and time occur, including irregularly collected sensor data or (spatiotemporal) point pattern data.

sftime objects can be constructed directly from sfc objects by combining them with a vector representing temporal information:

# example sfc object
x_sfc <- 
  sf::st_sfc(
    sf::st_point(1:2), 
    sf::st_point(c(1,3)), 
    sf::st_point(2:3), 
    sf::st_point(c(2,1))
  )

# create an sftime object directly from x_sfc
x_sftime1 <- sftime::st_sftime(a = 1:4, x_sfc, time = Sys.time()- 0:3 * 3600 * 24)

# first create the sf object and from this the sftime object
x_sf <- sf::st_sf(a = 1:4, x_sfc, time = x_sftime1$time)
x_sftime2 <- sftime::st_sftime(x_sf)

x_sftime3 <- sftime::st_as_sftime(x_sf) # alernative option

identical(x_sftime1, x_sftime2)
#> [1] TRUE
identical(x_sftime1, x_sftime3)
#> [1] TRUE

x_sftime1
#> Spatiotemporal feature collection with 4 features and 1 field
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 2 ymax: 3
#> CRS:           NA
#> Time column with class: 'POSIXt'.
#> Ranging from 2022-03-13 19:31:00 to 2022-03-16 19:31:00.
#>   a       x_sfc                time
#> 1 1 POINT (1 2) 2022-03-16 19:31:00
#> 2 2 POINT (1 3) 2022-03-15 19:31:00
#> 3 3 POINT (2 3) 2022-03-14 19:31:00
#> 4 4 POINT (2 1) 2022-03-13 19:31:00

Methods for sftime objects are:

methods(class = "sftime")
#>  [1] $<-               [                 [[<-              cbind            
#>  [5] filter            gather            nest              pivot_longer     
#>  [9] plot              print             rbind             separate         
#> [13] separate_rows     spread            st_as_sftime      st_cast          
#> [17] st_crop           st_difference     st_drop_geometry  st_filter        
#> [21] st_intersection   st_join           st_sym_difference st_time          
#> [25] st_time<-         st_union          transform         unite            
#> [29] unnest           
#> see '?methods' for accessing help and source code

Methods for sf objects which are not listed above work also for sftime objects.

Functions to get or set the time column of an sftime object

Functions to get or set the time column of an sftime object are:

# get the values from the time column
st_time(x_sftime1)
#> [1] "2022-03-16 19:31:00 CET" "2022-03-15 19:31:00 CET"
#> [3] "2022-03-14 19:31:00 CET" "2022-03-13 19:31:00 CET"
x_sftime1$time # alternative way
#> [1] "2022-03-16 19:31:00 CET" "2022-03-15 19:31:00 CET"
#> [3] "2022-03-14 19:31:00 CET" "2022-03-13 19:31:00 CET"

# set the values in the time column
st_time(x_sftime1) <- Sys.time()
st_time(x_sftime1)
#> [1] "2022-03-16 19:31:00 CET" "2022-03-16 19:31:00 CET"
#> [3] "2022-03-16 19:31:00 CET" "2022-03-16 19:31:00 CET"

# drop the time column to convert an sftime object to an sf object
st_drop_time(x_sftime1)
#> Simple feature collection with 4 features and 1 field
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 2 ymax: 3
#> CRS:           NA
#>   a       x_sfc
#> 1 1 POINT (1 2)
#> 2 2 POINT (1 3)
#> 3 3 POINT (2 3)
#> 4 4 POINT (2 1)
x_sftime1
#> Spatiotemporal feature collection with 4 features and 1 field
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 2 ymax: 3
#> CRS:           NA
#> Time column with class: 'POSIXt'.
#> Ranging from 2022-03-16 19:31:00 to 2022-03-16 19:31:00.
#>   a       x_sfc                time
#> 1 1 POINT (1 2) 2022-03-16 19:31:00
#> 2 2 POINT (1 3) 2022-03-16 19:31:00
#> 3 3 POINT (2 3) 2022-03-16 19:31:00
#> 4 4 POINT (2 1) 2022-03-16 19:31:00

# add a time column to an sf object converts it to an sftime object
st_time(x_sftime1, time_column_name = "time") <- Sys.time()
class(x_sftime1)
#> [1] "sftime"     "sf"         "data.frame"

# These can also be used with pipes
x_sftime1 <-
  x_sftime1 %>%
  st_drop_time() %>%
  st_set_time(Sys.time(), time_column_name = "time")

Conversion to class sftime

sftime supports coercion to sftime objects from the following classes (grouped according to packages):

  • sf: sf
  • stars: stars
  • spacetime: STI, STIDF
  • trajectories: Track, Tracks, TracksCollection
  • sftrack: sftrack, sftraj

Conversion from sf objects:

# define the geometry column
g <- 
  st_sfc(
    st_point(c(1, 2)), 
    st_point(c(1, 3)), 
    st_point(c(2, 3)), 
    st_point(c(2, 1)), 
    st_point(c(3, 1))
  )

# crate sf object
x4_sf <- st_sf(a = 1:5, g, time = Sys.time() + 1:5)

# convert to sftime
x4_sftime <- st_as_sftime(x4_sf) 
class(x4_sftime)
#> [1] "sftime"     "sf"         "data.frame"

Conversion from stars objects:

# load sample data
x5_stars <- stars::read_ncdf(system.file("nc/bcsd_obs_1999.nc", package = "stars"), var = c("pr", "tas"))
#> No projection information found in nc file. 
#>  Coordinate variable units found to be degrees, 
#>  assuming WGS84 Lat/Lon.

# convert to sftime
x5_sftime <- st_as_sftime(x5_stars, time_column_name = "time")

st_as_sftime.stars is a wrapper around st_as_sf.stars. As a consequence, some dimensions of the stars object can be dropped during conversion. Temporal information in stars objects are typically stored as dimension of an attribute. Therefore, some argument settings to st_as_sftime can drop the dimension with temporal information and therefore throw an error. For example, setting merge = TRUE drops dimension time and therefore conversion fails. Similarly, setting long = FALSE returns the attribute values in a wide format, where each column is a time point:

# failed conversion to sftime
x5_sftime <- st_as_sftime(x5_stars, merge = TRUE, time_column_name = "time")
#> Error in st_as_sftime.stars(x5_stars, merge = TRUE, time_column_name = "time"): `time_column_name` is not a column in the converted object.
x5_sftime <- st_as_sftime(x5_stars, long = FALSE, time_column_name = "time")
#> Error in st_as_sftime.stars(x5_stars, long = FALSE, time_column_name = "time"): `time_column_name` is not a column in the converted object.

Conversion from spacetime objects

# get sample data
example(STI, package = "spacetime")
#> 
#> STI> sp = cbind(x = c(0,0,1), y = c(0,1,1))
#> 
#> STI> row.names(sp) = paste("point", 1:nrow(sp), sep="")
#> 
#> STI> library(sp)
#> 
#> STI> sp = SpatialPoints(sp)
#> 
#> STI> time = as.POSIXct("2010-08-05")+3600*(10:13)
#> 
#> STI> m = c(10,20,30) # means for each of the 3 point locations
#> 
#> STI> mydata = rnorm(length(sp)*length(time),mean=rep(m, 4))
#> 
#> STI> IDs = paste("ID",1:length(mydata))
#> 
#> STI> mydata = data.frame(values = signif(mydata,3), ID=IDs)
#> 
#> STI> stidf = as(STFDF(sp, time, mydata), "STIDF")
#> 
#> STI> stidf[1:2,]
#> An object of class "STIDF"
#> Slot "data":
#>   values   ID
#> 1   9.69 ID 1
#> 2  20.00 ID 2
#> 
#> Slot "sp":
#> SpatialPoints:
#>        x y
#> point1 0 0
#> point2 0 1
#> Coordinate Reference System (CRS) arguments: NA 
#> 
#> Slot "time":
#>                     timeIndex
#> 2010-08-05 10:00:00         1
#> 2010-08-05 10:00:00         1
#> 
#> Slot "endTime":
#> [1] "2010-08-05 11:00:00 CEST" "2010-08-05 11:00:00 CEST"
#> 
#> 
#> STI> all.equal(stidf, stidf[stidf,])
#> [1] TRUE
class(stidf)
#> [1] "STIDF"
#> attr(,"package")
#> [1] "spacetime"

# conversion to sftime
x1_sftime <- st_as_sftime(stidf)

Conversion from Track, Tracks, TracksCollections objects (trajectories package)

# get a sample TracksCollection
x2_TracksCollection <- trajectories::rTracksCollection(p = 2, m = 3, n = 40)

# convert to sftime
x2_TracksCollection_sftime <- st_as_sftime(x2_TracksCollection)
x2_Tracks_sftime <- st_as_sftime(x2_TracksCollection@tracksCollection[[1]])
x2_Track_sftime <- st_as_sftime(x2_TracksCollection@tracksCollection[[1]]@tracks[[1]])

Subsetting

Different subsetting methods exist for sftime objects. Since sftime objects are built on top of sf objects, all subsetting methods for sf objects also work for sftime objects.

Above (section The sftime class), the method to subset the time column was introduced:

st_time(x_sftime1)
#> [1] "2022-03-16 19:31:00 CET" "2022-03-16 19:31:00 CET"
#> [3] "2022-03-16 19:31:00 CET" "2022-03-16 19:31:00 CET"

Other subsetting functions work as for sf objects, e.g. selecting rows by row indices returns the specified rows. A key difference is that the active time column of an sftime object is not sticky — in contrast to the active simple feature column in sf objects.
Therefore, the active time column of an sftime object always has to be selected explicitly. If omitted, the subset will simplify to an sf objects without the active time column:

# selecting rows and columns (works just as for sf objects)
x_sftime1[1, ]
#> Spatiotemporal feature collection with 1 feature and 1 field
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 2 xmax: 1 ymax: 2
#> CRS:           NA
#> Time column with class: 'POSIXt'.
#> Representing 2022-03-16 19:31:00.
#>   a       x_sfc                time
#> 1 1 POINT (1 2) 2022-03-16 19:31:00
x_sftime1[, 3]
#> Spatiotemporal feature collection with 4 features and 0 fields
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 2 ymax: 3
#> CRS:           NA
#> Time column with class: 'POSIXt'.
#> Ranging from 2022-03-16 19:31:00 to 2022-03-16 19:31:00.
#>                  time       x_sfc
#> 1 2022-03-16 19:31:00 POINT (1 2)
#> 2 2022-03-16 19:31:00 POINT (1 3)
#> 3 2022-03-16 19:31:00 POINT (2 3)
#> 4 2022-03-16 19:31:00 POINT (2 1)

# beware: the time column is not sticky. If omitted, the subset becomes an sf object
class(x_sftime1[, 1])
#> [1] "sf"         "data.frame"
class(x_sftime1["a"]) # the same
#> [1] "sf"         "data.frame"
x_sftime1[, 1]
#> Simple feature collection with 4 features and 1 field
#> Geometry type: POINT
#> Dimension:     XY
#> Bounding box:  xmin: 1 ymin: 1 xmax: 2 ymax: 3
#> CRS:           NA
#>   a       x_sfc
#> 1 1 POINT (1 2)
#> 2 2 POINT (1 3)
#> 3 3 POINT (2 3)
#> 4 4 POINT (2 1)

# to retain the time column and an sftime object, explicitly select the time column during subsetting:
class(x_sftime1[, c(1, 3)])
#> [1] "sftime"     "sf"         "data.frame"
class(x_sftime1[c("a", "time")]) # the same
#> [1] "sftime"     "sf"         "data.frame"

Plotting

For quick plotting, a plot method exists for sftime objects, which plots longitude-latitude coordinates and colors simple features according to values of a specified variable. Different panels are plotted for different time intervals which can be specified. Simple feature geometries might be overlaid several times when multiple observations fall in the same time interval. This is similar to stplot() from package spacetime with mode = "xy":

coords <- matrix(runif(100), ncol = 2)
g <- sf::st_sfc(lapply(1:50, function(i) st_point(coords[i, ]) ))

x_sftime4 <- 
  st_sftime(
    a = 1:200,
    b = rnorm(200),
    id_object = as.factor(rep(1:4,each=50)),
    geometry = g, 
    time = as.POSIXct("2020-09-01 00:00:00") + 0:49 * 3600 * 6
) 
#> Warning in data.frame(..., check.names = FALSE): row names were found from a
#> short variable and have been discarded

plot(x_sftime4, key.pos = 4)

#> NULL

The plotting method internally uses the plot method for sf objects. This makes it possible to customize plot appearance using the arguments of plot.sf(), for example:

plot(x_sftime4, number = 10, max.plot = 10, key.pos = 4)

#> NULL

To create customized plots or plots which have different variables on plot axes than longitude and latitude, we recommend using ggplot2. For example, the plot method output can be mimicked by:

library(ggplot2)

ggplot() + 
  geom_sf(data = x_sftime4, aes(color = b)) + 
  facet_wrap(~ cut_number(time, n = 6)) +
  theme(
    panel.spacing.x = unit(4, "mm"), 
    panel.spacing.y = unit(4, "mm")
  )

This strategy can also be used to create other plots, for example plotting the id of entities over time (similar to stplot() with mode = "xt"):

ggplot(x_sftime4) + 
  geom_point(aes(y = id_object, x = time, color = b))

Or for plotting time series of values of all variables with different panels for each entity (location) defined via a categorical variable (similar to stplot() with mode = "tp"):

x_sftime4 %>%
  tidyr::pivot_longer(cols = c("a", "b"), names_to = "variable", values_to = "value") %>%
  ggplot() + 
  geom_path(aes(y = value, x = time, color = variable)) +
  facet_wrap(~ id_object)

Or for plotting time series of values of all variables for all entities defined via a categorical variable with different panels for each variable (similar to stplot() with mode = "ts"):

x_sftime4 %>%
  tidyr::pivot_longer(cols = c("a", "b"), names_to = "variable", values_to = "value") %>%
  ggplot() + 
  geom_path(aes(y = value, x = time, color = id_object)) +
  facet_wrap(~ variable, scales = "free_y")

User-defined time columns

The time column is a special column of the underlying sf object which defines time information (timestamps and temporal ordering) alongside the simple features column of an sf object. Common time representations in R (e.g. POSIXct, POSIXlt, Date, yearmon, yearqtr) are allowed, as well as optional user-defined types. Let us look at a simple example where we define a time column based on POSIXct

(tc <- as.POSIXct("2020-09-01 08:00:00")-0:3*3600*24)
#> [1] "2020-09-01 08:00:00 CEST" "2020-08-31 08:00:00 CEST"
#> [3] "2020-08-30 08:00:00 CEST" "2020-08-29 08:00:00 CEST"

The ordering is not altered upon construction (as in some other representations). If a different order is required, the order function and sort method can be applied to the time column:

tc
#> [1] "2020-09-01 08:00:00 CEST" "2020-08-31 08:00:00 CEST"
#> [3] "2020-08-30 08:00:00 CEST" "2020-08-29 08:00:00 CEST"
order(tc)
#> [1] 4 3 2 1
sort(tc)
#> [1] "2020-08-29 08:00:00 CEST" "2020-08-30 08:00:00 CEST"
#> [3] "2020-08-31 08:00:00 CEST" "2020-09-01 08:00:00 CEST"

In some applications it might be useful to have more complex temporal information such as intervals of different length. The following example is also meant as template for other user-defined classes which could be used to build the time column of the sftime class.

At first, we will need a few helper functions:

# utility functions
as.character.interval <- function(x) {
  paste0("[", x[1], ", ", x[2], "]")
}

print.interval <- function(x, ...) {
  cat("Interval:", as.character(x), "\n")
}

#'[.intervals' <- function(x, i) {
#  sx <- unclass(x)[i]
#  class(sx) <- "intervals"
#  sx
#}

Now, we can define the different intervals used to represent our temporal information:

# time interval definition
i1 <- c(5.3,12)
class(i1) <- "interval"
i2 <- c(3.1,6)
class(i2) <- "interval"
i3 <- c(1.4,6.9)
class(i3) <- "interval"
i4 <- c(1,21)
class(i4) <- "interval"

intrvls <- structure(list(i1, i2, i3, i4), class = "Intervals")
# provide dedicated generic to xtfrm for class intervals

The advantage is to be able to define different sorting approaches:

xtfrm.Intervals <- function(x) sapply(x, mean)
# - sort by centre
(tc <- intrvls)
#> [[1]]
#> Interval: [5.3, 12] 
#> 
#> [[2]]
#> Interval: [3.1, 6] 
#> 
#> [[3]]
#> Interval: [1.4, 6.9] 
#> 
#> [[4]]
#> Interval: [1, 21] 
#> 
#> attr(,"class")
#> [1] "Intervals"
order(tc)
#> [1] 3 2 1 4
sort(tc)[1]
#> [[1]]
#> Interval: [1.4, 6.9]
# - sort by end
xtfrm.Intervals <- function(x) sapply(x, max)
(tc <- intrvls)
#> [[1]]
#> Interval: [5.3, 12] 
#> 
#> [[2]]
#> Interval: [3.1, 6] 
#> 
#> [[3]]
#> Interval: [1.4, 6.9] 
#> 
#> [[4]]
#> Interval: [1, 21] 
#> 
#> attr(,"class")
#> [1] "Intervals"
order(tc)
#> [1] 2 3 1 4
sort(tc)[1]
#> [[1]]
#> Interval: [3.1, 6]
# - sort by start
xtfrm.Intervals <- function(x) sapply(x, min)
tc <- intrvls
order(tc)
#> [1] 4 3 2 1
sort(tc)[1]
#> [[1]]
#> Interval: [1, 21]

Based on the sorting procedure (begin, centre or end of the interval), the smallest element (each last line) and the order of the time column changes.