Merge pull request #292 from spsanderson/development

Fix #291
spsanderson · Oct 4, 2022 · 8447eab · 8447eab
2 parents 728a0cb + 11c58f6
commit 8447eab
Show file tree

Hide file tree

Showing 76 changed files with 4,861 additions and 4,788 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -7,7 +7,8 @@ None
 None
 
 ## Minor Fixes and Improvements
-None
+Fix #291 - Update `tidy_stat_tbl()` to fix `tibble` output so it no longer ignores
+passed arguments and fix `data.table` to directly pass ... arguments.
 
 # TidyDensity 1.2.3
 

diff --git a/R/00_global_variables.R b/R/00_global_variables.R
@@ -1,12 +1,12 @@
 globalVariables(
   names = c(
     "d", "density", "dx", "dy", "p", "sd", "sim_number", "x", "y",
-    ".n",".num_sims","dist_name","random_walk_value","results",
-    "dist_type","var","shape","rec_no","value","Empirical","bootstrap_samples",
-    "cmy","lambda","location","m","max_est","mean_log","method","min_est",
-    "name","prob","rate","sd_log","shape1","shape2","size","total","total_deviance",
-    "abs_aic","aic_value","data","dist_with_params","ks","lm","lm_model","mu",
-    "stan_dev","tidy_ks","prop","dens_tbl","cih","cil","mstat","stat",".",
+    ".n", ".num_sims", "dist_name", "random_walk_value", "results",
+    "dist_type", "var", "shape", "rec_no", "value", "Empirical", "bootstrap_samples",
+    "cmy", "lambda", "location", "m", "max_est", "mean_log", "method", "min_est",
+    "name", "prob", "rate", "sd_log", "shape1", "shape2", "size", "total", "total_deviance",
+    "abs_aic", "aic_value", "data", "dist_with_params", "ks", "lm", "lm_model", "mu",
+    "stan_dev", "tidy_ks", "prop", "dens_tbl", "cih", "cil", "mstat", "stat", ".",
     "variable"
   )
 )
diff --git a/R/augment-bootstrap-density.R b/R/augment-bootstrap-density.R
@@ -35,55 +35,55 @@
 #' @export
 #'
 
