Merge pull request #57 from harphub/develop

Merge develop

DESCRIPTION

@@ -1,14 +1,14 @@
 Package: harpPoint
 Title: Point verifition for NWP forecasts
-Version: 0.2.0
+Version: 0.2.1
 Authors@R: as.person(c(
     "Andrew Singleton <[email protected]> [aut, cre]", 
     "Alex Deckmyn <[email protected]> [aut]"
   ))
 Description: Functions for computing verification scores for NWP forecasts. 
     Part of the harp ecosystem. 
 Depends:
-    harpCore (>= 0.2.0),
+    harpCore (>= 0.2.2),
     R (>= 3.3.1)
 License: MIT + file LICENSE
 Encoding: UTF-8
@@ -28,7 +28,7 @@ Imports:
     magrittr,
     rlang,
     stats,
-    harpIO (>= 0.2.0),
+    harpIO (>= 0.2.2),
     progress,
     matrixStats,
     SpecsVerification,
@@ -39,8 +39,8 @@ Imports:
     hexbin,
     tidyselect
 Remotes:
-    harphub/harpCore,
-    harphub/harpIO
+    harphub/harpCore@v0.2.2,
+    harphub/harpIO@v0.2.2
 URL: https://github.com/harphub/harpPoint
 BugReports: https://github.com/harphub/harpPoint/issues
 Suggests: 

NAMESPACE

@@ -53,7 +53,7 @@ S3method(scale_point_forecast,default)
 S3method(scale_point_forecast,harp_list)
 S3method(select,harp_fcst)
 S3method(shift_forecast,default)
-S3method(shift_forecast,harp_fcst)
+S3method(shift_forecast,harp_list)
 S3method(spread_members,default)
 S3method(spread_members,harp_fcst)
 S3method(transmute,harp_fcst)

NEWS.md

@@ -1,3 +1,13 @@
+# harpPoint v0.2.1
+
+* HOTFIX released on 2nd February 2024
+
+* Fixes a bug that caused errors in `check_obs_against_fcst()` for deterministic
+forecasts
+
+* Fixes bug that meant `lag_forecast()` and `shift_forecast()` did not accept 
+the harp >= v0.2.0 column naming convention
+
 # harpPoint v0.2.0
 
 This is a major update. Most of the changes are internal, but there are some 

R/check_obs_against_fcst.R

@@ -53,7 +53,7 @@ check_obs_against_fcst <- function(
     .num_sd_allowed <- num_sd_allowed
   }
 
