arrange_ and mutate_ replaced by their SE equivalent

DESCRIPTION

@@ -27,7 +27,8 @@ Imports:
     mvnfast (>= 0.2.2),
     plyr (>= 1.8.0),
     pryr (>= 0.1.2),
-    tibble (>= 1.3.0)
+    tibble (>= 1.3.0),
+    rlang (>= 0.3)
 License: GPL (>= 3)
 LazyData: true
 VignetteBuilder: knitr

NAMESPACE

@@ -145,6 +145,7 @@ export(set_covariates_)
 export(status_cluster)
 export(use_cluster)
 export(use_distribution)
+import(rlang)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,as.tbl)
 importFrom(dplyr,as_data_frame)

R/acceptability_curve.R

@@ -22,16 +22,16 @@ acceptability_curve <- function(x, wtp_thresholds) {
       by = ".key"
     ) %>% 
     dplyr::group_by_(~ .index, ~ .ceac) %>% 
-    dplyr::mutate_(
-      .nmb = ~ .effect * .ceac - .cost,
-      .top_strategy = ~ .nmb == max(.nmb),
-      .top_strategy = ~ .top_strategy & cumsum(.top_strategy) == 1
+    dplyr::mutate(
+      .nmb = .effect * .ceac - .cost,
+      .top_strategy = .nmb == max(.nmb),
+      .top_strategy = .top_strategy & cumsum(.top_strategy) == 1
       # in case 2 nmb are identical, pick first
     ) %>% 
-    dplyr::group_by_(~ .ceac, ~ .strategy_names) %>% 
-    dplyr::summarise_(.n = ~ sum(.top_strategy)) %>% 
-    dplyr::group_by_(~ .ceac) %>% 
-    dplyr::mutate_(.p = ~ .n / sum(.n))
+    dplyr::group_by(.ceac, .strategy_names) %>% 
+    dplyr::summarise(.n = sum(.top_strategy)) %>% 
+    dplyr::group_by(.ceac) %>% 
+    dplyr::mutate(.p = .n / sum(.n))
 }
 
 generate_wtp <- function(max_wtp,

R/combine.R

@@ -80,7 +80,7 @@ combine_models <- function(newmodels, weights, oldmodel) {
 
   res <- 
     dplyr::bind_rows(list_res) %>%
-    dplyr::mutate_(.dots = get_ce(oldmodel))
+    dplyr::mutate(!!!compat_lazy_dots(get_ce(oldmodel)))
 
   root_strategy <- get_root_strategy(res)
   noncomparable_strategy <- get_noncomparable_strategy(res)

R/compat-lazyeval.R

@@ -0,0 +1,100 @@
+# nocov start - compat-lazyeval (last updated: rlang 0.3.0)
+
+# This file serves as a reference for compatibility functions for lazyeval.
+# Please find the most recent version in rlang's repository.
+
+
+warn_underscored <- function() {
+  return(NULL)
+  warn(paste(
+    "The underscored versions are deprecated in favour of",
+    "tidy evaluation idioms. Please see the documentation",
+    "for `quo()` in rlang"
+  ))
+}
+warn_text_se <- function() {
+  return(NULL)
+  warn("Text parsing is deprecated, please supply an expression or formula")
+}
+
+compat_lazy <- function(lazy, env = caller_env(), warn = TRUE) {
+  if (warn) warn_underscored()
+
+  if (missing(lazy)) {
+    return(quo())
+  }
+  if (is_quosure(lazy)) {
+    return(lazy)
+  }
+  if (is_formula(lazy)) {
+    return(as_quosure(lazy, env))
+  }
+
+  out <- switch(typeof(lazy),
+                symbol = ,
+                language = new_quosure(lazy, env),
+                character = {
+                  if (warn) warn_text_se()
+                  parse_quo(lazy[[1]], env)
+                },
+                logical = ,
+                integer = ,
+                double = {
+                  if (length(lazy) > 1) {
+                    warn("Truncating vector to length 1")
+                    lazy <- lazy[[1]]
+                  }
+                  new_quosure(lazy, env)
+                },
+                list =
+                  if (inherits(lazy, "lazy")) {
+                    lazy = new_quosure(lazy$expr, lazy$env)
+                  }
+  )
+
+  if (is_null(out)) {
+    abort(sprintf("Can't convert a %s to a quosure", typeof(lazy)))
+  } else {
+    out
+  }
+}
+
+compat_lazy_dots <- function(dots, env, ..., .named = FALSE) {
+  if (missing(dots)) {
+    dots <- list()
+  }
+  if (inherits(dots, c("lazy", "formula"))) {
+    dots <- list(dots)
+  } else {
+    dots <- unclass(dots)
+  }
+  dots <- c(dots, list(...))
+
+  warn <- TRUE
+  for (i in seq_along(dots)) {
+    dots[[i]] <- compat_lazy(dots[[i]], env, warn)
+    warn <- FALSE
+  }
+
+  named <- have_name(dots)
+  if (.named && any(!named)) {
+    nms <- vapply(dots[!named], function(x) expr_text(get_expr(x)), character(1))
+    names(dots)[!named] <- nms
+  }
+
+  names(dots) <- names2(dots)
+  dots
+}
+
+compat_as_lazy <- function(quo) {
+  structure(class = "lazy", list(
+    expr = get_expr(quo),
+    env = get_env(quo)
+  ))
+}
+compat_as_lazy_dots <- function(...) {
+  structure(class = "lazy_dots", lapply(quos(...), compat_as_lazy))
+}
+
+
+# nocov end

R/efficiency_frontier.R

@@ -40,11 +40,11 @@ get_frontier.default <- function(x) {
     x$.cost <- x$.cost - cbm
 
     x <- x %>% 
-      dplyr::filter_(~ .effect >= 0) %>% # not needed in theory
-      dplyr::mutate_(
-        .icer = ~ .cost / .effect
+      dplyr::filter(.effect >= 0) %>% # not needed in theory
+      dplyr::mutate(
+        .icer = .cost / .effect
       ) %>% 
-      dplyr::arrange_(~.icer, ~ .effect)
+      dplyr::arrange(.icer, .effect)
 
     enext <- dplyr::slice(x, 1)$.effect # relies on NaN last sorting
 

R/evpi.R

@@ -11,11 +11,11 @@ compute_evpi <- function(x, wtp_thresholds) {
       by = ".key"
     ) %>% 
     dplyr::group_by_(~ .ceac, ~ .index) %>% 
-    dplyr::mutate_(
-      .nmb = ~ .effect * .ceac - .cost,
-      .top_strategy = ~ .nmb == max(.nmb),
-      .top_strategy = ~ .top_strategy & cumsum(.top_strategy) == 1,
-      .top_choice = ~ .strategy_names == .strategy_choice
+    dplyr::mutate(
+      .nmb = .effect * .ceac - .cost,
+      .top_strategy = .nmb == max(.nmb),
+      .top_strategy = .top_strategy & cumsum(.top_strategy) == 1,
+      .top_choice = .strategy_names == .strategy_choice
       # in case 2 nmb are identical, pick first
     ) %>% 
     dplyr::summarise_(
@@ -71,8 +71,8 @@ export_psa <- function(x) {
       key_col = ".key",
       value_col = ".value",
       gather_cols = c(".cost", ".effect")) %>% 
-    dplyr::mutate_(
-      .var_name = ~ paste(.key, .strategy_names, sep = "_")) %>% 
+    dplyr::mutate(
+      .var_name = paste(.key, .strategy_names, sep = "_")) %>% 
     dplyr::select(-.key, -.strategy_names) %>% 
     reshape_wide(key_col = ".var_name", value_col = ".value")
 

R/heemod.R

@@ -94,6 +94,8 @@
 #'   
 #' @importFrom tibble tibble
 #' @importFrom tibble tibble_
+#' 
+#' @import rlang
 NULL
 
 #' @export

R/matrix_eval.R

@@ -84,11 +84,13 @@ eval_transition.uneval_matrix <- function(x, parameters) {
   # update calls to dispatch_strategy()
   x <- dispatch_strategy_hack(x)
 
-  tab_res <- dplyr::mutate_(
+  x_tidy <- compat_lazy_dots(x, caller_env)
+
+  tab_res <- dplyr::mutate(
     parameters,
-    .dots = c(
-      lazyeval::lazy_dots(C = -pi),
-      x))[names(x)]
+    C = -pi,
+    !!!x_tidy
+  )[names(x)]
 
   n <- get_matrix_order(x)
 

R/param_eval.R

@@ -17,6 +17,7 @@ eval_parameters <- function(x, cycles = 1,
                             strategy_name = NA) {
   # update calls to dispatch_strategy()
   x <- dispatch_strategy_hack(x) 
+
   old_classes <- class(x)
   if (length(x)) x <- structure(x[!has_state_time(x)],
                            class = old_classes)
@@ -27,11 +28,13 @@ eval_parameters <- function(x, cycles = 1,
     strategy = strategy_name
   )
 
+  x_tidy <- compat_lazy_dots(x)
+
   # other datastructure?
   res <- try(
-    dplyr::mutate_(
+    dplyr::mutate(
       start_tibble,
-      .dots = x
+      !!!x_tidy
     ), silent = TRUE
   )
 
@@ -58,9 +61,9 @@ eval_parameters <- function(x, cycles = 1,
     long_res <- lapply(
       seq_along(x),
       function(i) {
-        try(dplyr::mutate_(
+        try(dplyr::mutate(
           start_tibble,
-          .dots = x[seq_len(i)]
+          !!!x_tidy[seq_len(i)]
         ), silent = TRUE)
       }
     )
@@ -86,8 +89,9 @@ eval_parameters <- function(x, cycles = 1,
 
 eval_init <- function(x, parameters) {
   to_keep <- names(x)
+  x_tidy <- compat_lazy_dots(x)
   if (length(to_keep)) {
-    dplyr::mutate_(.data = parameters, .dots = x)[to_keep]
+    dplyr::mutate(.data = parameters, !!!x_tidy)[to_keep]
   } else {
     tibble::tibble()
   }

R/part_surv.R

@@ -396,7 +396,7 @@ join_fits_across_time <- function(this_part){
 if(nrow(this_part) == 1) return(this_part$fit[[1]])
   if ("until" %in% names(this_part)) {
     this_part <-
-      dplyr::arrange_(this_part, ~ until)
+      dplyr::arrange(this_part, until)
 
     join_(dots = this_part$fit, 
              at= this_part$until[!is.na(this_part$until)])
@@ -437,15 +437,15 @@ join_fits_to_def <- function(surv_def, fit_tibble) {
   }
 
     fit_tibble <-
-    dplyr::mutate_(fit_tibble, type = ~ toupper(type))
+    dplyr::mutate(fit_tibble, type = toupper(type))
 
   ## reduce fit expressions to distribution names
   should_be_fits_2 <- surv_def %>%
-    dplyr::mutate_(
-      dist = ~ gsub("fit\\((.*)\\)", "\\1", dist) %>%
+    dplyr::mutate(
+      dist = gsub("fit\\((.*)\\)", "\\1", dist) %>%
         gsub("'", "", .) %>%
         gsub('"', '', .),
-      .type = ~ toupper(.type)
+      .type = toupper(.type)
     )
   ok_dist_names <-
     should_be_fits_2$dist %in% c(allowed_fit_distributions, "km")

R/resamp_eval.R

@@ -57,9 +57,12 @@ run_psa <- function(model, psa, N, resample) {
     list_res[[n]]$.index <- index
   }
 
+  x_tidy <- get_ce(model) %>%
+    compat_lazy_dots()
+
   res <- 
     dplyr::bind_rows(list_res)
-  res <- dplyr::mutate_(res, .dots = get_ce(model))
+  res <- dplyr::mutate(res, !!!x_tidy)
 
   run_model <- res %>% 
     dplyr::select(-.index) %>% 
@@ -168,8 +171,9 @@ eval_resample <- function(psa, N) {
         lapply(
           m,
           function(x) as.call(list(as.name("/"), as.name(x), as.name(".denom")))),
-        m)))
-    res <- dplyr::mutate_(res, .dots = list_expr) %>% 
+        m))) %>%
+      compat_lazy_dots()
+    res <- dplyr::mutate(res, !!!list_expr) %>% 
       dplyr::select(-.denom)
   }
   res

R/resamp_print.R

@@ -108,8 +108,8 @@ plot.psa <- function(x, type = c("ce", "ac", "cov", "evpi"),
     },
     cov = {
       tab <- compute_cov(x, diff = diff, threshold = threshold, ...) %>% 
-        dplyr::mutate_(
-          .prop = ~ .prop * 100
+        dplyr::mutate(
+          .prop = .prop * 100
         )
 
       ggplot2::ggplot(
@@ -132,18 +132,18 @@ scale.psa <- function(x, center = TRUE, scale = TRUE) {
 
   if (scale) {
     res <- res %>% 
-      dplyr::mutate_(
-        .cost = ~ .cost / .n_indiv,
-        .effect = ~ .effect / .n_indiv
+      dplyr::mutate(
+        .cost = .cost / .n_indiv,
+        .effect = .effect / .n_indiv
       )
   }
 
   if (center) {
     res <- res %>% 
       dplyr::group_by_(".index") %>% 
-      dplyr::mutate_(
-        .cost = ~ (.cost - sum(.cost * (.strategy_names == .bm))),
-        .effect = ~ (.effect - sum(.effect * (.strategy_names == .bm)))
+      dplyr::mutate(
+        .cost = (.cost - sum(.cost * (.strategy_names == .bm))),
+        .effect = (.effect - sum(.effect * (.strategy_names == .bm)))
       ) %>% 
       dplyr::ungroup()
   }