update branch from master

.Rbuildignore

@@ -5,9 +5,9 @@
 ^LICENSE\.md$
 ^cran-comments\.md$
 ^CRAN-RELEASE$
-^NEWS.md
 ^R/sandbox\.R$
-^Readme.md
-^Readme.Rmd
+^README.Rmd
+^_pkgdown.yml$
 ^doc$
 ^Meta$
+^_pkgdown\.yml$

.github/workflows/check-full.yaml

@@ -2,8 +2,6 @@ on:
   push:
     branches:
       - master
-  schedule:
-    - cron: "0 0 * * *"
   pull_request:
     branches:
       - master
@@ -20,12 +18,10 @@ jobs:
       fail-fast: false
       matrix:
         config:
-          - {os: macOS-latest,   r: 'devel'}
-          - {os: macOS-latest,   r: 'release'}
+          - {os: macOS-latest, r: 'release'}
           - {os: windows-latest, r: 'release'}
-          - {os: ubuntu-16.04,   r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
-          - {os: ubuntu-16.04,   r: 'oldrel',  rspm: "https://packagemanager.rstudio.com/cran/__linux__/xenial/latest"}
-
+          - {os: ubuntu-20.04, r: 'release'}
+          - {os: ubuntu-20.04, r: 'oldrel'}
     env:
       R_REMOTES_NO_ERRORS_FROM_WARNINGS: true
       RSPM: ${{ matrix.config.rspm }}
@@ -60,15 +56,18 @@ jobs:
         env:
           RHUB_PLATFORM: linux-x86_64-ubuntu-gcc
         run: |
-          Rscript -e "remotes::install_github('r-hub/sysreqs')"
-          sysreqs=$(Rscript -e "cat(sysreqs::sysreq_commands('DESCRIPTION'))")
-          sudo -s eval "$sysreqs"
+          while read -r cmd
+          do
+            eval sudo $cmd
+          done < <(Rscript -e 'writeLines(remotes::system_requirements("ubuntu", "20.04"))')
+          sudo apt-get -y install libudunits2-dev libgdal-dev libqpdf-dev libcurl4-openssl-dev
+        shell: bash
+
       - name: Install dependencies
         run: |
           remotes::install_deps(dependencies = TRUE)
           remotes::install_cran("rcmdcheck")
         shell: Rscript {0}
-
       - name: Session info
         run: |
           options(width = 100)

DESCRIPTION

@@ -67,7 +67,7 @@ Suggests:
     knitr,
     rmarkdown
 RoxygenNote: 7.1.1
-URL: https://github.com/epiforecasts/scoringutils
+URL: https://github.com/epiforecasts/scoringutils, https://epiforecasts.io/scoringutils/
 BugReports: https://github.com/epiforecasts/scoringutils/issues
 VignetteBuilder: knitr
 Depends: 

NAMESPACE

@@ -38,7 +38,6 @@ export(score_heatmap)
 export(score_table)
 export(sharpness)
 export(show_avail_forecasts)
-export(update_list)
 export(wis_components)
 importFrom(data.table,"%like%")
 importFrom(data.table,':=')

NEWS.md

@@ -1,44 +1,50 @@
-## scoringutils 0.1.7.2
-### Package updates
+# scoringutils 0.1.7.2
+
+## Package updates
 - minor bug fixes (previously, 'interval_score' needed to be among the 
 selected metrics)
+- all data.tables are now returned as `table[]` rather than as `table`, 
+such that they don't have to be called twice to display the contents. 
+
+# scoringutils 0.1.7
 
-## scoringutils 0.1.7
 ## Feature updates
 - added a function, `pairwise_comparison()` that runs pairwise comparisons 
 between models on the output of `eval_forecasts()`
 - added functionality to compute relative skill within `eval_forecasts()`
 - added a function to visualise pairwise comparisons
 
-### Package updates
+## Package updates
 - The WIS definition change introduced in version 0.1.5 was partly corrected
 such that the difference in weighting is only introduced when summarising 
 over scores from different interval ranges
 
-## scoringutils 0.1.6
+# scoringutils 0.1.
+
 ## Feature updates
 - `eval_forecasts()` can now handle a separate forecast and truth data set as 
 as input
 - `eval_forecasts()` now supports scoring point forecasts along side quantiles
 in a quantile-based format. Currently the only metric used is the absolute error
 
-### Package updates
+## Package updates
 - Many functions, especially `eval_forecasts()` got a major rewrite. While 
 functionality should be unchanged, the code should now be easier to maintain
 - Some of the data-handling functions got renamed, but old names are supported
 as well for now. 
 
 
-## scoringutils 0.1.5
-### Package updates
+# scoringutils 0.1.5
+
+## Package updates
 - changed the default definition of the weighted interval score. Previously, 
 the median prediction was counted twice, but is no only counted once. If you 
 want to go back to the old behaviour, you can call the interval_score function
 with the argument `count_median_twice = FALSE`. 
 
-## scoringutils 0.1.4
+# scoringutils 0.1.4
 
-### Feature updates
+## Feature updates
 - we added basic plotting functionality to visualise scores. You can now
 easily obtain diagnostic plots based on scores as produced by `eval_forecasts`.
 - `correlation_plot` shows correlation between metrics
@@ -47,16 +53,16 @@ chosen metric
 - `score_heatmap` visualises scores as heatmap
 - `score_table` shows a coloured summary table of scores
 
-### package updates
+## package updates
 - renamed "calibration" to "coverage"
 - renamed "true_values" to "true_value" in data.frames
 - renamed "predictions" to "prediction" in data.frames
 - renamed "is_overprediction" to "overprediction"
 - renamed "is_underprediction" to "underprediction"
 
-## scoringutils 0.1.3
+# scoringutils 0.1.3
 
-### (Potentially) Breaking changes
+## (Potentially) Breaking changes
 - the by argument in `eval_forecasts` now has a slightly changed meaning. It 
 now denotes the lowest possible grouping unit, i.e. the unit of one observation
 and needs to be specified explicitly. The default is now `NULL`. The reason for
@@ -68,7 +74,7 @@ to be included.
 - for the interval score, `weigh = TRUE` is now the default option.
 - (potentially planned) rename true_values to true_value and predictions to prediction. 
 
-### Feature updates
+## Feature updates
 - updated quantile evaluation metrics in `eval_forecasts`. Bias as well as 
 calibration now take all quantiles into account
 - Included option to summarise scores according to a `summarise_by` argument in 
@@ -77,31 +83,31 @@ as an arbitrary set of quantiles.
 - `eval_forecasts` can now return pit histograms. 
 - switched to ggplot2 for plotting
 
-## scoringutils 0.1.2
+# scoringutils 0.1.2
 
-### (Potentially) Breaking changes
+## (Potentially) Breaking changes
 - all scores in eval_forecasts were consistently renamed to lower case. 
 Interval_score is now interval_score, CRPS is now crps etc. 
 
-### Feature updates
+## Feature updates
 - included support for grouping scores according to a vector of column names
 in `eval_forecasts`
 - included support for passing down arguments to lower-level functions in 
 `eval_forecasts`
 - included support for three new metrics to score quantiles with 
 `eval_forecasts`: bias, sharpness and calibration
 
-### Package updates
+## Package updates
 - example data now has a horizon column to illustrate the use of grouping
 - documentation updated to explain the above listed changes
 
-## scoringutils 0.1.1
+# scoringutils 0.1.1
 
-### Feature updates
+## Feature updates
 - included support for a long as well as wide input formats for 
 quantile forecasts that are scored with `eval_forecasts`
 
-### Package updates
+## Package updates
 - updated documentation for the `eval_forecasts`
 - added badges to the Readme
 

R/bias.R

@@ -92,22 +92,14 @@ bias <- function(true_values, predictions) {
   n_pred <- ncol(predictions)
 
   # empirical cdf
-  P_x <- vapply(seq_along(true_values),
-                function(i) {
-                  sum(predictions[i,] <= true_values[i]) / n_pred
-                },
-                .0)
+  P_x <- rowSums(predictions <= true_values) / n_pred
 
   if (continuous_predictions) {
     res <- 1 - 2 * P_x
     return(res)
   } else {
     # for integer case also calculate empirical cdf for (y-1)
-    P_xm1 <- vapply(seq_along(true_values),
-                    function(i) {
-                      sum(predictions[i,] <= true_values[i] - 1) / n_pred
-                    },
-                    .0)
+    P_xm1 <- rowSums(predictions <= (true_values - 1)) / n_pred
 
     res <- 1 - (P_x + P_xm1)
     return(res)

R/eval_forecasts_binary.R

@@ -45,6 +45,8 @@ eval_forecasts_binary <- function(data,
                by = summarise_by]
 
   }
+
+  return(res[])
 }
 
 

R/eval_forecasts_continuous_integer.R

@@ -169,5 +169,5 @@ eval_forecasts_sample <- function(data,
                 pit_plots = pit_histograms)
   }
 
