/
inside.R
executable file
·188 lines (169 loc) · 6.63 KB
/
inside.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
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
#' Pass code into the multiverse
#'
#' Add code to the multiverse using the function using a function call, or an assignment operator, which is
#' a wrapper around the function
#'
#' The inside function can only access variables which can be accessed at the same environment
#' where the multiverse object was declared in.
#'
#' @details To perform a multiverse analysis, we will need to write code to be executed within the multiverse.
#' The \code{inside()} functions allows us to do this. Use \code{inside()} to pass any code to the specified multiverse,
#' which is captured as an expression. To define multiple analysis options in the code passed to the multiverse,
#' use the \code{branch()} function.
#'
#' @seealso \code{branch()} for more details on how to declare multiple analysis options.
#'
#' The \code{inside} function only stores the code, and does not execute any code at this step. To execute, we
#' provide separate functions. See \code{execute()} for executing the code.
#'
#' Instead of using the \code{inside()} function, an alternate implementation of the multiverse is using
#' the assignment operator, `<-` (please refer to examples below).
#'
#' \emph{Note}: the \code{inside()} function can only access variables which can be accessed at the same level as the multiverse
#' object. Since \code{inside()} is merely an interface to add analysis to the multiverse object, even if it is being called
#' by another function, it is actually manipulating the multiverse object, which will have a different parent environment
#' from where \code{inside()} is called, and hence not have access to variables which might be accessible in the environment
#' within the function from where \code{inside()} is called.
#'
#' @param multiverse A multive[])rse object. A multiverse object is an S3 object which can be defined using \code{multiverse()}
#'
#' @param .expr R syntax. All the operations that the user wants to perform within the multiverse can be passed.
#' Since it accepts a single argument, chunks of code can be passed using `\{\}`. See example for details.
#'
#' @param .label It is extracted automatically from the code block of type \code{multiverse}
#' when run in an RMarkdown document. This should be used only within an RMarkdown document.
#' Defaults to NULL.
#'
#' @param .execute_default Should the default multiverse be executed as part of this call?
#'
#' @return a multiverse object
#'
#' @examples
#' \donttest{
#' M.1 <- multiverse()
#'
#' # using `inside` to declare multiverse code
#' inside(M.1, {
#' data <- rnorm(100, 50, 20)
#'
#' x.mean <- mean(data, trim = branch(
#' trim_values,
#' "trim_none" ~ 0,
#' "trim_1pc" ~ 0.05,
#' "trim_5pc" ~ 0.025,
#' "trim_10pc" ~ 0.05
#' ))
#' })
#'
#' # declaring multiple options for a data processing step (calculating a new variable)
#' data(durante)
#' df <- durante
#'
#' inside(M.1, {
#' df <- df %>%
#' mutate( ComputedCycleLength = StartDateofLastPeriod - StartDateofPeriodBeforeLast ) %>%
#' mutate( NextMenstrualOnset = branch(menstrual_calculation,
#' "mc_option1" ~ StartDateofLastPeriod + ComputedCycleLength,
#' "mc_option2" ~ StartDateofLastPeriod + ReportedCycleLength,
#' "mc_option3" ~ StartDateNext
#' ))
#' })
#'
#' }
#'
#' @importFrom rlang is_call
#' @importFrom rlang enexpr
#' @importFrom rlang is_null
#' @importFrom magrittr inset
#' @importFrom purrr map
#'
#' @name inside
#' @export
inside <- function(multiverse, .expr, .label = NULL, .execute_default = TRUE) {
.code = enexpr(.expr)
add_and_parse_code(multiverse, .code, .label)
## execute everything from where things have changed
# direct calls to inside() by the user result in execution of the
# default universe in the global environment.
if (.execute_default) {
invisible( execute_universe(multiverse) )
}
}
add_and_parse_code <- function(multiverse, .expr, .name = NULL) {
m_obj <- attr(multiverse, "multiverse")
.super_env <- attr(multiverse, "multiverse_super_env")
# check if .name is NULL
# if it is NULL auto-generate
if (is.null(.name)) {
.name = as.character(length(m_obj$code) + 1)
}
# ensure that .expr is a single self-contained { ... } block
if(!is_call(.expr, "{")) {
.expr = as.call(list(quote(`{`), .expr))
}
# expand .options arguments in branch calls
.expr = expand_branch_options(.expr)
.loc = length(m_obj$code)
# what has been unchanged so far in the tree
# everything post will be edited in the subsequent steps
# there is no code declared in the multiverse
if (is_null(m_obj$code)) {
# code block is not named, it is just appended to a unnamed list -> inside() declaration
if (is.null(.name)) {
.c = list(.expr)
} # code block is named, it is just appended to a named list
else {
.c = list()
.c[[.name]] = .expr
}
.expr <- .c
} else {
# there is code already declared in the multiverse
if (is.null(.name)) .c = append(m_obj$code[1:.loc], .expr)
else {
# replaces existing code
.c = m_obj$code
.c[[.name]] = .expr
#.expr needs to be changed so that we recompute everything that occurs subsequently
.expr = .c[which(names(.c) == .name):length(.c)]
.name = names(.c)[which(names(.c) == .name)]
}
}
mapply(parse_multiverse, .expr, names(.expr), MoreArgs = list(.multiverse = multiverse, .code = .c))
m_obj$code <- .c
# case 1: if code is being added to the end,
# unchanged_until should be the length of the list
#
# case 2: if a previous element, n, in the code list
# is being edited, unchanged until should be n - 1
if (tail(names(.c), n = 1) == .name) {
# case 1
m_obj$unchanged_until = length(.c) - 1
} else {
# case 2:
# `which` returns the index of the code block which has changed
# we substract one to indicate what has been unchanged
.p_idx = which( names(.c) == .name ) - 1
if (.p_idx == 0) m_obj$unchanged_until = NA
else m_obj$unchanged_until = .p_idx
}
# m_obj$unchanged_until <- length(.c) - length(.name)
}
# expand use of .options argument in branch calls
expand_branch_options <- function(.expr) {
if (is.call(.expr)) {
if (is_call(.expr, "branch")) {
.new_expr = .expr
if(".options" %in% names(.expr)) {
.eval_seq = eval(.expr[['.options']])
.idx = match(c(".options"), names(.expr))
.new_expr = magrittr::inset(unname(.expr), c(.idx:((.idx-1) + length(.eval_seq))), .eval_seq)
}
return(.new_expr)
} else {
as.call(map(as.list(.expr), ~ expand_branch_options(.x)))
}
} else {
.expr
}
}