Recent updates of some functions and their documentation

DESCRIPTION

@@ -11,15 +11,15 @@ Imports: stats, utils, graphics, methods, lattice, sp (>= 1.1-0),
         spacetime (>= 1.0-0), zoo
 Suggests: rgdal, rgeos, OpenStreetMap, RCurl, rjson, adehabitatLT, xts,
         knitr, rgl, forecast, MASS, spatstat, taxidata
-Description: Classes and methods for trajectory data, with support for nesting individual Track objects in track sets (Tracks) and track sets for different entities in collections of Tracks. Methods include selection, generalization, aggregation, intersection, simulation, and plotting.
+Description: Classes and methods for trajectory data, with support for nesting individual Track objects in track sets (Tracks) and track sets for different entities in collections of Tracks. Methods include selection, generalization, aggregation, intersection, simulation, and plotting. It further includes exploratory methods such as Kernel smoothing, Voronoi tessellation, distance analysis, K- and pair correlation functions.
 License: GPL (>= 2)
 URL: http://github.com/edzer/trajectories
 Additional_repositories: http://pebesma.staff.ifgi.de
 BugReports: http://github.com/edzer/trajectories/issues
 VignetteBuilder: knitr
 Collate: Class-Tracks.R Tracks-methods.R generalize.R stcube.R stplot.R
         difftrack.R compare-methods.R rtracks.R Trackstat.R
