File: available-module-functions.R

package info (click to toggle)
r-cran-bayesplot 1.14.0-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid
  • size: 7,288 kB
  • sloc: sh: 13; makefile: 2
file content (143 lines) | stat: -rw-r--r-- 3,742 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
#' Get or view the names of available plotting or data functions
#'
#' @export
#' @param pattern,fixed,invert Passed to [base::grep()].
#' @param plots_only If `TRUE` (the default) only plotting functions are
#'   searched for. If `FALSE` then functions that return data for plotting
#'   (functions ending in `_data()`) are also included.
#' @return A possibly empty character vector of function names with several
#'   additional attributes (for use by a custom print method). If `pattern`
#'   is missing then the returned object contains the names of all available
#'   plotting functions in the [MCMC], [PPC], or [PPD] module, depending on
#'   which function is called. If `pattern` is specified then a subset of
#'   function names is returned.
#'
#' @examples
#' available_mcmc()
#' available_mcmc("nuts")
#' available_mcmc("rhat|neff")
#'
#' available_ppc()
#' available_ppc("grouped")
#' available_ppc("grouped", invert = TRUE)
#'
#' available_ppd()
#' available_ppd("grouped")
#'
#' # can also see which functions that return data are available
#' available_ppc(plots_only = FALSE)
#'
#' # only show the _data functions
#' available_ppc("_data", plots_only = FALSE)
#' available_ppd("_data", plots_only = FALSE)
#' available_mcmc("_data", plots_only = FALSE)
#'
available_ppc <-
  function(pattern = NULL,
           fixed = FALSE,
           invert = FALSE,
           plots_only = TRUE) {
    .list_module_functions(
      .module = "ppc",
      .pattern = pattern,
      fixed = fixed,
      invert = invert,
      plots_only = plots_only
    )
  }

#' @rdname available_ppc
#' @export
available_ppd <-
  function(pattern = NULL,
           fixed = FALSE,
           invert = FALSE,
           plots_only = TRUE) {
    .list_module_functions(
      .module = "ppd",
      .pattern = pattern,
      fixed = fixed,
      invert = invert,
      plots_only = plots_only
    )
  }

#' @rdname available_ppc
#' @export
available_mcmc <-
  function(pattern = NULL,
           fixed = FALSE,
           invert = FALSE,
           plots_only = TRUE) {
    .list_module_functions(
      .module = "mcmc",
      .pattern = pattern,
      fixed = fixed,
      invert = invert,
      plots_only = plots_only
    )
  }

#' @export
print.bayesplot_function_list <- function(x, ...) {
  atts <- attributes(x)
  cat("bayesplot", toupper(atts[["module"]]), "module:\n")
  if (!is.null(atts[["pattern"]])) {
    msg <- paste0("(", ifelse(atts[["inverted"]], "excluding", "matching"),
                  " pattern '", atts[["pattern"]], "')")
    cat(msg, "\n")
  }
  cat(paste0("  ", x), sep = "\n")
  invisible(x)
}


# internal ----------------------------------------------------------------
.list_module_functions <-
  function(.module = c("ppc", "ppd", "mcmc"),
           .pattern,
           fixed = FALSE,
           invert = FALSE,
           plots_only = TRUE) {

    .module <- match.arg(.module)

    all_funs <- grep(
      pattern = paste0("^", .module, "_"),
      x = getNamespaceExports("bayesplot"),
      value = TRUE
    )
    return_funs <- sort(all_funs)

    if (plots_only) {
      # drop _data() functions
      return_funs <-
        grep(
          pattern = "_data()",
          x = return_funs,
          invert = TRUE,
          value = TRUE
        )
    }

    if (!is.null(.pattern)) {
      return_funs <- grep(
        pattern = .pattern,
        x = return_funs,
        value = TRUE,
        fixed = fixed,
        invert = invert
      )
    }

    # remove deprecated functions
    return_funs <- setdiff(return_funs, "ppc_loo_pit")

    structure(
      return_funs,
      class = c("bayesplot_function_list", "character"),
      module = .module,
      pattern = .pattern,
      inverted = invert
    )
  }