-
Notifications
You must be signed in to change notification settings - Fork 6
/
Copy pathmake-age-polys.R
106 lines (93 loc) · 3.24 KB
/
make-age-polys.R
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
#' Produces multiple transformations of the age term for fractional polynomial
#' analyses
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' When we do trajectory analyses using fractional polynomials we often want
#' to try models with different combinations of age polynomials. This function
#' creates multiple transformations of an age variable to different powers. We recommend moving to
#' \code{dsTidyverseClient::ds.mutate()} which is quicker, although would require a few more lines
#' of code.
#'
#' @template conns
#' @template df
#' @param age_var Character specifying age variable within `df` to transform.
#' @param poly_form Character vector of powers by which to transform `age_var`.
#' @param poly_names Character vector of names for the created variables. Must
#' the same length and order as `poly_form`.
#' @template checks
#' @param agevars Retired argument name. Please use `age_var' instead.
#'
#' @return Transformations of age are added as columns to server-side object
#' specified in `df`.
#'
#' @importFrom tibble tibble
#' @importFrom dplyr %>%
#' @importFrom purrr pmap cross2 map_chr
#' @importFrom dsBaseClient ds.cbind
#' @importFrom DSI datashield.connections_find
#'
#' @family trajectory functions
#' @family data manipulation functions
#'
#' @export
dh.makeAgePolys <- function(df = NULL, age_var = NULL,
poly_form = c("^-2", "^-1", "^-0.5", "log", "^0.5", "^2", "^3"),
poly_names = c("_m_2", "_m_1", "_m_0_5", "log", "_0_5", "_2", "_3"),
conns = NULL, checks = TRUE, agevars = NULL) {
lifecycle::signal_stage("superseded", "dh.makeAgePolys()")
df <- df
if (is.null(df)) {
stop("`df` must not be NULL.", call. = FALSE)
}
if (is.null(age_var)) {
stop("`age_var` must not be NULL.", call. = FALSE)
}
if (length(poly_names) != length(poly_form)) {
stop("The vectors supplied to `poly_names` and `poly_form` are not the same length", call. = FALSE)
}
if (!missing(agevars)) {
warning("Please use `age_var` instead of `agevars`")
age_var <- agevars
}
if (is.null(conns)) {
conns <- datashield.connections_find()
}
if (checks == TRUE) {
.isDefined(df = df, vars = age_var, conns = conns)
}
## We have to do log a bit more differently
log_yn <- any(str_detect(poly_form, "log") == TRUE)
if (log_yn == TRUE) {
poly_names <- poly_names[str_detect(poly_names, "log") == FALSE]
poly_form <- poly_form[str_detect(poly_form, "log") == FALSE]
}
df_age <- paste0(df, "$", age_var)
polys <- tibble(
poly = cross2(age_var, poly_names) %>% map_chr(paste, sep = "", collapse = ""),
form = cross2(df_age, poly_form) %>% map_chr(paste, sep = "", collapse = "")
)
if (log_yn == TRUE) {
polys <- add_row(
polys,
poly = paste0(age_var, "_log"),
form = paste0("log(", df_age, ")")
)
}
polys %>%
pmap(function(poly, form, ...) {
ds.assign(
toAssign = form,
newobj = poly,
datasources = conns
)
})
ds.cbind(x = c(df, polys$poly), newobj = df, datasources = conns)
dh.tidyEnv(
obj = polys$poly,
type = "remove"
)
cat("\nThe following transformations of age have been created in
dataframe:", df, "\n\n", polys$poly)
}