Interpolating, smoothing, and simulating trajectories

create some data

t0 = as.POSIXct(as.Date("2013-09-30",tz="CET"))
# person A, track 1:
x = c(7,6,5,5,4,3,3)
y = c(7,7,6,5,5,6,7)
n = length(x)
set.seed(131)
t = t0 + cumsum(runif(n) * 60)
library(sp)
require(rgdal)
## Loading required package: rgdal
## rgdal: version: 1.2-15, (SVN revision 691)
##  Geospatial Data Abstraction Library extensions to R successfully loaded
##  Loaded GDAL runtime: GDAL 2.1.2, released 2016/10/24
##  Path to GDAL shared files: /usr/share/gdal/2.1
##  GDAL binary built with GEOS: TRUE 
##  Loaded PROJ.4 runtime: Rel. 4.9.3, 15 August 2016, [PJ_VERSION: 493]
##  Path to PROJ.4 shared files: (autodetected)
##  Linking to sp version: 1.2-5
crs = CRS("+proj=longlat +ellps=WGS84") # longlat

library(spacetime)
stidf = STIDF(SpatialPoints(cbind(x,y),crs), t, data.frame(co2 = rnorm(n)))

library(trajectories)
A1 = Track(stidf)
# person A, track 2:
x = c(7,6,6,7,7)
y = c(6,5,4,4,3)
n = length(x)
t = max(t) + cumsum(runif(n) * 60)
stidf = STIDF(SpatialPoints(cbind(x,y),crs), t, data.frame(co2 = rnorm(n)))

A2 = Track(stidf)
# Tracks for person A:
A = Tracks(list(A1=A1,A2=A2))
# person B, track 1:
x = c(2,2,1,1,2,3)
y = c(5,4,3,2,2,3)
n = length(x)
t = max(t) + cumsum(runif(n) * 60)
stidf = STIDF(SpatialPoints(cbind(x,y),crs), t, data.frame(co2 = rnorm(n)))
B1 = Track(stidf)
# person B, track 2:
x = c(3,3,4,3,3,4)
y = c(5,4,3,2,1,1)
n = length(x)
t = max(t) + cumsum(runif(n) * 60)
stidf = STIDF(SpatialPoints(cbind(x,y),crs), t, data.frame(co2 = rnorm(n)))
B2 = Track(stidf)
# Tracks for person A:
B = Tracks(list(B1=B1,B2=B2))
Tr = TracksCollection(list(A=A,B=B))
stplot(Tr, scales = list(draw=TRUE))

stplot(Tr, attr = "direction", arrows=TRUE, lwd = 3, by = "direction")

stplot(Tr, attr = "direction", arrows=TRUE, lwd = 3, by = "IDs")

plot(Tr, col=2, axes=TRUE)

dim(Tr)
##        IDs     tracks geometries 
##          2          4         24
dim(Tr[2])
##     tracks geometries 
##          2         12
dim(Tr[2][1])
## geometries 
##          6
u = stack(Tr) # four IDs
dim(u)
##        IDs     tracks geometries 
##          4          4         24
dim(unstack(u, c(1,1,2,2))) # regroups to original
##        IDs     tracks geometries 
##          2          4         24
dim(unstack(u, c(1,1,2,3))) # regroups to three IDs
##        IDs     tracks geometries 
##          3          4         24
dim(unstack(u, c(1,2,2,1))) # regroups differently
##        IDs     tracks geometries 
##          2          4         24
as(Tr, "data.frame")[1:10,] # tracks separated by NA rows
##         x  y sp.ID                time             endTime timeIndex
## A.A1.1  7  7     1 2013-09-30 02:00:12 2013-09-30 02:00:12         1
## A.A1.2  6  7     2 2013-09-30 02:00:19 2013-09-30 02:00:19         2
## A.A1.3  5  6     3 2013-09-30 02:00:37 2013-09-30 02:00:37         3
## A.A1.4  5  5     4 2013-09-30 02:01:00 2013-09-30 02:01:00         4
## A.A1.5  4  5     5 2013-09-30 02:01:50 2013-09-30 02:01:50         5
## A.A1.6  3  6     6 2013-09-30 02:02:22 2013-09-30 02:02:22         6
## A.A1.7  3  7     7 2013-09-30 02:02:53 2013-09-30 02:02:53         7
## A.A1.8 NA NA    NA                <NA>                <NA>        NA
## A.A2.1  7  6     1 2013-09-30 02:03:31 2013-09-30 02:03:31         1
## A.A2.2  6  5     2 2013-09-30 02:04:09 2013-09-30 02:04:09         2
##                co2 Track IDs
## A.A1.1 -0.71322105    A1   A
## A.A1.2  1.37185185    A1   A
## A.A1.3 -0.39982855    A1   A
## A.A1.4 -0.47880016    A1   A
## A.A1.5 -0.54870456    A1   A
## A.A1.6  0.48757652    A1   A
## A.A1.7 -0.06981164    A1   A
## A.A1.8          NA    A1   A
## A.A2.1  1.40377616    A2   A
## A.A2.2  0.79969808    A2   A
as(Tr, "segments")[1:10,]   # track segments as records
##        x0 y0 x1 y1                time        co2 distance duration
## A.A1.1  7  7  6  7 2013-09-30 02:00:12 -0.7132211 110495.2  7.49653
## A.A1.2  6  7  5  6 2013-09-30 02:00:19  1.3718518 156407.3 17.59639
## A.A1.3  5  6  5  5 2013-09-30 02:00:37 -0.3998285 110583.3 22.54678
## A.A1.4  5  5  4  5 2013-09-30 02:01:00 -0.4788002 110898.7 50.78081
## A.A1.5  4  5  3  6 2013-09-30 02:01:50 -0.5487046 156547.2 31.75229
## A.A1.6  3  6  3  7 2013-09-30 02:02:22  0.4875765 110587.4 31.11752
## A.A2.1  7  6  6  5 2013-09-30 02:03:31  1.4037762 156547.2 37.52483
## A.A2.2  6  5  6  4 2013-09-30 02:04:09  0.7996981 110579.9 24.03699
## A.A2.3  6  4  7  4 2013-09-30 02:04:33 -0.7110605 111050.1 34.96193
## A.A2.4  7  4  7  3 2013-09-30 02:05:08 -1.5005960 110577.2 19.64212
##            speed direction Track IDs
## A.A1.1 14739.515 270.06094    A1   A
## A.A1.2  8888.604 224.87295    A1   A
## A.A1.3  4904.618 180.00000    A1   A
## A.A1.4  2183.870 270.04358    A1   A
## A.A1.5  4930.266 315.17903    A1   A
## A.A1.6  3553.863   0.00000    A1   A
## A.A2.1  4171.830 224.91682    A2   A
## A.A2.2  4600.407 180.00000    A2   A
## A.A2.3  3176.316  89.96512    A2   A
## A.A2.4  5629.598 180.00000    A2   A
Tr[["distance"]] = Tr[["distance"]] * 1000
Tr$distance = Tr$distance / 1000
Tr$distance
##    A.A11    A.A12    A.A13    A.A14    A.A15    A.A16    A.A21    A.A22 
## 110495.2 156407.3 110583.3 110898.7 156547.2 110587.4 156547.2 110579.9 
##    A.A23    A.A24    B.B11    B.B12    B.B13    B.B14    B.B15    B.B21 
## 111050.1 110577.2 110579.9 156757.4 110575.2 111252.1 156827.6 110579.9 
##    B.B22    B.B23    B.B24    B.B25 
## 156757.4 156827.6 110573.8 111302.6
# work with custum TrackStats function:
MyStats = function(track) {
    df = apply(coordinates(track@sp), 2, diff) # requires sp
    data.frame(distance = apply(df, 1, function(x) sqrt(sum(x^2))))
}
crs = CRS(as.character(NA))
stidf = STIDF(SpatialPoints(cbind(x,y),crs), t, data.frame(co2 = rnorm(n)))
B2 = Track(stidf) # no longer longlat;
B3 = Track(stidf, fn = MyStats)
all.equal(B3$distance, B2$distance)
## [1] TRUE

