Merge pull request #120 from epiforecasts/review-vapply

Remove unnecessary vapply()
epiforecasts · Aug 16, 2021 · d09ff23 · d09ff23
2 parents 6bfa1d0 + 129bd40
commit d09ff23
Show file tree

Hide file tree

Showing 2 changed files with 4 additions and 20 deletions.
diff --git a/R/bias.R b/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)

diff --git a/R/pit.R b/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