Matthew Boone, Rocio Joo, Mathieu Basille
Ecology Society of America conference 2020
Build a movement framework that the community will buy into
Flexible enough to contain ever expanding structures of movement models
Make methods and documentation transparent
Fully compatible with sf, tidyverse, and ggplot
Our goals are not to replace any of these existing packages. But to create a class that is flexible enough to be used by all these packages.
animal_id timestamp longitude latitude fix
Length:17447 Length:17447 Min. :-80.89 Min. : 0.00 Length:17447
Class :character Class :character 1st Qu.:-80.28 1st Qu.: 0.00 Class :character
Mode :character Mode :character Median :-80.27 Median :26.07 Mode :character
Mean :-54.89 Mean :17.83
3rd Qu.: 0.00 3rd Qu.:26.07
Max. : 0.00 Max. :27.89
devtools::install_github("mablab/sftrack")
raccoon <- read.csv('my_data/raccoon_data.csv')
summary(raccoon)
Prepare
library(lubridate)
raccoon$timestamp <- ymd_hms(raccoon$timestamp)
# lat/long crs
wsg <- 'EPSG:4326'
Create
my_sftrack <- as_sftrack(raccoon, burst = 'animal_id', time = 'timestamp',
coords = c('longitude', 'latitude'), crs=wsg, zeroNA = TRUE)
plot(my_sftrack, axes = T, graticule = TRUE, pch = 4, lwd=3.8)
my_sftrack <- my_sftrack[c('TTP-058','TTP-041'),]
print(my_sftrack, n_row=12)
Sftrack with 4769 features and 7 fields (2236 empty geometries)
Geometry : "geometry" (XY, crs: WGS 84)
Timestamp : "timestamp" (POSIXct in UTC)
Burst : "burst" (*id*)
-------------------------------
animal_id timestamp longitude latitude fix burst geometry
10891 TTP-041 2019-01-15 17:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
3351 TTP-041 2019-01-16 17:02:30 -80.27812 26.06610 3D (id: TTP-041) POINT (-80.27812 26.0661)
3352 TTP-041 2019-01-17 17:02:30 -80.27830 26.06561 3D (id: TTP-041) POINT (-80.2783 26.06561)
3353 TTP-041 2019-01-18 17:02:30 -80.27835 26.06566 3D (id: TTP-041) POINT (-80.27835 26.06566)
3354 TTP-041 2019-01-19 00:02:30 -80.27531 26.06607 3D (id: TTP-041) POINT (-80.27531 26.06607)
3355 TTP-041 2019-01-19 01:02:05 -80.27620 26.06573 3D (id: TTP-041) POINT (-80.2762 26.06573)
3356 TTP-041 2019-01-19 02:02:05 -80.27636 26.06859 3D (id: TTP-041) POINT (-80.27636 26.06859)
10892 TTP-041 2019-01-19 03:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
10893 TTP-041 2019-01-19 04:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
10894 TTP-041 2019-01-19 05:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
15584 TTP-041 2019-01-19 06:02:30 -80.27873 26.06819 2D (id: TTP-041) POINT (-80.27873 26.06819)
10895 TTP-041 2019-01-19 07:02:30 0.00000 0.00000 NO (id: TTP-041) POINT EMPTY
library(OpenStreetMap)
# Get bounding box from sf geometry
bbox <- st_bbox(my_sftrack)
lower_right <- bbox[c(2,3)] + c(-0.01,0.2)
upper_left <- bbox[c(4,1)] + c(0.01,-0.2)
# download open street map
map <- openmap(upper_left,lower_right,
zoom=11, type='osm')
# project map
map <- openproj(map)
plot(map)
plot(my_sftrack, add= T, pch=4, lwd=2, col = 'black')
utm_17 <- '+proj=utm +zone=17 +ellps=WGS84 +datum=WGS84 +units=m +no_defs'
my_sftrack <- st_transform(my_sftrack, crs = utm_17)
# Make a polygon within study
poly_pts <- list(
rbind(
c(572300, 2883500),
c(572600, 2883500),
c(572600, 2883700),
c(572300, 2883700),
c(572300, 2883500)
)
)
polygon <- st_sfc(st_polygon(poly_pts), crs=utm_17)
# What points are within a polygon?
plot(polygon, axes= T, graticule = TRUE, expandBB = c(1.5,1.5,1.5,1.5), col =sf.colors(alpha=0.2))
plot(my_sftrack, add =T)
answer <- st_within(my_sftrack, polygon, sparse=FALSE)
sub_sftrack <- my_sftrack[answer, ]
head(sub_sftrack)
Sftrack with 6 features and 7 fields (0 empty geometries)
Geometry : "geometry" (XY, crs: +proj=utm +zone=17 +ellps=WGS84 +datum=WGS84 +units=m +no_defs)
Timestamp : "timestamp" (POSIXct in UTC)
Burst : "burst" (*id*)
-------------------------------
animal_id timestamp longitude latitude fix burst geometry
3382 TTP-041 2019-01-24 02:02:09 -80.27637 26.07026 3D (id: TTP-041) POINT (572377.1 2883665)
15601 TTP-041 2019-01-28 20:02:30 -80.27576 26.06974 2D (id: TTP-041) POINT (572438.2 2883608)
3425 TTP-041 2019-02-03 19:02:14 -80.27701 26.07041 3D (id: TTP-041) POINT (572313.6 2883681)
3426 TTP-041 2019-02-03 20:02:08 -80.27466 26.07010 3D (id: TTP-041) POINT (572548.8 2883649)
3482 TTP-041 2019-02-13 02:02:09 -80.27630 26.06926 3D (id: TTP-041) POINT (572385.2 2883555)
17035 TTP-041 2019-02-22 02:02:20 -80.27497 26.06999 3D (id: TTP-041) POINT (572517.3 2883636)
step_calc <- step_metrics(my_sftrack)
head(step_calc)
dx dy dist dt abs_angle rel_angle speed
1 NA NA NA 86400 NA NA NA
2 18.008768 53.593639 56.538428 86400 1.2466258 NA 6.543800e-04
3 4.727009 4.625484 6.613601 86400 0.7745432 -0.4720826 7.654631e-05
4 303.425593 47.756375 307.160807 25200 0.1561101 -0.6184331 1.218892e-02
5 89.014047 38.261403 96.888779 3575 0.4059593 0.2498492 2.710176e-02
6 17.864152 316.988342 317.491318 3600 1.5145000 1.1085407 8.819203e-02
sftrack_id
1 TTP-041_2019-01-15 17:02:30
2 TTP-041_2019-01-16 17:02:30
3 TTP-041_2019-01-17 17:02:30
4 TTP-041_2019-01-18 17:02:30
5 TTP-041_2019-01-19 00:02:30
6 TTP-041_2019-01-19 01:02:05
summary(step_calc)
dx dy dist dt abs_angle
Min. : 0.000 Min. : 0.000 Min. : 0.00 Min. : 872 Min. :0.0003
1st Qu.: 1.191 1st Qu.: 1.316 1st Qu.: 4.20 1st Qu.: 3584 1st Qu.:0.4701
Median : 23.989 Median : 28.200 Median : 61.41 Median : 3600 Median :0.9192
Mean : 89.687 Mean : 126.776 Mean : 174.98 Mean : 5561 Mean :0.8712
3rd Qu.: 96.840 3rd Qu.: 154.804 3rd Qu.: 235.78 3rd Qu.: 3600 3rd Qu.:1.2716
Max. :9821.837 Max. :14427.086 Max. :14427.40 Max. :86400 Max. :1.5699
NA's :2237 NA's :2237 NA's :2237 NA's :2 NA's :2794
rel_angle speed sftrack_id
Min. :-1.502 Min. :0.0000 Length:4769
1st Qu.:-0.390 1st Qu.:0.0011 Class :character
Median :-0.009 Median :0.0220 Mode :character
Mean :-0.005 Mean :0.0629
3rd Qu.: 0.369 3rd Qu.:0.0768
Max. : 1.511 Max. :7.7028
NA's :3228 NA's :2237
# Filter out by travel distance
my_sftrack <- my_sftrack[!is.na(step_calc$dist) &step_calc$dist<200,]
library(OpenStreetMap)
map_zoom <-
openmap(c(26.078,-80.292),c(26.062,-80.262),
zoom=15, type='osm')
# project to UTM 17
map_zoom <- openproj(map_zoom, utm_17)
plot(map_zoom)
plot(my_sftrack, add= T, pch=4, lwd=2)
my_sftraj <- as_sftraj(my_sftrack)
head(my_sftraj)
Sftraj with 6 features and 7 fields (0 empty geometries)
Geometry : "geometry" (XY, crs: +proj=utm +zone=17 +ellps=WGS84 +datum=WGS84 +units=m +no_defs)
Timestamp : "timestamp" (POSIXct in UTC)
Burst : "burst" (*id*)
-------------------------------
animal_id timestamp longitude latitude fix burst
3351 TTP-041 2019-01-16 17:02:30 -80.27812 26.06610 3D (id: TTP-041)
3352 TTP-041 2019-01-17 17:02:30 -80.27830 26.06561 3D (id: TTP-041)
3354 TTP-041 2019-01-19 00:02:30 -80.27531 26.06607 3D (id: TTP-041)
3356 TTP-041 2019-01-19 02:02:05 -80.27636 26.06859 3D (id: TTP-041)
15584 TTP-041 2019-01-19 06:02:30 -80.27873 26.06819 2D (id: TTP-041)
3357 TTP-041 2019-01-19 08:02:30 -80.27837 26.06565 3D (id: TTP-041)
geometry
3351 LINESTRING (572205.1 288320...
3352 LINESTRING (572187.1 288315...
3354 LINESTRING (572485.8 288320...
3356 LINESTRING (572378.9 288348...
15584 LINESTRING (572142.7 288343...
3357 LINESTRING (572180.1 288315...
plot(my_sftraj, graticule = TRUE, key.pos=4, main = 'Tree Tops Park Raccoons')
data('raccoon',package='sftrack')
raccoon$timestamp <- ymd_hms(raccoon$timestamp)
# create a new month category
raccoon$month <- month(raccoon$timestamp)
burst = c(id = 'animal_id', month = 'month')
my_sftraj <- as_sftraj(raccoon, burst = burst,
time = 'timestamp', coords = c('longitude', 'latitude'),
crs=wsg, zeroNA = TRUE)
# Check out what group is active
active_burst(my_sftraj)
[1] "id" "month"
plot(my_sftraj, graticule = TRUE)
active_burst(my_sftraj) <- 'id'
plot(my_sftraj, graticule = TRUE)
sf
plot methods.sftraj
class and grouping structure
@birderboone
github/birderboone
mablab.org