/R/lmodel2-tidiers.R

https://github.com/tidymodels/broom · R · 113 lines · 44 code · 4 blank · 65 comment · 1 complexity · 6591d08480f06b382129841cfd9db72b MD5 · raw file

  1. #' @templateVar class lmodel2
  2. #' @template title_desc_tidy
  3. #'
  4. #' @param x A `lmodel2` object returned by [lmodel2::lmodel2()].
  5. #' @template param_unused_dots
  6. #'
  7. #' @evalRd return_tidy(
  8. #' "term",
  9. #' "estimate",
  10. #' "p.value",
  11. #' "conf.low",
  12. #' "conf.high",
  13. #' method = "Either OLS/MA/SMA/RMA"
  14. #' )
  15. #'
  16. #' @details There are always only two terms in an `lmodel2`: `"Intercept"`
  17. #' and `"Slope"`. These are computed by four methods: OLS
  18. #' (ordinary least squares), MA (major axis), SMA (standard major
  19. #' axis), and RMA (ranged major axis).
  20. #'
  21. #' The returned p-value is one-tailed and calculated via a permutation test.
  22. #' A permutational test is used because distributional assumptions may not
  23. #' be valid. More information can be found in
  24. #' `vignette("mod2user", package = "lmodel2")`.
  25. #'
  26. #' @examples
  27. #'
  28. #' library(lmodel2)
  29. #'
  30. #' data(mod2ex2)
  31. #' Ex2.res <- lmodel2(Prey ~ Predators, data = mod2ex2, "relative", "relative", 99)
  32. #' Ex2.res
  33. #'
  34. #' tidy(Ex2.res)
  35. #' glance(Ex2.res)
  36. #'
  37. #' # this allows coefficient plots with ggplot2
  38. #' library(ggplot2)
  39. #' ggplot(tidy(Ex2.res), aes(estimate, term, color = method)) +
  40. #' geom_point() +
  41. #' geom_errorbarh(aes(xmin = conf.low, xmax = conf.high)) +
  42. #' geom_errorbarh(aes(xmin = conf.low, xmax = conf.high))
  43. #' @export
  44. #' @seealso [tidy()], [lmodel2::lmodel2()]
  45. #' @aliases lmodel2_tidiers
  46. #' @family lmodel2 tidiers
  47. tidy.lmodel2 <- function(x, ...) {
  48. ret <- x$regression.results[c(1:3, 5)] %>%
  49. select(
  50. method = Method,
  51. Intercept,
  52. Slope,
  53. p.value = `P-perm (1-tailed)`
  54. ) %>%
  55. pivot_longer(
  56. cols = c(dplyr::everything(), -method, -p.value),
  57. names_to = "term",
  58. values_to = "estimate"
  59. ) %>%
  60. arrange(method, term)
  61. # add confidence intervals
  62. confints <- x$confidence.intervals %>%
  63. pivot_longer(
  64. cols = c(dplyr::everything(), -Method),
  65. names_to = "key",
  66. values_to = "value"
  67. ) %>%
  68. tidyr::separate(key, c("level", "term"), "-") %>%
  69. mutate(level = ifelse(level == "2.5%", "conf.low", "conf.high")) %>%
  70. tidyr::pivot_wider(c(Method, term),
  71. names_from = level,
  72. values_from = value
  73. ) %>%
  74. dplyr::arrange(Method) %>%
  75. as.data.frame() %>%
  76. select(method = Method, term, conf.low, conf.high)
  77. ret %>%
  78. inner_join(confints, by = c("method", "term")) %>%
  79. # change column order so `p.value` is at the end
  80. select(-p.value, dplyr::everything()) %>%
  81. as_tibble()
  82. }
  83. #' @templateVar class lmodel2
  84. #' @template title_desc_glance
  85. #'
  86. #' @inherit tidy.lmodel2 params examples
  87. #'
  88. #' @evalRd return_glance(
  89. #' "r.squared",
  90. #' "p.value",
  91. #' theta = "Angle between OLS lines `lm(y ~ x)` and `lm(x ~ y)`",
  92. #' H = "H statistic for computing confidence interval of major axis slope",
  93. #' "nobs"
  94. #' )
  95. #'
  96. #' @export
  97. #' @seealso [glance()], [lmodel2::lmodel2()]
  98. #' @family lmodel2 tidiers
  99. #'
  100. glance.lmodel2 <- function(x, ...) {
  101. as_glance_tibble(
  102. r.squared = x$rsquare,
  103. theta = x$theta,
  104. p.value = x$P.param,
  105. H = x$H,
  106. nobs = stats::nobs(x),
  107. na_types = "rrrri"
  108. )
  109. }