-bootstrap_density_augment <- function(.data){
+bootstrap_density_augment <- function(.data) {
+  atb <- attributes(.data)
 
-    atb <- attributes(.data)
-
-    # Checks
-    if (!is.data.frame(.data)){
-        rlang::abort(
-            message = "'.data' is expecting a data.frame/tibble. Please supply.",
-            use_cli_format = TRUE
-        )
-    }
+  # Checks
+  if (!is.data.frame(.data)) {
+    rlang::abort(
+      message = "'.data' is expecting a data.frame/tibble. Please supply.",
+      use_cli_format = TRUE
+    )
+  }
 
-    if (!atb$tibble_type %in% c("tidy_bootstrap","tidy_bootstrap_nested")){
-        rlang::abort(
-            message = "Must pass data to this function from either tidy_bootstrap() or
+  if (!atb$tibble_type %in% c("tidy_bootstrap", "tidy_bootstrap_nested")) {
+    rlang::abort(
+      message = "Must pass data to this function from either tidy_bootstrap() or
       bootstrap_unnest_tbl().",
       use_cli_format = TRUE
-        )
-    }
-
-    # Add density data
-    if(atb$tibble_type == "tidy_bootstrap_nested"){
-        df_tbl <- dplyr::as_tibble(.data) %>%
-            TidyDensity::bootstrap_unnest_tbl()
-    }
+    )
+  }
 
-    if(atb$tibble_type == "tidy_bootstrap"){
-        df_tbl <- dplyr::as_tibble(.data)
-    }
+  # Add density data
+  if (atb$tibble_type == "tidy_bootstrap_nested") {
+    df_tbl <- dplyr::as_tibble(.data) %>%
+      TidyDensity::bootstrap_unnest_tbl()
+  }
 
-    df_tbl <- df_tbl %>%
-        dplyr::nest_by(sim_number) %>%
-        dplyr::mutate(dens_tbl = list(
-            stats::density(unlist(data),
-                           n = nrow(data))[c("x","y")] %>%
-                purrr::set_names("dx","dy") %>%
-                dplyr::as_tibble())) %>%
-        tidyr::unnest(cols = c(data, dens_tbl)) %>%
-        dplyr::mutate(x = dplyr::row_number()) %>%
-        dplyr::ungroup() %>%
-        dplyr::select(sim_number, x, y, dx, dy, dplyr::everything())
+  if (atb$tibble_type == "tidy_bootstrap") {
+    df_tbl <- dplyr::as_tibble(.data)
+  }
 
-    # Return
-    attr(df_tbl, "tibble_type") <- "bootstrap_density"
-    attr(df_tbl, "incoming_tibble_type") <- atb$tibble_type
-    attr(df_tbl, ".num_sims") <- atb$.num_sims
-    attr(df_tbl, "dist_with_params") <- atb$dist_with_params
-    attr(df_tbl, "distribution_family_type") <- atb$distribution_family_type
+  df_tbl <- df_tbl %>%
+    dplyr::nest_by(sim_number) %>%
+    dplyr::mutate(dens_tbl = list(
+      stats::density(unlist(data),
+        n = nrow(data)
+      )[c("x", "y")] %>%
+        purrr::set_names("dx", "dy") %>%
+        dplyr::as_tibble()
+    )) %>%
+    tidyr::unnest(cols = c(data, dens_tbl)) %>%
+    dplyr::mutate(x = dplyr::row_number()) %>%
+    dplyr::ungroup() %>%
+    dplyr::select(sim_number, x, y, dx, dy, dplyr::everything())
 
-    return(df_tbl)
+  # Return
+  attr(df_tbl, "tibble_type") <- "bootstrap_density"
+  attr(df_tbl, "incoming_tibble_type") <- atb$tibble_type
+  attr(df_tbl, ".num_sims") <- atb$.num_sims
+  attr(df_tbl, "dist_with_params") <- atb$dist_with_params
+  attr(df_tbl, "distribution_family_type") <- atb$distribution_family_type
 
+  return(df_tbl)
 }
diff --git a/R/augment-bootstrap-p.R b/R/augment-bootstrap-p.R
@@ -30,43 +30,42 @@
 #' @export
 #'
 
-bootstrap_p_augment <- function(.data, .value, .names = "auto"){
+bootstrap_p_augment <- function(.data, .value, .names = "auto") {
+  column_expr <- rlang::enquo(.value)
 
-    column_expr <- rlang::enquo(.value)
-
-    if(rlang::quo_is_missing(column_expr)){
-        rlang::abort(
-            message = "bootstrap_p_vec(.value) is missing",
-            use_cli_format = TRUE
-        )
-    }
-
-    col_nms <- names(tidyselect::eval_select(rlang::enquo(.value), .data))
+  if (rlang::quo_is_missing(column_expr)) {
+    rlang::abort(
+      message = "bootstrap_p_vec(.value) is missing",
+      use_cli_format = TRUE
+    )
+  }
 
-    make_call <- function(col){
-        rlang::call2(
-            "bootstrap_p_vec",
-            .x = rlang::sym(col),
-            .ns = "TidyDensity"
-        )
-    }
+  col_nms <- names(tidyselect::eval_select(rlang::enquo(.value), .data))
 
-    grid <- expand.grid(
-        col                = col_nms
-        , stringsAsFactors = FALSE
+  make_call <- function(col) {
+    rlang::call2(
+      "bootstrap_p_vec",
+      .x = rlang::sym(col),
+      .ns = "TidyDensity"
     )
+  }
+
+  grid <- expand.grid(
+    col = col_nms,
+    stringsAsFactors = FALSE
+  )
 
-    calls <- purrr::pmap(.l = list(grid$col), make_call)
+  calls <- purrr::pmap(.l = list(grid$col), make_call)
 
-    if(any(.names == "auto")){
-        newname <- "p"
-    } else {
-        newname <- as.list(.names)
-    }
+  if (any(.names == "auto")) {
+    newname <- "p"
+  } else {
+    newname <- as.list(.names)
+  }
 
-    calls <- purrr::set_names(calls, newname)
+  calls <- purrr::set_names(calls, newname)
 
-    ret <- dplyr::as_tibble(dplyr::mutate(.data, !!!calls))
+  ret <- dplyr::as_tibble(dplyr::mutate(.data, !!!calls))
 
-    return(ret)
+  return(ret)
 }
diff --git a/R/augment-bootstrap-q.R b/R/augment-bootstrap-q.R
@@ -31,43 +31,42 @@
 #' @export
 #'
 
-bootstrap_q_augment <- function(.data, .value, .names = "auto"){
+bootstrap_q_augment <- function(.data, .value, .names = "auto") {
+  column_expr <- rlang::enquo(.value)
 
-    column_expr <- rlang::enquo(.value)
-
-    if(rlang::quo_is_missing(column_expr)){
-        rlang::abort(
-            message = "bootstrap_q_vec(.value) is missing",
-            use_cli_format = TRUE
-        )
-    }
-
-    col_nms <- names(tidyselect::eval_select(rlang::enquo(.value), .data))
+  if (rlang::quo_is_missing(column_expr)) {
+    rlang::abort(
+      message = "bootstrap_q_vec(.value) is missing",
+      use_cli_format = TRUE
+    )
+  }
 
-    make_call <- function(col){
-        rlang::call2(
-            "bootstrap_q_vec",
-            .x = rlang::sym(col),
-            .ns = "TidyDensity"
-        )
-    }
+  col_nms <- names(tidyselect::eval_select(rlang::enquo(.value), .data))
 
-    grid <- expand.grid(
-        col                = col_nms
-        , stringsAsFactors = FALSE
+  make_call <- function(col) {
+    rlang::call2(
+      "bootstrap_q_vec",
+      .x = rlang::sym(col),
+      .ns = "TidyDensity"
     )
+  }
+
+  grid <- expand.grid(
+    col = col_nms,
+    stringsAsFactors = FALSE
+  )
 
-    calls <- purrr::pmap(.l = list(grid$col), make_call)
+  calls <- purrr::pmap(.l = list(grid$col), make_call)
 
-    if(any(.names == "auto")){
-        newname <- "q"
-    } else {
-        newname <- as.list(.names)
-    }
+  if (any(.names == "auto")) {
+    newname <- "q"
+  } else {
+    newname <- as.list(.names)
+  }
 
-    calls <- purrr::set_names(calls, newname)
+  calls <- purrr::set_names(calls, newname)
 
-    ret <- dplyr::as_tibble(dplyr::mutate(.data, !!!calls))
+  ret <- dplyr::as_tibble(dplyr::mutate(.data, !!!calls))
 
-    return(ret)
+  return(ret)
 }