Merge pull request #819 from epiforecasts/review-partial

Partially merge changes suggested by code review in #791

DESCRIPTION

@@ -7,16 +7,16 @@ Authors@R: c(
            family = "Bosse",
            role = c("aut", "cre"),
            email = "[email protected]",
-           comment = c(ORCID = "https://orcid.org/0000-0002-7750-5280")),
+           comment = c(ORCID = "0000-0002-7750-5280")),
     person(given = "Sam Abbott",
            role = c("aut"),
            email = "[email protected]",
            comment = c(ORCID = "0000-0001-8057-8037")), 
     person(given = "Hugo",
            family = "Gruson",
            role = c("aut"),
-           email = "hugo.gruson@lshtm.ac.uk",
-           comment = c(ORCID = "https://orcid.org/0000-0002-4094-1476")),
+           email = "hugo.gruson[email protected]",
+           comment = c(ORCID = "0000-0002-4094-1476")),
     person(given = "Johannes Bracher",
            role = c("ctb"),
            email = "[email protected]",

NAMESPACE

@@ -91,6 +91,7 @@ importFrom(checkmate,assert_factor)
 importFrom(checkmate,assert_function)
 importFrom(checkmate,assert_list)
 importFrom(checkmate,assert_logical)
+importFrom(checkmate,assert_matrix)
 importFrom(checkmate,assert_number)
 importFrom(checkmate,assert_numeric)
 importFrom(checkmate,assert_subset)
@@ -104,6 +105,7 @@ importFrom(checkmate,check_set_equal)
 importFrom(checkmate,check_vector)
 importFrom(checkmate,test_factor)
 importFrom(checkmate,test_list)
+importFrom(checkmate,test_names)
 importFrom(checkmate,test_numeric)
 importFrom(checkmate,test_subset)
 importFrom(cli,cli_abort)

R/check-input-helpers.R

@@ -166,7 +166,7 @@ check_columns_present <- function(data, columns) {
 #' @keywords internal_input_check
 test_columns_present <- function(data, columns) {
   check <- check_columns_present(data, columns)
-  return(is.logical(check))
+  return(isTRUE(check))
 }
 
 #' Test whether column names are NOT present in a data.frame
@@ -175,11 +175,8 @@ test_columns_present <- function(data, columns) {
 #' more columns are present, the function returns FALSE.
 #' @inheritParams document_check_functions
 #' @return Returns TRUE if none of the columns are present and FALSE otherwise
+#' @importFrom checkmate test_names
 #' @keywords internal_input_check
 test_columns_not_present <- function(data, columns) {
-  if (any(columns %in% colnames(data))) {
-    return(FALSE)
-  } else {
-    return(TRUE)
-  }
+  test_names(colnames(data), disjunct.from = columns)
 }

R/check-inputs-scoring-functions.R

@@ -7,7 +7,7 @@
 #'   N (number of columns) the number of samples per forecast.
 #'   If `observed` is just a single number, then predicted values can just be a
 #'   vector of size N.
-#' @importFrom checkmate assert assert_numeric check_matrix
+#' @importFrom checkmate assert assert_numeric check_matrix assert_matrix
 #' @inherit document_assert_functions params return
 #' @keywords internal_input_check
 assert_input_sample <- function(observed, predicted) {
@@ -21,7 +21,7 @@ assert_input_sample <- function(observed, predicted) {
       check_matrix(predicted, mode = "numeric", nrows = n_obs)
     )
   } else {
-    assert(check_matrix(predicted, mode = "numeric", nrows = n_obs))
+    assert_matrix(predicted, mode = "numeric", nrows = n_obs)
   }
   return(invisible(NULL))
 }

R/convenience-functions.R

@@ -127,7 +127,7 @@ transform_forecasts <- function(forecast,
       #nolint start: keyword_quote_linter
       cli_abort(
         c(
-          "!" = "If a column 'scale' is present, entries with scale =='natural'
+          `!` = "If a column 'scale' is present, entries with scale =='natural'
           are required for the transformation."
         )
       )

R/correlations.R

@@ -48,7 +48,7 @@ get_correlations <- function(scores,
   return(correlations[])
 }
 
-# helper function to obtain upper triangle of matrix
+# helper function to obtain lower triangle of matrix
 get_lower_tri <- function(cormat) {
   cormat[lower.tri(cormat)] <- NA
   return(cormat)

R/default-scoring-rules.R

@@ -29,14 +29,15 @@ select_metrics <- function(metrics, select = NULL, exclude = NULL) {
 
   if (is.null(select) && is.null(exclude)) {
     return(metrics)
-  } else if (is.null(select)) {
+  }
+  if (is.null(select)) {
     assert_subset(exclude, allowed)
     select <- allowed[!allowed %in% exclude]
     return(metrics[select])
-  } else {
-    assert_subset(select, allowed)
-    return(metrics[select])
   }
+  assert_subset(select, allowed)
+  return(metrics[select])
+
 }
 
 #' Customises a metric function with additional arguments.

R/print.R

@@ -49,10 +49,8 @@ print.forecast_binary <- function(x, ...) {
   } else {
     cli_text(
       col_blue(
-        "Forecast type:"
-      )
-    )
-    cli_text(
+        "Forecast type: "
+      ),
       "{forecast_type}"
     )
   }

README.md

@@ -104,8 +104,7 @@ forecast_quantile <- example_quantile |>
 #>   unexpected.
 
 print(forecast_quantile, 2)
-#> Forecast type:
-#> quantile
+#> Forecast type: quantile
 #> Forecast unit:
 #> location, forecast_date, target_end_date, target_type, model, and horizon
 #> 

tests/testthat/_snaps/print.md

@@ -3,8 +3,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      binary
+      Forecast type: binary
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -42,8 +41,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      binary
+      Forecast type: binary
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -81,8 +79,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      binary
+      Forecast type: binary
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -120,8 +117,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      binary
+      Forecast type: binary
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -159,8 +155,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      quantile
+      Forecast type: quantile
       Forecast unit:
       location, target_end_date, target_type, location_name, forecast_date, model,
       and horizon
@@ -199,8 +194,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      quantile
+      Forecast type: quantile
       Forecast unit:
       location, target_end_date, target_type, location_name, forecast_date, model,
       and horizon
@@ -239,8 +233,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      quantile
+      Forecast type: quantile
       Forecast unit:
       location, target_end_date, target_type, location_name, forecast_date, model,
       and horizon
@@ -279,8 +272,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      quantile
+      Forecast type: quantile
       Forecast unit:
       location, target_end_date, target_type, location_name, forecast_date, model,
       and horizon
@@ -319,8 +311,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      point
+      Forecast type: point
       Forecast unit:
       location, target_end_date, target_type, location_name, forecast_date, model,
       and horizon
@@ -359,8 +350,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      point
+      Forecast type: point
       Forecast unit:
       location, target_end_date, target_type, location_name, forecast_date, model,
       and horizon
@@ -399,8 +389,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      point
+      Forecast type: point
       Forecast unit:
       location, target_end_date, target_type, location_name, forecast_date, model,
       and horizon
@@ -439,8 +428,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      point
+      Forecast type: point
       Forecast unit:
       location, target_end_date, target_type, location_name, forecast_date, model,
       and horizon
@@ -479,8 +467,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      sample
+      Forecast type: sample
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -518,8 +505,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      sample
+      Forecast type: sample
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -557,8 +543,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      sample
+      Forecast type: sample
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -596,8 +581,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      sample
+      Forecast type: sample
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -635,8 +619,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      sample
+      Forecast type: sample
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -674,8 +657,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      sample
+      Forecast type: sample
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -713,8 +695,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      sample
+      Forecast type: sample
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon
@@ -752,8 +733,7 @@
     Code
       print(dat)
     Message
-      Forecast type:
-      sample
+      Forecast type: sample
       Forecast unit:
       location, location_name, target_end_date, target_type, forecast_date, model,
       and horizon

tests/testthat/test-summarise_scores.R

@@ -91,4 +91,12 @@ test_that("summarise_scores() across argument works as expected", {
       scores, by = c("location", "target_type")
     )
   )
+
+  expect_warning(
+    summarise_scores(
+      scores, across = c("horizon", "model", "forecast_date", "target_end_date"),
+      by = c("model", "target_type")
+    ),
+    "You specified `across` and `by` at the same time.`by` will be ignored"
+  )
 })