-  return(res)
+  return(res[])
 }

R/eval_forecasts_helper.R

@@ -20,7 +20,7 @@ add_quantiles <- function(dt, varnames, quantiles, by) {
                                                              na.rm = TRUE)),
        by = c(by)]
   }
-  return(dt)
+  return(dt[])
 }
 
 
@@ -41,5 +41,5 @@ add_sd <- function(dt, varnames, by) {
   for (varname in varnames) {
     dt[, paste0(varname, "_sd") := sd(get(varname), na.rm = TRUE), by = by]
   }
-  return(dt)
+  return(dt[])
 }

R/eval_forecasts_quantile.R

@@ -117,8 +117,12 @@ eval_forecasts_quantile <- function(data,
     quantile_data[, quantile_coverage := (true_value <= prediction)]
   }
 
-  # merge only if something was computed
-  if (any(c("aem", "quantile_coverage") %in% metrics)) {
+  # merge metrics computed on quantile data (i.e. aem, quantile_coverage) back
+  # into metrics computed on range data. One important side effect of this is
+  # that it controls whether we count the median twice for the interval score
+  # (row is then duplicated) or only once. However, merge only needs to happen
+  # if we computed either the interval score or the aem or quantile coverage
+  if (any(c("aem", "interval_score", "quantile_coverage") %in% metrics)) {
     # delete unnecessary columns before merging back
     keep_cols <- unique(c(by, "quantile", "aem", "quantile_coverage",
                           "boundary", "range"))
@@ -183,12 +187,12 @@ eval_forecasts_quantile <- function(data,
   }
 
   # if neither quantile nor range are in summarise_by, remove coverage and quantile_coverage
-  if (!("range" %in% summarise_by)) {
+  if (!("range" %in% summarise_by) & ("coverage" %in% colnames(res))) {
     res[, c("coverage") := NULL]
   }
   if (!("quantile" %in% summarise_by) & "quantile_coverage" %in% names(res)) {
     res[, c("quantile_coverage") := NULL]
   }
 
-  return(res)
+  return(res[])
 }

R/interval_score.R

@@ -53,6 +53,7 @@
 #'                upper = upper,
 #'                interval_range = interval_range)
 #'
+#' # example with missing values and separate results
 #' interval_score(true_values = c(true_values, NA),
 #'                lower = c(lower, NA),
 #'                upper = c(NA, upper),

R/pairwise-comparisons.R

@@ -172,7 +172,7 @@ add_rel_skill_to_eval_forecasts <- function(unsummarised_scores,
   # also delete skill metric from output
   out[, eval(rel_skill_metric) := NULL]
 
-  return(out)
+  return(out[])
 }
 
 
@@ -278,6 +278,8 @@ pairwise_comparison_one_group <- function(scores,
                             by = "model"]
     # merge back to retain the ratios even for comparisons with the baseline
     result <- merge(result, result_without_baseline, all.x = TRUE)
+    # avoid mixture of NA and NaN which can cause problems downstream
+    result[is.na(theta), theta := NA_real_]
     # remove NAs form merge in the thetas
     result[, theta := unique(na.omit(theta)), by = "model"]
   } else {
@@ -303,7 +305,7 @@ pairwise_comparison_one_group <- function(scores,
   data.table::setnames(out, old = c("ratio", "theta", "rel_to_baseline"),
                        new = c("mean_scores_ratio", "relative_skill", "scaled_rel_skill"))
 
-  return(out)
+  return(out[])
 }
 
 
@@ -341,7 +343,7 @@ compare_two_models <- function(scores,
   scores <- data.table::as.data.table(scores)
 
   if (!("model" %in% names(scores))) {
-    stop("pairwise compairons require a column called 'model'")
+    stop("pairwise comparisons require a column called 'model'")
   }
 
   # select only columns in c(by, var)

R/pit.R

@@ -166,11 +166,7 @@ pit <- function(true_values,
 
   # calculate emipirical cumulative distribution function as
   # Portion of (y_true <= y_predicted)
-  P_x <- vapply(seq_along(true_values),
-                function(i) {
-                  sum(predictions[i, ] <= true_values[i]) / n_pred
-                },
-                .0)
+  P_x <- rowSums(predictions <= true_values) / n_pred
 
   # calculate PIT for continuous predictions case
   if (continuous_predictions) {
@@ -190,11 +186,7 @@ pit <- function(true_values,
   # calculate PIT for integer predictions case
   if (!continuous_predictions) {
     # empirical cdf for (y-1) for integer-valued predictions
-    P_xm1 <- vapply(seq_along(true_values),
-                    function(i) {
-                      sum(predictions[i,] <= true_values[i] - 1) / n_pred
-                    },
-                    .0)
+    P_xm1 <- rowSums(predictions <= (true_values - 1)) / n_pred
     # do n_replicates times for randomised PIT
     u <- replicate(n_replicates, P_xm1 + stats::runif(n) * (P_x - P_xm1))
     # apply Anderson Darling test on u values

R/plot.R

@@ -744,13 +744,14 @@ plot_predictions <- function(data = NULL,
     select_median <- (forecasts$range %in% 0 & forecasts$boundary == "lower")
     median <- forecasts[select_median]
 
-    plot <- plot +
-      ggplot2::geom_line(data = median,
-                         mapping = ggplot2::aes(y = prediction, colour = "median"),
-                         lwd = 0.4)
+    if (nrow(median) > 0) {
+      plot <- plot +
+        ggplot2::geom_line(data = median,
+                           mapping = ggplot2::aes(y = prediction, colour = "median"),
+                           lwd = 0.4)
+      }
   }
 
-
   # facet if specified by the user
   if (!is.null(facet_formula)) {
     if (facet_wrap_or_grid == "facet_wrap") {

R/utils.R

@@ -177,7 +177,6 @@ extract_from_list <- function(list, what) {
 #' @param defaults A list of default settings
 #' @param optional A list of optional settings to override defaults
 #' @return A list
-#' @export
 #'
 #' @keywords internal
 update_list <- function(defaults = list(), optional = list()) {