Interpolating trajectories

opar = par()
par(mfrow = c(1, 2))
plot(B2, ylim = c(.5, 6))
plot(B2, pch = 16, add = TRUE)
title("irregular time steps")
i = index(B2)
B3 = approxTrack(B2, seq(min(i), max(i), length.out = 50))
plot(B3, col = 'red', type = 'p', add = TRUE)
B4 = approxTrack(B2, seq(min(i), max(i), length.out = 50), FUN = spline)
plot(B4, col = 'blue', type = 'b', add = TRUE)
# regular time steps:
t = max(t) + (1:n) * 60 # regular
B2 = Track(STIDF(SpatialPoints(cbind(x,y),crs), t, data.frame(co2 = rnorm(n))))
plot(B2, ylim = c(.5, 6))
plot(B2, pch = 16, add = TRUE)
title("constant time steps")
i = index(B2)
B3 = approxTrack(B2)
plot(B3, type = 'p', col = 'red', add = TRUE)
B4 = approxTrack(B2, FUN = spline)
plot(B4, type = 'p', col = 'blue', add = TRUE)

par(opar)
## Warning in par(opar): graphical parameter "cin" cannot be set
## Warning in par(opar): graphical parameter "cra" cannot be set
## Warning in par(opar): graphical parameter "csi" cannot be set
## Warning in par(opar): graphical parameter "cxy" cannot be set
## Warning in par(opar): graphical parameter "din" cannot be set
## Warning in par(opar): graphical parameter "page" cannot be set

Smoothing trajectories

smth = function(x,y,xout,...) predict(smooth.spline(as.numeric(x), y), as.numeric(xout))
data(storms)
plot(storms, type = 'p')
## Warning in axis(side, at = at, labels = labels, ...): graphical parameter
## "type" is obsolete

## Warning in axis(side, at = at, labels = labels, ...): graphical parameter
## "type" is obsolete
## Warning in title(...): graphical parameter "type" is obsolete
storms.smooth = approxTracksCollection(storms, FUN = smth, n = 200)
## Warning in validityMethod(object): tracks with overlapping time intervals:
## 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18
## Warning in validityMethod(object): tracks with overlapping time intervals:
## 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19
## Warning in validityMethod(object): tracks with overlapping time intervals:
## 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20
## Warning in validityMethod(object): tracks with overlapping time intervals:
## 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
plot(storms.smooth, add = TRUE, col = 'red')

Simulating random trajectories

x = rTrack()
dim(x)
## geometries 
##        100
plot(x)

x = rTracks(sd1 = 120)
dim(x)
##     tracks geometries 
##         20       2000
plot(as(x, "SpatialLines"), col = 1:dim(x)[1], axes=TRUE)

x = rTracksCollection() # star
dim(x)
##        IDs     tracks geometries 
##         10        200      20000
plot(x)

x = rTracksCollection(sd2 = 200)
plot(x, col=1:dim(x)[1])