auto.arima.Track

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

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(

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
 	}
 )

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, ...){

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
+          }
 )

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)

man/auto.arima.Track.Rd

@@ -29,6 +29,7 @@ Mohammad Mehdi Moradi <moradi@uji.es>
 \link[trajectories]{rTrack}, \link[forecast]{auto.arima}
 }
 \examples{
+library(forecast)
 X <- rTrack()
 auto.arima.Track(X)
 }