-  fcst_regex <- "_mbr[[:digit:]]{3}|_det$|^fcst$|^forecast$"
+  fcst_regex <- "_mbr[[:digit:]]{3}|_det$|_fcst$|^fcst$|^forecast$"
   if (.num_sd_allowed > 0) {
 
     tolerance <- join_models(

R/harpPoint_tidyverse.R

@@ -176,6 +176,17 @@ join_models.harp_list <- function(
   by = c("SID", "fcst_dttm", "valid_dttm", "lead_time"),
   ...
 ) {
+  # Make sure deterministic models get unique forecast columns
+  .fcst <- purrr::imap(
+    .fcst,
+    ~{
+      colnames(.x)[colnames(.x) == "fcst"] <- paste0(.y, "_fcst")
+      colnames(.x)[colnames(.x) == "forecast"] <- paste0(.y, "_fcst")
+      .x
+    }
+  )
+
+  # Do the join
   join_func <- get(paste0(join_type, "_join"), envir = asNamespace("dplyr"))
   purrr::reduce(.fcst, join_func, by = by, ...) %>%
     tibble::as_tibble() %>%

R/lag_forecast.R

@@ -57,7 +57,8 @@ lag_forecast.default <- function(fcst_df, fcst_model, parent_cycles, direction =
     )
 
   purrr::map_dfr(split(fcst_df, fcst_df$parent_cycle), lag_cycle, direction) %>%
-    tidyr::drop_na()
+    tidyr::drop_na() %>%
+    harpCore::as_harp_df()
 
 }
 
@@ -99,10 +100,18 @@ find_parent <- function(val, vec, direction) {
 }
 
 lag_cycle <- function(df, direction) {
+
+  colnames(df) <- suppressWarnings(harpCore::psub(
+    colnames(df),
+    c("fcdate", "validdate", "leadtime"),
+    c("fcst_dttm", "valid_dttm", "lead_time")
+  ))
+
   parent_cycle   <- unique(df$parent_cycle)
   child_cycles   <- df$fcst_cycle[df$fcst_cycle != parent_cycle]
   num_children   <- length(child_cycles)
   lagged_df      <- dplyr::filter(df, .data$fcst_cycle == parent_cycle)
+
   if (harpIO:::tidyr_new_interface()) {
     lagged_df <- tidyr::unnest(lagged_df, tidyr::one_of("data"))
   } else {
@@ -125,17 +134,21 @@ lag_cycle <- function(df, direction) {
       } else {
         child_members <- tidyr::unnest(child_members)
       }
+
       lagged_df <- dplyr::inner_join(
         lagged_df,
         child_members %>%
           dplyr::select_if(~ !all(is.na(.))) %>%
           dplyr::mutate(
-            leadtime = .data$leadtime - lag_hours * direction,
-            fcdate   = .data$fcdate   + lag_hours * 3600 * direction
+            lead_time = .data$lead_time - lag_hours * direction,
+            fcst_dttm = .data$fcst_dttm + lag_hours * 3600 * direction
           ) %>%
           dplyr::select(-.data$fcst_cycle, -.data$parent_cycle),
         by = intersect(
-          c("SID", "fcdate", "leadtime", "validdate", "parameter", "units", "model_elevation"),
+          c(
+            "SID", "fcdate", "leadtime", "validdate", "parameter", "units",
+            "model_elevation", "fcst_dttm", "valid_dttm", "lead_time"
+          ),
           colnames(lagged_df)
         ),
         suffix = c("", "_lag")

R/shift_forecast.R

@@ -28,23 +28,29 @@ shift_forecast.default <- function(.fcst, fcst_shifts, drop_negative_lead_times
     stop("Only one 'fcst_shifts' allowed per forecast model.", call. = FALSE)
   }
 
+  colnames(.fcst) <- suppressWarnings(harpCore::psub(
+    colnames(.fcst),
+    c("fcdate", "validdate", "leadtime"),
+    c("fcst_dttm", "valid_dttm", "lead_time")
+  ))
+
   .fcst <- .fcst %>%
     dplyr::mutate(
-      fcdate     = .data$fcdate + fcst_shifts * 3600,
-      leadtime   = .data$leadtime - fcst_shifts,
-      fcst_cycle = substr(harpIO::unixtime_to_str_datetime(.data$fcdate, harpIO::YMDh), 9, 10)
+      fcst_dttm  = .data$fcst_dttm + fcst_shifts * 3600,
+      lead_time  = .data$lead_time - fcst_shifts,
+      fcst_cycle = substr(harpIO::unixtime_to_str_datetime(.data$fcst_dttm, harpIO::YMDh), 9, 10)
     )
 
   if (drop_negative_lead_times) {
-    .fcst <- dplyr::filter(.fcst, .data$leadtime >= 0)
+    .fcst <- dplyr::filter(.fcst, .data$lead_time >= 0)
   }
 
-  .fcst
+  harpCore::as_harp_df(.fcst)
 
 }
 
 #' @export
-shift_forecast.harp_fcst <- function(.fcst, fcst_shifts, keep_unshifted = FALSE, drop_negative_lead_times = TRUE) {
+shift_forecast.harp_list <- function(.fcst, fcst_shifts, keep_unshifted = FALSE, drop_negative_lead_times = TRUE) {
 
   if (!is.list(fcst_shifts)) {
     if (length(fcst_shifts) > 1) {
@@ -88,6 +94,6 @@ shift_forecast.harp_fcst <- function(.fcst, fcst_shifts, keep_unshifted = FALSE,
       USE.NAMES = FALSE
     )
   }
-  .fcst
+  harpCore::as_harp_list(.fcst)
 }