better handling for yromit in show_prdseries

Author: fawda123

.vscode/settings.json

@@ -0,0 +1,3 @@
+{
+    "positron.r.pipe": "%>%"
+}

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: wqtrends
 Title: Assess Water Quality Trends with Generalized Additive Models
-Version: 1.5.1.9000
-Date: 2025-08-11
+Version: 1.5.1.9001
+Date: 2025-08-15
 Authors@R: c(
     person(given = "Marcus",
       family = "Beck",

R/show_prdseries.R

@@ -10,13 +10,18 @@
 #' @param xlim optional numeric vector of length two for x-axis limits
 #' @param ylim optional numeric vector of length two for y-axis limits
 #' @param col optional chr string for line color
+#' @param minomit numeric indicating number of observations in the observed data to exclude it in the predicted series for a given year if provided to \code{yromit}
 #' 
 #' @return A \code{\link[ggplot2]{ggplot}} object
 #' @export
 #' 
 #' @details
 #' The optional \code{yromit} vector can be used to omit years from the plot. This may be preferred if the predicted values from the model deviate substantially from other years likely due to missing data.
 #' 
+#' The \code{yromit} argument behaves differently for this function compared to others because of a mismatch in the timestep for the predicted time series and the observed data. The function will attempt to find "bookends" in the observed data that match with the predicted time series for each year in \code{yromit}.  For example, if there is a gap in the observed data that spans multiple years and a single year value is included with \code{yromit} that is within the gap, the predicted time series will not be shown for the entire gap in the observed data even if additional years within the gap were not provided to \code{yromit}.
+#'  
+#' Entire years where observed data are present can also be removed from the predicted time series if they exceed a minimum number of observations defined by \code{minomit}. For example, if a year has at least 8 observations and \code{yromit} includes that year, the predicted time series for that entire year will be removed.
+#' 
 #' @concept show
 #' 
 #' @examples
@@ -30,19 +35,71 @@
 #' mod <- anlz_gam(tomod, trans = 'log10')
 #' 
 #' show_prdseries(mod, ylab = 'Chlorophyll-a (ug/L)')
-show_prdseries <- function(mod, ylab, yromit = NULL, alpha = 0.7, base_size = 11, xlim = NULL, ylim = NULL, col = 'brown'){
+show_prdseries <- function(mod, ylab, yromit = NULL, alpha = 0.7, base_size = 11, xlim = NULL, ylim = NULL, col = 'brown', minomit = 8){
 
   # get predictions
   prds <- anlz_prd(mod)
 
-  if(!is.null(yromit))
-    prds <- prds %>%
+  if(!is.null(yromit)){
+
+    # date range from model data that include yromit
+    moddat <- mod$model %>%
+      dplyr::filter(!is.na(value)) %>% 
       dplyr::mutate(
-        value = dplyr::case_when(
-          yr %in% !!yromit ~ NA_real_, 
-          TRUE ~ value
-        )
+        date = as.Date(lubridate::date_decimal(cont_year)),
+        yr = lubridate::year(date)
       )
+    
+    for(yr in yromit){
+      # omit the full year if there is "lots" of data
+      if(length(moddat[moddat$yr == yr, 'value']) >= minomit){
+        prds[prds$yr == yr, 'value'] <- NA_real_
+      
+      # otherwise, find bookends
+      } else {
+
+        # if year completely missing
+        if(!yr %in% moddat$yr){
+
+          if(yr > max(moddat$yr) | yr < min(moddat$yr))
+            next()
+          
+          strdt <- moddat %>% 
+            dplyr::filter(yr < !!yr) %>% 
+            dplyr::pull(date) %>% 
+            max()
+          enddt <- moddat %>% 
+            dplyr::filter(yr > !!yr) %>% 
+            dplyr::pull(date) %>% 
+            min()
+
+        # if year is included, find the gap
+        } else {
+          
+          yr <- yr + 0.5 # start in the middle
+          strdt <- moddat %>% 
+            dplyr::filter(cont_year < !!yr) %>% 
+            dplyr::pull(date) %>% 
+            max()
+          enddt <- moddat %>% 
+            dplyr::filter(cont_year > !!yr) %>% 
+            dplyr::pull(date) %>% 
+            min()
+
+        }
+
+        prds <- prds %>% 
+            dplyr::mutate(
+              value = dplyr::case_when(
+                date >= strdt & date <= enddt ~ NA_real_, 
+                TRUE ~ value
+              )
+            )
+        
+      }
+    }
+    
+  }
 
   # get transformation
   trans <- unique(prds$trans)