Merge pull request #12 from g-rppl/dev

Add visualisation methods

.Rbuildignore

@@ -7,3 +7,5 @@
 ^inst/Stan/.*\.exe$
 ^test\.R$
 ^TODO\.md$
+^doc$
+^Meta$

.github/workflows/pkgdown.yml

@@ -46,8 +46,7 @@ jobs:
 
       - name: Deploy to GitHub pages 🚀
         if: github.event_name != 'pull_request'
-        uses: JamesIves/github-pages-deploy-action@v4.4.1
+        uses: JamesIves/github-pages-deploy-action@v4
         with:
-          clean: false
           branch: gh-pages
           folder: docs

.gitignore

@@ -4,3 +4,5 @@ inst/doc
 docs
 TODO.md
 test.R
+/doc/
+/Meta/

DESCRIPTION

@@ -3,7 +3,7 @@ Title: Estimate flight tracks from telemetry data
 Description: `stantrackr` is a `R` package that provides simple functionality
   to estimate flight tracks from telemetry data using random walk models written
   in Stan.
-Version: 0.2.0
+Version: 0.3.0
 License: MIT + file LICENSE
 Authors@R: 
   person("Georg", "Rüppel", , "[email protected]", role = c("aut", "cre"),
@@ -16,7 +16,8 @@ Imports:
   HDInterval,
   cmdstanr,
   dplyr,
-  lubridate
+  lubridate,
+  ggplot2
 Additional_repositories:
   https://mc-stan.org/r-packages/
 SystemRequirements: CmdStan (https://mc-stan.org/users/interfaces/cmdstan)
@@ -28,7 +29,6 @@ RoxygenNote: 7.2.3
 Suggests: 
   knitr,
   rmarkdown,
-  tidyverse,
   sf,
   leaflet,
   sfheaders,

NAMESPACE

@@ -1,14 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(as.data.frame,stantrackr)
+S3method(plot,stantrackr)
 S3method(print,stantrackr)
 S3method(summary,stantrackr)
 export(getDraws)
 export(locate)
+export(mapTrack)
 export(track)
 importFrom(HDInterval,hdi)
 importFrom(cmdstanr,cmdstan_model)
-importFrom(dplyr,"%>%")
 importFrom(dplyr,arrange)
 importFrom(dplyr,bind_cols)
 importFrom(dplyr,distinct)
@@ -18,6 +19,15 @@ importFrom(dplyr,mutate)
 importFrom(dplyr,n)
 importFrom(dplyr,select)
 importFrom(dplyr,summarise)
+importFrom(ggplot2,.data)
+importFrom(ggplot2,aes)
+importFrom(ggplot2,geom_path)
+importFrom(ggplot2,geom_point)
+importFrom(ggplot2,geom_segment)
+importFrom(ggplot2,ggplot)
+importFrom(ggplot2,ggtitle)
+importFrom(ggplot2,labs)
+importFrom(ggplot2,ylab)
 importFrom(lubridate,is.POSIXct)
 importFrom(lubridate,round_date)
 importFrom(stats,complete.cases)

R/locate.R

@@ -41,9 +41,10 @@
 #' locate(motusData, det_range = list("yagi-5"=10, "yagi-6"=12))
 #' }
 #'
-#' @importFrom dplyr %>% arrange distinct group_by mutate select
+#' @importFrom dplyr arrange distinct group_by mutate select
 #' @importFrom lubridate round_date is.POSIXct
 #' @importFrom stats complete.cases weighted.mean
+#' @importFrom ggplot2 .data
 #'
 #' @export
 #'
@@ -58,9 +59,6 @@ locate <- function(
     aBearing = "antBearing",
     det_range = 12,
     dtime = 2) {
-  # Bind variables locally so that R CMD check doesn't complain
-  lon <- lat <- NULL
-
   # Build data
   d <- .buildData(data, ID, ts, sig, aLon, aLat, aType, aBearing, det_range)
 
@@ -69,7 +67,7 @@ locate <- function(
     d$aLon, d$aLat, d$aBearing, d$det_range / 2
   ))
 
-  d <- cbind(d, tmp) %>% arrange(ID, ts)
+  d <- cbind(d, tmp) |> arrange(ID, ts)
 
   # Estimate oscillating error based on antenna bearing
   lon_sd <- (d$det_range / 6) * sin(1 / 90 * pi * d$aBearing - pi / 2) +
@@ -84,20 +82,20 @@ locate <- function(
   # Weighted means per minute interval
   d$ts <- round_date(d$ts, unit = paste(dtime, "min"))
 
-  d <- d %>%
-    group_by(ID, ts) %>%
+  d <- d |>
+    group_by(ID, ts) |>
     mutate(
-      lon = weighted.mean(lon, sig),
-      lat = weighted.mean(lat, sig),
+      lon = weighted.mean(.data$lon, sig),
+      lat = weighted.mean(.data$lat, sig),
       lon_sd = weighted.mean(lon_sd, sig),
       lat_sd = weighted.mean(lat_sd, sig)
-    ) %>%
-    distinct(ts, .keep_all = TRUE) %>%
+    ) |>
+    distinct(ts, .keep_all = TRUE) |>
     select(-c(sig, aLon, aLat, aType, aBearing, det_range))
 
   # Proportions of time intervals
-  d <- d %>%
-    group_by(ID) %>%
+  d <- d |>
+    group_by(ID) |>
     mutate(w = dtime / c(dtime, diff(as.numeric(ts) / 60)))
 
   return(as.data.frame(d))

R/summary.R

@@ -98,7 +98,7 @@ summary.stantrackr <- function(
 #' @param ... Additional arguments passed to `print()`.
 #'
 #' @seealso `summary.stantrackr()`
-#' 
+#'
 #' @importFrom dplyr bind_cols
 #'
 #' @method print stantrackr
@@ -117,7 +117,7 @@ print.stantrackr <- function(x, digits = 3, ...) {
 #' @param ... Unused; for compatibility with the generic method.
 #'
 #' @seealso `summary.stantrackr()`
-#' 
+#'
 #' @importFrom dplyr bind_cols
 #'
 #' @method as.data.frame stantrackr
@@ -137,12 +137,11 @@ as.data.frame.stantrackr <- function(x, ...) {
 #'
 #' @return A `data.frame` with the draws.
 #'
+#' @importFrom ggplot2 .data
+#'
 #' @export
 #'
 getDraws <- function(fit, nsim = 50) {
-  # Bind variables locally so that R CMD check doesn't complain
-  ID <- tID <- iter <- time <- NULL
-
   # Sample iterations and chains
   it <- sample(dimnames(fit$draws$lon)$iteration, nsim)
   ch <- sample(dimnames(fit$draws$lon)$chain, 1)
@@ -155,8 +154,8 @@ getDraws <- function(fit, nsim = 50) {
     iter = it,
     lon = c(fit$draws$lon[it, ch, ]),
     lat = c(fit$draws$lat[it, ch, ])
-  ) %>%
-    mutate(tID = paste(ID, iter, sep = "_")) %>%
-    arrange(tID, time)
+  ) |>
+    mutate(tID = paste(.data$ID, .data$iter, sep = "_")) |>
+    arrange(.data$tID, .data$time)
   return(sim)
 }

R/track.R

@@ -1,7 +1,7 @@
 #' Model data
 #'
 #' @description
-#' Model flight path from point estimates using a DCRW model.
+#' Model flight path from point estimates using a Hidden Markov Model.
 #'
 #' @param data A `data.frame` containing the point estimate data.
 #' @param states The number of states to use in the model; defaults to `1`.
@@ -49,21 +49,19 @@
 #' track(loc, i_lambda = FALSE, parallel_chains = 4)
 #' }
 #'
-#' @importFrom dplyr %>% n group_by summarise filter
+#' @importFrom dplyr n group_by summarise filter
+#' @importFrom ggplot2 .data
 #' @importFrom cmdstanr cmdstan_model
 #'
 #' @export
 #'
 track <- function(data, states = 1, i_lambda = TRUE, ...) {
-  # Bind variables locally so that R CMD check doesn't complain
-  . <- ID <- NULL
-
   # Check data
-  ids <- data %>%
-    group_by(ID) %>%
-    summarise(n = n()) %>%
-    filter(n < 3) %>%
-    .$ID
+  ids <- data |>
+    group_by(.data$ID) |>
+    summarise(n = n()) |>
+    filter(n < 3) |>
+    _$ID
   if (length(ids) > 0) {
     warning(paste0(
       ifelse(length(ids) < 2, "ID ", "IDs "), paste(ids, collapse = ", "),

R/visualise.R

@@ -0,0 +1,101 @@
+#' Plot model results
+#'
+#' @description
+#' Plot model results per individual and variable.
+#'
+#' @param x An object of class `stantrackr`.
+#' @param vars The variables to plot. Defaults to `c("lon", "lat")`.
+#' @param id The individuals to plot. Defaults to `NULL` which plots all
+#'   individuals.
+#' @param ... Additional arguments passed to `stantrckr::summary()`.
+#'
+#' @return
+#' Returns one or multiple `ggplot` plots.
+#'
+#' @seealso `stantrackr::summary()`
+#'
+#' @examples
+#' \dontrun{
+#' # Set ggplot theme
+#' theme_set(theme_bw(base_size = 20))
+#'
+#' # Plot
+#' plot(fit)
+#' plot(fit, vars = "speed", prob = 0.89, ci = "ETI")
+#' }
+#'
+#' @importFrom dplyr filter
+#' @importFrom ggplot2 ggplot aes .data geom_segment geom_point ggtitle ylab
+#'
+#' @method plot stantrackr
+#' @export
+#'
+plot.stantrackr <- function(x, vars = c("lon", "lat"), id = NULL, ...) {
+  if (is.null(id)) {
+    id <- unique(x$ID)
+  }
+  for (i in id) {
+    for (var in vars) {
+      g <- summary(x, var, ...) |>
+        filter(.data$ID == i) |>
+        ggplot() +
+        geom_segment(aes(
+          x = .data$time, y = .data[[paste0(var, ".lower")]],
+          xend = .data$time, yend = .data[[paste0(var, ".upper")]]
+        ), alpha = 0.2) +
+        geom_point(aes(x = .data$time, y = .data[[paste0(var, ".mean")]])) +
+        ggtitle(paste("ID:", i)) +
+        ylab(var)
+      plot(g)
+    }
+  }
+}
+
+#' Map model result
+#'
+#' @description
+#' Map individual flight trajectories and model uncertainty.
+#'
+#' @param fit An object of class `stantrackr`.
+#' @param id The individuals to plot. Defaults to `NULL` which plots all
+#'   individuals.
+#' @param nsim The number of posterior draws to plot. Defaults to `50`.
+#' @param lwd The line width for the mean trajectory. Defaults to `2`.
+#' @param alpha The alpha value for the posterior draws. Defaults to `0.1`.
+#'
+#' @return
+#' Returns an overview map with the mean trajectories and `nsim` posterior draws
+#'   per individual.
+#'
+#' @examples
+#' \dontrun{
+#' mapTrack(fit)
+#' mapTrack(fit, nsim = 100, alpha = 0.05)
+#' }
+#'
+#' @importFrom ggplot2 ggplot aes .data geom_path labs
+#'
+#' @export
+#'
+mapTrack <- function(fit, id = NULL, nsim = 50, lwd = 2, alpha = 0.1) {
+  if (is.null(id)) {
+    id <- unique(fit$ID)
+  }
+  g <- fit |>
+    as.data.frame() |>
+    filter(.data$ID %in% id) |>
+    ggplot()
+  if (nsim > 0) {
+    draws <- getDraws(fit, nsim = nsim)
+    g <- g +
+      geom_path(
+        data = draws |> filter(.data$ID %in% id),
+        aes(.data$lon, .data$lat, group = .data$tID), alpha = alpha
+      )
+  }
+  g +
+    geom_path(aes(.data$lon, .data$lat, colour = as.factor(.data$ID)),
+      lwd = lwd
+    ) +
+    labs(colour = "ID")
+}

_pkgdown.yml

@@ -2,7 +2,6 @@ reference:
   - title: Data
     contents:
       - "`motusData`"
-
   - title: Model
     contents:
       - "`locate`"
@@ -13,3 +12,7 @@ reference:
       - "`summary.stantrackr`"
       - "`as.data.frame.stantrackr`"
       - "`getDraws`"
+  - title: Visualise
+    contents:
+      - "`plot.stantrackr`"
+      - "`mapTrack`"