diff --git a/DESCRIPTION b/DESCRIPTION index 206da48..02d7d87 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -9,8 +9,9 @@ Authors@R: person("Nikolai", "Gorte", role = "ctb"), person("Mehdi", "Moradi", role = "ctb")) Depends: R (>= 3.0.0), sp (>= 1.1-0), spacetime (>= 1.0-0) -Imports: stats, utils, graphics, methods, lattice, spatstat -Suggests: rgdal, rgeos, OpenStreetMap, RCurl, rjson, adehabitatLT, xts, knitr, rgl, forecast, MASS, taxidata +Imports: stats, utils, graphics, methods, lattice, spatstat, grDevices +Suggests: rgdal, rgeos, OpenStreetMap, RCurl, rjson, adehabitatLT, xts, knitr, rgl,forecast, MASS +LazyData: no 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 (TracksCollection). Methods include selection, generalization, aggregation, intersection, simulation, and plotting. License: GPL (>= 2) URL: http://github.com/edzer/trajectories diff --git a/NAMESPACE b/NAMESPACE index 6258903..a73b26e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,8 +9,8 @@ importFrom(utils, head, tail, stack, unstack) importFrom(graphics, arrows, box, lines, points, segments, legend, polygon, title) importFrom(grDevices, rainbow, heat.colors) importFrom(spatstat, marks, psp, midpoints.psp, lengths.psp, - 'marks<-', owin, as.ppp, pairdist, density.psp, density.ppp, - Kinhom, pcfinhom, idw, bw.ppl, bw.diggle, bw.scott) + 'marks<-', owin, as.ppp, pairdist, density.psp, density.ppp, + Kinhom, pcfinhom, idw, bw.ppl, bw.diggle, bw.scott) # importFrom(rgl, open3d, plot3d, lines3d) exportClasses( @@ -32,10 +32,10 @@ export( rTrack, rTracks, rTracksCollection, as.Track, as.Track.arrow, as.Track.ppp, auto.arima.Track, avedistTrack, avemove, chimaps, density.Track, Kinhom.Track, pcfinhom.Track, reTrack, Track.idw, - plot.distrack, -# marks, psp, midpoints.psp, lengths.psp, 'marks<-', owin, as.ppp, pairdist, density.psp, density.ppp, Kinhom, pcfinhom, idw, bw.ppl, bw.diggle, bw.scott, plot.arwlen, - plot.KTrack, plot.gTrack, plot.distrack, - tsqTracks, uniqueTrack + plot.distrack, marks, psp, midpoints.psp, lengths.psp, + 'marks<-', owin, as.ppp, pairdist, density.psp, density.ppp, + Kinhom, pcfinhom, idw, bw.ppl, bw.diggle, bw.scott, plot.arwlen, + plot.KTrack,plot.gTrack,plot.distrack,rngTrack,tsqTracks,uniqueTrack ) exportMethods( diff --git a/R/Tracks-methods.R b/R/Tracks-methods.R index a878a23..ed8debe 100644 --- a/R/Tracks-methods.R +++ b/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, length)-1) ret } ) diff --git a/R/Trackstat.R b/R/Trackstat.R index dfc22c1..d4b5cfb 100644 --- a/R/Trackstat.R +++ b/R/Trackstat.R @@ -94,7 +94,7 @@ avedistTrack <- function(X,timestamp){ avedist <- unlist(avedist) class(avedist) <- c("distrack","numeric") attr(avedist,"ppp") <- Y - attr(avedist,"tsq") <- timeseq[-1] + attr(avedist,"tsq") <- timeseq[-c(1,length(timeseq))] return(avedist) } print.distrack <- function(x, ...){ diff --git a/R/generalize.R b/R/generalize.R index df2f4cd..398c4d6 100644 --- a/R/generalize.R +++ b/R/generalize.R @@ -1,104 +1,104 @@ # Provide generalize methods. generalize.Track <- function(t, FUN = mean, ..., timeInterval, distance, n, tol, toPoints) { - if (sum(!c(missing(timeInterval), missing(distance), missing(n))) != 1) - stop("exactly one parameter from (timeInterval, distance, n) has to be specified") - if(!missing(timeInterval)) { - origin = index(t@time) - cut = cut(origin, timeInterval) - segmentLengths = rle(as.numeric(cut))$lengths - } - if (!missing(distance)) { - # Total distances from each point to the first one. - origin = c(0, cumsum(t@connections$distance)) - cut = floor(origin / distance) - segmentLengths = rle(cut)$lengths - } - if (!missing(n)) { - dim = dim(t)["geometries"] - if(n != 1 && dim / n > 1) { - rep = floor((dim-n)/(n-1) + 1) - mod = (dim-n) %% (n-1) - if(mod == 0) - segmentLengths = rep(n, rep) - else - segmentLengths = c(rep(n, rep), mod + 1) - } else - segmentLengths = dim - } - # Update segment lengths to consider all segments for generalisation. In - # case the cut-point falls between two points of the track to be - # generalised, attach the next point to the current segment. If the cut- - # point matches a point of the track, leave everything as is. - toIndex = cumsum(segmentLengths) - segmentLengths_ = integer() - for(i in seq_along(segmentLengths)) { - if (i == length(segmentLengths) - || (!missing(timeInterval) && origin[toIndex[i]] %in% seq(origin[1], origin[length(origin)], timeInterval)) - || (!missing(distance) && origin[toIndex[i]] > 0 && origin[toIndex[i]] %% distance == 0) - || (!missing(n))) - segmentLengths_[i] = segmentLengths[i] - else { - segmentLengths_[i] = segmentLengths[i] + 1 - if(i == length(segmentLengths) - 1 && segmentLengths[i+1] == 1) - break() - } - } - segmentLengths = segmentLengths_ - # Aggregate over each segment. - stidfs = list() - endTime = NULL - for(i in seq_along(segmentLengths)) { - from = if(i == 1) 1 else tail(cumsum(segmentLengths[1:(i-1)]), n = 1) - (i-2) - to = from + segmentLengths[i] - 1 - if(!missing(toPoints) && toPoints) - sp = t@sp[(from+to)/2] - else { - l = Lines(list(Line(t@sp[from:to])), paste("L", i, sep = "")) - sp = SpatialLines(list(l), proj4string = CRS(proj4string(t))) - if(!missing(tol) && nrow(coordinates(sp)[[1]][[1]]) > 1) { - if (!requireNamespace("rgeos", quietly = TRUE)) - stop("rgeos required for tolerance") - sp = rgeos::gSimplify(spgeom = sp, tol = tol, - topologyPreserve = TRUE) - } - } - time = t@time[from] - if (is.null(endTime)) { - endTime = t@endTime[to] - tz = attr(endTime, "tzone") - } else - endTime = c(endTime, t@endTime[to]) - data = data.frame(lapply(t@data[from:to, , drop = FALSE], FUN, ...)) # EP added ... - #stidfs = c(stidfs, STIDF(sp, time, data, t@endTime[to])) - stidfs = c(stidfs, STIDF(sp, time, data)) - } - stidf = do.call(rbind, stidfs) - # Provide a workaround, since rbind'ing objects of class POSIXct as used - # in the "endTime" slot of STIDF objects does not work properly. - attr(endTime, "tzone") = tz - stidf@endTime = endTime - Track(stidf) + if (sum(!c(missing(timeInterval), missing(distance), missing(n))) != 1) + stop("exactly one parameter from (timeInterval, distance, n) has to be specified") + if(!missing(timeInterval)) { + origin = index(t@time) + cut = cut(origin, timeInterval) + segmentLengths = rle(as.numeric(cut))$lengths + } + if (!missing(distance)) { + # Total distances from each point to the first one. + origin = c(0, cumsum(t@connections$distance)) + cut = floor(origin / distance) + segmentLengths = rle(cut)$lengths + } + if (!missing(n)) { + dim = dim(t)["geometries"] + if(n != 1 && dim / n > 1) { + rep = floor((dim-n)/(n-1) + 1) + mod = (dim-n) %% (n-1) + if(mod == 0) + segmentLengths = rep(n, rep) + else + segmentLengths = c(rep(n, rep), mod + 1) + } else + segmentLengths = dim + } + # Update segment lengths to consider all segments for generalisation. In + # case the cut-point falls between two points of the track to be + # generalised, attach the next point to the current segment. If the cut- + # point matches a point of the track, leave everything as is. + toIndex = cumsum(segmentLengths) + segmentLengths_ = integer() + for(i in seq_along(segmentLengths)) { + if (i == length(segmentLengths) + || (!missing(timeInterval) && origin[toIndex[i]] %in% seq(origin[1], origin[length(origin)], timeInterval)) + || (!missing(distance) && origin[toIndex[i]] > 0 && origin[toIndex[i]] %% distance == 0) + || (!missing(n))) + segmentLengths_[i] = segmentLengths[i] + else { + segmentLengths_[i] = segmentLengths[i] + 1 + if(i == length(segmentLengths) - 1 && segmentLengths[i+1] == 1) + break() + } + } + segmentLengths = segmentLengths_ + # Aggregate over each segment. + stidfs = list() + endTime = NULL + for(i in seq_along(segmentLengths)) { + from = if(i == 1) 1 else tail(cumsum(segmentLengths[1:(i-1)]), n = 1) - (i-2) + to = from + segmentLengths[i] - 1 + if(!missing(toPoints) && toPoints) + sp = t@sp[(from+to)/2] + else { + l = Lines(list(Line(t@sp[from:to])), paste("L", i, sep = "")) + sp = SpatialLines(list(l), proj4string = CRS(proj4string(t))) + if(!missing(tol) && nrow(coordinates(sp)[[1]][[1]]) > 1) { + if (!requireNamespace("rgeos", quietly = TRUE)) + stop("rgeos required for tolerance") + sp = rgeos::gSimplify(spgeom = sp, tol = tol, + topologyPreserve = TRUE) + } + } + time = t@time[from] + if (is.null(endTime)) { + endTime = t@endTime[to] + tz = attr(endTime, "tzone") + } else + endTime = c(endTime, t@endTime[to]) + data = data.frame(lapply(t@data[from:to, , drop = FALSE], FUN, ...)) # EP added ... + #stidfs = c(stidfs, STIDF(sp, time, data, t@endTime[to])) + stidfs = c(stidfs, STIDF(sp, time, data)) + } + stidf = do.call(rbind, stidfs) + # Provide a workaround, since rbind'ing objects of class POSIXct as used + # in the "endTime" slot of STIDF objects does not work properly. + attr(endTime, "tzone") = tz + stidf@endTime = endTime + Track(stidf) } if(!isGeneric("generalize")) - setGeneric("generalize", function(t, FUN = mean, ...) - standardGeneric("generalize")) + setGeneric("generalize", function(t, FUN = mean, ...) + standardGeneric("generalize")) setMethod("generalize", signature(t = "Track"), generalize.Track) setMethod("generalize", signature(t = "Tracks"), - function(t, FUN = mean, ...) { - t@tracks = lapply(t@tracks, - function(x) generalize(x, FUN, ...)) - t - } + function(t, FUN = mean, ...) { + t@tracks = lapply(t@tracks, + function(x) generalize(x, FUN, ...)) + t + } ) setMethod("generalize", signature(t = "TracksCollection"), - function(t, FUN = mean, ...) { - t@tracksCollection = lapply(t@tracksCollection, - function(x) generalize(x, FUN, ...)) - t - } + function(t, FUN = mean, ...) { + t@tracksCollection = lapply(t@tracksCollection, + function(x) generalize(x, FUN, ...)) + t + } ) diff --git a/R/stplot.R b/R/stplot.R index e50f3e9..e85bdc4 100644 --- a/R/stplot.R +++ b/R/stplot.R @@ -1,73 +1,73 @@ tracksPanel = function(x, y, sp.layout, ...) { - sppanel(sp.layout, panel.number()) - panel.xyplot(x, y, ...) + sppanel(sp.layout, panel.number()) + panel.xyplot(x, y, ...) } segPanel = function(x, y, subscripts, ..., x0, y0, x1, y1, - arrows, length, col, sp.layout) { - sppanel(sp.layout, panel.number()) - if (arrows) - panel.arrows(x0[subscripts], y0[subscripts], - x1[subscripts], y1[subscripts], length = length, - col = col[subscripts], ...) - else - panel.segments(x0[subscripts], y0[subscripts], - x1[subscripts], y1[subscripts], - col = col[subscripts], ...) + arrows, length, col, sp.layout) { + sppanel(sp.layout, panel.number()) + if (arrows) + panel.arrows(x0[subscripts], y0[subscripts], + x1[subscripts], y1[subscripts], length = length, + col = col[subscripts], ...) + else + panel.segments(x0[subscripts], y0[subscripts], + x1[subscripts], y1[subscripts], + col = col[subscripts], ...) } stplotTracksCollection = function(obj, ..., by, groups, - scales = list(draw = FALSE), segments = TRUE, attr = NULL, - ncuts = length(col.regions), col.regions = bpy.colors(), cuts, - xlab = NULL, ylab = NULL, arrows = FALSE, length = 0.1, - xlim = bbexpand(bbox(obj)[1,], 0.04), - ylim = bbexpand(bbox(obj)[2,], 0.04), - sp.layout = NULL) { - sp = obj@tracksCollection[[1]]@tracks[[1]]@sp - scales = longlat.scales(sp, scales, xlim, ylim) - args = list(..., asp = mapasp(sp, xlim, ylim), scales = scales, - xlab = xlab, ylab = ylab, arrows = arrows, length = length, - xlim = xlim, ylim = ylim, sp.layout = sp.layout) - if (!is.null(attr)) { - df = as(obj, "segments") - args$x0 = df$x0 - args$y0 = df$y0 - args$x1 = df$x1 - args$y1 = df$y1 - # compute color: - z = df[[attr]] - attr = na.omit(z) - if (missing(cuts)) - cuts = seq(min(attr), max(attr), length.out = ncuts) - if (ncuts != length(col.regions)) { - cols = round(1 + (length(col.regions) - 1) * (0:(ncuts - - 1))/(ncuts - 1)) - fill = col.regions[cols] - } else - fill = col.regions - grps = cut(as.matrix(z), cuts, dig.lab = 4, include.lowest = TRUE) - args$col = fill[grps] - # set colorkey: - args$legend = list(right = list(fun = draw.colorkey, - args = list(key = list(col = col.regions, at = cuts), - draw = FALSE))) - if (is.null(args$panel)) - args$panel = "segPanel" - cn = c("x0", "y0") - } else { - if (is.null(args$panel)) - args$panel = "tracksPanel" - df = as(obj, "data.frame") - cn = coordnames(obj) - args$type = "l" - } - if (!missing(by)) - args$x = as.formula(paste(cn[2], "~", cn[1], "|", by)) - else - args$x = as.formula(paste(cn[2], cn[1], sep = " ~ ")) - if (!missing(groups)) - args$groups = df[[groups]] - args$data = df - do.call(xyplot, args) + scales = list(draw = FALSE), segments = TRUE, attr = NULL, + ncuts = length(col.regions), col.regions = bpy.colors(), cuts, + xlab = NULL, ylab = NULL, arrows = FALSE, length = 0.1, + xlim = bbexpand(bbox(obj)[1,], 0.04), + ylim = bbexpand(bbox(obj)[2,], 0.04), + sp.layout = NULL) { + sp = obj@tracksCollection[[1]]@tracks[[1]]@sp + scales = longlat.scales(sp, scales, xlim, ylim) + args = list(..., asp = mapasp(sp, xlim, ylim), scales = scales, + xlab = xlab, ylab = ylab, arrows = arrows, length = length, + xlim = xlim, ylim = ylim, sp.layout = sp.layout) + if (!is.null(attr)) { + df = as(obj, "segments") + args$x0 = df$x0 + args$y0 = df$y0 + args$x1 = df$x1 + args$y1 = df$y1 + # compute color: + z = df[[attr]] + attr = na.omit(z) + if (missing(cuts)) + cuts = seq(min(attr), max(attr), length.out = ncuts) + if (ncuts != length(col.regions)) { + cols = round(1 + (length(col.regions) - 1) * (0:(ncuts - + 1))/(ncuts - 1)) + fill = col.regions[cols] + } else + fill = col.regions + grps = cut(as.matrix(z), cuts, dig.lab = 4, include.lowest = TRUE) + args$col = fill[grps] + # set colorkey: + args$legend = list(right = list(fun = draw.colorkey, + args = list(key = list(col = col.regions, at = cuts), + draw = FALSE))) + if (is.null(args$panel)) + args$panel = "segPanel" + cn = c("x0", "y0") + } else { + if (is.null(args$panel)) + args$panel = "tracksPanel" + df = as(obj, "data.frame") + cn = coordnames(obj) + args$type = "l" + } + if (!missing(by)) + args$x = as.formula(paste(cn[2], "~", cn[1], "|", by)) + else + args$x = as.formula(paste(cn[2], cn[1], sep = " ~ ")) + if (!missing(groups)) + args$groups = df[[groups]] + args$data = df + do.call(xyplot, args) } setMethod("stplot", "TracksCollection", stplotTracksCollection) diff --git a/man/auto.arima.Track.Rd b/man/auto.arima.Track.Rd index a6cc3f5..88e2069 100644 --- a/man/auto.arima.Track.Rd +++ b/man/auto.arima.Track.Rd @@ -29,6 +29,7 @@ Mohammad Mehdi Moradi \link[trajectories]{rTrack}, \link[forecast]{auto.arima} } \examples{ +library(forecast) X <- rTrack() auto.arima.Track(X) } diff --git a/man/plot.arwlen.Rd b/man/plot.arwlen.Rd index 7d808d6..3cbc1b4 100644 --- a/man/plot.arwlen.Rd +++ b/man/plot.arwlen.Rd @@ -21,7 +21,4 @@ a plot. \author{ Mohammad Mehdi Moradi } - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - \seealso{avemove} diff --git a/man/plot.gTrack.Rd b/man/plot.gTrack.Rd index 51863e8..fff6d9f 100644 --- a/man/plot.gTrack.Rd +++ b/man/plot.gTrack.Rd @@ -16,5 +16,7 @@ plot method} \item{col}{ line color} \item{...}{ passed on to plot} } + \author{ Mohammad Mehdi Moradi } + diff --git a/man/print.ArimaTrack.Rd b/man/print.ArimaTrack.Rd index 24fbd0c..04c9130 100644 --- a/man/print.ArimaTrack.Rd +++ b/man/print.ArimaTrack.Rd @@ -16,11 +16,4 @@ print method.} } \author{ Mohammad Mehdi Moradi -} - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - -% Add one or more standard keywords, see file 'KEYWORDS' in the -% R documentation directory. -\keyword{ ~kwd1 }% use one of RShowDoc("KEYWORDS") -\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line +} \ No newline at end of file diff --git a/man/print.KTrack.Rd b/man/print.KTrack.Rd index 25d78fc..91dc9b7 100644 --- a/man/print.KTrack.Rd +++ b/man/print.KTrack.Rd @@ -19,4 +19,3 @@ Methods for class "KTrack" \author{ Mohammad Mehdi Moradi } - diff --git a/man/print.Track.Rd b/man/print.Track.Rd index 1d150b3..094af61 100644 --- a/man/print.Track.Rd +++ b/man/print.Track.Rd @@ -16,7 +16,4 @@ method to print an object of class "Track"} } \author{ Mohammad Mehdi Moradi -} - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - +} \ No newline at end of file diff --git a/man/print.Tracks.Rd b/man/print.Tracks.Rd index ef89489..948b64a 100644 --- a/man/print.Tracks.Rd +++ b/man/print.Tracks.Rd @@ -18,5 +18,3 @@ an object of class "Tracks" \author{ Mohammad Mehdi Moradi } - - diff --git a/man/print.TracksCollection.Rd b/man/print.TracksCollection.Rd index db8dc48..a04b942 100644 --- a/man/print.TracksCollection.Rd +++ b/man/print.TracksCollection.Rd @@ -15,6 +15,8 @@ print.TracksCollection(X) an object of class "TracksCollection" } } + \author{ Mohammad Mehdi Moradi } + diff --git a/man/print.Trrow.Rd b/man/print.Trrow.Rd index e2bee57..b50652c 100644 --- a/man/print.Trrow.Rd +++ b/man/print.Trrow.Rd @@ -18,6 +18,8 @@ Print objetcs of class "Trrow"} Mohammad Mehdi Moradi } + \seealso{ as.Track.arrow } + diff --git a/man/print.arwlen.Rd b/man/print.arwlen.Rd index 2e9cb40..fd31067 100644 --- a/man/print.arwlen.Rd +++ b/man/print.arwlen.Rd @@ -16,7 +16,4 @@ to print an object of class "arwlen".} } \author{ Mohammad Mehdi Moradi -} - -%% ~Make other sections like Warning with \section{Warning }{....} ~ - +} \ No newline at end of file diff --git a/man/print.gTrack.Rd b/man/print.gTrack.Rd index 2db0b1a..badf097 100644 --- a/man/print.gTrack.Rd +++ b/man/print.gTrack.Rd @@ -15,5 +15,3 @@ print method.} \item{...}{ignored} } \author{ Mohammad Mehdi Moradi } - - diff --git a/vignettes/article-004.pdf b/vignettes/article-004.pdf deleted file mode 100644 index a9d84a6..0000000 Binary files a/vignettes/article-004.pdf and /dev/null differ diff --git a/vignettes/article-007.pdf b/vignettes/article-006.pdf similarity index 98% rename from vignettes/article-007.pdf rename to vignettes/article-006.pdf index 3a14869..88e1264 100644 Binary files a/vignettes/article-007.pdf and b/vignettes/article-006.pdf differ diff --git a/vignettes/article-012.pdf b/vignettes/article-011.pdf similarity index 98% rename from vignettes/article-012.pdf rename to vignettes/article-011.pdf index 612a5b9..605508e 100644 Binary files a/vignettes/article-012.pdf and b/vignettes/article-011.pdf differ diff --git a/vignettes/article-014.pdf b/vignettes/article-013.pdf similarity index 99% rename from vignettes/article-014.pdf rename to vignettes/article-013.pdf index 733afb0..1627d3c 100644 Binary files a/vignettes/article-014.pdf and b/vignettes/article-013.pdf differ diff --git a/vignettes/article.R b/vignettes/article.R index 345d73b..205ba5c 100644 --- a/vignettes/article.R +++ b/vignettes/article.R @@ -8,42 +8,42 @@ library("MASS") ################################################### -### code chunk number 2: article.Rnw:109-111 +### code chunk number 2: article.Rnw:110-115 ################################################### -install.packages("taxidata", - repos = "http://pebesma.staff.ifgi.de",type = "source") +do_all <- FALSE +if(do_all){ + install.packages("taxidata", + repos = "http://pebesma.staff.ifgi.de",type = "source") +} ################################################### -### code chunk number 3: article.Rnw:116-123 +### code chunk number 3: article.Rnw:120-134 ################################################### library(trajectories) -library(taxidata) +if(do_all){ + library(taxidata) Beijing <- taxidata Z <- lapply(X=1:length(Beijing), function(i){ q <- cut(Beijing[[i]], "day", touch = F) return(q@tracks[[3]]) }) - - -################################################### -### code chunk number 4: article.Rnw:129-134 -################################################### plot(Z[[21]],xlim=c(420000,470000),ylim=c(4390000,4455000),lwd=2) plot(Z[[26]],add=T,col="orange",lwd=2) plot(Z[[20]],add=T,col=2,lwd=2) plot(Z[[12]],add=T,col=3,lwd=2) plot(Z[[15]],add=T,col=4,lwd=2) +} ################################################### -### code chunk number 5: article.Rnw:166-167 +### code chunk number 4: article.Rnw:167-168 ################################################### library(trajectories) ################################################### -### code chunk number 6: article.Rnw:172-183 +### code chunk number 5: article.Rnw:173-184 ################################################### set.seed(10) t0 = as.POSIXct(as.Date("2013-09-30",tz="CET")) @@ -59,13 +59,13 @@ A1 ################################################### -### code chunk number 7: article.Rnw:187-188 +### code chunk number 6: article.Rnw:188-189 ################################################### plot(A1) ################################################### -### code chunk number 8: article.Rnw:198-204 +### code chunk number 7: article.Rnw:199-205 ################################################### x <- runif(10,0,1) y <- runif(10,0,1) @@ -76,7 +76,7 @@ as.Track(x,y,date,covariate = records) ################################################### -### code chunk number 9: article.Rnw:210-220 +### code chunk number 8: article.Rnw:211-221 ################################################### x = c(7,6,6,7,7) y = c(6,5,4,4,3) @@ -91,7 +91,7 @@ A ################################################### -### code chunk number 10: article.Rnw:226-246 +### code chunk number 9: article.Rnw:227-247 ################################################### # person B, track 1: x = c(2,2,1,1,2,3) @@ -116,7 +116,7 @@ Tr ################################################### -### code chunk number 11: article.Rnw:295-299 +### code chunk number 10: article.Rnw:296-300 ################################################### dim(A1) dim(B1) @@ -125,13 +125,13 @@ downsample(A1,B1) ################################################### -### code chunk number 12: article.Rnw:303-304 +### code chunk number 11: article.Rnw:304-305 ################################################### stplot(Tr, attr = "co2", arrows = TRUE, lwd = 3, by = "IDs") ################################################### -### code chunk number 13: article.Rnw:314-320 +### code chunk number 12: article.Rnw:315-321 ################################################### set.seed(10) x <- rTrack();x @@ -142,7 +142,7 @@ z <- rTrack(bbox = m,transform = T,nrandom = T);z ################################################### -### code chunk number 14: article.Rnw:324-327 +### code chunk number 13: article.Rnw:325-328 ################################################### par(mfrow=c(2,2),mar=rep(2.2,4)) plot(x,lwd=2,main="x");plot(y,lwd=2,main="y") @@ -150,29 +150,33 @@ plot(w,lwd=2,main="w");plot(z,lwd=2,main="z") ################################################### -### code chunk number 15: article.Rnw:341-343 +### code chunk number 14: article.Rnw:342-344 ################################################### -## EJP: -#data("Beijing") -load("/home/edzer/data/mehdi/taxi/Y.RData") -Beijing = Y - library(forecast) -auto.arima.Track(Beijing[[5]]) +auto.arima.Track(A1) ################################################### -### code chunk number 16: article.Rnw:376-379 +### code chunk number 15: article.Rnw:377-390 ################################################### - tracks1 <- Tracks(list(Beijing[[1]],Beijing[[2]])) - tracks2 <- Tracks(list(Beijing[[3]],Beijing[[4]])) - dists(tracks1,tracks2,mean) +library(xts) +data(A3) +track2 <- A3 +index(track2@time) <- index(track2@time) + 32 +track2@sp@coords <- track2@sp@coords + 0.003 + +## create Tracks objects +tracks1 <- Tracks(list(A3, track2)) +tracks2 <- Tracks(list(track2, A3)) + +## calculate distances +## Not run: +dists(tracks1, tracks2,mean) ################################################### -### code chunk number 17: article.Rnw:394-404 +### code chunk number 16: article.Rnw:405-414 ################################################### -do_all <- FALSE if (do_all){ meandist <- avedistTrack(Beijing,timestamp = "20 mins") plot(meandist,type="l",lwd=2) @@ -185,7 +189,7 @@ do_all <- FALSE ################################################### -### code chunk number 18: article.Rnw:440-444 +### code chunk number 17: article.Rnw:450-454 ################################################### if(do_all){ b <- Track.idw(Beijing,timestamp = "20 mins",epsilon=1000) @@ -194,7 +198,7 @@ plot(b,main="",ribwid=0.04,ribsep=0.02) ################################################### -### code chunk number 19: article.Rnw:456-466 +### code chunk number 18: article.Rnw:466-476 ################################################### if(do_all){ q <- avemove(Beijing,timestamp = "20 mins",epsilon=1000) @@ -209,7 +213,7 @@ plot(b,main="",ribwid=0.04,ribsep=0.02) ################################################### -### code chunk number 20: article.Rnw:508-526 +### code chunk number 19: article.Rnw:518-536 ################################################### if(do_all){ d <- density.Track(Beijing,timestamp = "20 mins",bw.ppl) @@ -232,7 +236,7 @@ plot(b,main="",ribwid=0.04,ribsep=0.02) ################################################### -### code chunk number 21: article.Rnw:551-572 +### code chunk number 20: article.Rnw:561-582 ################################################### if(do_all){ ch <- chimaps(Beijing,timestamp = "20 mins",rank = 200) @@ -258,7 +262,7 @@ ch <- chimaps(Beijing,timestamp = "20 mins",rank = 200) ################################################### -### code chunk number 22: article.Rnw:624-632 +### code chunk number 21: article.Rnw:634-642 ################################################### if(do_all){ K <- Kinhom.Track(Beijing,correction = "translate", @@ -269,90 +273,4 @@ ch <- chimaps(Beijing,timestamp = "20 mins",rank = 200) plot(g) } -======= -### code chunk number 14: article.Rnw:368-375 -################################################### -meandist <- avedistTrack(Beijing,timestamp = "20 mins") -plot(meandist,type="l",lwd=2) -distinframe <- data.frame(tsq=attr(meandist,"tsq"),dist=meandist) -dist3rd <- distinframe[substr(distinframe$tsq,start = 1,stop=10)== - "2008-02-03",] -plot(dist3rd$tsq,dist3rd$dist,type="l",xlab="time", - ylab="average distance",lwd=2) - - -################################################### -### code chunk number 15: article.Rnw:412-414 -################################################### -b <- Track.idw(Beijing,timestamp = "20 mins",epsilon=1000) -plot(b,main="",ribwid=0.04,ribsep=0.02) - - -################################################### -### code chunk number 16: article.Rnw:426-434 -################################################### - q <- avemove(Beijing,timestamp = "20 mins",epsilon=1000) - par(mfrow=c(1,2)) - plot(q,type="l",lwd=2) - qdata <- data.frame(q,attr(q,"tsq")[-c(1,length(attr(q,"tsq")))]) - colnames(qdata) <- c("dist","startingtime") - q3rd <- qdata[substr(qdata$startingtime,start = 1,stop=10)=="2008-02-03",] - plot(q3rd$startingtime,q3rd$dist,type="l",xlab="time (hour)" - ,ylab="average movement",lwd=2) - - -################################################### -### code chunk number 17: article.Rnw:476-492 -################################################### -d <- density.Track(Beijing,timestamp = "20 mins",bw.ppl) -par(mfrow=c(1,2)) -plot(d,main="",ribwid=0.04,ribsep=0.02) -#focus on the center -w <- owin(c(440000,455000),c(4410000,4430000)) -pps <- attr(d,"ppps") -npps <- lapply(X=1:length(pps),FUN = function(i){ - pps[[i]][w] -}) - -centerimg <- lapply(X=1:length(npps),FUN = function(i){ - density(npps[[i]],bw.ppl(npps[[i]])) -}) -fcenterimg <- Reduce("+",centerimg)/length(centerimg) - -plot(fcenterimg,main="",ribwid=0.04,ribsep=0.02) - - -################################################### -### code chunk number 18: article.Rnw:517-536 -################################################### -ch <- chimaps(Beijing,timestamp = "20 mins",rank = 200) -chall <- attr(ch,"ims") -minmax <- lapply(X=1:length(chall),function(i){ - return(list(min(chall[[i]]$v),max(chall[[i]]$v))) - }) -minmax <- do.call("rbind",minmax) -col5 <- colorRampPalette(c('blue','white','red')) -color_levels=200 -par(mar=c(0,0,1,1)) -par(mfrow=c(1,3)) -plot(chall[[51]],zlim=c(-max(abs(unlist(minmax))),max(abs(unlist(minmax)))) - ,main=attr(ch,"timevec")[51],ribwid=0.04,ribsep=0.02, - col=col5(n=color_levels)) -plot(chall[[75]],zlim=c(-max(abs(unlist(minmax))),max(abs(unlist(minmax)))) - ,main=attr(ch,"timevec")[75],ribwid=0.04,ribsep=0.02, - col=col5(n=color_levels)) -plot(chall[[104]],zlim=c(-max(abs(unlist(minmax))),max(abs(unlist(minmax)))) - ,main=attr(ch,"timevec")[104],ribwid=0.04,ribsep=0.02, - col=col5(n=color_levels)) - - -################################################### -### code chunk number 19: article.Rnw:588-594 -################################################### - K <- Kinhom.Track(Beijing,correction = "translate", - timestamp = "20 mins",q=0) - par(mfrow=c(1,2)) - plot(K) - g <- pcfinhom.Track(Beijing,timestamp = "20 mins",q=0) - plot(g) diff --git a/vignettes/article.Rnw b/vignettes/article.Rnw index 1258c98..179629e 100644 --- a/vignettes/article.Rnw +++ b/vignettes/article.Rnw @@ -108,38 +108,38 @@ However, to the best of our knowledge, \proglang{R} is still missing a complete The entire dataset is stored in \proglang{R} package \pkg{taxidata} and can be installed through the following code. <<>>= -install.packages("taxidata", - repos = "http://pebesma.staff.ifgi.de",type = "source") +do_all <- FALSE +if(do_all){ + install.packages("taxidata", + repos = "http://pebesma.staff.ifgi.de",type = "source") +} @ Figure \ref{taxitracks} is generated using the following lines of code. <<>>= library(trajectories) -library(taxidata) +if(do_all){ + library(taxidata) Beijing <- taxidata Z <- lapply(X=1:length(Beijing), function(i){ q <- cut(Beijing[[i]], "day", touch = F) return(q@tracks[[3]]) }) -@ - - -\begin{figure}[htbp] -\begin{center} -<>= plot(Z[[21]],xlim=c(420000,470000),ylim=c(4390000,4455000),lwd=2) plot(Z[[26]],add=T,col="orange",lwd=2) plot(Z[[20]],add=T,col=2,lwd=2) plot(Z[[12]],add=T,col=3,lwd=2) plot(Z[[15]],add=T,col=4,lwd=2) +} @ -\end{center} +\begin{figure}[!h] +\centering +\includegraphics[width=0.6\linewidth]{Tracks-ex.pdf} \caption{Trajectory pattern containing tracks of five taxis on the 4th of Feb 2008 in Beijing, China. Each color represents a different taxi track.} \label{taxitracks} \end{figure} - Studying the behaviour of moving objects over time and their interaction, either between objects or with environment, plays a crucial role in understanding how they use space and more importantly how they interact each other. Moving objects are moving within a particular area over time, thus a snapshot of a trajectory pattern might be seen as a spatial point pattern. This aspect then empowers us to study the behaviour of moving objects within space and over time. A set of locations, usually non-uniformly distributed within a certain region, can be considered as a realisation of a spatial point process. Analysis of spatial point processes has been widely discussed in the literature \citep{MW03,IPSS08,D13,BRT15}. The \proglang{R} package \pkg{spatstat} \citep{baddeley05,BRT15} provides different tools for statistical analysis, model-fitting, simulation and tests on spatial point patterns. \cite{D13} has broadly considered the details of spatio-temporal point processes. Application of such processes can be found in traffic management, geography, forestry, ecology, epidemiology, seismology, astronomy and criminology. This paper describes a collection of tools provided by the \proglang{R} package \pkg{trajectories} to handle, simulate and statistically analyse movement data regardless of the domain, converting a trajectory pattern into a list of point patterns based on regular timestamps. We here propose different functions to analyse the behaviour of objects over time and how they use space and also how they interact with each other. The type of interaction between objects may vary over time. The effect of the environment on the type of interaction might also be of interest. Therefore, using the literature of spatial point processes, the \proglang{R} package \pkg{trajectories} opens up a new way of thinking about trajectory datasets. We define different classes to handle trajectories, and different functions for simulating and performing exploratory data analysis. We also borrow first and second-order characteristics from the literature of spatial point processes and, by adapting them to trajectory patterns, we aim at highlighting the most frequently used routes within the studied area together with disclosing the type of interaction between the objects over time. Moreover, the \pkg{trajectories} package fits time series models to the spatial coordinates of a trajectory dataset. @@ -341,7 +341,7 @@ Figure \ref{randomtracks} shows four different random tracks: \code{x} is a rand <<>>= library(forecast) -auto.arima.Track(Beijing[[5]]) +auto.arima.Track(A1) @ \section{Exploratory data analysis} \label{sec:explo} @@ -375,9 +375,19 @@ We here point out some useful information about the dataset: A simple way to get into the nature of movement data is to study the distance between objects. The function \code{dists} provides users with calculating the distance between a pair of objects of class \class{Tracks}. This considers the distance between tracks when they overlap in time. The output is a matrix with distances between each pair of tracks or 'NA', if they do not overlap in time. A function to calculate distances can be passed to \code{dists}, such as \code{mean}, \code{sum}, \code{frechetDist}, etc. <>= - tracks1 <- Tracks(list(Beijing[[1]],Beijing[[2]])) - tracks2 <- Tracks(list(Beijing[[3]],Beijing[[4]])) - dists(tracks1,tracks2,mean) +library(xts) +data(A3) +track2 <- A3 +index(track2@time) <- index(track2@time) + 32 +track2@sp@coords <- track2@sp@coords + 0.003 + +## create Tracks objects +tracks1 <- Tracks(list(A3, track2)) +tracks2 <- Tracks(list(track2, A3)) + +## calculate distances +## Not run: +dists(tracks1, tracks2,mean) @ \subsubsection{Average distance over time} @@ -393,7 +403,6 @@ We here point out some useful information about the dataset: \end{leftbar} Steps above are implemented in the function \code{avedistTrack}. In order to use \code{avedistTrack}, we only need to specify the argument \code{timestamp}. It then returns the average distance between objects based on that timestamps. <<>>= -do_all <- FALSE if (do_all){ meandist <- avedistTrack(Beijing,timestamp = "20 mins") plot(meandist,type="l",lwd=2) diff --git a/vignettes/article.pdf b/vignettes/article.pdf index 1b9e100..9fc353a 100644 Binary files a/vignettes/article.pdf and b/vignettes/article.pdf differ diff --git a/vignettes/article.tex b/vignettes/article.tex index 08bbe73..b1f6d3f 100644 --- a/vignettes/article.tex +++ b/vignettes/article.tex @@ -22,6 +22,7 @@ \newtheorem{definition}{Definition}[section] %% For Sweave-based articles about R packages: %% need no \usepackage{Sweave} +% \VignetteIndexEntry{ trajectories: Classes and Methods for Trajectory Data } @@ -34,7 +35,7 @@ \author{M. Mehdi Moradi\\University of Jaume I \And Edzer Pebesma\\University of M\"unster \And Jorge Mateu\\University of Jaume I} -\Plainauthor{Achim Zeileis, Second Author} +%\Plainauthor{Achim Zeileis, Second Author} %% - \title{} in title case %% - \Plaintitle{} without LaTeX markup (if any) @@ -104,8 +105,11 @@ The entire dataset is stored in \proglang{R} package \pkg{taxidata} and can be installed through the following code. \begin{Schunk} \begin{Sinput} -R> install.packages("taxidata", -+ repos = "http://pebesma.staff.ifgi.de",type = "source") +R> do_all <- FALSE +R> if(do_all){ ++ install.packages("taxidata", ++ repos = "http://pebesma.staff.ifgi.de",type = "source") ++ } \end{Sinput} \end{Schunk} @@ -114,34 +118,28 @@ \begin{Schunk} \begin{Sinput} R> library(trajectories) -R> library(taxidata) -R> Beijing <- taxidata -R> Z <- lapply(X=1:length(Beijing), function(i){ +R> if(do_all){ ++ library(taxidata) ++ Beijing <- taxidata ++ Z <- lapply(X=1:length(Beijing), function(i){ + q <- cut(Beijing[[i]], "day", touch = F) + return(q@tracks[[3]]) + }) ++ plot(Z[[21]],xlim=c(420000,470000),ylim=c(4390000,4455000),lwd=2) ++ plot(Z[[26]],add=T,col="orange",lwd=2) ++ plot(Z[[20]],add=T,col=2,lwd=2) ++ plot(Z[[12]],add=T,col=3,lwd=2) ++ plot(Z[[15]],add=T,col=4,lwd=2) ++ } \end{Sinput} \end{Schunk} - - -\begin{figure}[htbp] -\begin{center} -\begin{Schunk} -\begin{Sinput} -R> plot(Z[[21]],xlim=c(420000,470000),ylim=c(4390000,4455000),lwd=2) -R> plot(Z[[26]],add=T,col="orange",lwd=2) -R> plot(Z[[20]],add=T,col=2,lwd=2) -R> plot(Z[[12]],add=T,col=3,lwd=2) -R> plot(Z[[15]],add=T,col=4,lwd=2) -\end{Sinput} -\end{Schunk} -\includegraphics{article-004} -\end{center} +\begin{figure}[!h] +\centering +\includegraphics[width=0.6\linewidth]{Tracks-ex.pdf} \caption{Trajectory pattern containing tracks of five taxis on the 4th of Feb 2008 in Beijing, China. Each color represents a different taxi track.} \label{taxitracks} \end{figure} - Studying the behaviour of moving objects over time and their interaction, either between objects or with environment, plays a crucial role in understanding how they use space and more importantly how they interact each other. Moving objects are moving within a particular area over time, thus a snapshot of a trajectory pattern might be seen as a spatial point pattern. This aspect then empowers us to study the behaviour of moving objects within space and over time. A set of locations, usually non-uniformly distributed within a certain region, can be considered as a realisation of a spatial point process. Analysis of spatial point processes has been widely discussed in the literature \citep{MW03,IPSS08,D13,BRT15}. The \proglang{R} package \pkg{spatstat} \citep{baddeley05,BRT15} provides different tools for statistical analysis, model-fitting, simulation and tests on spatial point patterns. \cite{D13} has broadly considered the details of spatio-temporal point processes. Application of such processes can be found in traffic management, geography, forestry, ecology, epidemiology, seismology, astronomy and criminology. This paper describes a collection of tools provided by the \proglang{R} package \pkg{trajectories} to handle, simulate and statistically analyse movement data regardless of the domain, converting a trajectory pattern into a list of point patterns based on regular timestamps. We here propose different functions to analyse the behaviour of objects over time and how they use space and also how they interact with each other. The type of interaction between objects may vary over time. The effect of the environment on the type of interaction might also be of interest. Therefore, using the literature of spatial point processes, the \proglang{R} package \pkg{trajectories} opens up a new way of thinking about trajectory datasets. We define different classes to handle trajectories, and different functions for simulating and performing exploratory data analysis. We also borrow first and second-order characteristics from the literature of spatial point processes and, by adapting them to trajectory patterns, we aim at highlighting the most frequently used routes within the studied area together with disclosing the type of interaction between the objects over time. Moreover, the \pkg{trajectories} package fits time series models to the spatial coordinates of a trajectory dataset. @@ -205,7 +203,7 @@ \subsection{Track} R> plot(A1) \end{Sinput} \end{Schunk} -\includegraphics{article-007} +\includegraphics{article-006} \end{center} \caption{Single track A1 passed by person A.} \label{figA1} @@ -377,7 +375,7 @@ \subsection{segments} R> stplot(Tr, attr = "co2", arrows = TRUE, lwd = 3, by = "IDs") \end{Sinput} \end{Schunk} -\includegraphics{article-012} +\includegraphics{article-011} \caption{Co2 consumption over time.} \label{fig:co2consumptionovertime} \end{figure} @@ -447,7 +445,7 @@ \section{Simulation and model fitting}\label{simandfitt} R> plot(w,lwd=2,main="w");plot(z,lwd=2,main="z") \end{Sinput} \end{Schunk} -\includegraphics{article-014} +\includegraphics{article-013} \end{center} \caption{Simulated random tracks using \code{rTrack}. \code{x} is random track with all defaults. \code{y} is a random track transformed to a unit box. \code{w} is a random track transformed to the box $[0,10]\times [0,10]$ and \code{z} is in a same box as \code{w} but with the random number of points.} \label{randomtracks} @@ -463,11 +461,11 @@ \section{Simulation and model fitting}\label{simandfitt} \begin{Schunk} \begin{Sinput} R> library(forecast) -R> auto.arima.Track(Beijing[[5]]) +R> auto.arima.Track(A1) \end{Sinput} \begin{Soutput} -Arima model fitted to x-coordinate: ARIMA(1,0,2) with non-zero mean -Arima model fitted to y-coordinate: ARIMA(2,1,2) with drift +Arima model fitted to x-coordinate: ARIMA(0,1,0) with drift +Arima model fitted to y-coordinate: ARIMA(0,0,0) with non-zero mean \end{Soutput} \end{Schunk} @@ -503,14 +501,22 @@ \subsection{Distance analysis}\label{distanal} \begin{Schunk} \begin{Sinput} -R> tracks1 <- Tracks(list(Beijing[[1]],Beijing[[2]])) -R> tracks2 <- Tracks(list(Beijing[[3]],Beijing[[4]])) -R> dists(tracks1,tracks2,mean) +R> library(xts) +R> data(A3) +R> track2 <- A3 +R> index(track2@time) <- index(track2@time) + 32 +R> track2@sp@coords <- track2@sp@coords + 0.003 +R> ## create Tracks objects +R> tracks1 <- Tracks(list(A3, track2)) +R> tracks2 <- Tracks(list(track2, A3)) +R> ## calculate distances +R> ## Not run: +R> dists(tracks1, tracks2,mean) \end{Sinput} \begin{Soutput} - [,1] [,2] -[1,] 16854.55 9103.338 -[2,] 15025.30 10275.476 + [,1] [,2] +[1,] 0.5481612 0.0000000 +[2,] 0.0000000 0.5481612 \end{Soutput} \end{Schunk} @@ -528,7 +534,6 @@ \subsubsection{Average distance over time} Steps above are implemented in the function \code{avedistTrack}. In order to use \code{avedistTrack}, we only need to specify the argument \code{timestamp}. It then returns the average distance between objects based on that timestamps. \begin{Schunk} \begin{Sinput} -R> do_all <- FALSE R> if (do_all){ + meandist <- avedistTrack(Beijing,timestamp = "20 mins") + plot(meandist,type="l",lwd=2)