adding static mask

Merge branch 'main' of github.com:bluegreen-labs/skytrackr

# Conflicts:
#	R/skytrackr.R
#	analysis/demo_analysis.R

DESCRIPTION

@@ -36,10 +36,10 @@ Imports:
     ggplot2,
     plotly,
     rlang,
-    tidyr
-Suggests:
+    tidyr,
     dplyr,
-    patchwork,
+    patchwork
+Suggests:
     rnaturalearth,
     rmarkdown,
     covr,

NAMESPACE

@@ -5,6 +5,7 @@ export(log_lux)
 export(read_deg_lux)
 export(skytrackr)
 export(stk_fit)
+export(stk_map)
 export(stk_mask)
 export(stk_profile)
 export(stk_read_glf)

R/skytrackr.R

@@ -67,6 +67,9 @@ skytrackr <- function(
     verbose = TRUE
 ) {
 
+  # set global bounding box
+  bbox_global <- bbox
+
   # unravel the data
   data <- data |>
     dplyr::filter(
@@ -108,13 +111,6 @@ skytrackr <- function(
   pb$tick(0)
   }
 
-  if(plot){
-    maps::map(
-      xlim = bbox[c(1,3)],
-      ylim = bbox[c(2,4)]
-    )
-  }
-
   # create mask if required
   if(land_mask){
     mask <- stk_mask(buffer = buffer)
@@ -126,21 +122,25 @@ skytrackr <- function(
         if(!missing(start_location)){
 
           # create data point
-          roi <-  sf::st_as_sf(
-            data.frame(
-              lon = locations$longitude[i-1],
-              lat = locations$latitude[i-1]
+          roi <-  suppressMessages(suppressWarnings(
+            sf::st_as_sf(
+              data.frame(
+                lon = locations$longitude[i-1],
+                lat = locations$latitude[i-1]
               ),
-            coords = c("lon","lat"),
-            crs = "epsg:4326"
-          ) |>
-            sf::st_buffer(tolerance)
+              coords = c("lon","lat"),
+              crs = "epsg:4326"
+            ) |>
+              sf::st_buffer(tolerance)
+          ))
 
           if(land_mask){
-            roi <- sf::st_intersection(
-              roi,
-              mask
-            )
+            roi <- suppressMessages(suppressWarnings(
+              sf::st_intersection(
+                roi,
+                mask
+              )
+            ))
           }
 
           bbox <- roi |>
@@ -150,21 +150,25 @@ skytrackr <- function(
       if(!missing(start_location)) {
 
         # create data point
-        roi <- sf::st_as_sf(
-          data.frame(
-            lon = start_location[2],
-            lat = start_location[1]
-          ),
-          coords = c("lon","lat"),
-          crs = "epsg:4326"
-        ) |>
-          sf::st_buffer(tolerance)
+        roi <- suppressMessages(suppressWarnings(
+          sf::st_as_sf(
+            data.frame(
+              lon = start_location[2],
+              lat = start_location[1]
+            ),
+            coords = c("lon","lat"),
+            crs = "epsg:4326"
+          ) |>
+            sf::st_buffer(tolerance)
+        ))
 
         if(land_mask){
-          roi <- sf::st_intersection(
-            roi,
-            mask
-          )
+          roi <- suppressMessages(suppressWarnings(
+            sf::st_intersection(
+              roi,
+              mask
+            )
+          ))
         }
 
         bbox <- roi |>
@@ -204,26 +208,41 @@ message(
     }
 
     if(plot){
-      if(land_mask){
-        plot(
-          mask,
-          border = "grey",
-          add = TRUE
+      p <- stk_map(
+        locations,
+        buffer = buffer,
+        bbox = bbox_global
+      ) +
+        ggplot2::labs(
+          title = sprintf(
+            "%s (%s)",
+            data$logger[1],
+            locations$date[nrow(locations)]
+            )
         )
+
+      if(!missing(start_location)){
+        p <- p +
+          ggplot2::geom_point(
+            aes(
+              start_location[2],
+              start_location[1]
+            ),
+            colour = "red"
+          )
       }
 
-      graphics::lines(
-        locations[,5:4],
-        col = 'grey'
-      )
-      graphics::points(
-        locations[,5:4],
-        pch = 19,
-        col = 'red'
-      )
+      print(p)
     }
   }
 
+  # add equinox labels, two weeks
+  # before and after equinoxes
+  locations <- locations |>
+    mutate(
+      equinox = ifelse(TRUE, NA,NA)
+    )
+
   # return the data frame with
   # location
   return(locations)

R/stk_map.R

@@ -0,0 +1,47 @@
+#' Plot skytrackr results
+#'
+#' Create a map of estimated locations
+#'
+#' @param df a data frame with locations produced by skytrackr()
+#' @param buffer a land mask buffer value
+#' @param bbox a bounding box
+#'
+#' @return a ggplot map of tracked locations
+#' @export
+
+stk_map <- function(df, buffer, bbox) {
+   p <- ggplot2::ggplot(df) +
+    ggplot2::geom_sf(
+      data = stk_mask(buffer = buffer)
+      ) +
+    ggplot2::geom_sf(
+      data = stk_mask(buffer = 0)
+      ) +
+     ggplot2::labs(
+       x = "",
+       y = ""
+     )
+
+   if(nrow(df) > 1) {
+     p <- p +
+       ggplot2::geom_path(
+         aes(
+           longitude,
+           latitude
+         )
+       )
+   }
+
+   p <- p +
+    ggplot2::geom_point(
+      aes(
+        longitude,
+        latitude
+      )
+    ) +
+    ggplot2::coord_sf(
+      xlim = c(bbox[1], bbox[3]),
+      ylim = c(bbox[2], bbox[4])
+    ) +
+    ggplot2::theme_bw()
+}

R/stk_mask.R

@@ -8,22 +8,25 @@
 #' @return buffered land mask as an sf object
 #' @export
 
-stk_mask <- memoise::memoise(function(buffer = 1.5) {
+stk_mask <- memoise::memoise(function(buffer = 0) {
 
-  sf::sf_use_s2(FALSE)
-  land <- rnaturalearth::ne_download(
-    type = "land",
-    category = "physical",
-    returnclass = "sf"
+  suppressMessages(
+    suppressWarnings(
+      sf::sf_use_s2(FALSE)
+    )
   )
 
-  land <- suppressMessages(suppressWarnings(
-    land |>
-      sf::st_geometry() |>
-      sf::st_union() |>
-      sf::st_buffer(buffer)
+  land <- readRDS(system.file("extdata/mask.rds", package="skytrackr"))
+
+  if(buffer > 0){
+    land <- suppressMessages(suppressWarnings(
+      land |>
+        sf::st_geometry() |>
+        sf::st_union() |>
+        sf::st_buffer(buffer)
+      )
     )
-  )
+  }
 
   return(land)
 

R/stk_profile.R

@@ -2,6 +2,8 @@
 #' Plot seasonal profiles
 #'
 #' Uses plotly to provide a seasonal profile plot
+#' NOTE make this a method class so you can call
+#' plot(data.frame) or plot(df, plotly = TRUE)
 #'
 #' @param data skytrackr compatible data frame
 #' @param logger the logger to plot

analysis/demo_analysis.R

@@ -7,17 +7,12 @@ library(sf)
 lapply(list.files("R/","*.R", full.names = TRUE), source)
 #library(skytrackr)
 
-data <- stk_read_lux("data-raw/CC874_18Jun22_123407.lux")
+df <- stk_read_lux("data-raw/CH760_11Jun23_051213.lux")
 
-stk_profile(data)
-
-
-
-break
-# |>
-#   filter(
-#     date >= "2021-08-27"
-#   )
+df <- df |>
+  dplyr::filter(
+    (date >= "2022-08-12" & date <= "2023-04-27")
+  )
 
 # # batch processing via pipe for multiple sites
 # locations <- data |>
@@ -37,22 +32,14 @@ break
 
 #---- DEzs MCMC approach ----
 
-locations <- data |>
+locations <- df |>
   group_by(logger) |>
   do({
     skytrackr(
       .,
       start_location = c(51.08, 3.73),
       tolerance = 11,
       bbox = c(-20, -40, 60, 60),
-      control = list(
-          sampler = 'DEzs',
-          settings = list(
-              burnin = 1000,
-              iterations = 2000,
-              message = FALSE
-          )
-        ),
       land_mask = TRUE,
       plot = TRUE
     )

tests/testthat.r

@@ -0,0 +1,6 @@
+# Run all unit tests
+
+# This is a wrapper around all the tests specified
+# in the tests/testthat directory. These tests are visible
+# to users and serve as small examples as well.
+testthat::test_check("skytrackr")