-RoxygenNote: 6.0.1
+RoxygenNote: 7.0.2
 NeedsCompilation: no
 Packaged: 2018-09-25 11:59:22 UTC; edzer
 Author: Edzer Pebesma [aut, cre] (<https://orcid.org/0000-0001-8049-7069>),

NAMESPACE

@@ -29,7 +29,9 @@ export(
 	approxTrack, approxTracks, approxTracksCollection,
 	rTrack, rTracks, rTracksCollection, as.Track, as.Track.arrow,
 	as.Track.ppp, auto.arima.Track, avedistTrack, avemove, chimaps,
-	Kinhom.Track, pcfinhom.Track, reTrack, Track.idw, tsqTracks 
+	Kinhom.Track, pcfinhom.Track, reTrack,
+	tsqTracks,unique.Track,as.list.Tracks,as.list.TracksCollection,range.Track,
+	idw.Track
 )
 
 exportMethods(
@@ -64,6 +66,17 @@ S3method(plot, arwlen)
 S3method(print, summary.Track)
 S3method(print, summary.Tracks)
 S3method(print, summary.TracksCollection)
+S3method("as", "list.Tracks")
+S3method("as", "list.TracksCollection")
+S3method("unique", "Track")
+S3method(range, Track)
+S3method(range, Tracks)
+S3method(range, TracksCollection)
+S3method(stack, TracksCollection)
+S3method(unstack, TracksCollection)
+S3method(c, Track)
+S3method(c, Tracks)
+S3method(c, TracksCollection)
 S3method(print, arwlen)
 S3method(print, distrack)
 S3method(print, gTrack)

R/Class-Tracks.R

@@ -43,8 +43,9 @@ TrackStats = function(track) {
 	stopifnot(!any(duration == 0))
 #	if (class(try(cc <- coordinates(track), silent=TRUE)) == "try-error" ||
 #			!is.matrix(cc))
-	if (!is(track@sp, "SpatialPoints"))
-		data.frame(matrix(nrow = length(track@sp) - 1, ncol = 0)) # empty
+	if (!is(track@sp, "SpatialPoints")){
+	  data.frame(matrix(nrow = length(track@sp) - 1, ncol = 0)) # empty 
+	  }
 	else {
 		cc = coordinates(track@sp)
 		ll = identical(is.projected(track), FALSE)
@@ -100,7 +101,7 @@ TrackSummary = function(track) {
 	ix = index(track@time)
 	bb = bbox(track@sp)
 	conn = track@connections
-	data.frame(
+	d <- data.frame(
 		xmin = bb[1,1],
 		xmax = bb[1,2],
 		ymin = bb[2,1],
@@ -112,6 +113,8 @@ TrackSummary = function(track) {
 		medspeed = quantile(conn$speed, 0.5)
 		# TODO Compute some mean direction?
 	)
+	rownames(d) <- NULL
+	d
 }
 
 # Pre-computes elements of tracksData.

R/Tracks-methods.R

@@ -20,7 +20,7 @@ setAs("Tracks", "segments", function(from) {
 		ret = do.call(rbind, lapply(from@tracks, 
 			function(x) as(x, "segments")))
 		ret$Track = rep(names(from@tracks), 
-			times = sapply(from@tracks, length) - 1)
+			times = sapply(from@tracks, dim) - 1)
 		ret
 	}
 )
@@ -42,7 +42,7 @@ setAs("Track", "data.frame",
 
 setAs("Tracks", "data.frame", 
 	function(from) {
-		l = lapply(from@tracks, function(x) rbind(as(x, "data.frame"), NA))
+		l = lapply(from@tracks, function(x) as(x, "data.frame"))
 		d = do.call(rbind, l)
 		d$Track = rep(names(from@tracks), times = sapply(l, nrow))
 		d
@@ -230,6 +230,7 @@ plot.TracksCollection <- function(x, y, ..., xlim = stbox(x)[,1],
 		plot(as(x, "SpatialLines"), xlim = xlim, ylim = ylim, axes = axes, 
 			col = col, lwd = lwd, lty = lty, add = add, ...)
 }
+
 setMethod("plot", "TracksCollection", plot.TracksCollection)
 
 setMethod("plot", "Tracks", function(x, ...) plot(TracksCollection(list(x)), ...))
@@ -378,10 +379,6 @@ summary.Tracks = function(object, ...) {
 	obj
 }
 
-setMethod("show", "Track", function(object) print.Track(object))
-setMethod("show", "Tracks", function(object) print.Tracks(object))
-setMethod("show", "TracksCollection", function(object) print.TracksCollection(object))
-
 setMethod("summary", "Tracks", summary.Tracks)
 
 print.summary.Tracks = function(x, ...) {
@@ -439,14 +436,20 @@ print.summary.TracksCollection = function(x, ...) {
 	invisible(x)
 }
 
+# Provide show methods.
+
+setMethod("show", "Track", function(object) print.Track(object))
+setMethod("show", "Tracks", function(object) print.Tracks(object))
+setMethod("show", "TracksCollection", function(object) print.TracksCollection(object))
+
 # Provide selection methods.
-subs.Track <- function(x, i, j, ..., drop = TRUE) {
-	Track(as(x, "STIDF")[i, j, ..., drop = drop])
+subs.Track <- function(x, i, ..., drop = TRUE) {
+	Track(as(x, "STIDF")[i, ..., drop = drop])
 }
 
 setMethod("[", "Track", subs.Track)
 
-subs.Tracks <- function(x, i, j, ... , drop = TRUE) {
+subs.Tracks <- function(x, i, ... , drop = TRUE) {
 	if (missing(i))
 		i = 1:length(x@tracks)
 	else if (is(i, "Spatial"))
@@ -461,34 +464,34 @@ subs.Tracks <- function(x, i, j, ... , drop = TRUE) {
 		if (!any(i))
 			NULL
 		else 
-			Tracks(x@tracks[i], x@tracksData[i, j, drop=FALSE])
+			Tracks(x@tracks[i])
 	}
 }
 
 setMethod("[", "Tracks", subs.Tracks)
 
-subs.TracksCollection <- function(x, i, j, ... , drop = TRUE) {
-	if (!missing(j) && is.character(j)) {
-		for(tz in seq_along(x@tracksCollection)) {
-			for(t in seq_along(x[tz]@tracks)) {
-				data = x[tz][t]@data
-				connections = x[tz][t]@connections
-				if(j %in% names(data))
-					data = data[j]
-				else
-					# An empty data slot is returned if the passed attribute
-					# does not exist. The same applies to the connections slot.
-					data = data.frame(matrix(nrow = dim(x[tz][t])["geometries"], ncol = 0))
-				if(j %in% names(connections))
-					connections = connections[j]
-				else
-					connections = data.frame(matrix(nrow = dim(x[tz][t])["geometries"] - 1, ncol = 0))
-				# Write back the just processed data and connection slots.
-				x@tracksCollection[[tz]]@tracks[[t]]@data = data
-				x@tracksCollection[[tz]]@tracks[[t]]@connections = connections
-			}
-		}
-	}
+subs.TracksCollection <- function(x, i, ... , drop = TRUE) {
+	# if (!missing(j) && is.character(j)) {
+	# 	for(tz in seq_along(x@tracksCollection)) {
+	# 		for(t in seq_along(x[tz]@tracks)) {
+	# 			data = x[tz][t]@data
+	# 			connections = x[tz][t]@connections
+	# 			if(j %in% names(data))
+	# 				data = data[j]
+	# 			else
+	# 				# An empty data slot is returned if the passed attribute
+	# 				# does not exist. The same applies to the connections slot.
+	# 				data = data.frame(matrix(nrow = dim(x[tz][t])["geometries"], ncol = 0))
+	# 			if(j %in% names(connections))
+	# 				connections = connections[j]
+	# 			else
+	# 				connections = data.frame(matrix(nrow = dim(x[tz][t])["geometries"] - 1, ncol = 0))
+	# 			# Write back the just processed data and connection slots.
+	# 			x@tracksCollection[[tz]]@tracks[[t]]@data = data
+	# 			x@tracksCollection[[tz]]@tracks[[t]]@connections = connections
+	# 		}
+	# 	}
+	# }
 	if (missing(i))
 		s = 1:length(x@tracksCollection)
 	else if (is(i, "Spatial"))
@@ -531,8 +534,10 @@ subs.TracksCollection <- function(x, i, j, ... , drop = TRUE) {
 
 setMethod("[", "TracksCollection", subs.TracksCollection)
 
+
+
 setMethod("[[", c("Track", "ANY", "missing"), 
-	function(x, i, j, ...) {
+	function(x, i, ...) {
 		# TODO What if the attribute name coexists in both the data and
 		# connections slot? Returning a list is inconvenient in the way that it
 		# raises new design issues when making selections on objects of class
@@ -548,19 +553,19 @@ setMethod("[[", c("Track", "ANY", "missing"),
 )
 
 setMethod("[[", c("Tracks", "ANY", "missing"),
-	function(x, i, j, ...) {
-		do.call(c, lapply(x@tracks, function(t) t[[i]]))
+	function(x, i, ...) {
+		do.call(list, lapply(x@tracks, function(t) t[[i]]))
 	}
 )
 
 setMethod("[[", c("TracksCollection", "ANY", "missing"),
-	function(x, i, j, ...) {
-		do.call(c, lapply(x@tracksCollection, function(t) t[[i]]))
+	function(x, i, ...) {
+		do.call(list, lapply(x@tracksCollection, function(t) t[[i]]))
 	}
 )
 
 setReplaceMethod("[[", c("Track", "ANY", "missing", "ANY"), 
-	function(x, i, j, value) {
+	function(x, i, value) {
 		if (i %in% names(x@connections)) {
 			warning(paste("replacing", i, "in connections slot"))
 			x@connections[[i]] = value
@@ -571,7 +576,7 @@ setReplaceMethod("[[", c("Track", "ANY", "missing", "ANY"),
 )
 
 setReplaceMethod("[[", c("Tracks", "ANY", "missing", "ANY"), 
-	function(x, i, j, value) {
+	function(x, i,value) {
 		for(index in seq_along(x@tracks)) {
 			if(i %in% names(x[index]@data)) {
 				# "dim" (and with that "from" and "to") have to be reinitialized
@@ -594,7 +599,7 @@ setReplaceMethod("[[", c("Tracks", "ANY", "missing", "ANY"),
 )
 
 setReplaceMethod("[[", c("TracksCollection", "ANY", "missing", "ANY"), 
-	function(x, i, j, value) {
+	function(x, i,value) {
 		index = 1
 		for(tz in seq_along(x@tracksCollection)) {
 			for(t in seq_along(x[tz]@tracks)) {
@@ -719,11 +724,11 @@ setMethod("spTransform", c("TracksCollection", "CRS"),
 #         include.lowest = FALSE, right = TRUE, dig.lab = 3,
 #         ordered_result = FALSE, ...)
 
-cut.Track = function(x, breaks, ..., include.lowest = TRUE, touch = TRUE) {
-	i = index(x)
+cut.Track = function(track, breaks, ..., include.lowest = TRUE, touch = TRUE) {
+	i = index(track)
 	f = cut(i, breaks, ..., include.lowest = include.lowest)
-	d = dim(x) # nr of pts
-	x = as(x, "STIDF")
+	d = dim(track) # nr of pts
+	x = as(track, "STIDF")
 	if (! touch)
 		spl = lapply(split(x = seq_len(d), f), function(ind) x[ind, , drop = FALSE])
 	else
@@ -736,10 +741,10 @@ cut.Track = function(x, breaks, ..., include.lowest = TRUE, touch = TRUE) {
 	Tracks(lapply(spl[sapply(spl, length) > 1], Track))
 }
 
-cut.Tracks = function(x, breaks, ...) do.call(c, lapply(x@tracks, cut, breaks = breaks, ...))
+cut.Tracks = function(tr, breaks, ...) do.call(c, lapply(tr@tracks, cut, breaks = breaks, ...))
 
-cut.TracksCollection = function(x, breaks, ...) 	
-	TracksCollection(lapply(x@tracksCollection, cut, breaks = breaks, ...))
+cut.TracksCollection = function(tc, breaks, ...) 	
+	TracksCollection(lapply(tc@tracksCollection, cut, breaks = breaks, ...))
 
 "index<-.Track" = function(x, value) {
 	index(x@time) = value