Merge pull request #109 from Rafnuss/v3.1.6

V3.1.6

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: GeoPressureR
 Title: Global Positioning by Atmospheric Pressure
-Version: 3.1.5
+Version: 3.1.6
 Authors@R: c(
     person("Raphaël", "Nussbaumer", , "rafnuss@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0002-8185-1020")),

R/geopressure_map_mismatch.R

@@ -169,8 +169,7 @@ geopressure_map_mismatch <- function(tag,
     i_u <- 1
     cli::cli_progress_step(
       msg = "Read .geotiff: {.val {labels[i_u]}} | {i_u}/{length(urls)}",
-      msg_done = "Read .geotiff",
-      spinner = TRUE
+      msg_done = "Read .geotiff"
     )
     # nolint end
   }

R/plot_pressurepath.R

@@ -3,7 +3,8 @@
 #' Display a `pressurepath` data.frame as a timeseries or histogram
 #'
 #' @param pressurepath a GeoPressureR `pressurepath` data.frame.
-#' @param type Timeseries `"ts"` or histogram `"hist"`
+#' @param type timeseries `"timeseries"` (default), histogram `"histogram"`, or altitude
+#' `"altitude"`
 #' @inheritParams geopressure_map
 #' @param warning_std_thr Threshold of outliar, coefficient of the [z-score](
 #' https://en.wikipedia.org/wiki/Standard_score)
@@ -25,6 +26,10 @@
 #'
 #' plot_pressurepath(pressurepath)
 #'
+#' plot_pressurepath(pressurepath, type = "histogram")
+#'
+#' plot_pressurepath(pressurepath, type = "altitude")
+#'
 #' @family pressurepath
 #' @export
 plot_pressurepath <- function(pressurepath,
@@ -44,18 +49,21 @@ plot_pressurepath <- function(pressurepath,
     sd <- rep(1, times = length(unique(pressurepath$stap_id)))
   }
 
+  # Shorter name for the rest of the code
   pp <- pressurepath
 
-  # Compute the error
-  pp$error <- pp$pressure_tag - pp$pressure_era5_norm
-  pp$error[pp$label != ""] <- NA
-
   # Group by stapelev rather than stap in order to assess the use of elev
   pp$stapelev <- paste(pp$stap_id,
     ifelse(startsWith(pp$label, "elev_"), gsub("^.*?elev_", "", pp$label), "0"),
     sep = "|"
   )
 
+  # Compute the error
+  pp$error <- pp$pressure_tag - pp$pressure_era5_norm
+
+  # Remove error for discard
+  pp$error[pp$label == "discard"] <- NA
+
   # Compute the error std and offset
   tag_era5 <- merge(
     stats::aggregate(
@@ -75,7 +83,7 @@ plot_pressurepath <- function(pressurepath,
 
   # knitr::kable(tag_era5, "simple")
 
-  if ("ts" == type) {
+  if (type == "ts") {
     pp$warning <- (abs(pp$error) / sd[ifelse(pp$stap_id == 0, 1, pp$stap_id)]) >= warning_std_thr
 
     # convert stapelev to factor for color
@@ -103,9 +111,12 @@ plot_pressurepath <- function(pressurepath,
       ggplot2::theme_bw() +
       ggplot2::scale_y_continuous(name = "Pressure (hPa)") +
       ggplot2::theme(legend.position = "none")
-  } else if ("hist" == type) {
+  } else if (type == "histogram") {
     # Check if the empirical sd is greater than the sd used in the computation of the map
 
+    # Remove error for flight
+    pp <- pp[pp$stap_id != 0, ]
+
     pp$sd_param <- sd[ifelse(pp$stap_id == 0, 1, pp$stap_id)]
     pp$sd_ok <- pp$error_sd > pp$sd_param
     pp$stapelev <- factor(pp$stapelev, levels = tag_era5$stapelev)
@@ -162,6 +173,9 @@ plot_pressurepath <- function(pressurepath,
           color = "black"
         )
     }
+  } else {
+    cli::cli_abort("The type {.var {type}} of pressurepath plot does not exist. Available options
+                   are: {.val {c('ts', 'hist', 'altitude')}}")
   }
 
   if (plot_plotly) {

R/pressurepath2altitude.R

@@ -45,23 +45,36 @@ pressurepath2altitude <- function(pressurepath) {
     rule = 2
   )$y
 
-  # Compute the weight
+  # Compute the weight quantifying the proximity to the previous and next stap
   pp$w <- ifelse(pp$stap_interp == pp$stap_ref, 1, 1 - abs((pp$stap_interp - pp$stap_ref) * 2))
 
   # Weight the altitude
   pp$altitude_w <- pp$w * pp$altitude
+  pp$lon_w <- pp$w * pp$lon
+  pp$lat_w <- pp$w * pp$lat
 
-  # Sum the altitude by date, thus weighting average
+  # Sum the altitude by date, thus creating a weighted average
   pp_alt <- data.frame(
     date = sapply(split(pp$date, pp$date), stats::median),
+    label = sapply(split(pp$label, pp$date), unique),
     stap_id = sapply(split(pp$stap_id, pp$date), stats::median),
     altitude = sapply(split(pp$altitude_w, pp$date), sum),
+    lat = sapply(split(pp$lat_w, pp$date), sum),
+    lon = sapply(split(pp$lon_w, pp$date), sum),
     stap_s = sapply(split(pp$stap_ref, pp$date), min),
     stap_t = sapply(split(pp$stap_ref, pp$date), max)
   )
 
   # Because sum of weight is not exactly 1 all the time, we normalized by the sum
   pp_alt$altitude <- pp_alt$altitude / sapply(split(pp$w, pp$date), sum)
+  pp_alt$lat <- pp_alt$lat / sapply(split(pp$w, pp$date), sum)
+  pp_alt$lon <- pp_alt$lon / sapply(split(pp$w, pp$date), sum)
+
+  # Remove rowname
+  rownames(pp_alt) <- NULL
+
+  # Convert back to Posixct
+  pp_alt$date <- as.POSIXct(pp_alt$date, tz = attr(pp$date, "tzone"))
 
   # nolint start
   if (FALSE) {

R/pressurepath_create.R

@@ -137,8 +137,7 @@ pressurepath_create <- function(tag,
     # nolint start
     msg <- glue::glue("0/{nrow(path)}")
     cli::cli_progress_step(
-      "Generate requests (on GeoPressureAPI) for stap: {msg}",
-      spinner = TRUE
+      "Generate requests (on GeoPressureAPI) for stap: {msg}"
     )
     # nolint end
   }
@@ -171,12 +170,12 @@ pressurepath_create <- function(tag,
 
     # Send the query
     if (!is.na(path$lat[i_s]) && !is.na(path$lon[i_s]) && nrow(pressure_q) > 0) {
-      f[[i_s]] <- future::future({
+      f[[i_s]] <- future::future(expr = {
         geopressure_timeseries(path$lat[i_s], path$lon[i_s],
           pressure = pressure_q,
           quiet = TRUE
         )
-      })
+      }, seed = TRUE)
     }
   }
 
@@ -185,8 +184,7 @@ pressurepath_create <- function(tag,
     # nolint start
     msg2 <- glue::glue("0/{length(f)}")
     cli::cli_progress_step(
-      "Compute and download timeseries (on GEE server): {msg2}",
-      spinner = TRUE
+      "Compute and download timeseries (on GEE server): {msg2}"
     )
     # nolint end
   }