Skip to content
Permalink
Browse files

Remove quick functionality from tidy() and fix tests (#684)

* Start to remove quick argument

* Remove more quick

* Remove more quick

* Can't see any more quick?

* Try to unbreak travis

* Update NEWS

* Start to clean up for R CMD Check

* Smorgasboard of cleanup for R CMD Check

* Clean up for R CMD check

* Remove reference to param_quick in tidy.mlm()

* NAMESPACE update
  • Loading branch information...
alexpghayes committed Aug 7, 2019
1 parent 38b9fec commit 9b8fb69344cfdbaca4645c7120e4498dcce34fd5
Showing with 206 additions and 459 deletions.
  1. +0 −3 .travis.yml
  2. +3 −1 NEWS.md
  3. +1 −7 R/biglm-tidiers.R
  4. +1 −12 R/btergm-tidiers.R
  5. +33 −57 R/drc-tidiers.R
  6. +1 −6 R/gamlss-tidiers.R
  7. +4 −10 R/geepack-tidiers.R
  8. +7 −11 R/gmm-tidiers.R
  9. +1 −10 R/lavaan-tidiers.R
  10. +30 −56 R/lfe-tidiers.R
  11. +1 −8 R/lm-beta-tidiers.R
  12. +2 −5 R/mass-polr-tidiers.R
  13. +1 −1 R/nnet-tidiers.R
  14. +1 −1 R/ordinal-clm-tidiers.R
  15. +24 −6 R/ordinal-clmm-tidiers.R
  16. +2 −3 R/plm-tidiers.R
  17. +1 −1 R/rma-tidiers.R
  18. +4 −1 R/stats-htest-tidiers.R
  19. +4 −18 R/stats-lm-tidiers.R
  20. +0 −1 R/stats-mlm-tidiers.R
  21. +1 −11 R/stats-nls-tidiers.R
  22. +3 −3 R/survey-tidiers.R
  23. +0 −4 man-roxygen/param_quick.R
  24. +1 −1 man/augment.clm.Rd
  25. +9 −8 man/augment.drc.Rd
  26. +2 −2 man/augment.polr.Rd
  27. +1 −1 man/glance.clmm.Rd
  28. +7 −3 man/glance.drc.Rd
  29. +0 −1 man/glance.geeglm.Rd
  30. +1 −5 man/tidy.biglm.Rd
  31. +1 −6 man/tidy.btergm.Rd
  32. +3 −7 man/tidy.clmm.Rd
  33. +8 −11 man/tidy.drc.Rd
  34. +1 −5 man/tidy.felm.Rd
  35. +1 −5 man/tidy.gamlss.Rd
  36. +1 −6 man/tidy.geeglm.Rd
  37. +1 −5 man/tidy.glm.Rd
  38. +1 −5 man/tidy.gmm.Rd
  39. +1 −7 man/tidy.lavaan.Rd
  40. +1 −5 man/tidy.lm.Rd
  41. +1 −5 man/tidy.lm.beta.Rd
  42. +0 −4 man/tidy.mlm.Rd
  43. +1 −1 man/tidy.multinom.Rd
  44. +1 −6 man/tidy.nls.Rd
  45. +1 −5 man/tidy.plm.Rd
  46. +0 −4 man/tidy.polr.Rd
  47. +1 −5 man/tidy.rlm.Rd
  48. +1 −5 man/tidy.speedlm.Rd
  49. +0 −3 tests/testthat/test-biglm.R
  50. +0 −3 tests/testthat/test-btergm.R
  51. +1 −1 tests/testthat/test-cluster.R
  52. +16 −32 tests/testthat/test-drc.R
  53. +0 −5 tests/testthat/test-gamlss.R
  54. +2 −5 tests/testthat/test-geepack.R
  55. +0 −2 tests/testthat/test-gmm.R
  56. +0 −3 tests/testthat/test-lavaan.R
  57. +2 −12 tests/testthat/test-lfe.R
  58. +0 −7 tests/testthat/test-lmbeta-lm-beta.R
  59. +0 −2 tests/testthat/test-mass-rlm.R
  60. +0 −3 tests/testthat/test-plm.R
  61. +12 −9 tests/testthat/test-stats-htest.R
  62. +2 −11 tests/testthat/test-stats-lm.R
  63. +0 −3 tests/testthat/test-stats-nls.R
  64. +0 −3 tests/testthat/test-survey.R
  65. +0 −1 vignettes/adding-tidiers.Rmd
@@ -36,9 +36,6 @@ matrix:
- r: 3.3

r_binary_packages:
- rstanarm
- rstan
- lme4
- psych
- survival
- mclust
@@ -1,4 +1,4 @@
# broom 0.5.2.9000
# broom 0.5.2.9001
(To be released as 0.7.0)

## Breaking changes
@@ -15,6 +15,8 @@ changes in this version of `broom`. We list them below-
pattern `.fs` (e.g., `.fs1`, `.fs2`, `.fs3`, etc.), instead of `factor`
(e.g., `factor1`, `factor2`, `factor3`, etc.) (#650).

- We have removed all support for the `quick` argument in `tidy()` methods. TODO: explain why, and discuss alternatives.

## Changes to `augment()`

have overhauled `augment()` for general consistency improvements (hopefully,
@@ -5,7 +5,6 @@
#' [biglm::bigglm()].
#' @template param_confint
#' @template param_exponentiate
#' @template param_quick
#' @template param_unused_dots
#'
#' @evalRd return_tidy(regression = TRUE)
@@ -35,12 +34,7 @@
#' @family biglm tidiers
#' @seealso [tidy()], [biglm::biglm()], [biglm::bigglm()]
tidy.biglm <- function(x, conf.int = FALSE, conf.level = .95,
exponentiate = FALSE, quick = FALSE, ...) {
if (quick) {
co <- stats::coef(x)
ret <- tibble::enframe(co, name = "term", value = "estimate")
return(ret)
}
exponentiate = FALSE, ...) {

mat <- summary(x)$mat
nn <- c("estimate", "conf.low", "conf.high", "std.error", "p.value")
@@ -9,7 +9,6 @@
#' @param conf.level Confidence level for confidence intervals. Defaults to
#' 0.95.
#' @template param_exponentiate
#' @template param_quick
#' @template param_unused_dots
#'
#' @evalRd return_tidy("term", "estimate", "conf.low", "conf.high")
@@ -49,23 +48,13 @@
#' @export
#' @aliases btergm_tidiers
#' @seealso [tidy()], [btergm::btergm()]
tidy.btergm <- function(x, conf.level = .95,
exponentiate = FALSE, quick = FALSE, ...) {
tidy.btergm <- function(x, conf.level = .95, exponentiate = FALSE, ...) {

if (exponentiate) {
trans <- exp
} else {
trans <- identity
}

if (quick) {
co <- x@coef
ret <- tibble(
term = names(co),
estimate = trans(unname(co))
)
return(ret)
}

co <- btergm::confint(x, level = conf.level)

@@ -4,8 +4,7 @@
#' @param x A `drc` object produced by a call to [drc::drm()].
#' @template param_confint
#' @template param_unused_dots
#' @param quick whether to compute a smaller and faster version, containing
#' only the \code{term}, \code{curveid} and \code{estimate} columns.
#'
#' @evalRd return_tidy(
#' curveid = "Id of the curve",
#' "term",
@@ -18,66 +17,40 @@
#' )
#' @details The tibble has one row for each curve and term in the regression. The
#' `curveid` column indicates the curve.
#' @author Eduard Szoecs, \email{eduardszoecs@@gmail.com}
#'
#' @examples
#'
#' library(drc)
#'
#' mod <- drm(dead/total~conc, type,
#' weights = total, data = selenium, fct = LL.2(), type = "binomial")
#' mod
#'
#' tidy(mod)
#' tidy(mod, conf.int = TRUE)
#' tidy(mod, quick = TRUE)

#'
#' glance(mod)

#' # augment(mod)
#'
#' augment(mod, selenium)
#'
#'
#' @export
#' @seealso [tidy()], [drc::drm()]
#' @family drc tidiers
#' @aliases drc_tidiers
tidy.drc <- function(x, conf.int = FALSE, conf.level = 0.95, quick = FALSE, ...) {
if (quick) {
co <- coef(x)
nam <- names(co)
term <- gsub("^(.*):(.*)$", "\\1", nam)
curves <- x[["dataList"]][["curveid"]]
if (length(unique(curves)) > 1) {
curveid <- gsub("^(.*):(.*)$", "\\2", nam)
} else {
curveid <- unique(curves)
}
ret <- tibble(term = term,
curveid = curveid,
estimate = unname(co))
return(ret)
}

co <- coef(summary(x))

nam <- rownames(co)
term <- gsub("^(.*):(.*)$", "\\1", nam)
curves <- x[["dataList"]][["curveid"]]
if (length(unique(curves)) > 1) {
curveid <- gsub("^(.*):(.*)$", "\\2", nam)
} else {
curveid <- unique(curves)
}
ret <- data.frame(term = term,
curveid = curveid,
co, stringsAsFactors = FALSE)
names(ret) <- c("term", "curveid", "estimate", "std.error", "statistic",
"p.value")
rownames(ret) <- NULL
tidy.drc <- function(x, conf.int = FALSE, conf.level = 0.95, ...) {

ret <- coef(summary(x))
ret <- as_tibble(ret, rownames = "term")
ret <- tidyr::separate(ret, term, c("term", "curve"))

names(ret) <- c("term", "curve", "estimate", "std.error", "statistic", "p.value")

if (conf.int) {
conf <- confint(x, level = conf.level)
colnames(conf) <- c("conf.low", "conf.high")
rownames(conf) <- NULL
ret <- cbind(ret, conf)
ci <- broom_confint_terms(x, level = conf.level)
ret <- dplyr::left_join(ret, ci, by = "term")
}

return(as_tibble(ret))
ret
}

#' @templateVar class drc
@@ -97,11 +70,12 @@ tidy.drc <- function(x, conf.int = FALSE, conf.level = 0.95, quick = FALSE, ...)
#' @export
#' @family drc tidiers
glance.drc <- function(x, ...) {
ret <- data.frame(AIC = AIC(x),
BIC = BIC(x),
logLik = logLik(x),
df.residual = x$df.residual)
return(as_tibble(ret))
tibble(
AIC = stats::AIC(x),
BIC = stats::BIC(x),
logLik = stats::logLik(x),
df.residual = x$df.residual
)
}

#' @templateVar class drc
@@ -114,16 +88,18 @@ glance.drc <- function(x, ...) {
#' @template param_se_fit
#' @template param_unused_dots
#'
#' @evalRd return_augment(".conf.low" = "Lower Confidence Interval",
#' ".conf.high" = "Upper Confidence Interval",
#' @evalRd return_augment(
#' ".conf.low",
#' ".conf.high",
#' ".se.fit",
#' ".fitted",
#' ".resid",
#' ".cooksd")
#' ".cooksd"
#' )
#'
#' @seealso [augment()], [drc::drm()]
#' @export
#' @author Eduard Szoecs, \email{eduardszoecs@@gmail.com}
#'
#' @family drc tidiers
augment.drc <- function(x, data = NULL, newdata = NULL,
se_fit = FALSE, conf.int = FALSE, conf.level = 0.95, ...) {
@@ -183,4 +159,4 @@ augment.drc <- function(x, data = NULL, newdata = NULL,
}

as_tibble(ret)
}
}
@@ -2,7 +2,6 @@
#' @template title_desc_tidy
#'
#' @param x A `gamlss` object returned from [gamlss::gamlss()].
#' @template param_quick
#' @template param_unused_dots
#'
#' @evalRd return_tidy(
@@ -30,11 +29,7 @@
#' tidy(g)
#'
#' @export
tidy.gamlss <- function(x, quick = FALSE, ...) {
if (quick) {
co <- stats::coef(x)
return(tibble(term = names(co), estimate = unname(co)))
}
tidy.gamlss <- function(x, ...) {

# use capture.output to prevent summary from being printed to screen
utils::capture.output(s <- summary(x, type = "qr"))
@@ -3,7 +3,6 @@
#'
#' @param x A `geeglm` object returned from a call to [geepack::geeglm()].
#' @template param_confint
#' @template param_quick
#' @template param_exponentiate
#' @template param_unused_dots
#'
@@ -26,7 +25,6 @@
#' corstr = "exchangeable")
#'
#' tidy(geefit)
#' tidy(geefit, quick = TRUE)
#' tidy(geefit, conf.int = TRUE)
#'
#' @evalRd return_tidy(regresion = TRUE)
@@ -36,12 +34,8 @@
#' @seealso [tidy()], [geepack::geeglm()]
#'
tidy.geeglm <- function(x, conf.int = FALSE, conf.level = .95,
exponentiate = FALSE, quick = FALSE, ...) {
if (quick) {
co <- stats::coef(x)
ret <- tibble(term = names(co), estimate = unname(co))
return(ret)
}
exponentiate = FALSE, ...) {

co <- stats::coef(summary(x))

nn <- c("estimate", "std.error", "statistic", "p.value")
@@ -122,8 +116,8 @@ glance.geeglm <- function(x, ...) {
s <- summary(x)
tibble(
df.residual = x$df.residual,
n_clusters = length(s$clusz),
max_cluster_size = max(s$clusz),
n.clusters = length(s$clusz),
max.cluster.size = max(s$clusz),
alpha = x$geese$alpha,
gamma = x$geese$gamma
)
@@ -4,7 +4,6 @@
#' @param x A `gmm` object returned from [gmm::gmm()].
#' @template param_confint
#' @template param_exponentiate
#' @template param_quick
#' @template param_unused_dots
#'
#' @evalRd return_tidy(regression = TRUE)
@@ -79,17 +78,14 @@
#' @family gmm tidiers
#' @seealso [tidy()], [gmm::gmm()]
tidy.gmm <- function(x, conf.int = FALSE, conf.level = .95,
exponentiate = FALSE, quick = FALSE, ...) {
if (quick) {
co <- stats::coef(x)
ret <- tibble(term = names(co), estimate = unname(co))
} else {
co <- stats::coef(summary(x))

nn <- c("estimate", "std.error", "statistic", "p.value")
ret <- fix_data_frame(co, nn[1:ncol(co)])
}
exponentiate = FALSE, ...) {

co <- stats::coef(summary(x))
nn <- c("estimate", "std.error", "statistic", "p.value")
ret <- fix_data_frame(co, nn[1:ncol(co)])

# TODO: bump version requirement and use current returned object

# newer versions of GMM create a 'confint' object, so we can't use process_lm
ret <- process_lm(ret, x,
conf.int = FALSE, conf.level = conf.level,
@@ -5,7 +5,6 @@
#' and [lavaan::sem()].
#'
#' @template param_confint
#' @template param_quick
#'
#' @param ... Additional arguments passed to [lavaan::parameterEstimates()].
#' **Cautionary note**: Misspecified arguments may be silently ignored.
@@ -39,21 +38,13 @@
#' data = HolzingerSwineford1939, group = "school")
#'
#' tidy(cfa.fit)
#' tidy(cfa.fit, quick = TRUE)
#'
#' @export
#' @aliases lavaan_tidiers sem_tidiers cfa_tidiers
#' @family lavaan tidiers
#' @seealso [tidy()], [lavaan::cfa()], [lavaan::sem()],
#' [lavaan::parameterEstimates()]
tidy.lavaan <- function(x, conf.int = FALSE, conf.level = 0.95, quick = FALSE, ...) {

if (quick) {
terms <- paste(x@ParTable$lhs, x@ParTable$op, x@ParTable$rhs, sep = ' ')
ests <- x@ParTable$est
ret <- tibble(term = terms, estimate = ests)
return(ret)
}
tidy.lavaan <- function(x, conf.int = FALSE, conf.level = 0.95, ...) {

lavaan::parameterEstimates(x,
ci = conf.int,

0 comments on commit 9b8fb69

Please sign in to comment.
You can’t perform that action at this time.