rtables (version 0.4.0)

make_afun: Create custom analysis function wrapping existing function

Description

Create custom analysis function wrapping existing function

Usage

make_afun(
  fun,
  .stats = NULL,
  .formats = NULL,
  .labels = NULL,
  .indent_mods = NULL,
  .ungroup_stats = NULL,
  ...,
  .null_ref_cells = ".in_ref_col" %in% names(formals(fun))
)

Arguments

fun

function. The function to be wrapped in a new customized analysis fun. Should return named list.

.stats

character. Names of elements to keep from fun's full output.

.formats

ANY. vector/list of formats to override any defaults applied by fun.

.labels

character. Vector of labels to override defaults returned by fun

.indent_mods

integer. Named vector of indent modifiers for the generated rows.

.ungroup_stats

character. Vector of names, which must match elements of .stats

...

dots. Additional arguments to fun which effectively become new defaults. These can still be overriden by extra args within a split.

.null_ref_cells

logical(1). Should cells for the reference column be NULL-ed by the returned analysis function. Defaults to TRUE if fun accepts .in_ref_col as a formal argument. Note this argument occurs after ... so it must be fully specified by name when set.

Value

A function suitable for use in analyze with element selection, reformatting, and relabeling performed automatically.

See Also

analyze()

Examples

# NOT RUN {
s_summary <- function(x) {
  stopifnot(is.numeric(x))

  list(
    n = sum(!is.na(x)),
    mean_sd = c(mean = mean(x), sd = sd(x)),
    min_max = range(x)
  )
}

s_summary(iris$Sepal.Length)

a_summary <- make_afun(
  fun = s_summary,
  .formats = c(n = "xx", mean_sd = "xx.xx (xx.xx)", min_max = "xx.xx - xx.xx"),
  .labels = c(n = "n", mean_sd = "Mean (sd)", min_max = "min - max")
)

a_summary(x = iris$Sepal.Length)

a_summary2 <- make_afun(a_summary, .stats = c("n", "mean_sd"))

a_summary2(x = iris$Sepal.Length)

a_summary3 <- make_afun(a_summary, .formats = c(mean_sd = "(xx.xxx, xx.xxx)"))



s_foo <- function(df, .N_col, a = 1, b = 2) {
   list(
      nrow_df = nrow(df),
      .N_col = .N_col,
      a = a,
      b = b
   )
}

s_foo(iris, 40)

a_foo <- make_afun(s_foo, b = 4,
 .formats = c(nrow_df = "xx.xx", ".N_col" = "xx.", a = "xx", b = "xx.x"),
 .labels = c(nrow_df = "Nrow df", ".N_col" = "n in cols", a = "a value", b = "b value"),
 .indent_mods = c(nrow_df = 2L, a = 1L)
)

a_foo(iris, .N_col = 40)
a_foo2 <- make_afun(a_foo, .labels = c(nrow_df = "Number of Rows"))
a_foo(iris, .N_col = 40)

#grouping and further customization
s_grp <- function(df, .N_col, a = 1, b = 2) {
   list(
      nrow_df = nrow(df),
      .N_col = .N_col,
      letters = list(a = a,
                     b = b)
   )
}
a_grp <- make_afun(s_grp, b = 3, .labels = c(nrow_df = "row count", .N_col = "count in column"),
                   .formats = c(nrow_df = "xx.", .N_col = "xx."),
                   .indent_mod = c(letters = 1L),
                   .ungroup_stats ="letters")
a_grp(iris, 40)
a_aftergrp <- make_afun(a_grp, .stats = c("nrow_df", "b"), .formats = c(b = "xx."))
a_aftergrp(iris, 40)

s_ref <- function(x, .in_ref_col, .ref_group) {
   list(
         mean_diff = mean(x) - mean(.ref_group)
       )
}

a_ref <- make_afun(s_ref, .labels = c( mean_diff = "Mean Difference from Ref"))
a_ref(iris$Sepal.Length, .in_ref_col = TRUE, 1:10)
a_ref(iris$Sepal.Length, .in_ref_col = FALSE, 1:10)


# }