fix: target_param_grids bug

Author: dshemetov

R/targets_utils.R

@@ -6,7 +6,7 @@
 #' @export
 #' @importFrom rlang syms
 make_target_param_grid <- function(param_grid) {
-  param_grid %>%
+  param_grid %<>%
     select(-any_of("parent_id")) %>%
     mutate(forecaster = syms(forecaster)) %>%
     mutate(trainer = syms(trainer))
@@ -25,7 +25,7 @@ make_target_param_grid <- function(param_grid) {
 lists_of_real_values <- function(param_grid) {
   full_lists <- transpose(param_grid %>% select(-forecaster, -id))
   filter_nonvalues <- function(x) {
-    Filter(Negate(function(a) is.null(a) || is.na(a)), x)
+    Filter(function(a) !all(is.null(a)) && !all(is.na(a)), x)
   }
   map(full_lists, filter_nonvalues)
 }
@@ -35,11 +35,6 @@ lists_of_real_values <- function(param_grid) {
 #' Relies on the following globals:
 #' - `hhs_signal`
 #' - `chng_signal`
-#' - `geo_type`
-#' - `time_type`
-#' - `geo_values`
-#' - `time_values`
-#' - `issues`
 #' - `fetch_args`
 #'
 #' @export
@@ -51,10 +46,10 @@ make_data_targets <- function() {
         epidatr::pub_covidcast(
           source = "hhs",
           signals = hhs_signal,
-          geo_type = geo_type,
-          time_type = time_type,
-          geo_values = geo_values,
-          time_values = time_values,
+          geo_type = "state",
+          time_type = "day",
+          geo_values = "*",
+          time_values = epirange(from = "2020-01-01", to = "2024-01-01"),
           fetch_args = fetch_args
         )
       }
@@ -65,10 +60,10 @@ make_data_targets <- function() {
         epidatr::pub_covidcast(
           source = "chng",
           signals = chng_signal,
-          geo_type = geo_type,
-          time_type = time_type,
-          geo_values = geo_values,
-          time_values = time_values,
+          geo_type = "state",
+          time_type = "day",
+          geo_values = "*",
+          time_values = epirange(from = "2020-01-01", to = "2024-01-01"),
           fetch_args = fetch_args
         )
       }
@@ -86,15 +81,13 @@ make_data_targets <- function() {
     tar_target(
       name = hhs_latest_data_2022,
       command = {
-        hhs_latest_data %>%
-          filter(time_value >= "2022-01-01")
+        hhs_latest_data # %>% filter(time_value >= "2022-01-01", time_value < "2022-04-01")
       }
     ),
     tar_target(
       name = chng_latest_data_2022,
       command = {
-        chng_latest_data %>%
-          filter(time_value >= "2022-01-01")
+        chng_latest_data # %>% filter(time_value >= "2022-01-01", time_value < "2022-04-01")
       }
     ),
     tar_target(
@@ -103,11 +96,11 @@ make_data_targets <- function() {
         epidatr::pub_covidcast(
           source = "hhs",
           signals = hhs_signal,
-          geo_type = geo_type,
-          time_type = time_type,
-          geo_values = geo_values,
-          time_values = time_values,
-          issues = issues,
+          geo_type = "state",
+          time_type = "day",
+          geo_values = "*",
+          time_values = epirange(from = "20220101", to = "20220401"),
+          issues = "*",
           fetch_args = fetch_args
         )
       }
@@ -118,11 +111,11 @@ make_data_targets <- function() {
         epidatr::pub_covidcast(
           source = "chng",
           signals = chng_signal,
-          geo_type = geo_type,
-          time_type = time_type,
-          geo_values = geo_values,
-          time_values = time_values,
-          issues = issues,
+          geo_type = "state",
+          time_type = "day",
+          geo_values = "*",
+          time_values = epirange(from = "20220101", to = "20220401"),
+          issues = "*",
           fetch_args = fetch_args
         )
       }
@@ -135,17 +128,17 @@ make_data_targets <- function() {
           rename("hhs" := value) %>%
           rename(version = issue) %>%
           as_epi_archive(
-            geo_type = geo_type,
-            time_type = time_type,
+            geo_type = "state",
+            time_type = "day",
             compactify = TRUE
           )
         chng_archive_data_2022 %<>%
           select(geo_value, time_value, value, issue) %>%
           rename("chng" := value) %>%
           rename(version = issue) %>%
           as_epi_archive(
-            geo_type = geo_type,
-            time_type = time_type,
+            geo_type = "state",
+            time_type = "day",
             compactify = TRUE
           )
         epix_merge(hhs_archive_data_2022, chng_archive_data_2022, sync = "locf")$DT %>%

covid_hosp_explore.R

@@ -55,11 +55,6 @@ forecaster_params_grid_target <- list(
 # during the actual targets run, since the commands are frozen as expressions).
 hhs_signal <- "confirmed_admissions_covid_1d"
 chng_signal <- "smoothed_adj_outpatient_covid"
-geo_type <- "state"
-time_type <- "day"
-geo_values <- "*"
-time_values <- epidatr::epirange(from = "2020-01-01", to = "2024-01-01")
-issues <- "*"
 fetch_args <- epidatr::fetch_args_list(return_empty = TRUE, timeout_seconds = 200)
 data_targets <- make_data_targets()
 

flu_hosp_explore.R

@@ -40,12 +40,7 @@ forecaster_params_grid_target <- list(
 # during the actual targets run, since the commands are frozen as expressions).
 hhs_signal <- "confirmed_admissions_influenza_1d_prop_7dav"
 chng_signal <- "smoothed_adj_outpatient_flu"
-geo_type <- "state"
-time_type <- "day"
-geo_values <- "*"
-time_values <- epidatr::epirange(from = "2022-01-01", to = "2024-01-01")
-issues <- "*"
-fetch_args <- epidatr::fetch_args_list(return_empty = TRUE, timeout_seconds = 200)
+fetch_args <- epidatr::fetch_args_list(return_empty = TRUE, timeout_seconds = 300)
 data_targets <- make_data_targets()
 
 

run.R

@@ -56,7 +56,7 @@ Input: ")
     stop("selection `", project_selection, "` is invalid")
   )
 } else {
-  cat("Using project ", tar_project, "\n")
+  cat("Using project: ", tar_project, "\n")
 }
 Sys.setenv(TAR_PROJECT = tar_project)
 

tests/testthat/test-target-utils.R

@@ -1,14 +1,14 @@
 test_that("target param generation works", {
   ex_frame <- tribble(
-    ~forecaster, ~id, ~someNAs, ~someNULLs,
-    "scaled_pop", "linreg", TRUE, 35,
-    "scaled_pop", "linreg", NA, 35,
-    "scaled_pop", "linreg", FALSE, NULL,
+    ~forecaster, ~id, ~someNAs, ~someNULLs, ~someList, ~someYoDog,
+    "scaled_pop", "linreg", TRUE, 35, c(1, 3, 5), list(c(1, 2), c(3, 4)),
+    "scaled_pop", "linreg", NA, 35, c(1, 3, 5), list(c(1, 2), c(3, 4)),
+    "scaled_pop", "linreg", FALSE, NULL, c(1, 3, 5), list(c(1, 2), c(3, 4))
   )
   list_version <- list(
-    list(someNAs = TRUE, someNULLs = 35),
-    list(someNULLs = 35),
-    list(someNAs = FALSE)
+    list(someNAs = TRUE, someNULLs = 35, someList = c(1, 3, 5), someYoDog = list(c(1, 2), c(3, 4))),
+    list(someNULLs = 35, someList = c(1, 3, 5), someYoDog = list(c(1, 2), c(3, 4))),
+    list(someNAs = FALSE, someList = c(1, 3, 5), someYoDog = list(c(1, 2), c(3, 4)))
   )
   expect_equal(lists_of_real_values(ex_frame), list_version)
 })