diff --git a/main/coverage-report/index.html b/main/coverage-report/index.html new file mode 100644 index 000000000..1f5b84d82 --- /dev/null +++ b/main/coverage-report/index.html @@ -0,0 +1,49068 @@ + + +
+ + + + + + + + + + + + + + + + + + + + + + +1 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
2 | ++ | + + | +
3 | ++ |
+ # run ----+ |
+
4 | ++ | + + | +
5 | ++ |
+ #' Run the pipeline+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' Execute the pre-processing, main and post-processing functions in a single run.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @inheritParams gen_args+ |
+
10 | ++ |
+ #' @param object (`chevron_tlg`) input.+ |
+
11 | ++ |
+ #' @param auto_pre (`flag`) whether to perform the default pre processing step.+ |
+
12 | ++ |
+ #' @param ... extra arguments to pass to the pre-processing, main and post-processing functions.+ |
+
13 | ++ |
+ #'+ |
+
14 | ++ |
+ #' @name run+ |
+
15 | ++ |
+ #' @export+ |
+
16 | +158x | +
+ setGeneric("run", function(object, adam_db, auto_pre = TRUE, ...) standardGeneric("run"))+ |
+
17 | ++ | + + | +
18 | ++ |
+ #' Run the pipeline+ |
+
19 | ++ |
+ #' @rdname run+ |
+
20 | ++ |
+ #' @export+ |
+
21 | ++ |
+ #' @examples+ |
+
22 | ++ |
+ #' run(mng01, syn_data, auto_pre = TRUE, dataset = "adlb")+ |
+
23 | ++ |
+ setMethod(+ |
+
24 | ++ |
+ f = "run",+ |
+
25 | ++ |
+ signature = "chevron_tlg",+ |
+
26 | ++ |
+ definition = function(object, adam_db, auto_pre = TRUE, ...) {+ |
+
27 | +158x | +
+ checkmate::assert_list(adam_db, types = "list")+ |
+
28 | +158x | +
+ checkmate::assert_flag(auto_pre)+ |
+
29 | +158x | +
+ user_args <- list(...)+ |
+
30 | +158x | +
+ proc_data <- if (auto_pre) {+ |
+
31 | +156x | +
+ list(adam_db = do_call(object@preprocess, c(list(adam_db), user_args)))+ |
+
32 | ++ |
+ } else {+ |
+
33 | +2x | +
+ list(adam_db = adam_db)+ |
+
34 | ++ |
+ }+ |
+
35 | ++ | + + | +
36 | +147x | +
+ res_tlg <- list(tlg = do_call(object@main, c(proc_data, user_args)))+ |
+
37 | ++ | + + | +
38 | +137x | +
+ do_call(object@postprocess, c(res_tlg, user_args))+ |
+
39 | ++ |
+ }+ |
+
40 | ++ |
+ )+ |
+
41 | ++ | + + | +
42 | ++ | + + | +
43 | ++ |
+ # args_ls ----+ |
+
44 | ++ | + + | +
45 | ++ |
+ #' Get Arguments List+ |
+
46 | ++ |
+ #'+ |
+
47 | ++ |
+ #' @param x (`chevron_tlg`) input.+ |
+
48 | ++ |
+ #' @param simplify (`flag`) whether to simplify the output, coalescing the values of the parameters. The order of+ |
+
49 | ++ |
+ #' priority for the value of the parameters is: `main`, `preprocess` and `postprocess`.+ |
+
50 | ++ |
+ #' @param omit (`character`) the names of the argument to omit from the output.+ |
+
51 | ++ |
+ #'+ |
+
52 | ++ |
+ #' @rdname args_ls+ |
+
53 | ++ |
+ #' @export+ |
+
54 | +5x | +
+ setGeneric("args_ls", function(x, simplify = FALSE, omit = NULL) standardGeneric("args_ls"))+ |
+
55 | ++ | + + | +
56 | ++ |
+ #' @rdname args_ls+ |
+
57 | ++ |
+ #' @export+ |
+
58 | ++ |
+ setMethod(+ |
+
59 | ++ |
+ f = "args_ls",+ |
+
60 | ++ |
+ signature = "chevron_tlg",+ |
+
61 | ++ |
+ definition = function(x, simplify = FALSE, omit = NULL) {+ |
+
62 | +5x | +
+ checkmate::assert_flag(simplify)+ |
+
63 | +5x | +
+ checkmate::assert_character(omit, null.ok = TRUE)+ |
+
64 | ++ | + + | +
65 | +5x | +
+ x_ls <- list(+ |
+
66 | +5x | +
+ main = formals(x@main),+ |
+
67 | +5x | +
+ preprocess = formals(x@preprocess),+ |
+
68 | +5x | +
+ postprocess = formals(x@postprocess)+ |
+
69 | ++ |
+ )+ |
+
70 | ++ | + + | +
71 | +5x | +
+ x_sel <- lapply(x_ls, function(y) y[!names(y) %in% omit])+ |
+
72 | ++ | + + | +
73 | +5x | +
+ res <- if (simplify) {+ |
+
74 | +4x | +
+ Reduce(fuse_sequentially, x_sel)+ |
+
75 | ++ |
+ } else {+ |
+
76 | +1x | +
+ x_sel+ |
+
77 | ++ |
+ }+ |
+
78 | ++ | + + | +
79 | +5x | +
+ res+ |
+
80 | ++ |
+ }+ |
+
81 | ++ |
+ )+ |
+
82 | ++ | + + | +
83 | ++ |
+ # main ----+ |
+
84 | ++ | + + | +
85 | ++ |
+ #' Main+ |
+
86 | ++ |
+ #'+ |
+
87 | ++ |
+ #' retrieve or set `main` function.+ |
+
88 | ++ |
+ #'+ |
+
89 | ++ |
+ #' @param x (`chevron_tlg`) input.+ |
+
90 | ++ |
+ #'+ |
+
91 | ++ |
+ #' @aliases main+ |
+
92 | ++ |
+ #' @export+ |
+
93 | +2x | +
+ setGeneric("main", function(x) standardGeneric("main"))+ |
+
94 | ++ | + + | +
95 | ++ |
+ #' @rdname main+ |
+
96 | ++ |
+ #' @export+ |
+
97 | ++ |
+ setMethod(+ |
+
98 | ++ |
+ f = "main",+ |
+
99 | ++ |
+ signature = "chevron_tlg",+ |
+
100 | ++ |
+ definition = function(x) {+ |
+
101 | +2x | +
+ x@main+ |
+
102 | ++ |
+ }+ |
+
103 | ++ |
+ )+ |
+
104 | ++ | + + | +
105 | ++ |
+ #' Set Main Function+ |
+
106 | ++ |
+ #'+ |
+
107 | ++ |
+ #' @param x (`chevron_tlg`) input.+ |
+
108 | ++ |
+ #' @param value (`function`) returning a `tlg`. Typically one of the `_main` function of `chevron`.+ |
+
109 | ++ |
+ #'+ |
+
110 | ++ |
+ #' @rdname main+ |
+
111 | ++ |
+ #' @export+ |
+
112 | +2x | +
+ setGeneric("main<-", function(x, value) standardGeneric("main<-"))+ |
+
113 | ++ | + + | +
114 | ++ |
+ #' @rdname main+ |
+
115 | ++ |
+ #' @export+ |
+
116 | ++ |
+ setMethod(+ |
+
117 | ++ |
+ f = "main<-",+ |
+
118 | ++ |
+ signature = "chevron_tlg",+ |
+
119 | ++ |
+ definition = function(x, value) {+ |
+
120 | +2x | +
+ x@main <- value+ |
+
121 | +2x | +
+ validObject(x)+ |
+
122 | +1x | +
+ x+ |
+
123 | ++ |
+ }+ |
+
124 | ++ |
+ )+ |
+
125 | ++ | + + | +
126 | ++ |
+ # preprocess ----+ |
+
127 | ++ | + + | +
128 | ++ |
+ #' Pre process+ |
+
129 | ++ |
+ #'+ |
+
130 | ++ |
+ #' retrieve or set `preprocess` function.+ |
+
131 | ++ |
+ #'+ |
+
132 | ++ |
+ #' @param x (`chevron_tlg`) input.+ |
+
133 | ++ |
+ #'+ |
+
134 | ++ |
+ #' @aliases preprocess+ |
+
135 | ++ |
+ #' @export+ |
+
136 | +4x | +
+ setGeneric("preprocess", function(x) standardGeneric("preprocess"))+ |
+
137 | ++ | + + | +
138 | ++ |
+ #' @rdname preprocess+ |
+
139 | ++ |
+ #' @export+ |
+
140 | ++ |
+ setMethod(+ |
+
141 | ++ |
+ f = "preprocess",+ |
+
142 | ++ |
+ signature = "chevron_tlg",+ |
+
143 | ++ |
+ definition = function(x) {+ |
+
144 | +4x | +
+ x@preprocess+ |
+
145 | ++ |
+ }+ |
+
146 | ++ |
+ )+ |
+
147 | ++ | + + | +
148 | ++ |
+ #' Set Preprocess Function+ |
+
149 | ++ |
+ #'+ |
+
150 | ++ |
+ #' @param x (`chevron_tlg`) input.+ |
+
151 | ++ |
+ #' @param value (`function`) returning a pre-processed `list` of `data.frames` amenable to `tlg` creation. Typically+ |
+
152 | ++ |
+ #' one of the `_pre` function of `chevron`.+ |
+
153 | ++ |
+ #'+ |
+
154 | ++ |
+ #' @rdname preprocess+ |
+
155 | ++ |
+ #' @export+ |
+
156 | +3x | +
+ setGeneric("preprocess<-", function(x, value) standardGeneric("preprocess<-"))+ |
+
157 | ++ | + + | +
158 | ++ |
+ #' @rdname preprocess+ |
+
159 | ++ |
+ #' @export+ |
+
160 | ++ |
+ setMethod(+ |
+
161 | ++ |
+ f = "preprocess<-",+ |
+
162 | ++ |
+ signature = "chevron_tlg",+ |
+
163 | ++ |
+ definition = function(x, value) {+ |
+
164 | +3x | +
+ x@preprocess <- value+ |
+
165 | +3x | +
+ validObject(x)+ |
+
166 | +2x | +
+ x+ |
+
167 | ++ |
+ }+ |
+
168 | ++ |
+ )+ |
+
169 | ++ | + + | +
170 | ++ |
+ # postprocess ----+ |
+
171 | ++ | + + | +
172 | ++ |
+ #' Post process+ |
+
173 | ++ |
+ #'+ |
+
174 | ++ |
+ #' retrieve or set `postprocess` function.+ |
+
175 | ++ |
+ #'+ |
+
176 | ++ |
+ #' @param x (`chevron_tlg`) input.+ |
+
177 | ++ |
+ #'+ |
+
178 | ++ |
+ #' @aliases postprocess+ |
+
179 | ++ |
+ #' @export+ |
+
180 | +3x | +
+ setGeneric("postprocess", function(x) standardGeneric("postprocess"))+ |
+
181 | ++ | + + | +
182 | ++ |
+ #' @rdname postprocess+ |
+
183 | ++ |
+ #' @export+ |
+
184 | ++ |
+ setMethod(+ |
+
185 | ++ |
+ f = "postprocess",+ |
+
186 | ++ |
+ signature = "chevron_tlg",+ |
+
187 | ++ |
+ definition = function(x) {+ |
+
188 | +3x | +
+ x@postprocess+ |
+
189 | ++ |
+ }+ |
+
190 | ++ |
+ )+ |
+
191 | ++ | + + | +
192 | ++ |
+ #' Postprocess Assignment Function+ |
+
193 | ++ |
+ #'+ |
+
194 | ++ |
+ #' @param x (`chevron_tlg`) input.+ |
+
195 | ++ |
+ #' @param value (`function`) returning a post-processed `tlg`.+ |
+
196 | ++ |
+ #'+ |
+
197 | ++ |
+ #' @rdname postprocess+ |
+
198 | ++ |
+ #' @export+ |
+
199 | +2x | +
+ setGeneric("postprocess<-", function(x, value) standardGeneric("postprocess<-"))+ |
+
200 | ++ | + + | +
201 | ++ |
+ #' @rdname postprocess+ |
+
202 | ++ |
+ #' @export+ |
+
203 | ++ |
+ setMethod(+ |
+
204 | ++ |
+ f = "postprocess<-",+ |
+
205 | ++ |
+ signature = "chevron_tlg",+ |
+
206 | ++ |
+ definition = function(x, value) {+ |
+
207 | +2x | +
+ x@postprocess <- value+ |
+
208 | +2x | +
+ validObject(x)+ |
+
209 | +1x | +
+ x+ |
+
210 | ++ |
+ }+ |
+
211 | ++ |
+ )+ |
+
212 | ++ | + + | +
213 | ++ |
+ # script ----+ |
+
214 | ++ | + + | +
215 | ++ |
+ #' Create Script for Parameters Assignment+ |
+
216 | ++ |
+ #'+ |
+
217 | ++ |
+ #' @param x (`chevron_tlg`) input.+ |
+
218 | ++ |
+ #' @param adam_db (`string`) the name of the dataset.+ |
+
219 | ++ |
+ #' @param dict (`list`) with the name and value of custom arguments.+ |
+
220 | ++ |
+ #' @param details (`flag`) whether to show the code of all function. By default, only the detail of the code of the+ |
+
221 | ++ |
+ #' prepossessing step is printed.+ |
+
222 | ++ |
+ #' @param args (`string`) the name of argument list.+ |
+
223 | ++ |
+ #'+ |
+
224 | ++ |
+ #' @name script+ |
+
225 | ++ |
+ #' @rdname script+ |
+
226 | ++ |
+ NULL+ |
+
227 | ++ | + + | +
228 | ++ |
+ ## script_args ----+ |
+
229 | ++ | + + | +
230 | ++ |
+ #' @rdname script+ |
+
231 | ++ |
+ #' @export+ |
+
232 | +2x | +
+ setGeneric("script_args", function(x, dict = NULL) standardGeneric("script_args"))+ |
+
233 | ++ | + + | +
234 | ++ |
+ #' @rdname script+ |
+
235 | ++ |
+ #' @export+ |
+
236 | ++ |
+ #'+ |
+
237 | ++ |
+ #' @examples+ |
+
238 | ++ |
+ #' script_args(aet04)+ |
+
239 | ++ |
+ #'+ |
+
240 | ++ |
+ setMethod(+ |
+
241 | ++ |
+ f = "script_args",+ |
+
242 | ++ |
+ signature = "chevron_tlg",+ |
+
243 | ++ |
+ definition = function(x, dict = NULL) {+ |
+
244 | +2x | +
+ checkmate::assert_list(dict, null.ok = TRUE)+ |
+
245 | ++ | + + | +
246 | ++ |
+ # Construct call for attribution of all arguments+ |
+
247 | +2x | +
+ simple_arg <- args_ls(x, omit = c("tlg", "..."), simplify = TRUE)+ |
+
248 | +2x | +
+ simple_arg <- fuse_sequentially(dict, simple_arg)+ |
+
249 | +2x | +
+ names_args <- names(simple_arg)+ |
+
250 | +2x | +
+ val_args <- unname(simple_arg)+ |
+
251 | ++ | + + | +
252 | +2x | +
+ res <- alist()+ |
+
253 | +2x | +
+ for (i in seq_along(simple_arg)) {+ |
+
254 | +11x | +
+ val <- val_args[[i]]+ |
+
255 | +11x | +
+ id <- names_args[[i]]+ |
+
256 | ++ | + + | +
257 | +11x | +
+ if (missing(val)) {+ |
+
258 | +1x | +
+ res[[id]] <- rlang::call2("stop", "missing value")+ |
+
259 | ++ |
+ } else {+ |
+
260 | +10x | +
+ res[[id]] <- val+ |
+
261 | ++ |
+ }+ |
+
262 | ++ |
+ }+ |
+
263 | ++ | + + | +
264 | +2x | +
+ arg_calls <- mapply(function(x, y) rlang::call2("<-", sym(x), y), as.list(names(res)), res)+ |
+
265 | ++ | + + | +
266 | +2x | +
+ c(+ |
+
267 | +2x | +
+ "\n# Arguments definition ----\n",+ |
+
268 | +2x | +
+ unlist(lapply(arg_calls, deparse))+ |
+
269 | ++ |
+ )+ |
+
270 | ++ |
+ }+ |
+
271 | ++ |
+ )+ |
+
272 | ++ | + + | +
273 | ++ |
+ ## script_funs ----+ |
+
274 | ++ | + + | +
275 | ++ |
+ #' Create Script for `TLG` Generation+ |
+
276 | ++ |
+ #'+ |
+
277 | ++ |
+ #' @rdname script+ |
+
278 | ++ |
+ #' @export+ |
+
279 | +4x | +
+ setGeneric("script_funs", function(x, adam_db, args, details = FALSE) standardGeneric("script_funs"))+ |
+
280 | ++ | + + | +
281 | ++ |
+ #' @rdname script+ |
+
282 | ++ |
+ #' @export+ |
+
283 | ++ |
+ #'+ |
+
284 | ++ |
+ #' @examples+ |
+
285 | ++ |
+ #' script_funs(aet04, adam_db = "syn_data", args = "args")+ |
+
286 | ++ |
+ setMethod(+ |
+
287 | ++ |
+ f = "script_funs",+ |
+
288 | ++ |
+ signature = "chevron_tlg",+ |
+
289 | ++ |
+ definition = function(x, adam_db, args, details = FALSE) {+ |
+
290 | +4x | +
+ checkmate::assert_flag(details)+ |
+
291 | +4x | +
+ checkmate::assert_string(adam_db)+ |
+
292 | +4x | +
+ checkmate::assert_string(args)+ |
+
293 | ++ | + + | +
294 | +4x | +
+ if (details) {+ |
+
295 | +2x | +
+ c(+ |
+
296 | +2x | +
+ "# Edit Functions.",+ |
+
297 | +2x | +
+ deparse(+ |
+
298 | +2x | +
+ rlang::call2("<-", sym("pre_fun"), preprocess(x)),+ |
+
299 | +2x | +
+ control = "useSource"+ |
+
300 | ++ |
+ ),+ |
+
301 | ++ |
+ "",+ |
+
302 | +2x | +
+ deparse(+ |
+
303 | +2x | +
+ rlang::call2("<-", sym("main_fun"), main(x)),+ |
+
304 | +2x | +
+ control = "useSource"+ |
+
305 | ++ |
+ ),+ |
+
306 | ++ |
+ "",+ |
+
307 | +2x | +
+ deparse(+ |
+
308 | +2x | +
+ rlang::call2("<-", sym("post_fun"), postprocess(x)),+ |
+
309 | +2x | +
+ control = "useSource"+ |
+
310 | ++ |
+ ),+ |
+
311 | ++ |
+ "",+ |
+
312 | +2x | +
+ "# Create TLG",+ |
+
313 | +2x | +
+ glue::glue("tlg_output <- rlang::exec(.fn = pre_fun, adam_db = {adam_db}, !!!{args}) %>% \+ |
+
314 | +2x | +
+ rlang::exec(.fn = main_fun, !!!{args}) %>% \+ |
+
315 | +2x | +
+ rlang::exec(.fn = post_fun, !!!{args})")+ |
+
316 | ++ |
+ )+ |
+
317 | ++ |
+ } else {+ |
+
318 | +2x | +
+ tlg_name <- deparse(substitute(x))+ |
+
319 | +2x | +
+ c(+ |
+
320 | +2x | +
+ "# Edit Preprocessing Function.",+ |
+
321 | +2x | +
+ utils::capture.output(+ |
+
322 | +2x | +
+ print(+ |
+
323 | +2x | +
+ rlang::call2("<-", sym("pre_fun"), preprocess(x)),+ |
+
324 | +2x | +
+ useSource = TRUE+ |
+
325 | ++ |
+ )+ |
+
326 | ++ |
+ ),+ |
+
327 | ++ |
+ "",+ |
+
328 | +2x | +
+ "# Create TLG",+ |
+
329 | +2x | +
+ glue::glue("tlg_output <- rlang::exec(.fn = pre_fun, adam_db = {adam_db}, !!!{args}) %>% \+ |
+
330 | +2x | +
+ rlang::exec(.fn = run, object = {tlg_name}, !!!{args}, auto_pre = FALSE)")+ |
+
331 | ++ |
+ )+ |
+
332 | ++ |
+ }+ |
+
333 | ++ |
+ }+ |
+
334 | ++ |
+ )+ |
+
1 | ++ |
+ # ttet01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn ttet01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param dataset (`string`) the name of a table in the `adam_db` object.+ |
+
7 | ++ |
+ #' @param ref_group (`string`) The name of the reference group, the value should+ |
+
8 | ++ |
+ #' be identical to the values in `arm_var`, if not specified, it will by default+ |
+
9 | ++ |
+ #' use the first level or value of `arm_var`.+ |
+
10 | ++ |
+ #' @param summarize_event (`flag`) should the event description be displayed, default is TRUE+ |
+
11 | ++ |
+ #' @param perform_analysis (`string`) option to display statistical comparisons using stratified analyses,+ |
+
12 | ++ |
+ #' or unstratified analyses, or both, e.g. `c("unstrat", "strat")`. Only unstratified will be displayed by default+ |
+
13 | ++ |
+ #' @param strata (`string`) stratification factors, e.g. `strata = c("STRATA1", "STRATA2")`, by default as NULL+ |
+
14 | ++ |
+ #' @param pval_method (`string`) p-value method for testing hazard ratio = 1.+ |
+
15 | ++ |
+ #' Default method is `"log-rank"`, can also be set to `"wald"` or `"likelihood"`.+ |
+
16 | ++ |
+ #' @param conf_level (`numeric`) the level of confidence interval, default is 0.95.+ |
+
17 | ++ |
+ #' @param conf_type (`string`) confidence interval type. Options are `"plain"` (default), `"log"`, `"log-log"`,+ |
+
18 | ++ |
+ #' see more in `survival::survfit()`. Note option "none" is no longer supported.+ |
+
19 | ++ |
+ #' @param quantiles (`numeric`) of length two to specify the quantiles of survival time.+ |
+
20 | ++ |
+ #' @param ties (`string`) specifying the method for tie handling. Default is `"efron"`,+ |
+
21 | ++ |
+ #' can also be set to `"breslow"` or `"exact"`. see more in `survival::coxph()`+ |
+
22 | ++ |
+ #' @param timepoint (`numeric`) survival time point of interest.+ |
+
23 | ++ |
+ #' @param method (`string`) either `"surv"` (survival estimations),+ |
+
24 | ++ |
+ #' `"surv_diff"` (difference in survival with the control) or `"both"`.+ |
+
25 | ++ |
+ #'+ |
+
26 | ++ |
+ #'+ |
+
27 | ++ |
+ #' @details+ |
+
28 | ++ |
+ #' * No overall value.+ |
+
29 | ++ |
+ #'+ |
+
30 | ++ |
+ #'+ |
+
31 | ++ |
+ #' @export+ |
+
32 | ++ |
+ #'+ |
+
33 | ++ |
+ #'+ |
+
34 | ++ |
+ ttet01_main <- function(adam_db,+ |
+
35 | ++ |
+ dataset = "adtte",+ |
+
36 | ++ |
+ arm_var = "ARM",+ |
+
37 | ++ |
+ ref_group = NULL,+ |
+
38 | ++ |
+ summarize_event = TRUE,+ |
+
39 | ++ |
+ perform_analysis = "unstrat",+ |
+
40 | ++ |
+ strata = NULL,+ |
+
41 | ++ |
+ pval_method = "log-rank",+ |
+
42 | ++ |
+ conf_level = 0.95,+ |
+
43 | ++ |
+ conf_type = "log-log",+ |
+
44 | ++ |
+ quantiles = c(0.25, 0.75),+ |
+
45 | ++ |
+ ties = "efron",+ |
+
46 | ++ |
+ timepoint = c(6, 12),+ |
+
47 | ++ |
+ method = "both",+ |
+
48 | ++ |
+ ...) {+ |
+
49 | +1x | +
+ checkmate::assert_string(dataset)+ |
+
50 | +1x | +
+ assert_all_tablenames(adam_db, "adsl", dataset)+ |
+
51 | +1x | +
+ anl <- adam_db[[dataset]]+ |
+
52 | +1x | +
+ assert_single_value(anl$PARAMCD, label = sprintf("adam_db$%s$PARAMCD", dataset))+ |
+
53 | +1x | +
+ checkmate::assert_string(ref_group, null.ok = TRUE)+ |
+
54 | +1x | +
+ df_label <- sprintf("adam_db$%s", dataset)+ |
+
55 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], "AVALU", types = list("character"), label = df_label)+ |
+
56 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], c("IS_EVENT", "IS_NOT_EVENT"), types = list("logical"), label = df_label)+ |
+
57 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], "AVAL", types = list("numeric"), lower = 0, label = df_label)+ |
+
58 | +1x | +
+ assert_valid_variable(+ |
+
59 | +1x | +
+ adam_db[[dataset]], c("USUBJID", arm_var, "EVNT1", "EVNTDESC"),+ |
+
60 | +1x | +
+ types = list(c("character", "factor")), label = df_label+ |
+
61 | ++ |
+ )+ |
+
62 | +1x | +
+ checkmate::assert_flag(summarize_event)+ |
+
63 | +1x | +
+ checkmate::assert_subset(perform_analysis, c("unstrat", "strat"))+ |
+
64 | +1x | +
+ checkmate::assert_character(+ |
+
65 | +1x | +
+ strata,+ |
+
66 | +1x | +
+ null.ok = !"strat" %in% perform_analysis,+ |
+
67 | +1x | +
+ min.len = as.integer(!"strat" %in% perform_analysis)+ |
+
68 | ++ |
+ )+ |
+
69 | ++ | + + | +
70 | +1x | +
+ checkmate::assert_subset(ref_group, lvls(adam_db[[dataset]][[arm_var]]))+ |
+
71 | +1x | +
+ ref_group <- ref_group %||% lvls(anl[[arm_var]])[1]+ |
+
72 | ++ | + + | +
73 | +1x | +
+ assert_single_value(anl$AVALU, label = sprintf("adam_db$%s$AVALU", dataset))+ |
+
74 | +1x | +
+ timeunit <- unique(anl[["AVALU"]])+ |
+
75 | +1x | +
+ event_lvls <- lvls(anl$EVNT1)+ |
+
76 | +1x | +
+ lyt <- ttet01_lyt(+ |
+
77 | +1x | +
+ arm_var = arm_var,+ |
+
78 | +1x | +
+ ref_group = ref_group,+ |
+
79 | +1x | +
+ summarize_event = summarize_event,+ |
+
80 | +1x | +
+ perform_analysis = perform_analysis,+ |
+
81 | +1x | +
+ strata = strata,+ |
+
82 | +1x | +
+ pval_method = pval_method,+ |
+
83 | +1x | +
+ conf_level = conf_level,+ |
+
84 | +1x | +
+ conf_type = conf_type,+ |
+
85 | +1x | +
+ quantiles = quantiles,+ |
+
86 | +1x | +
+ ties = ties,+ |
+
87 | +1x | +
+ timeunit = timeunit,+ |
+
88 | +1x | +
+ timepoint = timepoint,+ |
+
89 | +1x | +
+ method = method,+ |
+
90 | +1x | +
+ event_lvls = event_lvls+ |
+
91 | ++ |
+ )+ |
+
92 | ++ | + + | +
93 | +1x | +
+ tbl <- build_table(lyt, anl)+ |
+
94 | ++ | + + | +
95 | +1x | +
+ tbl+ |
+
96 | ++ |
+ }+ |
+
97 | ++ | + + | +
98 | ++ |
+ #' `ttet01` Layout+ |
+
99 | ++ |
+ #'+ |
+
100 | ++ |
+ #' @inheritParams gen_args+ |
+
101 | ++ |
+ #' @param timeunit (`string`) time unit get from `AVALU`, by default is `"Months"`+ |
+
102 | ++ |
+ #'+ |
+
103 | ++ |
+ #' @keywords internal+ |
+
104 | ++ |
+ ttet01_lyt <- function(arm_var,+ |
+
105 | ++ |
+ ref_group,+ |
+
106 | ++ |
+ summarize_event,+ |
+
107 | ++ |
+ perform_analysis,+ |
+
108 | ++ |
+ strata,+ |
+
109 | ++ |
+ pval_method,+ |
+
110 | ++ |
+ conf_level,+ |
+
111 | ++ |
+ conf_type,+ |
+
112 | ++ |
+ quantiles,+ |
+
113 | ++ |
+ ties,+ |
+
114 | ++ |
+ timeunit,+ |
+
115 | ++ |
+ timepoint,+ |
+
116 | ++ |
+ method,+ |
+
117 | ++ |
+ event_lvls) {+ |
+
118 | +4x | +
+ lyt01 <- basic_table(show_colcounts = TRUE) %>%+ |
+
119 | +4x | +
+ split_cols_by(+ |
+
120 | +4x | +
+ var = arm_var, ref_group = ref_group+ |
+
121 | ++ |
+ ) %>%+ |
+
122 | +4x | +
+ summarize_vars(+ |
+
123 | +4x | +
+ vars = "IS_EVENT",+ |
+
124 | +4x | +
+ .stats = "count_fraction",+ |
+
125 | +4x | +
+ .labels = c(count_fraction = event_lvls[1])+ |
+
126 | ++ |
+ )+ |
+
127 | ++ | + + | +
128 | +4x | +
+ if (summarize_event) {+ |
+
129 | +1x | +
+ lyt01 <- lyt01 %>%+ |
+
130 | +1x | +
+ split_rows_by(+ |
+
131 | +1x | +
+ "EVNT1",+ |
+
132 | +1x | +
+ split_label = "Earliest contributing event",+ |
+
133 | +1x | +
+ split_fun = keep_split_levels(event_lvls[1]),+ |
+
134 | +1x | +
+ label_pos = "visible",+ |
+
135 | +1x | +
+ child_labels = "hidden",+ |
+
136 | +1x | +
+ indent_mod = 1L,+ |
+
137 | ++ |
+ ) %>%+ |
+
138 | +1x | +
+ summarize_vars("EVNTDESC", split_fun = drop_split_levels, .stats = "count_fraction")+ |
+
139 | ++ |
+ }+ |
+
140 | ++ | + + | +
141 | +4x | +
+ lyt01 <- lyt01 %>%+ |
+
142 | +4x | +
+ summarize_vars(+ |
+
143 | +4x | +
+ vars = "IS_NOT_EVENT",+ |
+
144 | +4x | +
+ .stats = "count_fraction",+ |
+
145 | +4x | +
+ .labels = c(count_fraction = event_lvls[2]),+ |
+
146 | +4x | +
+ nested = FALSE,+ |
+
147 | +4x | +
+ show_labels = "hidden"+ |
+
148 | ++ |
+ ) %>%+ |
+
149 | +4x | +
+ surv_time(+ |
+
150 | +4x | +
+ vars = "AVAL",+ |
+
151 | +4x | +
+ var_labels = paste0("Time to Event (", timeunit, ")"),+ |
+
152 | +4x | +
+ is_event = "IS_EVENT",+ |
+
153 | +4x | +
+ control = control_surv_time(+ |
+
154 | +4x | +
+ conf_level = conf_level,+ |
+
155 | +4x | +
+ conf_type = conf_type,+ |
+
156 | +4x | +
+ quantiles = quantiles+ |
+
157 | ++ |
+ ),+ |
+
158 | +4x | +
+ table_names = "time_to_event"+ |
+
159 | ++ |
+ )+ |
+
160 | ++ | + + | +
161 | +4x | +
+ for (perform in perform_analysis) {+ |
+
162 | +4x | +
+ lyt01 <- lyt01 %>%+ |
+
163 | +4x | +
+ coxph_pairwise(+ |
+
164 | +4x | +
+ vars = "AVAL",+ |
+
165 | +4x | +
+ is_event = "IS_EVENT",+ |
+
166 | +4x | +
+ var_labels = if (perform == "strat") "Stratified Analysis" else "Unstratified Analysis",+ |
+
167 | +4x | +
+ strat = if (perform == "strat") strata else NULL,+ |
+
168 | +4x | +
+ control = control_coxph(+ |
+
169 | +4x | +
+ pval_method = pval_method,+ |
+
170 | +4x | +
+ conf_level = conf_level,+ |
+
171 | +4x | +
+ ties = ties+ |
+
172 | ++ |
+ ),+ |
+
173 | +4x | +
+ table_names = if (perform == "strat") "coxph_stratified" else "coxph_unstratified"+ |
+
174 | ++ |
+ )+ |
+
175 | ++ |
+ }+ |
+
176 | ++ | + + | +
177 | +4x | +
+ lyt <- lyt01 %>%+ |
+
178 | +4x | +
+ surv_timepoint(+ |
+
179 | +4x | +
+ vars = "AVAL",+ |
+
180 | +4x | +
+ var_labels = timeunit,+ |
+
181 | +4x | +
+ time_point = timepoint,+ |
+
182 | +4x | +
+ is_event = "IS_EVENT",+ |
+
183 | +4x | +
+ method = method,+ |
+
184 | +4x | +
+ control = control_surv_timepoint(+ |
+
185 | +4x | +
+ conf_level = conf_level,+ |
+
186 | +4x | +
+ conf_type = conf_type+ |
+
187 | ++ |
+ ),+ |
+
188 | +4x | +
+ .labels = c("pt_at_risk" = render_safe("{Patient_label} remaining at risk"))+ |
+
189 | ++ |
+ )+ |
+
190 | ++ | + + | +
191 | +4x | +
+ return(lyt)+ |
+
192 | ++ |
+ }+ |
+
193 | ++ | + + | +
194 | ++ |
+ #' @describeIn ttet01 Preprocessing+ |
+
195 | ++ |
+ #'+ |
+
196 | ++ |
+ #' @inheritParams gen_args+ |
+
197 | ++ |
+ #' @param dataset (`string`) the name of a table in the `adam_db` object.+ |
+
198 | ++ |
+ #'+ |
+
199 | ++ |
+ #' @export+ |
+
200 | ++ |
+ #'+ |
+
201 | ++ |
+ ttet01_pre <- function(adam_db, dataset = "adtte",+ |
+
202 | ++ |
+ ...) {+ |
+
203 | +1x | +
+ adam_db[[dataset]] <- adam_db[[dataset]] %>%+ |
+
204 | +1x | +
+ mutate(+ |
+
205 | +1x | +
+ AVAL = day2month(.data$AVAL),+ |
+
206 | +1x | +
+ AVALU = "MONTHS",+ |
+
207 | +1x | +
+ IS_EVENT = .data$CNSR == 0,+ |
+
208 | +1x | +
+ IS_NOT_EVENT = .data$CNSR == 1,+ |
+
209 | +1x | +
+ EVNT1 = factor(+ |
+
210 | +1x | +
+ case_when(+ |
+
211 | +1x | +
+ IS_EVENT == TRUE ~ render_safe("{Patient_label} with event (%)"),+ |
+
212 | +1x | +
+ IS_EVENT == FALSE ~ render_safe("{Patient_label} without event (%)")+ |
+
213 | ++ |
+ ),+ |
+
214 | +1x | +
+ levels = render_safe(c("{Patient_label} with event (%)", "{Patient_label} without event (%)"))+ |
+
215 | ++ |
+ ),+ |
+
216 | +1x | +
+ EVNTDESC = factor(.data$EVNTDESC)+ |
+
217 | ++ |
+ )+ |
+
218 | ++ | + + | +
219 | +1x | +
+ adam_db+ |
+
220 | ++ |
+ }+ |
+
221 | ++ | + + | +
222 | ++ |
+ #' @describeIn ttet01 Postprocessing+ |
+
223 | ++ |
+ #'+ |
+
224 | ++ |
+ #' @inheritParams gen_args+ |
+
225 | ++ |
+ #'+ |
+
226 | ++ |
+ #'+ |
+
227 | ++ |
+ #' @export+ |
+
228 | ++ |
+ ttet01_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
229 | +! | +
+ if (prune_0) {+ |
+
230 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
231 | ++ |
+ }+ |
+
232 | +! | +
+ std_postprocess(tlg)+ |
+
233 | ++ |
+ }+ |
+
234 | ++ | + + | +
235 | ++ |
+ #' `TTET01` Binary Outcomes Summary+ |
+
236 | ++ |
+ #'+ |
+
237 | ++ |
+ #' `TTET01` template may be used to summarize any binary outcome or response variable at+ |
+
238 | ++ |
+ #' a single time point. Typical application for oncology+ |
+
239 | ++ |
+ #'+ |
+
240 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
241 | ++ |
+ #' @export+ |
+
242 | ++ |
+ #'+ |
+
243 | ++ |
+ #' @examples+ |
+
244 | ++ |
+ #' library(dplyr)+ |
+
245 | ++ |
+ #' library(dunlin)+ |
+
246 | ++ |
+ #'+ |
+
247 | ++ |
+ #' syn_data2 <- log_filter(syn_data, PARAMCD == "PFS", "adtte")+ |
+
248 | ++ |
+ #' run(ttet01, syn_data2)+ |
+
249 | ++ |
+ #' run(ttet01, syn_data2,+ |
+
250 | ++ |
+ #' summarize_event = FALSE, perform_analysis = c("unstrat", "strat"),+ |
+
251 | ++ |
+ #' strata = c("STRATA1", "STRATA2")+ |
+
252 | ++ |
+ #' )+ |
+
253 | ++ |
+ ttet01 <- chevron_t(+ |
+
254 | ++ |
+ main = ttet01_main,+ |
+
255 | ++ |
+ preprocess = ttet01_pre,+ |
+
256 | ++ |
+ postprocess = ttet01_post+ |
+
257 | ++ |
+ )+ |
+
1 | ++ |
+ # as we use NSE+ |
+
2 | ++ |
+ globalVariables(c(".", ":="))+ |
+
3 | ++ | + + | +
4 | ++ |
+ #' Retrieve labels for certain variables+ |
+
5 | ++ |
+ #'+ |
+
6 | ++ |
+ #' @param df (`data.frame`) containing columns with label attribute.+ |
+
7 | ++ |
+ #' @param vars (`character`) variable names in `df`.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' The labels will be returned if the column has `label` attribute, otherwise the column name will be returned.+ |
+
11 | ++ |
+ #' Any values between brackets {} will be replaced with `dunlin::render_safe`.+ |
+
12 | ++ |
+ #' @export+ |
+
13 | ++ |
+ var_labels_for <- function(df, vars) {+ |
+
14 | +248x | +
+ checkmate::assert_names(colnames(df), must.include = vars, what = "colnames")+ |
+
15 | +248x | +
+ render_safe(unname(formatters::var_labels(df, fill = TRUE)[vars]))+ |
+
16 | ++ |
+ }+ |
+
17 | ++ | + + | +
18 | ++ |
+ #' Prune Table up to an `ElementaryTable`+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ #' Avoid returning `NULL` when the `table` is empty.+ |
+
21 | ++ |
+ #'+ |
+
22 | ++ |
+ #' @param tlg (`TableTree`) object.+ |
+
23 | ++ |
+ #'+ |
+
24 | ++ |
+ #' @return pruned `TableTree`.+ |
+
25 | ++ |
+ #'+ |
+
26 | ++ |
+ smart_prune <- function(tlg) {+ |
+
27 | +77x | +
+ res <- prune_table(tlg)+ |
+
28 | ++ | + + | +
29 | +77x | +
+ if (is.null(res)) {+ |
+
30 | +19x | +
+ res <- build_table(rtables::basic_table(), df = data.frame())+ |
+
31 | +19x | +
+ col_info(res) <- col_info(tlg)+ |
+
32 | ++ |
+ }+ |
+
33 | ++ | + + | +
34 | +77x | +
+ res+ |
+
35 | ++ |
+ }+ |
+
36 | ++ | + + | +
37 | ++ | + + | +
38 | ++ |
+ #' Standard Post processing+ |
+
39 | ++ |
+ #'+ |
+
40 | ++ |
+ #' @param tlg (`TableTree`) object.+ |
+
41 | ++ |
+ #' @param ind (`integer`) the indentation of the table.+ |
+
42 | ++ |
+ #' @param ... not used at the moment.+ |
+
43 | ++ |
+ #'+ |
+
44 | ++ |
+ #' @note Standard post processing includes:+ |
+
45 | ++ |
+ #' * `NULL` report creation if necessary+ |
+
46 | ++ |
+ #' * indentation+ |
+
47 | ++ |
+ #'+ |
+
48 | ++ |
+ #' @return a post-processed `tlg`.+ |
+
49 | ++ |
+ #'+ |
+
50 | ++ |
+ #' @keywords internal+ |
+
51 | ++ |
+ #'+ |
+
52 | ++ |
+ std_postprocess <- function(tlg, ind = 2L, ...) {+ |
+
53 | +165x | +
+ checkmate::assert_int(ind, lower = 0L)+ |
+
54 | ++ | + + | +
55 | +165x | +
+ res <- report_null(tlg)+ |
+
56 | +165x | +
+ table_inset(res) <- ind+ |
+
57 | ++ | + + | +
58 | +165x | +
+ res+ |
+
59 | ++ |
+ }+ |
+
60 | ++ | + + | +
61 | ++ |
+ # Special formats ----+ |
+
62 | ++ | + + | +
63 | ++ |
+ #' Decimal Formatting+ |
+
64 | ++ |
+ #'+ |
+
65 | ++ |
+ #' @param digits (`integer`) number of digits.+ |
+
66 | ++ |
+ #' @param format (`string`) describing how the numbers should be formatted following the `sprintf` syntax.+ |
+
67 | ++ |
+ #' @param ne (`flag`) indicator whether to use "NE" to replace the actual value.+ |
+
68 | ++ |
+ #'+ |
+
69 | ++ |
+ #' @return `function` formatting numbers with the defined format.+ |
+
70 | ++ |
+ #'+ |
+
71 | ++ |
+ #' @export+ |
+
72 | ++ |
+ #'+ |
+
73 | ++ |
+ #' @examples+ |
+
74 | ++ |
+ #' fun <- h_format_dec(c(1, 1), "%s - %s")+ |
+
75 | ++ |
+ #' fun(c(123, 567.89))+ |
+
76 | ++ |
+ #'+ |
+
77 | ++ |
+ h_format_dec <- function(digits, format, ne = FALSE) {+ |
+
78 | +8937x | +
+ checkmate::assert_integerish(digits, lower = 0)+ |
+
79 | +8937x | +
+ checkmate::assert_string(format)+ |
+
80 | +8937x | +
+ if (any(is.na(digits))) {+ |
+
81 | +697x | +
+ function(x, ...) {+ |
+
82 | ++ |
+ ""+ |
+
83 | ++ |
+ }+ |
+
84 | ++ |
+ } else {+ |
+
85 | +8240x | +
+ if (ne) {+ |
+
86 | +4116x | +
+ ret <- function(x, ...) {+ |
+
87 | +4116x | +
+ do_call(sprintf, c(list(fmt = format), rep("NE", length(digits))))+ |
+
88 | ++ |
+ }+ |
+
89 | +4116x | +
+ return(ret)+ |
+
90 | ++ |
+ }+ |
+
91 | +4124x | +
+ digit_string <- paste0("%", ifelse(is.na(digits), "", paste0(".", digits)), "f")+ |
+
92 | +4124x | +
+ new_format <- do_call(sprintf, c(list(fmt = format), digit_string))+ |
+
93 | +4124x | +
+ formatters::sprintf_format(new_format)+ |
+
94 | ++ |
+ }+ |
+
95 | ++ |
+ }+ |
+
96 | ++ | + + | +
97 | ++ |
+ #' Fuse list elements+ |
+
98 | ++ |
+ #'+ |
+
99 | ++ |
+ #' @param x (`list`) to fuse.+ |
+
100 | ++ |
+ #' @param y (`list`) to fuse. Elements with names already existing in `x` are discarded.+ |
+
101 | ++ |
+ #'+ |
+
102 | ++ |
+ #' @keywords internal+ |
+
103 | ++ |
+ #'+ |
+
104 | ++ |
+ fuse_sequentially <- function(x, y) {+ |
+
105 | +12x | +
+ if (missing(y)) {+ |
+
106 | +1x | +
+ return(x)+ |
+
107 | ++ |
+ }+ |
+
108 | ++ | + + | +
109 | +11x | +
+ names_x <- names(x)+ |
+
110 | +11x | +
+ sel_names_y <- setdiff(names(y), names_x)+ |
+
111 | ++ | + + | +
112 | +11x | +
+ c(x, y[sel_names_y])+ |
+
113 | ++ |
+ }+ |
+
114 | ++ | + + | +
115 | ++ |
+ #' List of `grob` object+ |
+
116 | ++ |
+ #' @param ... (`grob`) objects+ |
+
117 | ++ |
+ #' @export+ |
+
118 | ++ |
+ grob_list <- function(...) {+ |
+
119 | +1x | +
+ ret <- list(...)+ |
+
120 | +1x | +
+ checkmate::assert_list(ret, types = c("grob"))+ |
+
121 | +1x | +
+ structure(+ |
+
122 | +1x | +
+ ret,+ |
+
123 | +1x | +
+ class = c("grob_list", "list")+ |
+
124 | ++ |
+ )+ |
+
125 | ++ |
+ }+ |
+
126 | ++ | + + | +
127 | ++ |
+ #' List of `gg` object+ |
+
128 | ++ |
+ #' @param ... (`ggplot`) objects+ |
+
129 | ++ |
+ #' @export+ |
+
130 | ++ |
+ gg_list <- function(...) {+ |
+
131 | +6x | +
+ ret <- list(...)+ |
+
132 | +6x | +
+ checkmate::assert_list(ret, types = c("ggplot"))+ |
+
133 | +6x | +
+ structure(+ |
+
134 | +6x | +
+ ret,+ |
+
135 | +6x | +
+ class = c("gg_list", "list")+ |
+
136 | ++ |
+ )+ |
+
137 | ++ |
+ }+ |
+
138 | ++ | + + | +
139 | ++ |
+ #' @export+ |
+
140 | ++ |
+ droplevels.character <- function(x, ...) {+ |
+
141 | +1x | +
+ x+ |
+
142 | ++ |
+ }+ |
+
143 | ++ | + + | +
144 | ++ |
+ #' Obtain levels from vector+ |
+
145 | ++ |
+ #' @param x (`character`) or (`factor`) object to obtain levels.+ |
+
146 | ++ |
+ #' @details+ |
+
147 | ++ |
+ #' For factors, the levels will be returned. For characters, the sorted unique values will be returned.+ |
+
148 | ++ |
+ #' @export+ |
+
149 | ++ |
+ lvls <- function(x) {+ |
+
150 | +320x | +
+ UseMethod("lvls")+ |
+
151 | ++ |
+ }+ |
+
152 | ++ |
+ #' @export+ |
+
153 | ++ |
+ lvls.default <- function(x) {+ |
+
154 | +1x | +
+ NULL+ |
+
155 | ++ |
+ }+ |
+
156 | ++ |
+ #' @export+ |
+
157 | ++ |
+ lvls.character <- function(x) {+ |
+
158 | +8x | +
+ sort(unique(x))+ |
+
159 | ++ |
+ }+ |
+
160 | ++ |
+ #' @export+ |
+
161 | ++ |
+ lvls.factor <- function(x) {+ |
+
162 | +311x | +
+ levels(x)+ |
+
163 | ++ |
+ }+ |
+
164 | ++ | + + | +
165 | ++ |
+ #' @keywords internal+ |
+
166 | ++ |
+ quote_str <- function(x) {+ |
+
167 | +13x | +
+ checkmate::assert_string(x)+ |
+
168 | +12x | +
+ paste0("`", x, "`")+ |
+
169 | ++ |
+ }+ |
+
170 | ++ | + + | +
171 | ++ |
+ #' @keywords internal+ |
+
172 | ++ |
+ modify_default_args <- function(fun, ...) {+ |
+
173 | +1x | +
+ ret <- fun+ |
+
174 | +1x | +
+ formals(ret) <- utils::modifyList(formals(fun), list(...), keep.null = TRUE)+ |
+
175 | +1x | +
+ return(ret)+ |
+
176 | ++ |
+ }+ |
+
177 | ++ | + + | +
178 | ++ |
+ #' Execute function with given arguments+ |
+
179 | ++ |
+ #' @details If the function has `...`, this function will not pass other arguments to `...`.+ |
+
180 | ++ |
+ #' Only named arguments are passed.+ |
+
181 | ++ |
+ #' @keywords internal+ |
+
182 | ++ |
+ execute_with_args <- function(fun, ...) {+ |
+
183 | +47x | +
+ args <- list(...)+ |
+
184 | +47x | +
+ do_call(fun, args[intersect(names(args), formalArgs(fun))])+ |
+
185 | ++ |
+ }+ |
+
186 | ++ | + + | +
187 | ++ |
+ #' Execute a Function Call+ |
+
188 | ++ |
+ #' @keywords internal+ |
+
189 | ++ |
+ do_call <- function(what, args) {+ |
+
190 | +8748x | +
+ arg_names <- names(args)+ |
+
191 | +8748x | +
+ if (is.null(arg_names)) {+ |
+
192 | +106x | +
+ arg_names <- sprintf("var_%s", seq_along(args))+ |
+
193 | +8642x | +
+ } else if (any(arg_names == "")) {+ |
+
194 | +8319x | +
+ arg_names_random <- sprintf("var_%s", seq_along(args))+ |
+
195 | +8319x | +
+ arg_names[arg_names == ""] <- arg_names_random[arg_names == ""]+ |
+
196 | ++ |
+ }+ |
+
197 | +8748x | +
+ args_env <- as.environment(setNames(args, arg_names))+ |
+
198 | +8748x | +
+ parent.env(args_env) <- parent.frame()+ |
+
199 | +8748x | +
+ new_args <- lapply(arg_names, as.symbol)+ |
+
200 | +8748x | +
+ names(new_args) <- names(args)+ |
+
201 | +8748x | +
+ do.call(what, new_args, envir = args_env)+ |
+
202 | ++ |
+ }+ |
+
1 | ++ |
+ # aet01_aesi ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn aet01_aesi Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param aesi_vars (`character`) the `AESI` variables to be included in the summary. Defaults to `NA`.+ |
+
7 | ++ |
+ #' @param grade_groups (`list`) the grade groups to be displayed.+ |
+
8 | ++ |
+ #' @details+ |
+
9 | ++ |
+ #' * Does not remove rows with zero counts by default.+ |
+
10 | ++ |
+ #'+ |
+
11 | ++ |
+ #' @note+ |
+
12 | ++ |
+ #' * `adam_db` object must contain an `adae` table with columns `"AEOUT"`, `"AEACN"`, `"AECONTRT"`, `"AESER"`,+ |
+
13 | ++ |
+ #' `"AREL"`, and the column specified by `arm_var`.+ |
+
14 | ++ |
+ #' * `aesi_vars` may contain any/all of the following variables to display: `"ALLRESWD"`, `"ALLRESDSM"`,+ |
+
15 | ++ |
+ #' `"ALLRESCONTRT"`, `"NOTRESWD"`, `"NOTRESDSM"`, `"NOTRESCONTRT"`, `"SERWD"`, `"SERDSM"`, `"SERCONTRT"`,+ |
+
16 | ++ |
+ #' `"RELWD"`, `"RELDSM"`, `"RELCONTRT"`, `"RELSER"`.+ |
+
17 | ++ |
+ #' * `aesi_vars` variable prefixes are defined as follows:+ |
+
18 | ++ |
+ #' * `"ALLRES"` = "all non-fatal adverse events resolved"+ |
+
19 | ++ |
+ #' * `"NOTRES"` = "at least one unresolved or ongoing non-fatal adverse event"+ |
+
20 | ++ |
+ #' * `"SER"` = "serious adverse event"+ |
+
21 | ++ |
+ #' * `"REL"` = "related adverse event"+ |
+
22 | ++ |
+ #' * `aesi_vars` variable suffixes are defined as follows:+ |
+
23 | ++ |
+ #' * `"WD"` = "patients with study drug withdrawn"+ |
+
24 | ++ |
+ #' * `"DSM"` = "patients with dose modified/interrupted"+ |
+
25 | ++ |
+ #' * `"CONTRT"` = "patients with treatment received"+ |
+
26 | ++ |
+ #' * Several `aesi_vars` can be added to the table at once:+ |
+
27 | ++ |
+ #' * `aesi_vars = "ALL"` will include all possible `aesi_vars`.+ |
+
28 | ++ |
+ #' * Including `"ALL_XXX"` in `aesi_vars` where `XXX` is one of the prefixes listed above will include all+ |
+
29 | ++ |
+ #' `aesi_vars` with that prefix.+ |
+
30 | ++ |
+ #'+ |
+
31 | ++ |
+ #' @export+ |
+
32 | ++ |
+ #'+ |
+
33 | ++ |
+ aet01_aesi_main <- function(adam_db,+ |
+
34 | ++ |
+ arm_var = "ACTARM",+ |
+
35 | ++ |
+ aesi_vars = NULL,+ |
+
36 | ++ |
+ grade_groups = NULL,+ |
+
37 | ++ |
+ lbl_overall = NULL,+ |
+
38 | ++ |
+ ...) {+ |
+
39 | +1x | +
+ assert_all_tablenames(adam_db, "adsl", "adae")+ |
+
40 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
41 | +1x | +
+ checkmate::assert_character(aesi_vars, null.ok = TRUE)+ |
+
42 | +1x | +
+ checkmate::assert_list(grade_groups, null.ok = TRUE)+ |
+
43 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
44 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var))+ |
+
45 | +1x | +
+ assert_valid_variable(adam_db$adae, c(arm_var))+ |
+
46 | +1x | +
+ assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE)+ |
+
47 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)+ |
+
48 | ++ | + + | +
49 | +1x | +
+ if (is.null(grade_groups)) {+ |
+
50 | +1x | +
+ grade_groups <- list(+ |
+
51 | +1x | +
+ "Grade 1" = "1",+ |
+
52 | +1x | +
+ "Grade 2" = "2",+ |
+
53 | +1x | +
+ "Grade 3" = "3",+ |
+
54 | +1x | +
+ "Grade 4" = "4",+ |
+
55 | +1x | +
+ "Grade 5 (fatal outcome)" = "5"+ |
+
56 | ++ |
+ )+ |
+
57 | ++ |
+ }+ |
+
58 | +1x | +
+ all_aesi_vars <- get_aesi_vars(aesi_vars)+ |
+
59 | +1x | +
+ assert_valid_variable(adam_db$adae, c(all_aesi_vars), empty_ok = TRUE, na_ok = TRUE, types = list("logical"))+ |
+
60 | +1x | +
+ lbl_aesi_vars <- var_labels_for(adam_db$adae, all_aesi_vars)+ |
+
61 | ++ | + + | +
62 | +1x | +
+ lyt <- aet01_aesi_lyt(+ |
+
63 | +1x | +
+ arm_var = arm_var,+ |
+
64 | +1x | +
+ aesi_vars = all_aesi_vars,+ |
+
65 | +1x | +
+ lbl_aesi_vars = lbl_aesi_vars,+ |
+
66 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
67 | +1x | +
+ grade_groups = grade_groups+ |
+
68 | ++ |
+ )+ |
+
69 | ++ | + + | +
70 | +1x | +
+ tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)+ |
+
71 | ++ | + + | +
72 | +1x | +
+ tbl+ |
+
73 | ++ |
+ }+ |
+
74 | ++ | + + | +
75 | ++ |
+ #' `aet01_aesi` Layout+ |
+
76 | ++ |
+ #'+ |
+
77 | ++ |
+ #' @inheritParams gen_args+ |
+
78 | ++ |
+ #' @param lbl_aesi_vars (`character`) the labels of the `AESI` variables to be summarized.+ |
+
79 | ++ |
+ #'+ |
+
80 | ++ |
+ #' @keywords internal+ |
+
81 | ++ |
+ #'+ |
+
82 | ++ |
+ aet01_aesi_lyt <- function(arm_var,+ |
+
83 | ++ |
+ aesi_vars,+ |
+
84 | ++ |
+ lbl_overall,+ |
+
85 | ++ |
+ lbl_aesi_vars,+ |
+
86 | ++ |
+ grade_groups) {+ |
+
87 | +5x | +
+ names(lbl_aesi_vars) <- aesi_vars+ |
+
88 | +5x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
89 | +5x | +
+ split_cols_by(var = arm_var) %>%+ |
+
90 | +5x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
91 | +5x | +
+ count_patients_with_event(+ |
+
92 | +5x | +
+ vars = "USUBJID",+ |
+
93 | +5x | +
+ filters = c("ANL01FL" = "Y"),+ |
+
94 | +5x | +
+ denom = "N_col",+ |
+
95 | +5x | +
+ .labels = c(count_fraction = render_safe("Total number of {patient_label} with at least one AE"))+ |
+
96 | ++ |
+ ) %>%+ |
+
97 | +5x | +
+ count_values(+ |
+
98 | +5x | +
+ "ANL01FL",+ |
+
99 | +5x | +
+ values = "Y",+ |
+
100 | +5x | +
+ .stats = "count",+ |
+
101 | +5x | +
+ .labels = c(count = "Total number of AEs"),+ |
+
102 | +5x | +
+ table_names = "total_aes"+ |
+
103 | ++ |
+ ) %>%+ |
+
104 | +5x | +
+ count_occurrences_by_grade(+ |
+
105 | +5x | +
+ var = "ATOXGR",+ |
+
106 | +5x | +
+ var_labels = render_safe("Total number of {patient_label} with at least one AE by worst grade"),+ |
+
107 | +5x | +
+ show_labels = "visible",+ |
+
108 | +5x | +
+ grade_groups = grade_groups+ |
+
109 | ++ |
+ ) %>%+ |
+
110 | +5x | +
+ count_patients_with_flags(+ |
+
111 | +5x | +
+ "USUBJID",+ |
+
112 | +5x | +
+ flag_variables = lbl_aesi_vars,+ |
+
113 | +5x | +
+ denom = "N_col"+ |
+
114 | ++ |
+ )+ |
+
115 | ++ |
+ }+ |
+
116 | ++ | + + | +
117 | ++ |
+ #' @describeIn aet01_aesi Preprocessing+ |
+
118 | ++ |
+ #'+ |
+
119 | ++ |
+ #' @inheritParams aet01_aesi_main+ |
+
120 | ++ |
+ #'+ |
+
121 | ++ |
+ #' @export+ |
+
122 | ++ |
+ #'+ |
+
123 | ++ |
+ aet01_aesi_pre <- function(adam_db,+ |
+
124 | ++ |
+ ...) {+ |
+
125 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", "adae"))+ |
+
126 | ++ | + + | +
127 | +1x | +
+ adam_db$adae <- adam_db$adae %>%+ |
+
128 | +1x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
129 | +1x | +
+ mutate(+ |
+
130 | +1x | +
+ NOT_RESOLVED = with_label(+ |
+
131 | +1x | +
+ .data$AEOUT %in% c("NOT RECOVERED/NOT RESOLVED", "RECOVERING/RESOLVING", "UNKNOWN"),+ |
+
132 | +1x | +
+ "Total number of {patient_label} with at least one unresolved or ongoing non-fatal AE"+ |
+
133 | ++ |
+ ),+ |
+
134 | +1x | +
+ ALL_RESOLVED = with_label(+ |
+
135 | +1x | +
+ !.data$AEOUT %in% "FATAL" & !.data$NOT_RESOLVED,+ |
+
136 | +1x | +
+ "Total number of {patient_label} with all non-fatal AEs resolved"+ |
+
137 | ++ |
+ ),+ |
+
138 | +1x | +
+ WD = with_label(+ |
+
139 | +1x | +
+ .data$AEACN %in% "DRUG WITHDRAWN", "Total number of {patient_label} with study drug withdrawn due to AE"+ |
+
140 | ++ |
+ ),+ |
+
141 | +1x | +
+ DSM = with_label(+ |
+
142 | +1x | +
+ .data$AEACN %in% c("DRUG INTERRUPTED", "DOSE INCREASED", "DOSE REDUCED"),+ |
+
143 | +1x | +
+ "Total number of {patient_label} with dose modified/interrupted due to AE"+ |
+
144 | ++ |
+ ),+ |
+
145 | +1x | +
+ CONTRT = with_label(+ |
+
146 | +1x | +
+ .data$AECONTRT %in% "Y", "Total number of {patient_label} with treatment received for AE"+ |
+
147 | ++ |
+ ),+ |
+
148 | +1x | +
+ SER = with_label(+ |
+
149 | +1x | +
+ .data$AESER %in% "Y", "Total number of {patient_label} with at least one serious AE"+ |
+
150 | ++ |
+ ),+ |
+
151 | +1x | +
+ REL = with_label(+ |
+
152 | +1x | +
+ .data$AREL %in% "Y", "Total number of {patient_label} with at least one related AE"+ |
+
153 | ++ |
+ ),+ |
+
154 | +1x | +
+ ALLRESWD = with_label(+ |
+
155 | +1x | +
+ .data$WD & .data$ALL_RESOLVED, " No. of {patient_label} with study drug withdrawn due to resolved AE"+ |
+
156 | ++ |
+ ),+ |
+
157 | +1x | +
+ ALLRESDSM = with_label(+ |
+
158 | +1x | +
+ .data$DSM & .data$ALL_RESOLVED, " No. of {patient_label} with dose modified/interrupted due to resolved AE"+ |
+
159 | ++ |
+ ),+ |
+
160 | +1x | +
+ ALLRESCONTRT = with_label(+ |
+
161 | +1x | +
+ .data$CONTRT & .data$ALL_RESOLVED, " No. of {patient_label} with treatment received for resolved AE"+ |
+
162 | ++ |
+ ),+ |
+
163 | +1x | +
+ NOTRESWD = with_label(+ |
+
164 | +1x | +
+ .data$WD & .data$NOT_RESOLVED,+ |
+
165 | +1x | +
+ " No. of {patient_label} with study drug withdrawn due to unresolved or ongoing AE"+ |
+
166 | ++ |
+ ),+ |
+
167 | +1x | +
+ NOTRESDSM = with_label(+ |
+
168 | +1x | +
+ .data$DSM & .data$NOT_RESOLVED,+ |
+
169 | +1x | +
+ " No. of {patient_label} with dose modified/interrupted due to unresolved or ongoing AE"+ |
+
170 | ++ |
+ ),+ |
+
171 | +1x | +
+ NOTRESCONTRT = with_label(+ |
+
172 | +1x | +
+ .data$CONTRT & .data$NOT_RESOLVED,+ |
+
173 | +1x | +
+ " No. of {patient_label} with treatment received for unresolved/ongoing AE"+ |
+
174 | ++ |
+ ),+ |
+
175 | +1x | +
+ SERWD = with_label(+ |
+
176 | +1x | +
+ .data$SER & .data$WD, " No. of {patient_label} with study drug withdrawn due to serious AE"+ |
+
177 | ++ |
+ ),+ |
+
178 | +1x | +
+ SERDSM = with_label(+ |
+
179 | +1x | +
+ .data$SER & .data$DSM, " No. of {patient_label} with dose modified/interrupted due to serious AE"+ |
+
180 | ++ |
+ ),+ |
+
181 | +1x | +
+ SERCONTRT = with_label(+ |
+
182 | +1x | +
+ .data$SER & .data$CONTRT, " No. of {patient_label} with treatment received for serious AE"+ |
+
183 | ++ |
+ ),+ |
+
184 | +1x | +
+ RELWD = with_label(+ |
+
185 | +1x | +
+ .data$REL & .data$WD, " No. of {patient_label} with study drug withdrawn due to related AE"+ |
+
186 | ++ |
+ ),+ |
+
187 | +1x | +
+ RELDSM = with_label(+ |
+
188 | +1x | +
+ .data$REL & .data$DSM, " No. of {patient_label} with dose modified/interrupted due to related AE"+ |
+
189 | ++ |
+ ),+ |
+
190 | +1x | +
+ RELCONTRT = with_label(+ |
+
191 | +1x | +
+ .data$REL & .data$CONTRT, " No. of {patient_label} with treatment received for related AE"+ |
+
192 | ++ |
+ ),+ |
+
193 | +1x | +
+ RELSER = with_label(+ |
+
194 | +1x | +
+ .data$REL & .data$SER, " No. of {patient_label} with serious, related AE"+ |
+
195 | ++ |
+ )+ |
+
196 | ++ |
+ ) %>%+ |
+
197 | +1x | +
+ mutate(+ |
+
198 | +1x | +
+ ATOXGR = factor(.data$ATOXGR, levels = 1:5)+ |
+
199 | ++ |
+ )+ |
+
200 | ++ | + + | +
201 | +1x | +
+ adam_db+ |
+
202 | ++ |
+ }+ |
+
203 | ++ | + + | +
204 | ++ |
+ #' @describeIn aet01_aesi Postprocessing+ |
+
205 | ++ |
+ #'+ |
+
206 | ++ |
+ #' @inheritParams gen_args+ |
+
207 | ++ |
+ #'+ |
+
208 | ++ |
+ #' @export+ |
+
209 | ++ |
+ aet01_aesi_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
210 | +1x | +
+ if (prune_0) {+ |
+
211 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
212 | ++ |
+ }+ |
+
213 | +1x | +
+ std_postprocess(tlg)+ |
+
214 | ++ |
+ }+ |
+
215 | ++ | + + | +
216 | ++ |
+ #' `AET01_AESI` Table 1 (Default) Adverse Event of Special Interest Summary Table.+ |
+
217 | ++ |
+ #'+ |
+
218 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
219 | ++ |
+ #' @export+ |
+
220 | ++ |
+ #'+ |
+
221 | ++ |
+ #' @examples+ |
+
222 | ++ |
+ #' run(aet01_aesi, syn_data)+ |
+
223 | ++ |
+ aet01_aesi <- chevron_t(+ |
+
224 | ++ |
+ main = aet01_aesi_main,+ |
+
225 | ++ |
+ preprocess = aet01_aesi_pre,+ |
+
226 | ++ |
+ postprocess = aet01_aesi_post+ |
+
227 | ++ |
+ )+ |
+
228 | ++ | + + | +
229 | ++ |
+ #' @keywords internal+ |
+
230 | ++ |
+ get_aesi_vars <- function(aesi_vars) {+ |
+
231 | +1x | +
+ if ("ALL" %in% aesi_vars) aesi_vars <- c("ALL_ALLRES", "ALL_NOTRES", "ALL_SER", "ALL_REL")+ |
+
232 | +5x | +
+ if (any(grepl("^ALL_", aesi_vars))) {+ |
+
233 | +1x | +
+ aesi <- c(grep("^ALL_", aesi_vars, value = TRUE, invert = TRUE), sapply(+ |
+
234 | +1x | +
+ c("WD", "DSM", "CONTRT"),+ |
+
235 | +1x | +
+ function(x) sub("^(ALL_)(.*)", paste0("\\2", x), grep("^ALL_", aesi_vars, value = TRUE))+ |
+
236 | ++ |
+ ))+ |
+
237 | +1x | +
+ if ("ALL_REL" %in% aesi_vars) aesi <- c(aesi, "RELSER")+ |
+
238 | ++ |
+ } else {+ |
+
239 | +4x | +
+ aesi <- aesi_vars+ |
+
240 | ++ |
+ }+ |
+
241 | +5x | +
+ all_aesi_vars <- c(+ |
+
242 | +5x | +
+ "WD", "DSM", "CONTRT", "ALL_RESOLVED", grep("^ALLRES", aesi, value = TRUE),+ |
+
243 | +5x | +
+ "NOT_RESOLVED", grep("^NOTRES", aesi, value = TRUE), "SER", grep("^SER", aesi, value = TRUE),+ |
+
244 | +5x | +
+ "REL", grep("^REL", aesi, value = TRUE)+ |
+
245 | ++ |
+ )+ |
+
246 | +5x | +
+ return(all_aesi_vars)+ |
+
247 | ++ |
+ }+ |
+
1 | ++ |
+ # egt03 ----+ |
+
2 | ++ |
+ #' @describeIn egt03 Main TLG function+ |
+
3 | ++ |
+ #'+ |
+
4 | ++ |
+ #' @param arm_var (`character`) the arm variables used for row split, typically `"ACTARMCD"`.+ |
+
5 | ++ |
+ #' @param summaryvar (`character`) variables to be analyzed, typically `"BNRIND"`. Labels of the corresponding columns+ |
+
6 | ++ |
+ #' are used as subtitles.+ |
+
7 | ++ |
+ #' @param splitvar (`character`) variables to be analyzed, typically `"ANRIND"`. Labels of the corresponding columns are+ |
+
8 | ++ |
+ #' used as subtitles.+ |
+
9 | ++ |
+ #'+ |
+
10 | ++ |
+ #' @details+ |
+
11 | ++ |
+ #' * `ADEG` data are subsetted to contain only "POST-BASELINE MINIMUM" visit+ |
+
12 | ++ |
+ #' * the number of patients by baseline assessment and minimum post-baseline assessment.+ |
+
13 | ++ |
+ #' * Percentages are based on the total number of patients in a treatment group.+ |
+
14 | ++ |
+ #' * Split columns by Analysis Reference Range Indicator, typically `ANRIND`.+ |
+
15 | ++ |
+ #' * Does not include a total column by default.+ |
+
16 | ++ |
+ #' * Sorted based on factor level.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @note+ |
+
19 | ++ |
+ #' * `adam_db` object must contain an `adeg` table with a `"ACTARMCD"` column as well as columns specified in+ |
+
20 | ++ |
+ #' `summaryvar` and `splitvar`.+ |
+
21 | ++ |
+ #'+ |
+
22 | ++ |
+ #' @export+ |
+
23 | ++ |
+ #'+ |
+
24 | ++ |
+ egt03_main <- function(adam_db,+ |
+
25 | ++ |
+ arm_var = "ACTARMCD",+ |
+
26 | ++ |
+ summaryvar = "BNRIND",+ |
+
27 | ++ |
+ splitvar = "ANRIND",+ |
+
28 | ++ |
+ visitvar = "AVISIT",+ |
+
29 | ++ |
+ ...) {+ |
+
30 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", "adeg"))+ |
+
31 | +1x | +
+ checkmate::assert_string(summaryvar)+ |
+
32 | +1x | +
+ assert_valid_variable(adam_db$adeg, summaryvar, types = list("character", "factor"))+ |
+
33 | +1x | +
+ checkmate::assert_string(splitvar)+ |
+
34 | +1x | +
+ assert_valid_variable(adam_db$adeg, c("PARAMCD", splitvar), types = list("character", "factor"))+ |
+
35 | +1x | +
+ assert_single_value(adam_db$adeg[[visitvar]])+ |
+
36 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)+ |
+
37 | +1x | +
+ assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
38 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
39 | +1x | +
+ assert_single_value(adam_db$adeg$PARAMCD)+ |
+
40 | +1x | +
+ lbl_armvar <- var_labels_for(adam_db$adeg, arm_var)+ |
+
41 | +1x | +
+ lbl_summaryvars <- var_labels_for(adam_db$adeg, summaryvar)+ |
+
42 | +1x | +
+ lbl_splitvar <- var_labels_for(adam_db$adeg, splitvar)+ |
+
43 | ++ | + + | +
44 | +1x | +
+ lyt <- egt03_lyt(+ |
+
45 | +1x | +
+ arm_var = arm_var,+ |
+
46 | +1x | +
+ splitvar = splitvar,+ |
+
47 | +1x | +
+ summaryvar = summaryvar,+ |
+
48 | +1x | +
+ lbl_armvar = lbl_armvar,+ |
+
49 | +1x | +
+ lbl_summaryvars = lbl_summaryvars+ |
+
50 | ++ |
+ )+ |
+
51 | +1x | +
+ adam_db$adeg$SPLIT_LABEL <- factor(rep(lbl_splitvar, nrow(adam_db$adeg)), levels = lbl_splitvar)+ |
+
52 | +1x | +
+ tbl <- build_table(+ |
+
53 | +1x | +
+ lyt,+ |
+
54 | +1x | +
+ df = adam_db$adeg+ |
+
55 | ++ |
+ )+ |
+
56 | ++ | + + | +
57 | +1x | +
+ return(tbl)+ |
+
58 | ++ |
+ }+ |
+
59 | ++ | + + | +
60 | ++ | + + | +
61 | ++ |
+ #' `egt03` Layout+ |
+
62 | ++ |
+ #'+ |
+
63 | ++ |
+ #' @inheritParams gen_args+ |
+
64 | ++ |
+ #' @inheritParams egt03_main+ |
+
65 | ++ |
+ #'+ |
+
66 | ++ |
+ #' @param lbl_armvar (`string`) label of the `arm_var` variable.+ |
+
67 | ++ |
+ #' @param lbl_summaryvars (`string`) label of the `summaryvar` variable.+ |
+
68 | ++ |
+ #'+ |
+
69 | ++ |
+ #' @keywords internal+ |
+
70 | ++ |
+ egt03_lyt <- function(arm_var,+ |
+
71 | ++ |
+ splitvar,+ |
+
72 | ++ |
+ summaryvar,+ |
+
73 | ++ |
+ lbl_armvar,+ |
+
74 | ++ |
+ lbl_summaryvars) {+ |
+
75 | +4x | +
+ indent <- 1L+ |
+
76 | +4x | +
+ space <- paste(rep(" ", indent * 2), collapse = "")+ |
+
77 | +4x | +
+ lbl_summaryvars <- paste0(space, lbl_summaryvars)+ |
+
78 | ++ | + + | +
79 | +4x | +
+ basic_table(show_colcounts = FALSE) %>%+ |
+
80 | +4x | +
+ split_cols_by("SPLIT_LABEL") %>%+ |
+
81 | +4x | +
+ split_cols_by(splitvar) %>%+ |
+
82 | +4x | +
+ split_rows_by(arm_var,+ |
+
83 | +4x | +
+ split_fun = drop_split_levels,+ |
+
84 | +4x | +
+ label_pos = "topleft",+ |
+
85 | +4x | +
+ split_label = lbl_armvar+ |
+
86 | ++ |
+ ) %>%+ |
+
87 | +4x | +
+ add_rowcounts() %>%+ |
+
88 | +4x | +
+ summarize_vars(summaryvar, denom = "N_row", .stats = "count_fraction") %>%+ |
+
89 | +4x | +
+ append_topleft(lbl_summaryvars)+ |
+
90 | ++ |
+ }+ |
+
91 | ++ | + + | +
92 | ++ |
+ #' @describeIn egt03 Preprocessing+ |
+
93 | ++ |
+ #'+ |
+
94 | ++ |
+ #' @inheritParams gen_args+ |
+
95 | ++ |
+ #' @inheritParams egt03_main+ |
+
96 | ++ |
+ #'+ |
+
97 | ++ |
+ #' @export+ |
+
98 | ++ |
+ egt03_pre <- function(adam_db, ...) {+ |
+
99 | +1x | +
+ adam_db$adeg <- adam_db$adeg %>%+ |
+
100 | +1x | +
+ filter(+ |
+
101 | +1x | +
+ .data$AVISIT == "POST-BASELINE MINIMUM"+ |
+
102 | ++ |
+ ) %>%+ |
+
103 | +1x | +
+ mutate(BNRIND = factor(+ |
+
104 | +1x | +
+ .data$BNRIND,+ |
+
105 | +1x | +
+ levels = c("LOW", "NORMAL", "HIGH", "Missing"),+ |
+
106 | +1x | +
+ labels = c("LOW", "NORMAL", "HIGH", "Missing")+ |
+
107 | ++ |
+ )) %>%+ |
+
108 | +1x | +
+ mutate(ANRIND = factor(+ |
+
109 | +1x | +
+ .data$ANRIND,+ |
+
110 | +1x | +
+ levels = c("LOW", "NORMAL", "HIGH", "Missing"),+ |
+
111 | +1x | +
+ labels = c("LOW", "NORMAL", "HIGH", "Missing")+ |
+
112 | ++ |
+ )) %>%+ |
+
113 | +1x | +
+ mutate(+ |
+
114 | +1x | +
+ BNRIND = with_label(.data$BNRIND, "Baseline Reference Range Indicator"),+ |
+
115 | +1x | +
+ ANRIND = with_label(.data$ANRIND, "Minimum Post-Baseline Assessment")+ |
+
116 | ++ |
+ )+ |
+
117 | ++ | + + | +
118 | +1x | +
+ adam_db+ |
+
119 | ++ |
+ }+ |
+
120 | ++ | + + | +
121 | ++ |
+ #' @describeIn egt03 Postprocessing+ |
+
122 | ++ |
+ #'+ |
+
123 | ++ |
+ #' @inheritParams gen_args+ |
+
124 | ++ |
+ #'+ |
+
125 | ++ |
+ #' @export+ |
+
126 | ++ |
+ egt03_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
127 | +! | +
+ if (prune_0) tlg <- smart_prune(tlg)+ |
+
128 | ++ | + + | +
129 | +1x | +
+ std_postprocess(tlg)+ |
+
130 | ++ |
+ }+ |
+
131 | ++ | + + | +
132 | ++ |
+ #' `EGT03` Shift Table of ECG Interval Data - Baseline versus Minimum or Maximum Post-Baseline+ |
+
133 | ++ |
+ #'+ |
+
134 | ++ |
+ #' The `EGT03` Table entries provide the number of patients by baseline assessment and minimum or maximum post-baseline+ |
+
135 | ++ |
+ #' assessment. Percentages are based on the total number of patients in a treatment group. Baseline is the patient's+ |
+
136 | ++ |
+ #' last observation prior to initiation of study drug.+ |
+
137 | ++ |
+ #'+ |
+
138 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
139 | ++ |
+ #' @export+ |
+
140 | ++ |
+ #'+ |
+
141 | ++ |
+ #' @examples+ |
+
142 | ++ |
+ #' library(dunlin)+ |
+
143 | ++ |
+ #' proc_data <- log_filter(syn_data, PARAMCD == "HR", "adeg")+ |
+
144 | ++ |
+ #' run(egt03, proc_data)+ |
+
145 | ++ |
+ egt03 <- chevron_t(+ |
+
146 | ++ |
+ main = egt03_main,+ |
+
147 | ++ |
+ preprocess = egt03_pre,+ |
+
148 | ++ |
+ postprocess = egt03_post+ |
+
149 | ++ |
+ )+ |
+
1 | ++ |
+ # pdt02 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn pdt02 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param dvreas_var (`string`) the variable defining the reason for deviation. By default `DVREAS`.+ |
+
7 | ++ |
+ #' @param dvterm_var (`string`) the variable defining the protocol deviation term. By default `DVTERM`.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' * Data should be filtered for major protocol deviations related to epidemic/pandemic.+ |
+
11 | ++ |
+ #' `(AEPRELFL == "Y" & DVCAT == "MAJOR")`.+ |
+
12 | ++ |
+ #' * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.+ |
+
13 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
14 | ++ |
+ #' * Split columns by arm.+ |
+
15 | ++ |
+ #' * Does not include a total column by default.+ |
+
16 | ++ |
+ #' * Sort by deviation reason alphabetically and within deviation reason by decreasing total number of patients with+ |
+
17 | ++ |
+ #' the specific deviation term.+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ #' @note+ |
+
20 | ++ |
+ #' * `adam_db` object must contain an `addv` table with the columns specified in `dvreas_var` and `dvterm_var`.+ |
+
21 | ++ |
+ #'+ |
+
22 | ++ |
+ #' @export+ |
+
23 | ++ |
+ #'+ |
+
24 | ++ |
+ pdt02_main <- function(adam_db,+ |
+
25 | ++ |
+ arm_var = "ARM",+ |
+
26 | ++ |
+ dvreas_var = "DVREAS",+ |
+
27 | ++ |
+ dvterm_var = "DVTERM",+ |
+
28 | ++ |
+ lbl_overall = NULL,+ |
+
29 | ++ |
+ ...) {+ |
+
30 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", "addv"))+ |
+
31 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
32 | +1x | +
+ checkmate::assert_string(dvreas_var)+ |
+
33 | +1x | +
+ checkmate::assert_string(dvterm_var)+ |
+
34 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
35 | +1x | +
+ assert_valid_variable(adam_db$addv, c(dvreas_var, dvterm_var), types = list(c("character", "factor")))+ |
+
36 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
37 | +1x | +
+ assert_valid_variable(adam_db$addv, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
38 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$addv, arm_var)+ |
+
39 | ++ | + + | +
40 | +1x | +
+ lbl_dvreas_var <- var_labels_for(adam_db$addv, dvreas_var)+ |
+
41 | +1x | +
+ lbl_dvterm_var <- var_labels_for(adam_db$addv, dvterm_var)+ |
+
42 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
43 | +1x | +
+ lyt <- pdt02_lyt(+ |
+
44 | +1x | +
+ arm_var = arm_var,+ |
+
45 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
46 | +1x | +
+ dvreas_var = dvreas_var,+ |
+
47 | +1x | +
+ lbl_dvreas_var = lbl_dvreas_var,+ |
+
48 | +1x | +
+ dvterm_var = dvterm_var,+ |
+
49 | +1x | +
+ lbl_dvterm_var = lbl_dvterm_var+ |
+
50 | ++ |
+ )+ |
+
51 | ++ | + + | +
52 | +1x | +
+ tbl <- build_table(lyt, adam_db$addv, alt_counts_df = adam_db$adsl)+ |
+
53 | ++ | + + | +
54 | +1x | +
+ tbl+ |
+
55 | ++ |
+ }+ |
+
56 | ++ | + + | +
57 | ++ |
+ #' `pdt02` Layout+ |
+
58 | ++ |
+ #'+ |
+
59 | ++ |
+ #' @inheritParams gen_args+ |
+
60 | ++ |
+ #' @inheritParams pdt02_main+ |
+
61 | ++ |
+ #' @param lbl_dvreas_var (`string`) label for the variable defining the reason for deviation.+ |
+
62 | ++ |
+ #' @param lbl_dvterm_var (`string`) label for the variable defining the protocol deviation term.+ |
+
63 | ++ |
+ #'+ |
+
64 | ++ |
+ #' @keywords internal+ |
+
65 | ++ |
+ #'+ |
+
66 | ++ |
+ pdt02_lyt <- function(arm_var,+ |
+
67 | ++ |
+ lbl_overall,+ |
+
68 | ++ |
+ dvreas_var,+ |
+
69 | ++ |
+ lbl_dvreas_var,+ |
+
70 | ++ |
+ dvterm_var,+ |
+
71 | ++ |
+ lbl_dvterm_var) {+ |
+
72 | +3x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
73 | +3x | +
+ split_cols_by(var = arm_var) %>%+ |
+
74 | +3x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
75 | +3x | +
+ analyze_num_patients(+ |
+
76 | +3x | +
+ vars = "USUBJID",+ |
+
77 | +3x | +
+ .stats = c("unique", "nonunique"),+ |
+
78 | +3x | +
+ .labels = c(+ |
+
79 | +3x | +
+ unique = render_safe(+ |
+
80 | +3x | +
+ "Total number of {patient_label} with at least one major protocol deviation related to epidemic/pandemic"+ |
+
81 | ++ |
+ ),+ |
+
82 | +3x | +
+ nonunique = "Total number of major protocol deviations related to epidemic/pandemic"+ |
+
83 | ++ |
+ )+ |
+
84 | ++ |
+ ) %>%+ |
+
85 | +3x | +
+ split_rows_by(+ |
+
86 | +3x | +
+ dvreas_var,+ |
+
87 | +3x | +
+ nested = FALSE,+ |
+
88 | +3x | +
+ split_fun = drop_split_levels,+ |
+
89 | +3x | +
+ label_pos = "topleft",+ |
+
90 | +3x | +
+ split_label = lbl_dvreas_var+ |
+
91 | ++ |
+ ) %>%+ |
+
92 | +3x | +
+ summarize_num_patients(+ |
+
93 | +3x | +
+ var = "USUBJID",+ |
+
94 | +3x | +
+ .stats = "unique",+ |
+
95 | +3x | +
+ .labels = NULL+ |
+
96 | ++ |
+ ) %>%+ |
+
97 | +3x | +
+ count_occurrences(+ |
+
98 | +3x | +
+ vars = dvterm_var,+ |
+
99 | +3x | +
+ id = "USUBJID"+ |
+
100 | ++ |
+ ) %>%+ |
+
101 | +3x | +
+ append_topleft(paste(" ", lbl_dvterm_var))+ |
+
102 | ++ |
+ }+ |
+
103 | ++ | + + | +
104 | ++ |
+ #' @describeIn pdt02 Preprocessing+ |
+
105 | ++ |
+ #'+ |
+
106 | ++ |
+ #' @inheritParams pdt02_main+ |
+
107 | ++ |
+ #'+ |
+
108 | ++ |
+ #' @export+ |
+
109 | ++ |
+ #'+ |
+
110 | ++ |
+ pdt02_pre <- function(adam_db,+ |
+
111 | ++ |
+ ...) {+ |
+
112 | +1x | +
+ adam_db$addv <- adam_db$addv %>%+ |
+
113 | +1x | +
+ mutate(across(all_of(c("DVCAT", "AEPRELFL")), ~ reformat(.x, missing_rule))) %>%+ |
+
114 | +1x | +
+ filter(.data$DVCAT == "MAJOR" & .data$AEPRELFL == "Y") %>%+ |
+
115 | +1x | +
+ mutate(across(all_of(c("DVREAS", "DVTERM")), ~ reformat(.x, nocoding))) %>%+ |
+
116 | +1x | +
+ mutate(+ |
+
117 | +1x | +
+ DVREAS = with_label(.data$DVREAS, "Primary Reason"),+ |
+
118 | +1x | +
+ DVTERM = with_label(.data$DVTERM, "Description")+ |
+
119 | ++ |
+ )+ |
+
120 | ++ | + + | +
121 | +1x | +
+ adam_db+ |
+
122 | ++ |
+ }+ |
+
123 | ++ | + + | +
124 | ++ |
+ #' @describeIn pdt02 Postprocessing+ |
+
125 | ++ |
+ #'+ |
+
126 | ++ |
+ #' @inheritParams pdt02_main+ |
+
127 | ++ |
+ #' @inheritParams gen_args+ |
+
128 | ++ |
+ #'+ |
+
129 | ++ |
+ #' @export+ |
+
130 | ++ |
+ #'+ |
+
131 | ++ |
+ pdt02_post <- function(tlg, prune_0 = TRUE, dvreas_var = "DVREAS", dvterm_var = "DVTERM", ...) {+ |
+
132 | +1x | +
+ if (prune_0) {+ |
+
133 | +1x | +
+ tlg <- smart_prune(tlg)+ |
+
134 | ++ |
+ }+ |
+
135 | ++ | + + | +
136 | +1x | +
+ tbl_sorted <- tlg %>%+ |
+
137 | +1x | +
+ sort_at_path(+ |
+
138 | +1x | +
+ path = c(dvreas_var, "*", dvterm_var),+ |
+
139 | +1x | +
+ scorefun = score_occurrences+ |
+
140 | ++ |
+ )+ |
+
141 | ++ | + + | +
142 | +1x | +
+ std_postprocess(tbl_sorted)+ |
+
143 | ++ |
+ }+ |
+
144 | ++ | + + | +
145 | ++ |
+ #' `pdt02` Major Protocol Deviations Related to Epidemic/Pandemic Table.+ |
+
146 | ++ |
+ #'+ |
+
147 | ++ |
+ #' A major protocol deviations+ |
+
148 | ++ |
+ #' table with the number of subjects and the total number of Major Protocol Deviations Related+ |
+
149 | ++ |
+ #' to Epidemic/Pandemic sorted alphabetically and deviations name sorted by frequencies.+ |
+
150 | ++ |
+ #'+ |
+
151 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
152 | ++ |
+ #' @export+ |
+
153 | ++ |
+ #'+ |
+
154 | ++ |
+ #' @examples+ |
+
155 | ++ |
+ #' run(pdt02, syn_data)+ |
+
156 | ++ |
+ pdt02 <- chevron_t(+ |
+
157 | ++ |
+ main = pdt02_main,+ |
+
158 | ++ |
+ lyt = pdt02_lyt,+ |
+
159 | ++ |
+ preprocess = pdt02_pre,+ |
+
160 | ++ |
+ postprocess = pdt02_post+ |
+
161 | ++ |
+ )+ |
+
1 | ++ |
+ # mht01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn mht01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' @details+ |
+
8 | ++ |
+ #' * Numbers represent absolute numbers of patients and fraction of `N`, or absolute number of event when specified.+ |
+
9 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
10 | ++ |
+ #' * Split columns by arm.+ |
+
11 | ++ |
+ #' * Does not include a total column by default.+ |
+
12 | ++ |
+ #' * Order by body system alphabetically and within body system and medical condition by decreasing total number of+ |
+
13 | ++ |
+ #' patients with the specific condition.+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @note+ |
+
16 | ++ |
+ #' * `adam_db` object must contain an `admh` table with columns `"MHBODSYS"` and `"MHDECOD"`.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @export+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ mht01_main <- function(adam_db,+ |
+
21 | ++ |
+ arm_var = "ARM",+ |
+
22 | ++ |
+ lbl_overall = NULL,+ |
+
23 | ++ |
+ ...) {+ |
+
24 | +1x | +
+ assert_all_tablenames(adam_db, c("admh", "adsl"))+ |
+
25 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
26 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
27 | +1x | +
+ assert_valid_variable(adam_db$admh, c("MHBODSYS", "MHDECOD"), types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
28 | +1x | +
+ assert_valid_variable(adam_db$admh, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
29 | +1x | +
+ assert_valid_variable(adam_db$adsl, "USUBJID", types = list(c("character", "factor")))+ |
+
30 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$admh, arm_var)+ |
+
31 | ++ | + + | +
32 | +1x | +
+ lbl_mhbodsys <- var_labels_for(adam_db$admh, "MHBODSYS")+ |
+
33 | +1x | +
+ lbl_mhdecod <- var_labels_for(adam_db$admh, "MHDECOD")+ |
+
34 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
35 | +1x | +
+ lyt <- mht01_lyt(+ |
+
36 | +1x | +
+ arm_var = arm_var,+ |
+
37 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
38 | +1x | +
+ lbl_mhbodsys = lbl_mhbodsys,+ |
+
39 | +1x | +
+ lbl_mhdecod = lbl_mhdecod+ |
+
40 | ++ |
+ )+ |
+
41 | ++ | + + | +
42 | +1x | +
+ tbl <- build_table(lyt, adam_db$admh, alt_counts_df = adam_db$adsl)+ |
+
43 | ++ | + + | +
44 | +1x | +
+ tbl+ |
+
45 | ++ |
+ }+ |
+
46 | ++ | + + | +
47 | ++ |
+ #' `mht01` Layout+ |
+
48 | ++ |
+ #'+ |
+
49 | ++ |
+ #' @inheritParams gen_args+ |
+
50 | ++ |
+ #' @inheritParams mht01_main+ |
+
51 | ++ |
+ #' @param lbl_mhbodsys (`string`) label associated with `"MHBODSYS"`.+ |
+
52 | ++ |
+ #' @param lbl_mhdecod (`string`) label associated with `"MHDECOD"`.+ |
+
53 | ++ |
+ #'+ |
+
54 | ++ |
+ #' @keywords internal+ |
+
55 | ++ |
+ #'+ |
+
56 | ++ |
+ mht01_lyt <- function(arm_var,+ |
+
57 | ++ |
+ lbl_overall,+ |
+
58 | ++ |
+ lbl_mhbodsys,+ |
+
59 | ++ |
+ lbl_mhdecod) {+ |
+
60 | +4x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
61 | +4x | +
+ split_cols_by(var = arm_var) %>%+ |
+
62 | +4x | +
+ add_colcounts() %>%+ |
+
63 | +4x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
64 | +4x | +
+ summarize_num_patients(+ |
+
65 | +4x | +
+ var = "USUBJID",+ |
+
66 | +4x | +
+ .stats = c("unique", "nonunique"),+ |
+
67 | +4x | +
+ .labels = c(+ |
+
68 | +4x | +
+ unique = render_safe("Total number of {patient_label} with at least one condition"),+ |
+
69 | +4x | +
+ nonunique = render_safe("Total number of conditions")+ |
+
70 | ++ |
+ )+ |
+
71 | ++ |
+ ) %>%+ |
+
72 | +4x | +
+ split_rows_by(+ |
+
73 | +4x | +
+ "MHBODSYS",+ |
+
74 | +4x | +
+ child_labels = "visible",+ |
+
75 | +4x | +
+ labels_var = "MHBODSYS",+ |
+
76 | +4x | +
+ nested = FALSE,+ |
+
77 | +4x | +
+ indent_mod = -1L,+ |
+
78 | +4x | +
+ split_fun = drop_split_levels,+ |
+
79 | +4x | +
+ label_pos = "topleft",+ |
+
80 | +4x | +
+ split_label = lbl_mhbodsys+ |
+
81 | ++ |
+ ) %>%+ |
+
82 | +4x | +
+ summarize_num_patients(+ |
+
83 | +4x | +
+ var = "USUBJID",+ |
+
84 | +4x | +
+ .stats = c("unique", "nonunique"),+ |
+
85 | +4x | +
+ .labels = c(+ |
+
86 | +4x | +
+ unique = render_safe("Total number of {patient_label} with at least one condition"),+ |
+
87 | +4x | +
+ nonunique = "Total number of conditions"+ |
+
88 | ++ |
+ )+ |
+
89 | ++ |
+ ) %>%+ |
+
90 | +4x | +
+ count_occurrences(+ |
+
91 | +4x | +
+ vars = "MHDECOD",+ |
+
92 | +4x | +
+ .indent_mods = -1L+ |
+
93 | ++ |
+ ) %>%+ |
+
94 | +4x | +
+ append_topleft(paste0(" ", lbl_mhdecod))+ |
+
95 | ++ |
+ }+ |
+
96 | ++ | + + | +
97 | ++ |
+ #' @describeIn mht01 Preprocessing+ |
+
98 | ++ |
+ #'+ |
+
99 | ++ |
+ #' @inheritParams gen_args+ |
+
100 | ++ |
+ #'+ |
+
101 | ++ |
+ #' @export+ |
+
102 | ++ |
+ #'+ |
+
103 | ++ |
+ mht01_pre <- function(adam_db, ...) {+ |
+
104 | +1x | +
+ adam_db$admh <- adam_db$admh %>%+ |
+
105 | +1x | +
+ filter(.data$ANL01FL == "Y")+ |
+
106 | ++ | + + | +
107 | +1x | +
+ adam_db$admh <- adam_db$admh %>%+ |
+
108 | +1x | +
+ mutate(+ |
+
109 | +1x | +
+ across(all_of(c("MHBODSYS", "MHDECOD")), ~ reformat(.x, nocoding))+ |
+
110 | ++ |
+ ) %>%+ |
+
111 | +1x | +
+ mutate(+ |
+
112 | +1x | +
+ MHBODSYS = with_label(.data$MHBODSYS, "MedDRA System Organ Class"),+ |
+
113 | +1x | +
+ MHDECOD = with_label(.data$MHDECOD, "MedDRA Preferred Term")+ |
+
114 | ++ |
+ )+ |
+
115 | ++ | + + | +
116 | +1x | +
+ adam_db+ |
+
117 | ++ |
+ }+ |
+
118 | ++ | + + | +
119 | ++ |
+ #' @describeIn mht01 Postprocessing+ |
+
120 | ++ |
+ #'+ |
+
121 | ++ |
+ #' @inheritParams gen_args+ |
+
122 | ++ |
+ #'+ |
+
123 | ++ |
+ #' @export+ |
+
124 | ++ |
+ #'+ |
+
125 | ++ |
+ mht01_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
126 | +1x | +
+ if (prune_0) {+ |
+
127 | +1x | +
+ tlg <- smart_prune(tlg)+ |
+
128 | ++ |
+ }+ |
+
129 | ++ | + + | +
130 | +1x | +
+ tbl_sorted <- tlg %>%+ |
+
131 | +1x | +
+ sort_at_path(+ |
+
132 | +1x | +
+ path = c("MHBODSYS", "*", "MHDECOD"),+ |
+
133 | +1x | +
+ scorefun = score_occurrences+ |
+
134 | ++ |
+ )+ |
+
135 | ++ | + + | +
136 | +1x | +
+ std_postprocess(tbl_sorted)+ |
+
137 | ++ |
+ }+ |
+
138 | ++ | + + | +
139 | ++ |
+ #' `MHT01` Medical History Table.+ |
+
140 | ++ |
+ #'+ |
+
141 | ++ |
+ #' The `MHT01` table provides an overview of the subjects medical+ |
+
142 | ++ |
+ #' history by SOC and Preferred Term.+ |
+
143 | ++ |
+ #'+ |
+
144 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
145 | ++ |
+ #' @export+ |
+
146 | ++ |
+ #'+ |
+
147 | ++ |
+ #' @examples+ |
+
148 | ++ |
+ #' run(mht01, syn_data)+ |
+
149 | ++ |
+ mht01 <- chevron_t(+ |
+
150 | ++ |
+ main = mht01_main,+ |
+
151 | ++ |
+ preprocess = mht01_pre,+ |
+
152 | ++ |
+ postprocess = mht01_post+ |
+
153 | ++ |
+ )+ |
+
1 | ++ |
+ # aet01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn aet01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param anl_vars Named (`list`) of (`character`) variables the safety variables to be summarized.+ |
+
7 | ++ |
+ #' @param anl_lbls (`character`) of analysis labels.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' * Does not remove rows with zero counts by default.+ |
+
11 | ++ |
+ #'+ |
+
12 | ++ |
+ #' @note+ |
+
13 | ++ |
+ #' * `adam_db` object must contain an `adsl` table with the `"DTHFL"` and `"DCSREAS"` columns.+ |
+
14 | ++ |
+ #' * `adam_db` object must contain an `adae` table with the columns passed to `anl_vars`.+ |
+
15 | ++ |
+ #'+ |
+
16 | ++ |
+ #' @export+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ aet01_main <- function(adam_db,+ |
+
19 | ++ |
+ arm_var = "ACTARM",+ |
+
20 | ++ |
+ lbl_overall = NULL,+ |
+
21 | ++ |
+ anl_vars = list(+ |
+
22 | ++ |
+ safety_var = c(+ |
+
23 | ++ |
+ "FATAL", "SER", "SERWD", "SERDSM",+ |
+
24 | ++ |
+ "RELSER", "WD", "DSM", "REL", "RELWD", "RELDSM", "SEV"+ |
+
25 | ++ |
+ )+ |
+
26 | ++ |
+ ),+ |
+
27 | ++ |
+ anl_lbls = "Total number of {patient_label} with at least one",+ |
+
28 | ++ |
+ ...) {+ |
+
29 | +1x | +
+ assert_all_tablenames(adam_db, "adsl", "adae")+ |
+
30 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
31 | +1x | +
+ checkmate::assert_list(anl_vars, types = "character", names = "unique")+ |
+
32 | +1x | +
+ checkmate::assert_character(anl_lbls, min.chars = 1L)+ |
+
33 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
34 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
35 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
36 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("DTHFL", "DCSREAS"), types = list(c("character", "factor")), min_chars = 0L)+ |
+
37 | +1x | +
+ assert_valid_variable(adam_db$adae, c(arm_var), types = list(c("character", "factor")))+ |
+
38 | +1x | +
+ assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
39 | +1x | +
+ assert_valid_variable(adam_db$adae, unlist(anl_vars), types = list("logical"), na_ok = TRUE, empty_ok = TRUE)+ |
+
40 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)+ |
+
41 | +1x | +
+ lbl_vars <- lapply(+ |
+
42 | +1x | +
+ anl_vars,+ |
+
43 | +1x | +
+ var_labels_for,+ |
+
44 | +1x | +
+ df = adam_db$adae+ |
+
45 | ++ |
+ )+ |
+
46 | +1x | +
+ anl_lbls <- render_safe(anl_lbls)+ |
+
47 | +1x | +
+ if (length(anl_lbls) == 1) {+ |
+
48 | +1x | +
+ anl_lbls <- rep(anl_lbls, length(anl_vars))+ |
+
49 | ++ |
+ }+ |
+
50 | +1x | +
+ lyts <- aet01_lyt(+ |
+
51 | +1x | +
+ arm_var = arm_var,+ |
+
52 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
53 | +1x | +
+ anl_vars = anl_vars,+ |
+
54 | +1x | +
+ anl_lbls = anl_lbls,+ |
+
55 | +1x | +
+ lbl_vars = lbl_vars+ |
+
56 | ++ |
+ )+ |
+
57 | ++ | + + | +
58 | +1x | +
+ rbind(+ |
+
59 | +1x | +
+ build_table(lyts$ae1, adam_db$adae, alt_counts_df = adam_db$adsl),+ |
+
60 | +1x | +
+ build_table(lyts$adsl, adam_db$adsl, alt_counts_df = adam_db$adsl),+ |
+
61 | +1x | +
+ build_table(lyts$ae2, adam_db$adae, alt_counts_df = adam_db$adsl)+ |
+
62 | ++ |
+ )+ |
+
63 | ++ |
+ }+ |
+
64 | ++ | + + | +
65 | ++ |
+ #' `aet01` Layout+ |
+
66 | ++ |
+ #'+ |
+
67 | ++ |
+ #' @inheritParams aet01_main+ |
+
68 | ++ |
+ #' @param anl_vars Named (`list`) of analysis variables.+ |
+
69 | ++ |
+ #' @param anl_lbls (`character`) of labels.+ |
+
70 | ++ |
+ #' @param lbl_vars Named (`list`) of analysis labels.+ |
+
71 | ++ |
+ #' @keywords internal+ |
+
72 | ++ |
+ #'+ |
+
73 | ++ |
+ aet01_lyt <- function(arm_var,+ |
+
74 | ++ |
+ lbl_overall,+ |
+
75 | ++ |
+ anl_vars,+ |
+
76 | ++ |
+ anl_lbls,+ |
+
77 | ++ |
+ lbl_vars) {+ |
+
78 | +6x | +
+ lyt_base <- basic_table(show_colcounts = TRUE) %>%+ |
+
79 | +6x | +
+ split_cols_by(var = arm_var) %>%+ |
+
80 | +6x | +
+ ifneeded_add_overall_col(lbl_overall)+ |
+
81 | +6x | +
+ lyt_ae1 <- lyt_base %>%+ |
+
82 | +6x | +
+ analyze_num_patients(+ |
+
83 | +6x | +
+ vars = "USUBJID",+ |
+
84 | +6x | +
+ .stats = c("unique", "nonunique"),+ |
+
85 | +6x | +
+ .labels = c(+ |
+
86 | +6x | +
+ unique = render_safe("Total number of {patient_label} with at least one AE"),+ |
+
87 | +6x | +
+ nonunique = "Total number of AEs"+ |
+
88 | ++ |
+ ),+ |
+
89 | +6x | +
+ .formats = list(unique = format_count_fraction_fixed_dp, nonunique = "xx"),+ |
+
90 | +6x | +
+ show_labels = "hidden"+ |
+
91 | ++ |
+ )+ |
+
92 | +6x | +
+ lyt_adsl <- lyt_base %>%+ |
+
93 | +6x | +
+ count_patients_with_event(+ |
+
94 | +6x | +
+ "USUBJID",+ |
+
95 | +6x | +
+ filters = c("DTHFL" = "Y"),+ |
+
96 | +6x | +
+ denom = "N_col",+ |
+
97 | +6x | +
+ .labels = c(count_fraction = "Total number of deaths"),+ |
+
98 | +6x | +
+ table_names = "TotDeath"+ |
+
99 | ++ |
+ ) %>%+ |
+
100 | +6x | +
+ count_patients_with_event(+ |
+
101 | +6x | +
+ "USUBJID",+ |
+
102 | +6x | +
+ filters = c("DCSREAS" = "ADVERSE EVENT"),+ |
+
103 | +6x | +
+ denom = "N_col",+ |
+
104 | +6x | +
+ .labels = c(count_fraction = render_safe("Total number of {patient_label} withdrawn from study due to an AE")),+ |
+
105 | +6x | +
+ table_names = "TotWithdrawal"+ |
+
106 | ++ |
+ )+ |
+
107 | ++ | + + | +
108 | +6x | +
+ lyt_ae2 <- lyt_base %>%+ |
+
109 | +6x | +
+ count_patients_recursive(+ |
+
110 | +6x | +
+ anl_vars = anl_vars,+ |
+
111 | +6x | +
+ anl_lbls = anl_lbls,+ |
+
112 | +6x | +
+ lbl_vars = lbl_vars+ |
+
113 | ++ |
+ )+ |
+
114 | +6x | +
+ return(list(ae1 = lyt_ae1, ae2 = lyt_ae2, adsl = lyt_adsl))+ |
+
115 | ++ |
+ }+ |
+
116 | ++ | + + | +
117 | ++ |
+ #' @describeIn aet01 Preprocessing+ |
+
118 | ++ |
+ #'+ |
+
119 | ++ |
+ #' @inheritParams aet01_main+ |
+
120 | ++ |
+ #'+ |
+
121 | ++ |
+ #' @export+ |
+
122 | ++ |
+ #'+ |
+
123 | ++ |
+ aet01_pre <- function(adam_db, ...) {+ |
+
124 | +1x | +
+ adam_db$adae <- adam_db$adae %>%+ |
+
125 | +1x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
126 | +1x | +
+ mutate(+ |
+
127 | +1x | +
+ FATAL = with_label(.data$AESDTH == "Y", "AE with fatal outcome"),+ |
+
128 | +1x | +
+ SER = with_label(.data$AESER == "Y", "Serious AE"),+ |
+
129 | +1x | +
+ SEV = with_label(.data$ASEV == "SEVERE", "Severe AE (at greatest intensity)"),+ |
+
130 | +1x | +
+ REL = with_label(.data$AREL == "Y", "Related AE"),+ |
+
131 | +1x | +
+ WD = with_label(.data$AEACN == "DRUG WITHDRAWN", "AE leading to withdrawal from treatment"),+ |
+
132 | +1x | +
+ DSM = with_label(+ |
+
133 | +1x | +
+ .data$AEACN %in% c("DRUG INTERRUPTED", "DOSE INCREASED", "DOSE REDUCED"),+ |
+
134 | +1x | +
+ "AE leading to dose modification/interruption"+ |
+
135 | ++ |
+ ),+ |
+
136 | +1x | +
+ SERWD = with_label(.data$SER & .data$WD, "Serious AE leading to withdrawal from treatment"),+ |
+
137 | +1x | +
+ SERDSM = with_label(.data$SER & .data$DSM, "Serious AE leading to dose modification/interruption"),+ |
+
138 | +1x | +
+ RELSER = with_label(.data$SER & .data$REL, "Related Serious AE"),+ |
+
139 | +1x | +
+ RELWD = with_label(.data$REL & .data$WD, "Related AE leading to withdrawal from treatment"),+ |
+
140 | +1x | +
+ RELDSM = with_label(.data$REL & .data$DSM, "Related AE leading to dose modification/interruption"),+ |
+
141 | +1x | +
+ CTC35 = with_label(.data$ATOXGR %in% c("3", "4", "5"), "Grade 3-5 AE"),+ |
+
142 | +1x | +
+ CTC45 = with_label(.data$ATOXGR %in% c("4", "5"), "Grade 4/5 AE")+ |
+
143 | ++ |
+ )+ |
+
144 | ++ | + + | +
145 | +1x | +
+ adam_db$adsl <- adam_db$adsl %>%+ |
+
146 | +1x | +
+ mutate(DCSREAS = reformat(.data$DCSREAS, missing_rule))+ |
+
147 | ++ | + + | +
148 | +1x | +
+ adam_db+ |
+
149 | ++ |
+ }+ |
+
150 | ++ | + + | +
151 | ++ |
+ #' @describeIn aet01 Postprocessing+ |
+
152 | ++ |
+ #'+ |
+
153 | ++ |
+ #' @inheritParams gen_args+ |
+
154 | ++ |
+ #'+ |
+
155 | ++ |
+ #' @export+ |
+
156 | ++ |
+ aet01_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
157 | +1x | +
+ if (prune_0) {+ |
+
158 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
159 | ++ |
+ }+ |
+
160 | +1x | +
+ std_postprocess(tlg)+ |
+
161 | ++ |
+ }+ |
+
162 | ++ | + + | +
163 | ++ |
+ #' `AET01` Table 1 (Default) Overview of Deaths and Adverse Events Summary Table 1.+ |
+
164 | ++ |
+ #'+ |
+
165 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
166 | ++ |
+ #' @export+ |
+
167 | ++ |
+ #'+ |
+
168 | ++ |
+ #' @examples+ |
+
169 | ++ |
+ #' run(aet01, syn_data, arm_var = "ARM")+ |
+
170 | ++ |
+ aet01 <- chevron_t(+ |
+
171 | ++ |
+ main = aet01_main,+ |
+
172 | ++ |
+ preprocess = aet01_pre,+ |
+
173 | ++ |
+ postprocess = aet01_post+ |
+
174 | ++ |
+ )+ |
+
1 | ++ |
+ #' @keywords internal+ |
+
2 | ++ |
+ split_and_summ_num_patients <- function(lyt, var, label, stats, summarize_labels, ...) {+ |
+
3 | +10x | +
+ checkmate::assert_string(var)+ |
+
4 | +10x | +
+ checkmate::assert_string(label)+ |
+
5 | +10x | +
+ lyt %>%+ |
+
6 | +10x | +
+ split_rows_by(+ |
+
7 | +10x | +
+ var,+ |
+
8 | +10x | +
+ child_labels = "visible",+ |
+
9 | +10x | +
+ nested = TRUE,+ |
+
10 | +10x | +
+ split_fun = rtables::drop_split_levels,+ |
+
11 | +10x | +
+ label_pos = "topleft",+ |
+
12 | +10x | +
+ split_label = label+ |
+
13 | ++ |
+ ) %>%+ |
+
14 | +10x | +
+ summarize_num_patients(+ |
+
15 | +10x | +
+ var = "USUBJID",+ |
+
16 | +10x | +
+ .stats = stats,+ |
+
17 | +10x | +
+ .labels = setNames(summarize_labels, stats),+ |
+
18 | ++ |
+ ...+ |
+
19 | ++ |
+ )+ |
+
20 | ++ |
+ }+ |
+
21 | ++ |
+ #' @keywords internal+ |
+
22 | ++ |
+ get_sort_path <- function(x) {+ |
+
23 | +44x | +
+ checkmate::assert_character(x, null.ok = TRUE)+ |
+
24 | +44x | +
+ x2 <- as.character(rbind(x, rep("*", length(x))))+ |
+
25 | +44x | +
+ x2[-length(x2)]+ |
+
26 | ++ |
+ }+ |
+
27 | ++ |
+ #' @keywords internal+ |
+
28 | ++ |
+ tlg_sort_by_vars <- function(tlg, vars, scorefun = cont_n_allcols, ...) {+ |
+
29 | +17x | +
+ purrr::reduce(+ |
+
30 | +17x | +
+ .x = lapply(seq_len(length(vars)), function(i) vars[seq_len(i)]),+ |
+
31 | +17x | +
+ .f = tlg_sort_by_var,+ |
+
32 | +17x | +
+ .init = tlg,+ |
+
33 | +17x | +
+ scorefun = scorefun,+ |
+
34 | ++ |
+ ...+ |
+
35 | ++ |
+ )+ |
+
36 | ++ |
+ }+ |
+
37 | ++ |
+ #' @keywords internal+ |
+
38 | ++ |
+ tlg_sort_by_var <- function(tlg, var, scorefun = cont_n_allcols, ...) {+ |
+
39 | +39x | +
+ checkmate::assert_character(var)+ |
+
40 | +39x | +
+ if (length(var) == 0) {+ |
+
41 | +! | +
+ return(tlg)+ |
+
42 | ++ |
+ }+ |
+
43 | +39x | +
+ var_path <- get_sort_path(var)+ |
+
44 | +39x | +
+ tlg %>%+ |
+
45 | +39x | +
+ valid_sort_at_path(+ |
+
46 | +39x | +
+ path = var_path,+ |
+
47 | +39x | +
+ scorefun = scorefun,+ |
+
48 | ++ |
+ ...+ |
+
49 | ++ |
+ )+ |
+
50 | ++ |
+ }+ |
+
51 | ++ |
+ #' @keywords internal+ |
+
52 | ++ |
+ valid_sort_at_path <- function(tt, path, scorefun, ...) {+ |
+
53 | +44x | +
+ if (valid_row_path(tt, path)) {+ |
+
54 | +37x | +
+ sort_at_path(tt, path, scorefun, ...)+ |
+
55 | ++ |
+ } else {+ |
+
56 | +7x | +
+ tt+ |
+
57 | ++ |
+ }+ |
+
58 | ++ |
+ }+ |
+
59 | ++ |
+ #' @keywords internal+ |
+
60 | ++ |
+ valid_row_path <- function(tlg, row_path) {+ |
+
61 | +44x | +
+ if (nrow(tlg) == 0) {+ |
+
62 | +2x | +
+ return(TRUE)+ |
+
63 | ++ |
+ }+ |
+
64 | +42x | +
+ rpaths <- row_paths(tlg)+ |
+
65 | +42x | +
+ non_star <- which(row_path != "*") + 1+ |
+
66 | +42x | +
+ rpaths_choice <- unique(lapply(rpaths, `[`, non_star))+ |
+
67 | +42x | +
+ any(vapply(rpaths_choice, identical, FUN.VALUE = TRUE, y = row_path[non_star - 1]))+ |
+
68 | ++ |
+ }+ |
+
69 | ++ | + + | +
70 | ++ |
+ #' Count patients recursively+ |
+
71 | ++ |
+ #' @param lyt (`PreDataTableLayouts`) `rtable` layout.+ |
+
72 | ++ |
+ #' @param anl_vars Named (`list`) of analysis variables.+ |
+
73 | ++ |
+ #' @param anl_lbls (`character`) of labels.+ |
+
74 | ++ |
+ #' @param lbl_vars Named (`list`) of analysis labels.+ |
+
75 | ++ |
+ #' @keywords internal+ |
+
76 | ++ |
+ count_patients_recursive <- function(lyt, anl_vars, anl_lbls, lbl_vars) {+ |
+
77 | +6x | +
+ checkmate::assert_list(anl_vars, names = "unique", types = "character")+ |
+
78 | +6x | +
+ checkmate::assert_character(anl_lbls, min.chars = 1L, len = length(anl_vars))+ |
+
79 | +6x | +
+ nms <- names(anl_vars)+ |
+
80 | +6x | +
+ for (k in seq_len(length(anl_vars))) {+ |
+
81 | +7x | +
+ lyt <- lyt %>%+ |
+
82 | +7x | +
+ count_patients_with_flags(+ |
+
83 | +7x | +
+ var = "USUBJID",+ |
+
84 | +7x | +
+ flag_variables = setNames(lbl_vars[[k]], anl_vars[[k]]),+ |
+
85 | +7x | +
+ denom = "N_col",+ |
+
86 | +7x | +
+ var_labels = anl_lbls[k],+ |
+
87 | +7x | +
+ show_labels = "visible",+ |
+
88 | +7x | +
+ table_names = nms[k],+ |
+
89 | +7x | +
+ .indent_mods = 0L+ |
+
90 | ++ |
+ )+ |
+
91 | ++ |
+ }+ |
+
92 | +6x | +
+ lyt+ |
+
93 | ++ |
+ }+ |
+
94 | ++ |
+ #' @keywords internal+ |
+
95 | ++ |
+ score_all_sum <- function(tt) {+ |
+
96 | +150x | +
+ cleaf <- collect_leaves(tt)[[1]]+ |
+
97 | +150x | +
+ if (NROW(cleaf) == 0) {+ |
+
98 | +! | +
+ stop("score_all_sum score function used at subtable [", obj_name(tt), "] that has no content.")+ |
+
99 | ++ |
+ }+ |
+
100 | +150x | +
+ sum(sapply(row_values(cleaf), function(cv) cv[1]))+ |
+
101 | ++ |
+ }+ |
+
102 | ++ |
+ #' @keywords internal+ |
+
103 | ++ |
+ summarize_row <- function(lyt, vars, afun, ...) {+ |
+
104 | +2x | +
+ summarize_row_groups(lyt = lyt, var = vars, cfun = afun, ...)+ |
+
105 | ++ |
+ }+ |
+
106 | ++ | + + | +
107 | ++ |
+ #' Summary factor allowing NA+ |
+
108 | ++ |
+ #' @param x (`factor`) input.+ |
+
109 | ++ |
+ #' @param denom (`string`) denominator choice.+ |
+
110 | ++ |
+ #' @param .N_row (`integer`) number of rows in row-split dataset.+ |
+
111 | ++ |
+ #' @param .N_col (`integer`) number of rows in column-split dataset.+ |
+
112 | ++ |
+ #' @param ... Not used+ |
+
113 | ++ |
+ #' @keywords internal+ |
+
114 | ++ |
+ s_summary_na <- function(x, labelstr, denom = c("n", "N_row", "N_col"), .N_row, .N_col, ...) { # nolint+ |
+
115 | +210x | +
+ denom <- match.arg(denom)+ |
+
116 | +210x | +
+ y <- list()+ |
+
117 | +210x | +
+ y$n <- length(x)+ |
+
118 | +210x | +
+ y$count <- as.list(table(x, useNA = "no"))+ |
+
119 | +210x | +
+ dn <- switch(denom,+ |
+
120 | +210x | +
+ n = length(x),+ |
+
121 | +210x | +
+ N_row = .N_row,+ |
+
122 | +210x | +
+ N_col = .N_col+ |
+
123 | ++ |
+ )+ |
+
124 | +210x | +
+ y$count_fraction <- lapply(y$count, function(x) {+ |
+
125 | +714x | +
+ c(x, ifelse(dn > 0, x / dn, 0))+ |
+
126 | ++ |
+ })+ |
+
127 | +210x | +
+ y$n_blq <- sum(grepl("BLQ|LTR|<[1-9]", x))+ |
+
128 | +210x | +
+ y+ |
+
129 | ++ |
+ }+ |
+
130 | ++ |
+ #' Summarize variables allow `NA`+ |
+
131 | ++ |
+ #' @keywords internal+ |
+
132 | ++ |
+ summarize_vars_allow_na <- function(+ |
+
133 | ++ |
+ lyt, vars, var_labels = vars,+ |
+
134 | ++ |
+ nested = TRUE, ..., show_labels = "default", table_names = vars,+ |
+
135 | ++ |
+ section_div = NA_character_, .stats = c("n", "count_fraction"),+ |
+
136 | ++ |
+ .formats = list(count_fraction = format_count_fraction_fixed_dp), .labels = NULL, .indent_mods = NULL, inclNAs = TRUE) { # nolint+ |
+
137 | +7x | +
+ afun <- make_afun(s_summary_na, .stats, .formats, .labels, .indent_mods, .ungroup_stats = c("count_fraction"))+ |
+
138 | +7x | +
+ analyze(+ |
+
139 | +7x | +
+ lyt = lyt, vars = vars, var_labels = var_labels,+ |
+
140 | +7x | +
+ afun = afun, nested = nested, extra_args = list(...),+ |
+
141 | +7x | +
+ inclNAs = inclNAs, show_labels = show_labels, table_names = table_names,+ |
+
142 | +7x | +
+ section_div = section_div+ |
+
143 | ++ |
+ )+ |
+
144 | ++ |
+ }+ |
+
145 | ++ | + + | +
146 | ++ |
+ #' Count or summarize by groups+ |
+
147 | ++ |
+ #' @param lyt (`PreDataTableLayouts`) `rtable` layout.+ |
+
148 | ++ |
+ #' @param var (`string`) of analysis variable.+ |
+
149 | ++ |
+ #' @param level (`string`) level to be displayed.+ |
+
150 | ++ |
+ #' @param detail_vars (`character`) of variables for detail information.+ |
+
151 | ++ |
+ #' @keywords internal+ |
+
152 | ++ |
+ count_or_summarize <- function(lyt, var, level, detail_vars, indent_mod = 0L, ...) {+ |
+
153 | +27x | +
+ checkmate::assert_string(level)+ |
+
154 | +27x | +
+ if (is.null(detail_vars)) {+ |
+
155 | +20x | +
+ lyt <- lyt %>%+ |
+
156 | +20x | +
+ count_values(+ |
+
157 | +20x | +
+ var,+ |
+
158 | +20x | +
+ values = level,+ |
+
159 | +20x | +
+ table_names = paste(var, level, sep = "_"),+ |
+
160 | +20x | +
+ .formats = list(count_fraction = format_count_fraction_fixed_dp),+ |
+
161 | +20x | +
+ .indent_mods = indent_mod,+ |
+
162 | ++ |
+ ...+ |
+
163 | ++ |
+ )+ |
+
164 | ++ |
+ } else {+ |
+
165 | +7x | +
+ lyt <- lyt %>%+ |
+
166 | +7x | +
+ split_rows_by(var, split_fun = keep_split_levels(level), indent_mod = indent_mod) %>%+ |
+
167 | +7x | +
+ summarize_row_groups(+ |
+
168 | +7x | +
+ format = format_count_fraction_fixed_dp+ |
+
169 | ++ |
+ ) %>%+ |
+
170 | +7x | +
+ split_rows_by_recurive(detail_vars[-length(detail_vars)], split_fun = drop_split_levels) %>%+ |
+
171 | +7x | +
+ summarize_vars(+ |
+
172 | +7x | +
+ detail_vars[length(detail_vars)],+ |
+
173 | +7x | +
+ .stats = "count_fraction",+ |
+
174 | +7x | +
+ denom = "N_col",+ |
+
175 | +7x | +
+ show_labels = "hidden",+ |
+
176 | +7x | +
+ .formats = list(count_fraction = format_count_fraction_fixed_dp),+ |
+
177 | ++ |
+ ...+ |
+
178 | ++ |
+ )+ |
+
179 | ++ |
+ }+ |
+
180 | +27x | +
+ lyt+ |
+
181 | ++ |
+ }+ |
+
182 | ++ | + + | +
183 | ++ |
+ #' Count or summarize by groups+ |
+
184 | ++ |
+ #' @param lyt (`PreDataTableLayouts`) `rtable` layout.+ |
+
185 | ++ |
+ #' @param row_split_var (`character`) variable to split rows by.+ |
+
186 | ++ |
+ #' @param ... Further arguments for `split_rows_by`+ |
+
187 | ++ |
+ #' @keywords internal+ |
+
188 | ++ |
+ split_rows_by_recurive <- function(lyt, row_split_var, ...) {+ |
+
189 | +29x | +
+ args <- list(...)+ |
+
190 | +29x | +
+ for (i in seq_len(length(row_split_var))) {+ |
+
191 | +12x | +
+ args_i <- lapply(args, obtain_value, index = i)+ |
+
192 | +12x | +
+ lyt <- do_call(+ |
+
193 | +12x | +
+ split_rows_by,+ |
+
194 | +12x | +
+ c(+ |
+
195 | +12x | +
+ list(+ |
+
196 | +12x | +
+ lyt = lyt,+ |
+
197 | +12x | +
+ row_split_var+ |
+
198 | ++ |
+ ),+ |
+
199 | +12x | +
+ args_i+ |
+
200 | ++ |
+ )+ |
+
201 | ++ |
+ )+ |
+
202 | ++ |
+ }+ |
+
203 | +29x | +
+ lyt+ |
+
204 | ++ |
+ }+ |
+
205 | ++ | + + | +
206 | ++ |
+ #' Obtain value from a vector+ |
+
207 | ++ |
+ #' @keywords internal+ |
+
208 | ++ |
+ obtain_value <- function(obj, index) {+ |
+
209 | +32x | +
+ if (is.list(obj)) {+ |
+
210 | +! | +
+ return(obj[[index]])+ |
+
211 | ++ |
+ }+ |
+
212 | +32x | +
+ if (is.vector(obj) && length(obj) >= index) {+ |
+
213 | +30x | +
+ return(obj[index])+ |
+
214 | ++ |
+ }+ |
+
215 | +2x | +
+ return(obj)+ |
+
216 | ++ |
+ }+ |
+
217 | ++ | + + | +
218 | ++ |
+ #' Get page by value+ |
+
219 | ++ |
+ #' @keywords internal+ |
+
220 | ++ |
+ get_page_by <- function(var, vars) {+ |
+
221 | +22x | +
+ checkmate::assert_character(vars, null.ok = TRUE)+ |
+
222 | +22x | +
+ checkmate::assert_character(var, null.ok = TRUE, max.len = 1L)+ |
+
223 | +22x | +
+ ret <- rep(FALSE, length(vars))+ |
+
224 | +22x | +
+ if (is.null(var) || length(var) == 0) {+ |
+
225 | +15x | +
+ return(ret)+ |
+
226 | ++ |
+ }+ |
+
227 | +7x | +
+ index <- match(var, vars)+ |
+
228 | +7x | +
+ checkmate::assert_int(index, na.ok = TRUE)+ |
+
229 | +7x | +
+ if (is.na(index)) {+ |
+
230 | +! | +
+ return(ret)+ |
+
231 | ++ |
+ }+ |
+
232 | +7x | +
+ ret[seq_len(index)] <- TRUE+ |
+
233 | +7x | +
+ return(ret)+ |
+
234 | ++ |
+ }+ |
+
235 | ++ | + + | +
236 | ++ |
+ #' Proportion layout+ |
+
237 | ++ |
+ #'+ |
+
238 | ++ |
+ #' @inheritParams rspt01_main+ |
+
239 | ++ |
+ #' @param lyt layout created by `rtables`+ |
+
240 | ++ |
+ #'+ |
+
241 | ++ |
+ #' @keywords internal+ |
+
242 | ++ |
+ proportion_lyt <- function(lyt, arm_var, methods, strata, conf_level, odds_ratio = TRUE, rsp_var = "IS_RSP") {+ |
+
243 | +8x | +
+ non_stratified <- length(strata) == 0L+ |
+
244 | +8x | +
+ lyt <- lyt %>%+ |
+
245 | +8x | +
+ estimate_proportion_diff(+ |
+
246 | +8x | +
+ vars = rsp_var,+ |
+
247 | +8x | +
+ show_labels = "visible",+ |
+
248 | +8x | +
+ var_labels = if (non_stratified) "Unstratified Analysis" else "Stratified Analysis",+ |
+
249 | +8x | +
+ conf_level = conf_level,+ |
+
250 | +8x | +
+ method = if (non_stratified) {+ |
+
251 | +6x | +
+ methods[["diff_conf_method"]] %||% "waldcc"+ |
+
252 | ++ |
+ } else {+ |
+
253 | +2x | +
+ methods[["strat_diff_conf_method"]] %||% "cmh"+ |
+
254 | ++ |
+ },+ |
+
255 | +8x | +
+ variables = list(strata = strata),+ |
+
256 | +8x | +
+ table_names = if (non_stratified) "est_prop_diff" else "est_prop_diff_strat"+ |
+
257 | ++ |
+ ) %>%+ |
+
258 | +8x | +
+ test_proportion_diff(+ |
+
259 | +8x | +
+ vars = rsp_var,+ |
+
260 | +8x | +
+ method = if (non_stratified) {+ |
+
261 | +6x | +
+ methods[["diff_pval_method"]] %||% "chisq"+ |
+
262 | ++ |
+ } else {+ |
+
263 | +2x | +
+ methods[["strat_diff_pval_method"]] %||% "cmh"+ |
+
264 | ++ |
+ },+ |
+
265 | +8x | +
+ variables = list(strata = strata),+ |
+
266 | +8x | +
+ table_names = if (non_stratified) "test_prop_diff" else "test_prop_diff_strat"+ |
+
267 | ++ |
+ )+ |
+
268 | ++ | + + | +
269 | +8x | +
+ if (odds_ratio) {+ |
+
270 | +4x | +
+ lyt <- lyt %>%+ |
+
271 | +4x | +
+ estimate_odds_ratio(+ |
+
272 | +4x | +
+ vars = rsp_var,+ |
+
273 | +4x | +
+ variables = if (non_stratified) list(strata = strata, arm = arm_var),+ |
+
274 | +4x | +
+ table_names = if (non_stratified) "est_or" else "est_or_strat"+ |
+
275 | ++ |
+ )+ |
+
276 | ++ |
+ }+ |
+
277 | ++ | + + | +
278 | +8x | +
+ lyt+ |
+
279 | ++ |
+ }+ |
+
280 | ++ | + + | +
281 | ++ |
+ #' Helper function to add a row split if specified+ |
+
282 | ++ |
+ #'+ |
+
283 | ++ |
+ #' @param lyt (`PreDataTableLayouts`) object.+ |
+
284 | ++ |
+ #' @param var (`string`) the name of the variable initiating a new row split.+ |
+
285 | ++ |
+ #' @param lbl_var (`string`)the label of the variable `var`.+ |
+
286 | ++ |
+ #'+ |
+
287 | ++ |
+ #' @keywords internal+ |
+
288 | ++ |
+ #'+ |
+
289 | ++ |
+ #' @return `PreDataTableLayouts` object.+ |
+
290 | ++ |
+ #'+ |
+
291 | ++ |
+ ifneeded_split_row <- function(lyt, var, lbl_var) {+ |
+
292 | +2x | +
+ if (is.null(var)) {+ |
+
293 | +1x | +
+ lyt+ |
+
294 | ++ |
+ } else {+ |
+
295 | +1x | +
+ split_rows_by(lyt, var,+ |
+
296 | +1x | +
+ label_pos = "topleft",+ |
+
297 | +1x | +
+ split_label = lbl_var+ |
+
298 | ++ |
+ )+ |
+
299 | ++ |
+ }+ |
+
300 | ++ |
+ }+ |
+
301 | ++ | + + | +
302 | ++ |
+ #' Helper function to add a column split if specified+ |
+
303 | ++ |
+ #'+ |
+
304 | ++ |
+ #' @param lyt (`rtables`) object.+ |
+
305 | ++ |
+ #' @param var (`string`) the name of the variable initiating a new column split.+ |
+
306 | ++ |
+ #' @param ... Additional arguments for `split_cols_by`.+ |
+
307 | ++ |
+ #'+ |
+
308 | ++ |
+ #' @keywords internal+ |
+
309 | ++ |
+ #'+ |
+
310 | ++ |
+ #' @return `rtables` object.+ |
+
311 | ++ |
+ #'+ |
+
312 | ++ |
+ ifneeded_split_col <- function(lyt, var, ...) {+ |
+
313 | +16x | +
+ if (is.null(var)) {+ |
+
314 | +11x | +
+ lyt+ |
+
315 | ++ |
+ } else {+ |
+
316 | +5x | +
+ split_cols_by(+ |
+
317 | +5x | +
+ lyt = lyt,+ |
+
318 | +5x | +
+ var = var,+ |
+
319 | ++ |
+ ...+ |
+
320 | ++ |
+ )+ |
+
321 | ++ |
+ }+ |
+
322 | ++ |
+ }+ |
+
323 | ++ | + + | +
324 | ++ |
+ #' Create a Null Report+ |
+
325 | ++ |
+ #' @rdname report_null+ |
+
326 | ++ |
+ #' @aliases null_report+ |
+
327 | ++ |
+ #' @param tlg (`TableTree`) object.+ |
+
328 | ++ |
+ #' @param ... not used. Important to be used directly as post processing function.+ |
+
329 | ++ |
+ #'+ |
+
330 | ++ |
+ #' @export+ |
+
331 | ++ |
+ #'+ |
+
332 | ++ |
+ #' @return original `TableTree` or a null report if no observation are found in the table.+ |
+
333 | ++ |
+ #'+ |
+
334 | ++ |
+ report_null <- function(tlg, ...) {+ |
+
335 | +165x | +
+ checkmate::assert_true(is.null(tlg) || rtables::is_rtable(tlg))+ |
+
336 | ++ | + + | +
337 | +165x | +
+ if (is.null(tlg) || nrow(tlg) == 0L) {+ |
+
338 | +27x | +
+ null_report+ |
+
339 | ++ |
+ } else {+ |
+
340 | +138x | +
+ tlg+ |
+
341 | ++ |
+ }+ |
+
342 | ++ |
+ }+ |
+
343 | ++ | + + | +
344 | ++ |
+ #' @export+ |
+
345 | ++ |
+ #' @rdname report_null+ |
+
346 | ++ |
+ null_report <- rtables::rtable(+ |
+
347 | ++ |
+ header = "",+ |
+
348 | ++ |
+ rrow("", "Null Report: No observations met the reporting criteria for inclusion in this output.")+ |
+
349 | ++ |
+ )+ |
+
350 | ++ | + + | +
351 | ++ |
+ #' @export+ |
+
352 | ++ |
+ #' @rdname report_null+ |
+
353 | ++ |
+ null_listing <- rlistings::as_listing(+ |
+
354 | ++ |
+ df = data.frame(x = formatters::with_label(+ |
+
355 | ++ |
+ "Null Report: No observations met the reporting criteria for inclusion in this output.", ""+ |
+
356 | ++ |
+ ))+ |
+
357 | ++ |
+ )+ |
+
358 | ++ | + + | +
359 | ++ |
+ has_overall_col <- function(lbl_overall) {+ |
+
360 | +90x | +
+ !is.null(lbl_overall) && !identical(lbl_overall, "")+ |
+
361 | ++ |
+ }+ |
+
362 | ++ | + + | +
363 | ++ |
+ ifneeded_add_overall_col <- function(lyt, lbl_overall) {+ |
+
364 | +90x | +
+ if (has_overall_col(lbl_overall)) {+ |
+
365 | +13x | +
+ add_overall_col(lyt, label = lbl_overall)+ |
+
366 | ++ |
+ } else {+ |
+
367 | +77x | +
+ lyt+ |
+
368 | ++ |
+ }+ |
+
369 | ++ |
+ }+ |
+
370 | ++ | + + | +
371 | ++ |
+ #' Analyze skip baseline+ |
+
372 | ++ |
+ #' @param x value to analyze+ |
+
373 | ++ |
+ #' @param .var variable name.+ |
+
374 | ++ |
+ #' @param .spl_context split context.+ |
+
375 | ++ |
+ #' @param paramcdvar (`string`) name of parameter code.+ |
+
376 | ++ |
+ #' @param visitvar (`string`) name of the visit variable.+ |
+
377 | ++ |
+ #' @param skip Named (`character`) indicating the pairs to skip in analyze.+ |
+
378 | ++ |
+ #' @param .stats (`character`) See `tern::summarize_variables`.+ |
+
379 | ++ |
+ #' @param .label (`character`) See `tern::summarize_variables`.+ |
+
380 | ++ |
+ #' @param .indent_mods (`integer`) See `tern::summarize_variables`.+ |
+
381 | ++ |
+ #' @param .N_col (`int`) See `tern::summarize_variables`.+ |
+
382 | ++ |
+ #' @param .N_row (`int`) See `tern::summarize_variables`.+ |
+
383 | ++ |
+ #' @param ... additional arguments for `tern::create_afun_summary`.+ |
+
384 | ++ |
+ #' @inheritParams cfbt01_main+ |
+
385 | ++ |
+ #' @keywords internal+ |
+
386 | ++ |
+ afun_skip <- function(+ |
+
387 | ++ |
+ x, .var, .spl_context, paramcdvar, visitvar, skip,+ |
+
388 | ++ |
+ precision, .stats, .labels = NULL, .indent_mods = NULL, .N_col, .N_row, ...) { # nolint+ |
+
389 | +1116x | +
+ param_val <- .spl_context$value[which(.spl_context$split == paramcdvar)]+ |
+
390 | ++ |
+ # Identify context+ |
+
391 | +1116x | +
+ split_level <- .spl_context$value[which(.spl_context$split == visitvar)]+ |
+
392 | +1116x | +
+ pcs <- if (.var %in% names(skip) && split_level %in% skip[[.var]]) {+ |
+
393 | +1116x | +
+ NA+ |
+
394 | ++ |
+ } else {+ |
+
395 | +1029x | +
+ precision[[param_val]] %||% precision[["default"]] %||% 2+ |
+
396 | ++ |
+ }+ |
+
397 | ++ | + + | +
398 | +1116x | +
+ fmts <- lapply(.stats, summary_formats, pcs = pcs, FALSE)+ |
+
399 | +1116x | +
+ names(fmts) <- .stats+ |
+
400 | +1116x | +
+ fmts_na <- lapply(.stats, summary_formats, pcs = pcs, ne = TRUE)+ |
+
401 | +1116x | +
+ ret <- tern::create_afun_summary(+ |
+
402 | +1116x | +
+ .stats, fmts, .labels, .indent_mods+ |
+
403 | +1116x | +
+ )(x = x, .var = .var, .spl_context = .spl_context, .N_col = .N_col, .N_row = .N_row, ...)+ |
+
404 | +1116x | +
+ for (i in seq_len(length(ret))) {+ |
+
405 | +4464x | +
+ attr(ret[[i]], "format_na_str") <- fmts_na[[i]]()+ |
+
406 | ++ |
+ }+ |
+
407 | +1116x | +
+ ret+ |
+
408 | ++ |
+ }+ |
+
409 | ++ | + + | +
410 | ++ |
+ summary_formats <- function(x, pcs, ne = FALSE) {+ |
+
411 | +8928x | +
+ checkmate::assert_int(pcs, lower = 0, na.ok = TRUE)+ |
+
412 | +8928x | +
+ switch(x,+ |
+
413 | +2232x | +
+ n = h_format_dec(format = "%s", digits = pcs - pcs, ne = ne),+ |
+
414 | ++ |
+ min = ,+ |
+
415 | ++ |
+ max = ,+ |
+
416 | +! | +
+ sum = h_format_dec(format = "%s", digits = pcs, ne = ne),+ |
+
417 | ++ |
+ mean = ,+ |
+
418 | ++ |
+ sd = ,+ |
+
419 | ++ |
+ median = ,+ |
+
420 | ++ |
+ mad = ,+ |
+
421 | ++ |
+ iqr = ,+ |
+
422 | ++ |
+ cv = ,+ |
+
423 | ++ |
+ geom_mean = ,+ |
+
424 | ++ |
+ geom_cv = ,+ |
+
425 | +2232x | +
+ se = h_format_dec(format = "%s", digits = pcs + 1, ne = ne),+ |
+
426 | ++ |
+ mean_sd = ,+ |
+
427 | +2232x | +
+ mean_se = h_format_dec(format = "%s (%s)", digits = rep(pcs + 1, 2), ne = ne),+ |
+
428 | ++ |
+ mean_ci = ,+ |
+
429 | ++ |
+ mean_sei = ,+ |
+
430 | ++ |
+ median_ci = ,+ |
+
431 | +! | +
+ mean_sdi = h_format_dec(format = "(%s, %s)", digits = rep(pcs + 1, 2), ne = ne),+ |
+
432 | +! | +
+ mean_pval = h_format_dec(format = "%s", digits = 2, ne = ne),+ |
+
433 | +! | +
+ quantiles = h_format_dec(format = "(%s - %s)", digits = rep(pcs + 1, 2), ne = ne),+ |
+
434 | +2232x | +
+ range = h_format_dec(format = "%s - %s", digits = rep(pcs, 2), ne = ne),+ |
+
435 | +! | +
+ median_range = h_format_dec(format = "%s (%s - %s)", digits = c(pcs, pcs + 1, pcs + 1), ne = ne)+ |
+
436 | ++ |
+ )+ |
+
437 | ++ |
+ }+ |
+
438 | ++ | + + | +
439 | ++ |
+ split_fun_map <- function(map) {+ |
+
440 | +9x | +
+ if (is.null(map)) {+ |
+
441 | +6x | +
+ drop_split_levels+ |
+
442 | ++ |
+ } else {+ |
+
443 | +3x | +
+ trim_levels_to_map(map = map)+ |
+
444 | ++ |
+ }+ |
+
445 | ++ |
+ }+ |
+
446 | ++ | + + | +
447 | ++ |
+ infer_mapping <- function(map_df, df) {+ |
+
448 | +3x | +
+ checkmate::assert_data_frame(df)+ |
+
449 | +3x | +
+ vars <- colnames(map_df)+ |
+
450 | +3x | +
+ checkmate::assert_names(names(df), must.include = vars)+ |
+
451 | +3x | +
+ for (x in vars) {+ |
+
452 | +7x | +
+ if (!checkmate::test_subset(map_df[[x]], lvls(df[[x]]))) {+ |
+
453 | +! | +
+ rlang::abort(+ |
+
454 | +! | +
+ paste0(+ |
+
455 | +! | +
+ "Provided map should only contain valid levels in dataset in variable ", x,+ |
+
456 | +! | +
+ ". Consider convert ", x, " to factor first and add",+ |
+
457 | +! | +
+ toString(setdiff(map_df[[x]], lvls(df[[x]]))), "levels to it."+ |
+
458 | ++ |
+ )+ |
+
459 | ++ |
+ )+ |
+
460 | ++ |
+ }+ |
+
461 | ++ |
+ }+ |
+
462 | +3x | +
+ res <- df[vars] %>%+ |
+
463 | +3x | +
+ unique() %>%+ |
+
464 | +3x | +
+ arrange(across(everything())) %>%+ |
+
465 | +3x | +
+ mutate(across(everything(), as.character))+ |
+
466 | +3x | +
+ if (!is.null(map_df)) {+ |
+
467 | +3x | +
+ dplyr::full_join(map_df, res, by = colnames(map_df))[vars]+ |
+
468 | ++ |
+ } else {+ |
+
469 | +! | +
+ res+ |
+
470 | ++ |
+ }+ |
+
471 | ++ |
+ }+ |
+
1 | ++ |
+ # cfbt01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn cfbt01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param summaryvars (`character`) variables to be analyzed. The label attribute of the corresponding column in+ |
+
7 | ++ |
+ #' table of `adam_db` is used as label.+ |
+
8 | ++ |
+ #' @param visitvar (`string`) typically one of `"AVISIT"` or user-defined visit incorporating `"ATPT"`.+ |
+
9 | ++ |
+ #' @param precision (named `list` of `integer`) where names are values found in the `PARAMCD` column and the the values+ |
+
10 | ++ |
+ #' indicate the number of digits in statistics. If `default` is set, and parameter precision not specified,+ |
+
11 | ++ |
+ #' the value for `default` will be used.+ |
+
12 | ++ |
+ #' @param .stats (`character`) statistics names, see `tern::summarize_vars()`.+ |
+
13 | ++ |
+ #' @param skip Named (`list`) of visit values that need to be inhibited.+ |
+
14 | ++ |
+ #' @param ... additional arguments like `.indent_mods`, `.labels`.+ |
+
15 | ++ |
+ #'+ |
+
16 | ++ |
+ #' @details+ |
+
17 | ++ |
+ #' * The `Analysis Value` column, displays the number of patients, the mean, standard deviation, median and range of+ |
+
18 | ++ |
+ #' the analysis value for each visit.+ |
+
19 | ++ |
+ #' * The `Change from Baseline` column, displays the number of patient and the mean, standard deviation,+ |
+
20 | ++ |
+ #' median and range of changes relative to the baseline.+ |
+
21 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
22 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
23 | ++ |
+ #' * Does not include a total column by default.+ |
+
24 | ++ |
+ #' * Sorted based on factor level; first by `PARAM` labels in alphabetic order then by chronological time point given+ |
+
25 | ++ |
+ #' by `AVISIT`. Re-level to customize order+ |
+
26 | ++ |
+ #'+ |
+
27 | ++ |
+ #' @note+ |
+
28 | ++ |
+ #' * `adam_db` object must contain table named as `dataset` with the columns specified in `summaryvars`.+ |
+
29 | ++ |
+ #'+ |
+
30 | ++ |
+ #' @export+ |
+
31 | ++ |
+ #'+ |
+
32 | ++ |
+ cfbt01_main <- function(adam_db,+ |
+
33 | ++ |
+ dataset,+ |
+
34 | ++ |
+ arm_var = "ACTARM",+ |
+
35 | ++ |
+ row_split_var = NULL,+ |
+
36 | ++ |
+ summaryvars = c("AVAL", "CHG"),+ |
+
37 | ++ |
+ visitvar = "AVISIT",+ |
+
38 | ++ |
+ precision = list(default = 2L),+ |
+
39 | ++ |
+ page_var = "PARAMCD",+ |
+
40 | ++ |
+ .stats = c("n", "mean_sd", "median", "range"),+ |
+
41 | ++ |
+ skip = list(CHG = "BASELINE"),+ |
+
42 | ++ |
+ ...) {+ |
+
43 | +4x | +
+ assert_all_tablenames(adam_db, c("adsl", dataset))+ |
+
44 | +4x | +
+ checkmate::assert_string(arm_var)+ |
+
45 | +4x | +
+ checkmate::assert_character(summaryvars, max.len = 2L, min.len = 1L)+ |
+
46 | +4x | +
+ checkmate::assert_character(row_split_var, null.ok = TRUE)+ |
+
47 | +4x | +
+ checkmate::assert_disjunct(row_split_var, c("PARAMCD", "PARAM", visitvar))+ |
+
48 | +4x | +
+ checkmate::assert_string(visitvar)+ |
+
49 | +4x | +
+ checkmate::assert_string(page_var, null.ok = TRUE)+ |
+
50 | +4x | +
+ checkmate::assert_subset(page_var, c(row_split_var, "PARAMCD"))+ |
+
51 | +4x | +
+ df_lbl <- paste0("adam_db$", dataset)+ |
+
52 | +4x | +
+ assert_valid_variable(adam_db[[dataset]], c(summaryvars), types = list("numeric"), empty_ok = TRUE, label = df_lbl)+ |
+
53 | +4x | +
+ assert_valid_variable(+ |
+
54 | +4x | +
+ adam_db[[dataset]], c(visitvar, row_split_var, "PARAM", "PARAMCD"),+ |
+
55 | +4x | +
+ types = list(c("character", "factor")), label = df_lbl+ |
+
56 | ++ |
+ )+ |
+
57 | +4x | +
+ assert_valid_variable(+ |
+
58 | +4x | +
+ adam_db[[dataset]], "USUBJID",+ |
+
59 | +4x | +
+ types = list(c("character", "factor")), empty_ok = TRUE, label = df_lbl+ |
+
60 | ++ |
+ )+ |
+
61 | +4x | +
+ assert_valid_variable(adam_db$adsl, "USUBJID", types = list(c("character", "factor")))+ |
+
62 | +4x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db[[dataset]], arm_var)+ |
+
63 | +4x | +
+ checkmate::assert_list(precision, types = "integerish", names = "unique")+ |
+
64 | +4x | +
+ vapply(precision, checkmate::assert_int, FUN.VALUE = numeric(1), lower = 0)+ |
+
65 | +4x | +
+ all_stats <- c(+ |
+
66 | +4x | +
+ "n", "sum", "mean", "sd", "se", "mean_sd", "mean_se", "mean_ci", "mean_sei",+ |
+
67 | +4x | +
+ "mean_sdi", "mean_pval", "median", "mad", "median_ci", "quantiles", "iqr", "range",+ |
+
68 | +4x | +
+ "cv", "min", "max", "median_range", "geom_mean", "geom_cv"+ |
+
69 | ++ |
+ )+ |
+
70 | +4x | +
+ checkmate::assert_subset(.stats, all_stats)+ |
+
71 | +4x | +
+ lbl_avisit <- var_labels_for(adam_db[[dataset]], visitvar)+ |
+
72 | +4x | +
+ lbl_param <- var_labels_for(adam_db[[dataset]], "PARAM")+ |
+
73 | ++ | + + | +
74 | +4x | +
+ summaryvars_lbls <- var_labels_for(adam_db[[dataset]], summaryvars)+ |
+
75 | +4x | +
+ row_split_lbl <- var_labels_for(adam_db[[dataset]], row_split_var)+ |
+
76 | ++ | + + | +
77 | +4x | +
+ lyt <- cfbt01_lyt(+ |
+
78 | +4x | +
+ arm_var = arm_var,+ |
+
79 | +4x | +
+ summaryvars = summaryvars,+ |
+
80 | +4x | +
+ summaryvars_lbls = summaryvars_lbls,+ |
+
81 | +4x | +
+ row_split_var = row_split_var,+ |
+
82 | +4x | +
+ row_split_lbl = row_split_lbl,+ |
+
83 | +4x | +
+ visitvar = visitvar,+ |
+
84 | +4x | +
+ lbl_avisit = lbl_avisit,+ |
+
85 | +4x | +
+ lbl_param = lbl_param,+ |
+
86 | +4x | +
+ precision = precision,+ |
+
87 | +4x | +
+ .stats = .stats,+ |
+
88 | +4x | +
+ page_var = page_var,+ |
+
89 | +4x | +
+ skip = skip,+ |
+
90 | ++ |
+ ...+ |
+
91 | ++ |
+ )+ |
+
92 | +4x | +
+ tbl <- build_table(+ |
+
93 | +4x | +
+ lyt,+ |
+
94 | +4x | +
+ df = adam_db[[dataset]],+ |
+
95 | +4x | +
+ alt_counts_df = adam_db$adsl+ |
+
96 | ++ |
+ )+ |
+
97 | ++ | + + | +
98 | +4x | +
+ tbl+ |
+
99 | ++ |
+ }+ |
+
100 | ++ | + + | +
101 | ++ |
+ #' `cfbt01` Layout+ |
+
102 | ++ |
+ #'+ |
+
103 | ++ |
+ #' @inheritParams gen_args+ |
+
104 | ++ |
+ #' @inheritParams cfbt01_main+ |
+
105 | ++ |
+ #'+ |
+
106 | ++ |
+ #' @param summaryvars (`character`) the variables to be analyzed. For this table, `AVAL` and `CHG` by default.+ |
+
107 | ++ |
+ #' @param summaryvars_lbls (`character`) the label of the variables to be analyzed.+ |
+
108 | ++ |
+ #' @param visitvar (`string`) typically one of `"AVISIT"` or user-defined visit incorporating `"ATPT"`.+ |
+
109 | ++ |
+ #' @param lbl_avisit (`string`) label of the `visitvar` variable.+ |
+
110 | ++ |
+ #' @param lbl_param (`string`) label of the `PARAM` variable.+ |
+
111 | ++ |
+ #' @param row_split_lbl (`character`) label of further row splits.+ |
+
112 | ++ |
+ #'+ |
+
113 | ++ |
+ #' @keywords internal+ |
+
114 | ++ |
+ #'+ |
+
115 | ++ |
+ cfbt01_lyt <- function(arm_var,+ |
+
116 | ++ |
+ summaryvars,+ |
+
117 | ++ |
+ summaryvars_lbls,+ |
+
118 | ++ |
+ row_split_var,+ |
+
119 | ++ |
+ row_split_lbl,+ |
+
120 | ++ |
+ visitvar,+ |
+
121 | ++ |
+ lbl_avisit,+ |
+
122 | ++ |
+ lbl_param,+ |
+
123 | ++ |
+ precision,+ |
+
124 | ++ |
+ page_var,+ |
+
125 | ++ |
+ .stats,+ |
+
126 | ++ |
+ skip,+ |
+
127 | ++ |
+ ...) {+ |
+
128 | +10x | +
+ page_by <- get_page_by(page_var, c(row_split_var, "PARAMCD"))+ |
+
129 | +10x | +
+ label_pos <- dplyr::if_else(page_by, "hidden", "topleft")+ |
+
130 | +10x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
131 | +10x | +
+ split_cols_by(arm_var) %>%+ |
+
132 | +10x | +
+ split_rows_by_recurive(+ |
+
133 | +10x | +
+ row_split_var,+ |
+
134 | +10x | +
+ split_label = row_split_lbl,+ |
+
135 | +10x | +
+ label_pos = head(label_pos, -1L), page_by = head(page_by, -1L)+ |
+
136 | ++ |
+ ) %>%+ |
+
137 | +10x | +
+ split_rows_by(+ |
+
138 | +10x | +
+ var = "PARAMCD",+ |
+
139 | +10x | +
+ labels_var = "PARAM",+ |
+
140 | +10x | +
+ split_fun = drop_split_levels,+ |
+
141 | +10x | +
+ label_pos = tail(label_pos, 1L),+ |
+
142 | +10x | +
+ split_label = lbl_param,+ |
+
143 | +10x | +
+ page_by = tail(page_by, 1L)+ |
+
144 | ++ |
+ ) %>%+ |
+
145 | +10x | +
+ split_rows_by(+ |
+
146 | +10x | +
+ visitvar,+ |
+
147 | +10x | +
+ split_fun = drop_split_levels,+ |
+
148 | +10x | +
+ label_pos = "topleft",+ |
+
149 | +10x | +
+ split_label = lbl_avisit+ |
+
150 | ++ |
+ ) %>%+ |
+
151 | +10x | +
+ split_cols_by_multivar(+ |
+
152 | +10x | +
+ vars = summaryvars,+ |
+
153 | +10x | +
+ varlabels = summaryvars_lbls,+ |
+
154 | +10x | +
+ nested = TRUE+ |
+
155 | ++ |
+ ) %>%+ |
+
156 | +10x | +
+ analyze_colvars(+ |
+
157 | +10x | +
+ afun = afun_skip,+ |
+
158 | +10x | +
+ extra_args = list(+ |
+
159 | +10x | +
+ visitvar = visitvar,+ |
+
160 | +10x | +
+ paramcdvar = "PARAMCD",+ |
+
161 | +10x | +
+ skip = skip,+ |
+
162 | +10x | +
+ precision = precision,+ |
+
163 | +10x | +
+ .stats = .stats,+ |
+
164 | ++ |
+ ...+ |
+
165 | ++ |
+ )+ |
+
166 | ++ |
+ )+ |
+
167 | ++ |
+ }+ |
+
168 | ++ | + + | +
169 | ++ |
+ #' @describeIn cfbt01 Preprocessing+ |
+
170 | ++ |
+ #'+ |
+
171 | ++ |
+ #' @inheritParams gen_args+ |
+
172 | ++ |
+ #' @export+ |
+
173 | ++ |
+ #'+ |
+
174 | ++ |
+ cfbt01_pre <- function(adam_db, dataset, ...) {+ |
+
175 | +4x | +
+ adam_db[[dataset]] <- adam_db[[dataset]] %>%+ |
+
176 | +4x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
177 | +4x | +
+ mutate(+ |
+
178 | +4x | +
+ AVISIT = reorder(.data$AVISIT, .data$AVISITN),+ |
+
179 | +4x | +
+ AVISIT = with_label(.data$AVISIT, "Analysis Visit"),+ |
+
180 | +4x | +
+ AVAL = with_label(.data$AVAL, "Value at Visit"),+ |
+
181 | +4x | +
+ CHG = with_label(.data$CHG, "Change from \nBaseline")+ |
+
182 | ++ |
+ )+ |
+
183 | ++ | + + | +
184 | +4x | +
+ adam_db+ |
+
185 | ++ |
+ }+ |
+
186 | ++ | + + | +
187 | ++ |
+ #' @describeIn cfbt01 Postprocessing+ |
+
188 | ++ |
+ #'+ |
+
189 | ++ |
+ #' @inheritParams gen_args+ |
+
190 | ++ |
+ #'+ |
+
191 | ++ |
+ #' @export+ |
+
192 | ++ |
+ cfbt01_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
193 | +4x | +
+ if (prune_0) {+ |
+
194 | +4x | +
+ tlg <- smart_prune(tlg)+ |
+
195 | ++ |
+ }+ |
+
196 | +4x | +
+ std_postprocess(tlg)+ |
+
197 | ++ |
+ }+ |
+
198 | ++ |
+ #' `CFBT01` Change from Baseline By Visit Table.+ |
+
199 | ++ |
+ #'+ |
+
200 | ++ |
+ #' The `CFBT01` table provides an+ |
+
201 | ++ |
+ #' overview of the actual values and its change from baseline of each respective arm+ |
+
202 | ++ |
+ #' over the course of the trial.+ |
+
203 | ++ |
+ #'+ |
+
204 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
205 | ++ |
+ #' @export+ |
+
206 | ++ |
+ #'+ |
+
207 | ++ |
+ #' @examples+ |
+
208 | ++ |
+ #' library(dunlin)+ |
+
209 | ++ |
+ #' proc_data <- log_filter(+ |
+
210 | ++ |
+ #' syn_data,+ |
+
211 | ++ |
+ #' PARAMCD %in% c("DIABP", "SYSBP"), "advs"+ |
+
212 | ++ |
+ #' )+ |
+
213 | ++ |
+ #' run(cfbt01, proc_data, dataset = "advs")+ |
+
214 | ++ |
+ cfbt01 <- chevron_t(+ |
+
215 | ++ |
+ main = cfbt01_main,+ |
+
216 | ++ |
+ preprocess = cfbt01_pre,+ |
+
217 | ++ |
+ postprocess = cfbt01_post+ |
+
218 | ++ |
+ )+ |
+
1 | ++ |
+ # dtht01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn dtht01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param time_since_last_dose (`flag`) should the time to event information be displayed.+ |
+
7 | ++ |
+ #' @param other_category (`flag`) should the breakdown of the `OTHER` category be displayed.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.+ |
+
11 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
12 | ++ |
+ #' * Does not include a total column by default.+ |
+
13 | ++ |
+ #'+ |
+
14 | ++ |
+ #' @note+ |
+
15 | ++ |
+ #' * `adam_db` object must contain an `adsl` table with the columns `"DTHFL"`, `"DTHCAT"` as well as `LDDTHGR1` if+ |
+
16 | ++ |
+ #' `time_since_last_dose` is `TRUE`.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @export+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ dtht01_main <- function(adam_db,+ |
+
21 | ++ |
+ arm_var = "ACTARM",+ |
+
22 | ++ |
+ other_category = FALSE,+ |
+
23 | ++ |
+ time_since_last_dose = FALSE,+ |
+
24 | ++ |
+ lbl_overall = NULL,+ |
+
25 | ++ |
+ ...) {+ |
+
26 | +2x | +
+ assert_all_tablenames(adam_db, "adsl")+ |
+
27 | +2x | +
+ checkmate::assert_string(arm_var)+ |
+
28 | +2x | +
+ checkmate::assert_flag(other_category)+ |
+
29 | +2x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
30 | +2x | +
+ checkmate::assert_flag(time_since_last_dose, null.ok = TRUE)+ |
+
31 | +2x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
32 | +2x | +
+ other_var <- if (other_category) "DTHCAUS"+ |
+
33 | +2x | +
+ dose_death_var <- if (time_since_last_dose) "LDDTHGR1"+ |
+
34 | +2x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list("character", "factor"))+ |
+
35 | +2x | +
+ assert_valid_variable(+ |
+
36 | +2x | +
+ adam_db$adsl,+ |
+
37 | +2x | +
+ "DTHFL",+ |
+
38 | +2x | +
+ types = list("character", "factor"), na_ok = TRUE, min_chars = 0L+ |
+
39 | ++ |
+ )+ |
+
40 | +2x | +
+ assert_valid_variable(+ |
+
41 | +2x | +
+ adam_db$adsl,+ |
+
42 | +2x | +
+ c("DTHCAT", other_var, dose_death_var),+ |
+
43 | +2x | +
+ types = list("character", "factor"), na_ok = TRUE, min_chars = 1L+ |
+
44 | ++ |
+ )+ |
+
45 | +2x | +
+ if (other_category) {+ |
+
46 | +1x | +
+ death_cause <- lvls(adam_db$adsl$DTHCAT)+ |
+
47 | +1x | +
+ if (length(death_cause) == 0L) {+ |
+
48 | +! | +
+ stop("other_category specified but could not find any level in `DTHCAT`!")+ |
+
49 | ++ |
+ }+ |
+
50 | +1x | +
+ other_level <- death_cause[length(death_cause)]+ |
+
51 | +1x | +
+ if (toupper(other_level) != "OTHER") {+ |
+
52 | +! | +
+ warning(+ |
+
53 | +! | +
+ "You included detailed information for Other, however the last level of ",+ |
+
54 | +! | +
+ " `adam_db$adsl$DTHCAT` looks like not `Other`.",+ |
+
55 | +! | +
+ call. = FALSE+ |
+
56 | ++ |
+ )+ |
+
57 | ++ |
+ }+ |
+
58 | ++ |
+ }+ |
+
59 | ++ | + + | +
60 | +2x | +
+ lyt <- dtht01_lyt(+ |
+
61 | +2x | +
+ arm_var = arm_var,+ |
+
62 | +2x | +
+ lbl_overall = lbl_overall,+ |
+
63 | +2x | +
+ other_var = other_var,+ |
+
64 | +2x | +
+ other_level = other_level,+ |
+
65 | +2x | +
+ death_flag = "DTHFL",+ |
+
66 | +2x | +
+ death_var = "DTHCAT",+ |
+
67 | +2x | +
+ dose_death_var = dose_death_var+ |
+
68 | ++ |
+ )+ |
+
69 | +2x | +
+ adsl <- adam_db$adsl %>%+ |
+
70 | +2x | +
+ mutate(TOTAL = "Primary Cause of Death")+ |
+
71 | +2x | +
+ build_table(lyt, adsl)+ |
+
72 | ++ |
+ }+ |
+
73 | ++ | + + | +
74 | ++ |
+ #' `dtht01` Layout+ |
+
75 | ++ |
+ #'+ |
+
76 | ++ |
+ #' @inheritParams dtht01_main+ |
+
77 | ++ |
+ #' @param death_falg (`string`) variable name of death flag.+ |
+
78 | ++ |
+ #' @param detah_var (`string`) variable name of death category.+ |
+
79 | ++ |
+ #' @param other_level (`string`) `"Other"` level in death category.+ |
+
80 | ++ |
+ #' @param other_var (`string`) variable name of death cause under `"Other"`.+ |
+
81 | ++ |
+ #' @param dose_death_var (`string`) variable name of the days from last dose.+ |
+
82 | ++ |
+ #'+ |
+
83 | ++ |
+ #' @keywords internal+ |
+
84 | ++ |
+ #'+ |
+
85 | ++ |
+ dtht01_lyt <- function(arm_var,+ |
+
86 | ++ |
+ lbl_overall,+ |
+
87 | ++ |
+ death_flag,+ |
+
88 | ++ |
+ death_var,+ |
+
89 | ++ |
+ other_level,+ |
+
90 | ++ |
+ other_var,+ |
+
91 | ++ |
+ dose_death_var) {+ |
+
92 | +5x | +
+ if (is.null(dose_death_var) && is.null(other_var)) {+ |
+
93 | +3x | +
+ lyt_block_fun <- analyze+ |
+
94 | ++ |
+ } else {+ |
+
95 | +2x | +
+ lyt_block_fun <- summarize_row+ |
+
96 | ++ |
+ }+ |
+
97 | +5x | +
+ lyt <- basic_table() %>%+ |
+
98 | +5x | +
+ split_cols_by(arm_var) %>%+ |
+
99 | +5x | +
+ add_colcounts() %>%+ |
+
100 | +5x | +
+ count_values(+ |
+
101 | +5x | +
+ death_flag,+ |
+
102 | +5x | +
+ values = "Y",+ |
+
103 | +5x | +
+ .labels = c(count_fraction = "Total number of deaths"),+ |
+
104 | +5x | +
+ .formats = c(count_fraction = format_count_fraction_fixed_dp)+ |
+
105 | ++ |
+ ) %>%+ |
+
106 | +5x | +
+ split_rows_by("TOTAL", child_labels = "visible", label_pos = "hidden", split_fun = drop_split_levels) %>%+ |
+
107 | +5x | +
+ lyt_block_fun(+ |
+
108 | +5x | +
+ death_var,+ |
+
109 | +5x | +
+ make_afun(+ |
+
110 | +5x | +
+ s_summary_na,+ |
+
111 | +5x | +
+ .stats = c("n", "count_fraction"), .ungroup_stats = "count_fraction",+ |
+
112 | +5x | +
+ .formats = list(n = "xx", count_fraction = format_count_fraction_fixed_dp)+ |
+
113 | ++ |
+ ),+ |
+
114 | +5x | +
+ indent_mod = 0L+ |
+
115 | ++ |
+ )+ |
+
116 | +5x | +
+ if (!is.null(other_var)) {+ |
+
117 | +2x | +
+ lyt <- lyt %>%+ |
+
118 | +2x | +
+ split_rows_by(death_var, split_fun = keep_split_levels(other_level), child_labels = "hidden") %>%+ |
+
119 | +2x | +
+ summarize_vars(other_var, .stats = "count_fraction", denom = "N_row")+ |
+
120 | ++ |
+ }+ |
+
121 | +5x | +
+ if (!is.null(dose_death_var)) {+ |
+
122 | +2x | +
+ lyt <- lyt %>%+ |
+
123 | +2x | +
+ summarize_vars_allow_na(+ |
+
124 | +2x | +
+ vars = dose_death_var,+ |
+
125 | +2x | +
+ var_labels = "Days from last drug administration",+ |
+
126 | +2x | +
+ .formats = list(count_fraction = format_count_fraction_fixed_dp),+ |
+
127 | +2x | +
+ show_labels = "visible",+ |
+
128 | +2x | +
+ nested = FALSE,+ |
+
129 | +2x | +
+ inclNAs = FALSE+ |
+
130 | ++ |
+ ) %>%+ |
+
131 | +2x | +
+ split_rows_by(+ |
+
132 | +2x | +
+ dose_death_var,+ |
+
133 | +2x | +
+ split_fun = drop_split_levels,+ |
+
134 | +2x | +
+ split_label = "Primary cause by days from last study drug administration",+ |
+
135 | +2x | +
+ label_pos = "visible",+ |
+
136 | +2x | +
+ nested = FALSE+ |
+
137 | ++ |
+ ) %>%+ |
+
138 | +2x | +
+ summarize_vars_allow_na(+ |
+
139 | +2x | +
+ death_var,+ |
+
140 | +2x | +
+ .formats = list(count_fraction = format_count_fraction_fixed_dp)+ |
+
141 | ++ |
+ )+ |
+
142 | ++ |
+ }+ |
+
143 | +5x | +
+ lyt+ |
+
144 | ++ |
+ }+ |
+
145 | ++ | + + | +
146 | ++ |
+ #' @describeIn dtht01 Preprocessing+ |
+
147 | ++ |
+ #'+ |
+
148 | ++ |
+ #' @inheritParams gen_args+ |
+
149 | ++ |
+ #'+ |
+
150 | ++ |
+ #' @export+ |
+
151 | ++ |
+ #'+ |
+
152 | ++ |
+ dtht01_pre <- function(adam_db, ...) {+ |
+
153 | +2x | +
+ death_format <- rule(+ |
+
154 | +2x | +
+ "Adverse Event" = "ADVERSE EVENT",+ |
+
155 | +2x | +
+ "Progressive Disease" = "PROGRESSIVE DISEASE",+ |
+
156 | +2x | +
+ "Other" = "OTHER"+ |
+
157 | ++ |
+ )+ |
+
158 | +2x | +
+ adam_db$adsl <- adam_db$adsl %>%+ |
+
159 | +2x | +
+ mutate(+ |
+
160 | +2x | +
+ DTHCAT = reformat(.data$DTHCAT, death_format)+ |
+
161 | ++ |
+ )+ |
+
162 | +2x | +
+ adam_db+ |
+
163 | ++ |
+ }+ |
+
164 | ++ | + + | +
165 | ++ | + + | +
166 | ++ |
+ #' @describeIn dtht01 Postprocessing+ |
+
167 | ++ |
+ #'+ |
+
168 | ++ |
+ #' @inheritParams gen_args+ |
+
169 | ++ |
+ #'+ |
+
170 | ++ |
+ #' @export+ |
+
171 | ++ |
+ #'+ |
+
172 | ++ |
+ dtht01_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
173 | +2x | +
+ if (prune_0) {+ |
+
174 | +2x | +
+ tlg <- smart_prune(tlg)+ |
+
175 | ++ |
+ }+ |
+
176 | +2x | +
+ std_postprocess(tlg)+ |
+
177 | ++ |
+ }+ |
+
178 | ++ | + + | +
179 | ++ |
+ #' `DTHT01` Table 1 (Default) Death Table.+ |
+
180 | ++ |
+ #'+ |
+
181 | ++ |
+ #' A description of the causes of death optionally with the breakdown of the+ |
+
182 | ++ |
+ #' `OTHER` category and/or post-study reporting of death.+ |
+
183 | ++ |
+ #'+ |
+
184 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
185 | ++ |
+ #' @export+ |
+
186 | ++ |
+ #'+ |
+
187 | ++ |
+ #' @examples+ |
+
188 | ++ |
+ #'+ |
+
189 | ++ |
+ #' db <- syn_data+ |
+
190 | ++ |
+ #'+ |
+
191 | ++ |
+ #' run(dtht01, db)+ |
+
192 | ++ |
+ #' run(dtht01, db, other_category = TRUE, time_since_last_dose = TRUE)+ |
+
193 | ++ |
+ dtht01 <- chevron_t(+ |
+
194 | ++ |
+ main = dtht01_main,+ |
+
195 | ++ |
+ preprocess = dtht01_pre,+ |
+
196 | ++ |
+ postprocess = dtht01_post+ |
+
197 | ++ |
+ )+ |
+
1 | ++ |
+ # dmt01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn dmt01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param summaryvars (`character`) variables summarized in demographic table. The label attribute of the corresponding+ |
+
7 | ++ |
+ #' column in `adsl` table of `adam_db` is used as label.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' * Information from `ADSUB` are generally included into `ADSL` before analysis.+ |
+
11 | ++ |
+ #' * Default demographic and characteristics table+ |
+
12 | ++ |
+ #' * If not specified otherwise, numbers represent absolute numbers of patients and fraction of `N`+ |
+
13 | ++ |
+ #' * Remove zero-count rows+ |
+
14 | ++ |
+ #' * Split columns by arm (planned or actual / code or description)+ |
+
15 | ++ |
+ #' * Include a total column by default+ |
+
16 | ++ |
+ #'+ |
+
17 | ++ |
+ #' @note+ |
+
18 | ++ |
+ #' * `adam_db` object must contain an `adsl` table with the columns specified in `summaryvars`.+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ #' @export+ |
+
21 | ++ |
+ #'+ |
+
22 | ++ |
+ dmt01_main <- function(adam_db,+ |
+
23 | ++ |
+ arm_var = "ARM",+ |
+
24 | ++ |
+ summaryvars = c(+ |
+
25 | ++ |
+ "AAGE",+ |
+
26 | ++ |
+ "AGEGR1",+ |
+
27 | ++ |
+ "SEX",+ |
+
28 | ++ |
+ "ETHNIC",+ |
+
29 | ++ |
+ "RACE"+ |
+
30 | ++ |
+ ),+ |
+
31 | ++ |
+ lbl_overall = "All {Patient_label}",+ |
+
32 | ++ |
+ ...) {+ |
+
33 | +1x | +
+ assert_valid_variable(adam_db$adsl, summaryvars)+ |
+
34 | +1x | +
+ summaryvars_lbls <- var_labels_for(adam_db$adsl, summaryvars)+ |
+
35 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
36 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
37 | +1x | +
+ lyt <- dmt01_lyt(+ |
+
38 | +1x | +
+ arm_var = arm_var,+ |
+
39 | +1x | +
+ summaryvars = summaryvars,+ |
+
40 | +1x | +
+ summaryvars_lbls = summaryvars_lbls,+ |
+
41 | +1x | +
+ lbl_overall = lbl_overall+ |
+
42 | ++ |
+ )+ |
+
43 | ++ | + + | +
44 | +1x | +
+ tbl <- build_table(lyt, adam_db$adsl)+ |
+
45 | ++ | + + | +
46 | +1x | +
+ tbl+ |
+
47 | ++ |
+ }+ |
+
48 | ++ | + + | +
49 | ++ |
+ #' `dmt01` Layout+ |
+
50 | ++ |
+ #' @param summaryvars_lbls (`character`) labels corresponding to the analyzed variables.+ |
+
51 | ++ |
+ #'+ |
+
52 | ++ |
+ #' @inheritParams gen_args+ |
+
53 | ++ |
+ #'+ |
+
54 | ++ |
+ #'+ |
+
55 | ++ |
+ #' @keywords internal+ |
+
56 | ++ |
+ #'+ |
+
57 | ++ |
+ dmt01_lyt <- function(arm_var,+ |
+
58 | ++ |
+ summaryvars,+ |
+
59 | ++ |
+ summaryvars_lbls,+ |
+
60 | ++ |
+ lbl_overall) {+ |
+
61 | +4x | +
+ basic_table() %>%+ |
+
62 | +4x | +
+ split_cols_by(var = arm_var) %>%+ |
+
63 | +4x | +
+ add_colcounts() %>%+ |
+
64 | +4x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
65 | +4x | +
+ summarize_vars(+ |
+
66 | +4x | +
+ vars = summaryvars,+ |
+
67 | +4x | +
+ var_labels = summaryvars_lbls,+ |
+
68 | +4x | +
+ .formats = list(count_fraction = format_count_fraction_fixed_dp)+ |
+
69 | ++ |
+ )+ |
+
70 | ++ |
+ }+ |
+
71 | ++ | + + | +
72 | ++ |
+ #' @describeIn dmt01 Preprocessing+ |
+
73 | ++ |
+ #'+ |
+
74 | ++ |
+ #' @inheritParams gen_args+ |
+
75 | ++ |
+ #'+ |
+
76 | ++ |
+ #'+ |
+
77 | ++ |
+ #' @export+ |
+
78 | ++ |
+ #'+ |
+
79 | ++ |
+ dmt01_pre <- function(adam_db, ...) {+ |
+
80 | +1x | +
+ adam_db$adsl <- adam_db$adsl %>%+ |
+
81 | +1x | +
+ mutate(SEX = reformat(.data$SEX, rule(Male = "M", Female = "F")))+ |
+
82 | +1x | +
+ adam_db+ |
+
83 | ++ |
+ }+ |
+
84 | ++ | + + | +
85 | ++ |
+ #' @describeIn dmt01 Postprocessing+ |
+
86 | ++ |
+ #'+ |
+
87 | ++ |
+ #' @inheritParams gen_args+ |
+
88 | ++ |
+ #'+ |
+
89 | ++ |
+ #'+ |
+
90 | ++ |
+ #' @export+ |
+
91 | ++ |
+ dmt01_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
92 | +1x | +
+ if (prune_0) {+ |
+
93 | +1x | +
+ tlg <- smart_prune(tlg)+ |
+
94 | ++ |
+ }+ |
+
95 | +1x | +
+ std_postprocess(tlg)+ |
+
96 | ++ |
+ }+ |
+
97 | ++ | + + | +
98 | ++ |
+ #' `DMT01` Table 1 (Default) Demographics and Baseline Characteristics Table 1.+ |
+
99 | ++ |
+ #'+ |
+
100 | ++ |
+ #' For each variable, summary statistics are+ |
+
101 | ++ |
+ #' by default based on the number of patients in the corresponding `n` row.+ |
+
102 | ++ |
+ #'+ |
+
103 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
104 | ++ |
+ #' @export+ |
+
105 | ++ |
+ #'+ |
+
106 | ++ |
+ #' @examples+ |
+
107 | ++ |
+ #' run(dmt01, syn_data)+ |
+
108 | ++ |
+ dmt01 <- chevron_t(+ |
+
109 | ++ |
+ main = dmt01_main,+ |
+
110 | ++ |
+ preprocess = dmt01_pre,+ |
+
111 | ++ |
+ postprocess = dmt01_post+ |
+
112 | ++ |
+ )+ |
+
1 | ++ |
+ # lbt14 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn lbt14 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param gr_missing (`string`) how missing baseline grades should be handled. Defaults to `"incl"` to include the+ |
+
7 | ++ |
+ #' `"Missing"`+ |
+
8 | ++ |
+ #' level. Other options are `"excl"` to exclude patients with missing baseline grades and `"gr_0"` to convert missing+ |
+
9 | ++ |
+ #' baseline grades to grade 0.+ |
+
10 | ++ |
+ #' @param direction (`string`) one of `"high"` or `"low"` indicating which shift direction should be detailed.+ |
+
11 | ++ |
+ #'+ |
+
12 | ++ |
+ #' @details+ |
+
13 | ++ |
+ #' * Only the worst grade recorded for each patient is included in the table.+ |
+
14 | ++ |
+ #' * If no missing baseline lab results, the "Missing" level of `BTOXGR` is excluded.+ |
+
15 | ++ |
+ #' * Grades 0, 1, 2, 3, and 4 are counted as `"Not Low"` when `direction = "low"`. Conversely, when `direction =+ |
+
16 | ++ |
+ #' "high"`, Grades 0, -1, -2, -3, and -4 are counted as `"Not High".+ |
+
17 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
18 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ #' @note+ |
+
21 | ++ |
+ #' * `adam_db` object must contain an `adlb` table with columns `"USUBJID"`, `"PARAM"`, `"BTOXGR"`, `"ATOXGR"`,+ |
+
22 | ++ |
+ #' and the column specified by `arm_var`.+ |
+
23 | ++ |
+ #'+ |
+
24 | ++ |
+ #' @export+ |
+
25 | ++ |
+ #'+ |
+
26 | ++ |
+ lbt14_main <- function(adam_db,+ |
+
27 | ++ |
+ arm_var = "ACTARM",+ |
+
28 | ++ |
+ gr_missing = "incl",+ |
+
29 | ++ |
+ ...) {+ |
+
30 | +4x | +
+ assert_all_tablenames(adam_db, c("adsl", "adlb"))+ |
+
31 | +4x | +
+ checkmate::assert_string(arm_var)+ |
+
32 | +4x | +
+ checkmate::assert_choice(gr_missing, c("incl", "excl", "gr_0"))+ |
+
33 | +4x | +
+ assert_valid_variable(adam_db$adlb, c("ATOXGR", "BTOXGR"), types = list("factor"), na_ok = TRUE)+ |
+
34 | +4x | +
+ assert_valid_variable(adam_db$adlb, c("PARAM"), types = list(c("character", "factor")), na_ok = FALSE)+ |
+
35 | +4x | +
+ assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
36 | +4x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))+ |
+
37 | +4x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)+ |
+
38 | ++ | + + | +
39 | +4x | +
+ lyt <- lbt14_lyt(+ |
+
40 | +4x | +
+ arm_var = arm_var+ |
+
41 | ++ |
+ )+ |
+
42 | ++ | + + | +
43 | +4x | +
+ tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)+ |
+
44 | ++ | + + | +
45 | +4x | +
+ tbl+ |
+
46 | ++ |
+ }+ |
+
47 | ++ | + + | +
48 | ++ |
+ #' `lbt14` Layout+ |
+
49 | ++ |
+ #'+ |
+
50 | ++ |
+ #' @inheritParams lbt14_main+ |
+
51 | ++ |
+ #'+ |
+
52 | ++ |
+ #' @keywords internal+ |
+
53 | ++ |
+ #'+ |
+
54 | ++ |
+ lbt14_lyt <- function(arm_var) {+ |
+
55 | +14x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
56 | +14x | +
+ split_cols_by(arm_var) %>%+ |
+
57 | +14x | +
+ split_rows_by(+ |
+
58 | +14x | +
+ "PARAM",+ |
+
59 | +14x | +
+ split_fun = drop_split_levels,+ |
+
60 | +14x | +
+ label_pos = "topleft",+ |
+
61 | +14x | +
+ split_label = "Parameter"+ |
+
62 | ++ |
+ ) %>%+ |
+
63 | +14x | +
+ split_rows_by(+ |
+
64 | +14x | +
+ "BTOXGR",+ |
+
65 | +14x | +
+ label_pos = "topleft",+ |
+
66 | +14x | +
+ split_label = " Baseline NCI-CTCAE Grade",+ |
+
67 | +14x | +
+ indent_mod = 2L+ |
+
68 | ++ |
+ ) %>%+ |
+
69 | +14x | +
+ summarize_num_patients(var = "USUBJID", .stats = c("unique_count"), unique_count_suffix = FALSE) %>%+ |
+
70 | +14x | +
+ count_occurrences_by_grade("ATOXGR", denom = "n", drop = FALSE, .indent_mods = 3L) %>%+ |
+
71 | +14x | +
+ append_topleft(" Post-baseline NCI-CTCAE Grade")+ |
+
72 | ++ |
+ }+ |
+
73 | ++ | + + | +
74 | ++ |
+ #' @describeIn lbt14 Preprocessing+ |
+
75 | ++ |
+ #'+ |
+
76 | ++ |
+ #' @inheritParams gen_args+ |
+
77 | ++ |
+ #' @inheritParams lbt14_main+ |
+
78 | ++ |
+ #'+ |
+
79 | ++ |
+ #' @export+ |
+
80 | ++ |
+ #'+ |
+
81 | ++ |
+ lbt14_pre <- function(adam_db,+ |
+
82 | ++ |
+ gr_missing = "incl",+ |
+
83 | ++ |
+ direction = "low",+ |
+
84 | ++ |
+ ...) {+ |
+
85 | +4x | +
+ checkmate::assert_choice(gr_missing, c("incl", "excl", "gr_0"))+ |
+
86 | +4x | +
+ checkmate::assert_choice(direction, c("low", "high"))+ |
+
87 | +4x | +
+ if (direction == "high") {+ |
+
88 | +1x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
89 | +1x | +
+ filter(.data$WGRHIFL == "Y") %>%+ |
+
90 | +1x | +
+ h_adsl_adlb_merge_using_worst_flag(+ |
+
91 | +1x | +
+ adsl = adam_db$adsl,+ |
+
92 | +1x | +
+ worst_flag = c("WGRHIFL" = "Y")+ |
+
93 | ++ |
+ )+ |
+
94 | ++ |
+ } else {+ |
+
95 | +3x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
96 | +3x | +
+ filter(.data$WGRLOFL == "Y") %>%+ |
+
97 | +3x | +
+ h_adsl_adlb_merge_using_worst_flag(+ |
+
98 | +3x | +
+ adsl = adam_db$adsl,+ |
+
99 | +3x | +
+ worst_flag = c("WGRLOFL" = "Y")+ |
+
100 | ++ |
+ )+ |
+
101 | ++ |
+ }+ |
+
102 | +4x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
103 | +4x | +
+ mutate(+ |
+
104 | +4x | +
+ across(all_of(c("BTOXGR", "ATOXGR")), ~ forcats::fct_na_level_to_value(.x, "<Missing>"))+ |
+
105 | ++ |
+ )+ |
+
106 | ++ | + + | +
107 | +4x | +
+ grade_rule <- get_grade_rule(direction, gr_missing)+ |
+
108 | +4x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
109 | +4x | +
+ mutate(+ |
+
110 | +4x | +
+ across(all_of(c("BTOXGR", "ATOXGR")), ~ reformat(.x, grade_rule))+ |
+
111 | ++ |
+ )+ |
+
112 | +4x | +
+ adam_db+ |
+
113 | ++ |
+ }+ |
+
114 | ++ | + + | +
115 | ++ |
+ #' @describeIn lbt14 Postprocessing+ |
+
116 | ++ |
+ #'+ |
+
117 | ++ |
+ #' @inheritParams gen_args+ |
+
118 | ++ |
+ #'+ |
+
119 | ++ |
+ #' @export+ |
+
120 | ++ |
+ #'+ |
+
121 | ++ |
+ lbt14_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
122 | +4x | +
+ if (prune_0) tlg <- tlg %>% trim_rows()+ |
+
123 | +4x | +
+ std_postprocess(tlg)+ |
+
124 | ++ |
+ }+ |
+
125 | ++ | + + | +
126 | ++ |
+ #' `LBT14` Laboratory Test Results Shift Table – Highest `NCI-CTCAE` Grade Post-Baseline by+ |
+
127 | ++ |
+ #' Baseline Grade (Low or High Direction).+ |
+
128 | ++ |
+ #'+ |
+
129 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
130 | ++ |
+ #' @export+ |
+
131 | ++ |
+ #'+ |
+
132 | ++ |
+ #' @examples+ |
+
133 | ++ |
+ #' run(lbt14, syn_data)+ |
+
134 | ++ |
+ lbt14 <- chevron_t(+ |
+
135 | ++ |
+ main = lbt14_main,+ |
+
136 | ++ |
+ preprocess = lbt14_pre,+ |
+
137 | ++ |
+ postprocess = lbt14_post+ |
+
138 | ++ |
+ )+ |
+
1 | ++ |
+ # aet04 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn aet04 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param grade_groups (`list`) putting in correspondence toxicity grades and labels.+ |
+
7 | ++ |
+ #'+ |
+
8 | ++ |
+ #' @details+ |
+
9 | ++ |
+ #' * Numbers represent absolute numbers of patients and fraction of `N`, or absolute number of event when specified.+ |
+
10 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
11 | ++ |
+ #' * Events with missing grading values are excluded.+ |
+
12 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
13 | ++ |
+ #' * Does not include a total column by default.+ |
+
14 | ++ |
+ #' * Sort Body System or Organ Class and Dictionary-Derived Term by highest overall frequencies. Analysis Toxicity+ |
+
15 | ++ |
+ #' Grade is sorted by severity.+ |
+
16 | ++ |
+ #'+ |
+
17 | ++ |
+ #' @note+ |
+
18 | ++ |
+ #' * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"`, `"AEDECOD"` and `"ATOXGR"`.+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ #' @export+ |
+
21 | ++ |
+ #'+ |
+
22 | ++ |
+ aet04_main <- function(adam_db,+ |
+
23 | ++ |
+ arm_var = "ACTARM",+ |
+
24 | ++ |
+ lbl_overall = NULL,+ |
+
25 | ++ |
+ grade_groups = NULL,+ |
+
26 | ++ |
+ ...) {+ |
+
27 | +1x | +
+ assert_all_tablenames(adam_db, "adsl", "adae")+ |
+
28 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
29 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
30 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
31 | +1x | +
+ assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD"), types = list(c("character", "factor")))+ |
+
32 | +1x | +
+ assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
33 | +1x | +
+ assert_valid_variable(adam_db$adae, "ATOXGR", na_ok = TRUE, types = list("factor"))+ |
+
34 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)+ |
+
35 | ++ | + + | +
36 | +1x | +
+ lbl_aebodsys <- var_labels_for(adam_db$adae, "AEBODSYS")+ |
+
37 | +1x | +
+ lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")+ |
+
38 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
39 | +1x | +
+ checkmate::assert_list(grade_groups, types = "character", null.ok = TRUE)+ |
+
40 | +1x | +
+ if (is.null(grade_groups)) {+ |
+
41 | +1x | +
+ grade_groups <- list(+ |
+
42 | +1x | +
+ "Grade 1-2" = c("1", "2"),+ |
+
43 | +1x | +
+ "Grade 3-4" = c("3", "4"),+ |
+
44 | +1x | +
+ "Grade 5" = c("5")+ |
+
45 | ++ |
+ )+ |
+
46 | ++ |
+ }+ |
+
47 | ++ | + + | +
48 | +1x | +
+ lyt <- aet04_lyt(+ |
+
49 | +1x | +
+ arm_var = arm_var,+ |
+
50 | +1x | +
+ total_var = "TOTAL_VAR",+ |
+
51 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
52 | +1x | +
+ lbl_aebodsys = lbl_aebodsys,+ |
+
53 | +1x | +
+ lbl_aedecod = lbl_aedecod,+ |
+
54 | +1x | +
+ grade_groups = grade_groups+ |
+
55 | ++ |
+ )+ |
+
56 | +1x | +
+ adam_db$adae$TOTAL_VAR <- "- Any adverse events - "+ |
+
57 | +1x | +
+ tbl <- build_table(lyt, df = adam_db$adae, alt_counts_df = adam_db$adsl)+ |
+
58 | ++ | + + | +
59 | +1x | +
+ tbl+ |
+
60 | ++ |
+ }+ |
+
61 | ++ | + + | +
62 | ++ |
+ #' `aet04` Layout+ |
+
63 | ++ |
+ #'+ |
+
64 | ++ |
+ #' @inheritParams aet04_main+ |
+
65 | ++ |
+ #'+ |
+
66 | ++ |
+ #' @param lbl_aebodsys (`string`) text label for `AEBODSYS`.+ |
+
67 | ++ |
+ #' @param lbl_aedecod (`string`) text label for `AEDECOD`.+ |
+
68 | ++ |
+ #' @param grade_groups (`list`) putting in correspondence toxicity grades and labels.+ |
+
69 | ++ |
+ #' @param total_var (`string`) variable to create summary of all variables.+ |
+
70 | ++ |
+ #'+ |
+
71 | ++ |
+ #' @keywords internal+ |
+
72 | ++ |
+ #'+ |
+
73 | ++ |
+ aet04_lyt <- function(arm_var,+ |
+
74 | ++ |
+ total_var,+ |
+
75 | ++ |
+ lbl_overall,+ |
+
76 | ++ |
+ lbl_aebodsys,+ |
+
77 | ++ |
+ lbl_aedecod,+ |
+
78 | ++ |
+ grade_groups) {+ |
+
79 | +8x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
80 | +8x | +
+ split_cols_by(var = arm_var) %>%+ |
+
81 | +8x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
82 | +8x | +
+ split_rows_by(+ |
+
83 | +8x | +
+ var = total_var,+ |
+
84 | +8x | +
+ label_pos = "hidden",+ |
+
85 | +8x | +
+ child_labels = "visible",+ |
+
86 | +8x | +
+ indent_mod = -1L+ |
+
87 | ++ |
+ ) %>%+ |
+
88 | +8x | +
+ summarize_num_patients(+ |
+
89 | +8x | +
+ var = "USUBJID",+ |
+
90 | +8x | +
+ .stats = "unique",+ |
+
91 | +8x | +
+ .labels = "- Any Grade -",+ |
+
92 | +8x | +
+ .indent_mods = 7L+ |
+
93 | ++ |
+ ) %>%+ |
+
94 | +8x | +
+ count_occurrences_by_grade(+ |
+
95 | +8x | +
+ var = "ATOXGR",+ |
+
96 | +8x | +
+ grade_groups = grade_groups,+ |
+
97 | +8x | +
+ .indent_mods = 6L+ |
+
98 | ++ |
+ ) %>%+ |
+
99 | +8x | +
+ split_rows_by(+ |
+
100 | +8x | +
+ "AEBODSYS",+ |
+
101 | +8x | +
+ child_labels = "visible",+ |
+
102 | +8x | +
+ nested = FALSE,+ |
+
103 | +8x | +
+ split_fun = drop_split_levels,+ |
+
104 | +8x | +
+ label_pos = "topleft",+ |
+
105 | +8x | +
+ split_label = lbl_aebodsys+ |
+
106 | ++ |
+ ) %>%+ |
+
107 | +8x | +
+ split_rows_by(+ |
+
108 | +8x | +
+ "AEDECOD",+ |
+
109 | +8x | +
+ child_labels = "visible",+ |
+
110 | +8x | +
+ split_fun = add_overall_level("- Overall -", trim = TRUE),+ |
+
111 | +8x | +
+ label_pos = "topleft",+ |
+
112 | +8x | +
+ split_label = lbl_aedecod+ |
+
113 | ++ |
+ ) %>%+ |
+
114 | +8x | +
+ summarize_num_patients(+ |
+
115 | +8x | +
+ var = "USUBJID",+ |
+
116 | +8x | +
+ .stats = "unique",+ |
+
117 | +8x | +
+ .labels = "- Any Grade -",+ |
+
118 | +8x | +
+ .indent_mods = 6L+ |
+
119 | ++ |
+ ) %>%+ |
+
120 | +8x | +
+ count_occurrences_by_grade(+ |
+
121 | +8x | +
+ var = "ATOXGR",+ |
+
122 | +8x | +
+ grade_groups = grade_groups,+ |
+
123 | +8x | +
+ .indent_mods = 5L+ |
+
124 | ++ |
+ ) %>%+ |
+
125 | +8x | +
+ append_topleft(" Grade")+ |
+
126 | ++ |
+ }+ |
+
127 | ++ | + + | +
128 | ++ |
+ #' @describeIn aet04 Preprocessing+ |
+
129 | ++ |
+ #'+ |
+
130 | ++ |
+ #' @inheritParams gen_args+ |
+
131 | ++ |
+ #'+ |
+
132 | ++ |
+ #' @export+ |
+
133 | ++ |
+ #'+ |
+
134 | ++ |
+ aet04_pre <- function(adam_db, ...) {+ |
+
135 | +1x | +
+ atoxgr_lvls <- c("1", "2", "3", "4", "5")+ |
+
136 | +1x | +
+ adam_db$adae <- adam_db$adae %>%+ |
+
137 | +1x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
138 | +1x | +
+ mutate(+ |
+
139 | +1x | +
+ AEBODSYS = reformat(.data$AEBODSYS, nocoding),+ |
+
140 | +1x | +
+ AEDECOD = reformat(.data$AEDECOD, nocoding),+ |
+
141 | +1x | +
+ ATOXGR = factor(.data$ATOXGR, levels = atoxgr_lvls)+ |
+
142 | ++ |
+ )+ |
+
143 | +1x | +
+ adam_db+ |
+
144 | ++ |
+ }+ |
+
145 | ++ | + + | +
146 | ++ |
+ #' @describeIn aet04 Postprocessing+ |
+
147 | ++ |
+ #'+ |
+
148 | ++ |
+ #' @inheritParams gen_args+ |
+
149 | ++ |
+ #'+ |
+
150 | ++ |
+ #' @export+ |
+
151 | ++ |
+ #'+ |
+
152 | ++ |
+ aet04_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
153 | +1x | +
+ tlg <- tlg %>%+ |
+
154 | +1x | +
+ tlg_sort_by_vars(c("AEBODSYS", "AEDECOD"), score_all_sum, decreasing = TRUE)+ |
+
155 | +1x | +
+ if (prune_0) tlg <- trim_rows(tlg)+ |
+
156 | +1x | +
+ std_postprocess(tlg)+ |
+
157 | ++ |
+ }+ |
+
158 | ++ | + + | +
159 | ++ |
+ #' `AET04` Table 1 (Default) Adverse Events by Highest `NCI` `CTACAE` `AE` Grade Table 1.+ |
+
160 | ++ |
+ #'+ |
+
161 | ++ |
+ #' The `AET04` table provides an+ |
+
162 | ++ |
+ #' overview of adverse event with the highest `NCI` `CTCAE` grade per individual.+ |
+
163 | ++ |
+ #'+ |
+
164 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
165 | ++ |
+ #' @export+ |
+
166 | ++ |
+ #'+ |
+
167 | ++ |
+ #' @examples+ |
+
168 | ++ |
+ #' grade_groups <- list(+ |
+
169 | ++ |
+ #' "Grade 1-2" = c("1", "2"),+ |
+
170 | ++ |
+ #' "Grade 3-4" = c("3", "4"),+ |
+
171 | ++ |
+ #' "Grade 5" = c("5")+ |
+
172 | ++ |
+ #' )+ |
+
173 | ++ |
+ #' proc_data <- dunlin::log_filter(syn_data, AEBODSYS == "cl A.1", "adae")+ |
+
174 | ++ |
+ #' run(aet04, proc_data, grade_groups = grade_groups)+ |
+
175 | ++ |
+ aet04 <- chevron_t(+ |
+
176 | ++ |
+ main = aet04_main,+ |
+
177 | ++ |
+ preprocess = aet04_pre,+ |
+
178 | ++ |
+ postprocess = aet04_post+ |
+
179 | ++ |
+ )+ |
+
1 | ++ |
+ # assert_all_tablenames ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' Assert that all names are among names of a `list` of `data.frame`.+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @param db (`list` of `data.frame`) input to check for the presence of tables.+ |
+
6 | ++ |
+ #' @param tab (`character`) the names of the tables to be checked.+ |
+
7 | ++ |
+ #' @param null_ok (`flag`) can `x` be NULL.+ |
+
8 | ++ |
+ #' @param qualifier (`string`) to be returned if the check fails.+ |
+
9 | ++ |
+ #'+ |
+
10 | ++ |
+ #' @export+ |
+
11 | ++ |
+ #'+ |
+
12 | ++ |
+ #' @examples+ |
+
13 | ++ |
+ #' \dontrun{+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' lsd <- list(+ |
+
16 | ++ |
+ #' mtcars = mtcars,+ |
+
17 | ++ |
+ #' iris = iris+ |
+
18 | ++ |
+ #' )+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ #' assert_all_tablenames(lsd, c("mtcars", "iris", "x"), qualifier = "first test:")+ |
+
21 | ++ |
+ #' }+ |
+
22 | ++ |
+ assert_all_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {+ |
+
23 | +211x | +
+ checkmate::assert_list(db, types = "data.frame", names = "unique")+ |
+
24 | +211x | +
+ checkmate::assert_character(tab, null.ok = null_ok)+ |
+
25 | +211x | +
+ checkmate::assert_string(qualifier, null.ok = TRUE)+ |
+
26 | ++ | + + | +
27 | +211x | +
+ diff <- setdiff(tab, names(db))+ |
+
28 | ++ | + + | +
29 | +211x | +
+ if (length(diff) == 0) {+ |
+
30 | +209x | +
+ invisible(NULL)+ |
+
31 | ++ |
+ } else {+ |
+
32 | +2x | +
+ stop(+ |
+
33 | +2x | +
+ paste(qualifier, "Expected table names:", toString(diff), "not in", deparse(substitute(db)))+ |
+
34 | ++ |
+ )+ |
+
35 | ++ |
+ }+ |
+
36 | ++ |
+ }+ |
+
37 | ++ | + + | +
38 | ++ |
+ # assert_one_tablenames ----+ |
+
39 | ++ | + + | +
40 | ++ |
+ #' Assert that at least one name is among table names of a `list` of `data.frame`.+ |
+
41 | ++ |
+ #'+ |
+
42 | ++ |
+ #' @param db (`list` of `data.frame`) input to check for the presence or tables.+ |
+
43 | ++ |
+ #' @param tab (`character`) the names of the tables to be checked.+ |
+
44 | ++ |
+ #' @param null_ok (`flag`) can `x` be NULL.+ |
+
45 | ++ |
+ #' @param qualifier (`string`) to be returned if the check fails.+ |
+
46 | ++ |
+ #'+ |
+
47 | ++ |
+ #' @keywords internal+ |
+
48 | ++ |
+ #'+ |
+
49 | ++ |
+ #' @examples+ |
+
50 | ++ |
+ #' \dontrun{+ |
+
51 | ++ |
+ #'+ |
+
52 | ++ |
+ #' lsd <- list(+ |
+
53 | ++ |
+ #' mtcars = mtcars,+ |
+
54 | ++ |
+ #' iris = iris+ |
+
55 | ++ |
+ #' )+ |
+
56 | ++ |
+ #'+ |
+
57 | ++ |
+ #' assert_one_tablenames(lsd, c("mtcars", "x", "y"), qualifier = "first test:")+ |
+
58 | ++ |
+ #' }+ |
+
59 | ++ |
+ assert_one_tablenames <- function(db, tab, null_ok = TRUE, qualifier = NULL) {+ |
+
60 | +4x | +
+ checkmate::assert_list(db, types = "data.frame", names = "unique")+ |
+
61 | +4x | +
+ checkmate::assert_character(tab, null.ok = null_ok)+ |
+
62 | +4x | +
+ checkmate::assert_string(qualifier, null.ok = TRUE)+ |
+
63 | ++ | + + | +
64 | +4x | +
+ diff <- setdiff(tab, names(db))+ |
+
65 | ++ | + + | +
66 | +4x | +
+ common <- intersect(tab, names(db))+ |
+
67 | ++ | + + | +
68 | +4x | +
+ if (length(common) > 0) {+ |
+
69 | +2x | +
+ invisible(NULL)+ |
+
70 | ++ |
+ } else {+ |
+
71 | +2x | +
+ stop(+ |
+
72 | +2x | +
+ paste(qualifier, "At least one of:", toString(tab), "is expected to be a table name of", deparse(substitute(db)))+ |
+
73 | ++ |
+ )+ |
+
74 | ++ |
+ }+ |
+
75 | ++ |
+ }+ |
+
76 | ++ | + + | +
77 | ++ | + + | +
78 | ++ | + + | +
79 | ++ |
+ # assert_single_value ----+ |
+
80 | ++ | + + | +
81 | ++ |
+ #' Check variable only has one unique value.+ |
+
82 | ++ |
+ #' @param x value vector.+ |
+
83 | ++ |
+ #' @param label (`string`) label of input.+ |
+
84 | ++ |
+ #' @export+ |
+
85 | ++ |
+ assert_single_value <- function(x, label = deparse(substitute(x))) {+ |
+
86 | +38x | +
+ unique_param_val <- unique(x)+ |
+
87 | +38x | +
+ if (length(unique_param_val) > 1) {+ |
+
88 | +! | +
+ stop(+ |
+
89 | +! | +
+ quote_str(label),+ |
+
90 | +! | +
+ " has more than one values ",+ |
+
91 | +! | +
+ toString(unique_param_val),+ |
+
92 | +! | +
+ ", only one value is allowed."+ |
+
93 | ++ |
+ )+ |
+
94 | ++ |
+ }+ |
+
95 | ++ |
+ }+ |
+
96 | ++ | + + | +
97 | ++ |
+ # assert_valid_var ----+ |
+
98 | ++ | + + | +
99 | ++ |
+ #' @title Check whether var is valid+ |
+
100 | ++ |
+ #' @details+ |
+
101 | ++ |
+ #' This function checks the variable values are valid or not.+ |
+
102 | ++ |
+ #' @param x value of col_split variable+ |
+
103 | ++ |
+ #' @param label (`string`) hints.+ |
+
104 | ++ |
+ #' @param na_ok (`flag`) whether NA value is allowed+ |
+
105 | ++ |
+ #' @param empty_ok (`flag`) whether length 0 value is allowed.+ |
+
106 | ++ |
+ #' @param ... Further arguments to methods.+ |
+
107 | ++ |
+ #' @export+ |
+
108 | ++ |
+ assert_valid_var <- function(x, label, na_ok, empty_ok, ...) {+ |
+
109 | +1297x | +
+ UseMethod("assert_valid_var")+ |
+
110 | ++ |
+ }+ |
+
111 | ++ |
+ #' @rdname assert_valid_var+ |
+
112 | ++ |
+ #' @export+ |
+
113 | ++ |
+ #' @param min_chars (`integer`) the minimum length of the characters.+ |
+
114 | ++ |
+ assert_valid_var.character <- function(+ |
+
115 | ++ |
+ x, label = deparse(substitute(x)),+ |
+
116 | ++ |
+ na_ok = FALSE, empty_ok = FALSE,+ |
+
117 | ++ |
+ min_chars = 1L, ...) {+ |
+
118 | +304x | +
+ checkmate::assert_character(+ |
+
119 | +304x | +
+ x,+ |
+
120 | +304x | +
+ min.chars = min_chars,+ |
+
121 | +304x | +
+ min.len = as.integer(!empty_ok),+ |
+
122 | +304x | +
+ any.missing = na_ok,+ |
+
123 | +304x | +
+ .var.name = label,+ |
+
124 | ++ |
+ ...+ |
+
125 | ++ |
+ )+ |
+
126 | ++ |
+ }+ |
+
127 | ++ | + + | +
128 | ++ |
+ #' @rdname assert_valid_var+ |
+
129 | ++ |
+ #' @export+ |
+
130 | ++ |
+ assert_valid_var.factor <- function(+ |
+
131 | ++ |
+ x, label = deparse(substitute(x)),+ |
+
132 | ++ |
+ na_ok = FALSE, empty_ok = FALSE,+ |
+
133 | ++ |
+ min_chars = 1L, ...) {+ |
+
134 | +764x | +
+ checkmate::assert_character(+ |
+
135 | +764x | +
+ levels(x),+ |
+
136 | +764x | +
+ min.chars = min_chars,+ |
+
137 | +764x | +
+ .var.name = paste("level of", label)+ |
+
138 | ++ |
+ )+ |
+
139 | +763x | +
+ checkmate::assert_factor(+ |
+
140 | +763x | +
+ x,+ |
+
141 | +763x | +
+ min.levels = as.integer(!empty_ok),+ |
+
142 | +763x | +
+ any.missing = na_ok,+ |
+
143 | +763x | +
+ .var.name = label,+ |
+
144 | ++ |
+ ...+ |
+
145 | ++ |
+ )+ |
+
146 | ++ |
+ }+ |
+
147 | ++ | + + | +
148 | ++ |
+ #' @rdname assert_valid_var+ |
+
149 | ++ |
+ #' @export+ |
+
150 | ++ |
+ assert_valid_var.logical <- function(x, label = deparse(substitute(x)), na_ok = TRUE, empty_ok = FALSE, ...) {+ |
+
151 | +134x | +
+ checkmate::assert_logical(+ |
+
152 | +134x | +
+ x,+ |
+
153 | +134x | +
+ min.len = as.integer(!empty_ok),+ |
+
154 | +134x | +
+ any.missing = na_ok,+ |
+
155 | +134x | +
+ .var.name = label,+ |
+
156 | ++ |
+ ...+ |
+
157 | ++ |
+ )+ |
+
158 | ++ |
+ }+ |
+
159 | ++ |
+ #' @rdname assert_valid_var+ |
+
160 | ++ |
+ #' @param integerish (`flag`) whether the number should be treated as `integerish`.+ |
+
161 | ++ |
+ #' @export+ |
+
162 | ++ |
+ assert_valid_var.numeric <- function(+ |
+
163 | ++ |
+ x, label = deparse(substitute(x)),+ |
+
164 | ++ |
+ na_ok = TRUE, empty_ok = FALSE, integerish = FALSE, ...) {+ |
+
165 | +95x | +
+ check_fun <- if (integerish) checkmate::assert_integerish else checkmate::assert_numeric+ |
+
166 | +95x | +
+ check_fun(+ |
+
167 | +95x | +
+ x,+ |
+
168 | +95x | +
+ min.len = as.integer(!empty_ok),+ |
+
169 | +95x | +
+ any.missing = na_ok,+ |
+
170 | +95x | +
+ .var.name = label,+ |
+
171 | ++ |
+ ...+ |
+
172 | ++ |
+ )+ |
+
173 | ++ |
+ }+ |
+
174 | ++ | + + | +
175 | ++ |
+ #' @rdname assert_valid_var+ |
+
176 | ++ |
+ #' @export+ |
+
177 | ++ |
+ assert_valid_var.default <- function(x, label = deparse(substitute(x)), na_ok = FALSE, empty_ok = FALSE, ...) {+ |
+
178 | ++ |
+ }+ |
+
179 | ++ | + + | +
180 | ++ |
+ # assert_valid_variable ----+ |
+
181 | ++ | + + | +
182 | ++ |
+ #' Check variables in a data frame are valid character or factor.+ |
+
183 | ++ |
+ #' @param df (`data.frame`) input dataset.+ |
+
184 | ++ |
+ #' @param vars (`character`) variables to check.+ |
+
185 | ++ |
+ #' @param label (`string`) labels of the data frame.+ |
+
186 | ++ |
+ #' @param types Named (`list`) of type of the input.+ |
+
187 | ++ |
+ #' @param ... further arguments for `assert_valid_var`. Please note that different methods have different arguments+ |
+
188 | ++ |
+ #' so if provided make sure the variables to check is of the same class.+ |
+
189 | ++ |
+ #'+ |
+
190 | ++ |
+ #' @export+ |
+
191 | ++ |
+ assert_valid_variable <- function(df, vars, label = deparse(substitute(df)), types = NULL, ...) {+ |
+
192 | +790x | +
+ checkmate::assert_names(colnames(df), must.include = vars, what = "colnames")+ |
+
193 | ++ | + + | +
194 | +784x | +
+ labels <- sprintf("%s$%s", label, vars)+ |
+
195 | +784x | +
+ if (length(types) == 1 && is.null(names(types))) {+ |
+
196 | +686x | +
+ types <- setNames(rep(types, length(vars)), vars)+ |
+
197 | ++ |
+ }+ |
+
198 | +784x | +
+ if (!is.null(types)) {+ |
+
199 | +728x | +
+ vars_to_check <- which(vars %in% names(types))+ |
+
200 | +728x | +
+ mapply(+ |
+
201 | +728x | +
+ assert_valid_type,+ |
+
202 | +728x | +
+ df[vars[vars_to_check]],+ |
+
203 | +728x | +
+ types = types[vars_to_check],+ |
+
204 | +728x | +
+ label = labels[vars_to_check]+ |
+
205 | ++ |
+ )+ |
+
206 | ++ |
+ }+ |
+
207 | +782x | +
+ collection <- checkmate::makeAssertCollection()+ |
+
208 | +782x | +
+ mapply(assert_valid_var, df[vars], labels, MoreArgs = list(..., add = collection), SIMPLIFY = FALSE)+ |
+
209 | +782x | +
+ checkmate::reportAssertions(collection)+ |
+
210 | ++ |
+ }+ |
+
211 | ++ | + + | +
212 | ++ |
+ # assert_valid_type ----+ |
+
213 | ++ | + + | +
214 | ++ |
+ #' Check variable is of correct type+ |
+
215 | ++ |
+ #' @param x Object to check the type.+ |
+
216 | ++ |
+ #' @param types (`character`) possible types to check.+ |
+
217 | ++ |
+ #' @param label (`string`) label.+ |
+
218 | ++ |
+ assert_valid_type <- function(x, types, label = deparse(substitute(x))) {+ |
+
219 | +1096x | +
+ if (!any(vapply(types, is, object = x, FUN.VALUE = TRUE))) {+ |
+
220 | +2x | +
+ abort(+ |
+
221 | +2x | +
+ paste0(+ |
+
222 | +2x | +
+ quote_str(label),+ |
+
223 | +2x | +
+ " is not of type ",+ |
+
224 | +2x | +
+ toString(types)+ |
+
225 | ++ |
+ )+ |
+
226 | ++ |
+ )+ |
+
227 | ++ |
+ }+ |
+
228 | ++ |
+ }+ |
+
229 | ++ | + + | +
230 | ++ |
+ # assert_valid_var_pair ----+ |
+
231 | ++ | + + | +
232 | ++ |
+ #' Check variables are of same levels+ |
+
233 | ++ |
+ #' @param df1 (`data.frame`) input.+ |
+
234 | ++ |
+ #' @param df2 (`data.frame`) input.+ |
+
235 | ++ |
+ #' @param var (`string`) variable to check.+ |
+
236 | ++ |
+ #' @param lab1 (`string`) label hint for `df1`.+ |
+
237 | ++ |
+ #' @param lab2 (`string`) label hint for `df2`.+ |
+
238 | ++ |
+ assert_valid_var_pair <- function(df1, df2, var, lab1 = deparse(substitute(df1)), lab2 = deparse(substitute(df2))) {+ |
+
239 | +142x | +
+ checkmate::assert_data_frame(df1)+ |
+
240 | +142x | +
+ checkmate::assert_data_frame(df2)+ |
+
241 | +142x | +
+ checkmate::assert_string(var)+ |
+
242 | +142x | +
+ lvl_x <- lvls(df1[[var]])+ |
+
243 | +142x | +
+ lvl_y <- lvls(df2[[var]])+ |
+
244 | +142x | +
+ if (!identical(lvl_x, lvl_y)) {+ |
+
245 | +3x | +
+ abort(+ |
+
246 | +3x | +
+ paste0(+ |
+
247 | +3x | +
+ quote_str(lab1), " and ",+ |
+
248 | +3x | +
+ quote_str(lab2), " should contain the same levels in variable ",+ |
+
249 | +3x | +
+ quote_str(var), "!"+ |
+
250 | ++ |
+ )+ |
+
251 | ++ |
+ )+ |
+
252 | ++ |
+ }+ |
+
253 | ++ |
+ }+ |
+
1 | ++ |
+ # ext01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn ext01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param summaryvars (`character`) variables to be analyzed. The label attribute of the corresponding column in `adex`+ |
+
7 | ++ |
+ #' table of `adam_db` is used as label.+ |
+
8 | ++ |
+ #' @param map (`data.frame`) of mapping for split rows.+ |
+
9 | ++ |
+ #'+ |
+
10 | ++ |
+ #' @details+ |
+
11 | ++ |
+ #' * Default Exposure table+ |
+
12 | ++ |
+ #' * The `n` row provides the number of non-missing values. The percentages for categorical variables is based on `n`.+ |
+
13 | ++ |
+ #' The percentages for `Total number of patients with at least one dose modification` are based on the number of+ |
+
14 | ++ |
+ #' patients in the corresponding analysis population given by `N`.+ |
+
15 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
16 | ++ |
+ #' * Does not include a total column by default.+ |
+
17 | ++ |
+ #' * Sorted by alphabetic order of the `PARAM` value. Transform to factor and re-level for custom order.+ |
+
18 | ++ |
+ #' * `ANL01FL` is not relevant subset.+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ #' @note+ |
+
21 | ++ |
+ #' * `adam_db` object must contain an `adex` table with columns specified in `summaryvars`.+ |
+
22 | ++ |
+ #'+ |
+
23 | ++ |
+ #' @export+ |
+
24 | ++ |
+ #'+ |
+
25 | ++ |
+ ext01_main <- function(adam_db,+ |
+
26 | ++ |
+ arm_var = "ACTARM",+ |
+
27 | ++ |
+ summaryvars = "AVAL",+ |
+
28 | ++ |
+ row_split_var = "PARCAT2",+ |
+
29 | ++ |
+ lbl_overall = NULL,+ |
+
30 | ++ |
+ page_var = NULL,+ |
+
31 | ++ |
+ map = NULL,+ |
+
32 | ++ |
+ ...) {+ |
+
33 | +2x | +
+ assert_all_tablenames(adam_db, c("adsl", "adex"))+ |
+
34 | +2x | +
+ checkmate::assert_string(arm_var)+ |
+
35 | +2x | +
+ checkmate::assert_character(summaryvars)+ |
+
36 | +2x | +
+ checkmate::assert_character(row_split_var, null.ok = TRUE)+ |
+
37 | +2x | +
+ checkmate::assert_data_frame(map, null.ok = TRUE)+ |
+
38 | +2x | +
+ assert_valid_variable(adam_db$adex, colnames(map), types = list(c("character", "factor")))+ |
+
39 | +2x | +
+ if (!is.null(map)) {+ |
+
40 | +! | +
+ map <- infer_mapping(map, adam_db$adex)+ |
+
41 | ++ |
+ }+ |
+
42 | +2x | +
+ assert_valid_variable(adam_db$adex, summaryvars, empty_ok = TRUE, na_ok = TRUE)+ |
+
43 | +2x | +
+ assert_valid_variable(+ |
+
44 | +2x | +
+ adam_db$adex, c(row_split_var, "PARAMCD", "PARAM"),+ |
+
45 | +2x | +
+ types = list(c("character", "factor")), empty_ok = TRUE+ |
+
46 | ++ |
+ )+ |
+
47 | +2x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
48 | +2x | +
+ checkmate::assert_string(page_var, null.ok = TRUE)+ |
+
49 | +2x | +
+ checkmate::assert_subset(page_var, c(row_split_var))+ |
+
50 | +2x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adex, arm_var)+ |
+
51 | +2x | +
+ assert_valid_variable(adam_db$adex, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
52 | +2x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
53 | ++ | + + | +
54 | +2x | +
+ summaryvars_lbls <- var_labels_for(adam_db$adex, summaryvars)+ |
+
55 | +2x | +
+ row_split_lbl <- var_labels_for(adam_db$adex, row_split_var)+ |
+
56 | +2x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
57 | +2x | +
+ lyt <- ext01_lyt(+ |
+
58 | +2x | +
+ arm_var = arm_var,+ |
+
59 | +2x | +
+ summaryvars = summaryvars,+ |
+
60 | +2x | +
+ summaryvars_lbls = summaryvars_lbls,+ |
+
61 | +2x | +
+ row_split_var = row_split_var,+ |
+
62 | +2x | +
+ row_split_lbl = row_split_lbl,+ |
+
63 | +2x | +
+ lbl_overall = lbl_overall,+ |
+
64 | +2x | +
+ page_var = page_var,+ |
+
65 | +2x | +
+ map = map+ |
+
66 | ++ |
+ )+ |
+
67 | ++ | + + | +
68 | +2x | +
+ tbl <- build_table(lyt, adam_db$adex, adam_db$adsl)+ |
+
69 | ++ | + + | +
70 | +2x | +
+ tbl+ |
+
71 | ++ |
+ }+ |
+
72 | ++ | + + | +
73 | ++ |
+ #' `ext01` Layout+ |
+
74 | ++ |
+ #'+ |
+
75 | ++ |
+ #' @inheritParams gen_args+ |
+
76 | ++ |
+ #'+ |
+
77 | ++ |
+ #' @param summaryvars (`character`) the name of the variable to be analyzed. By default `"AVAL"`.+ |
+
78 | ++ |
+ #' @param summaryvars_lbls (`character`) the label associated with the analyzed variable.+ |
+
79 | ++ |
+ #'+ |
+
80 | ++ |
+ #'+ |
+
81 | ++ |
+ #' @keywords internal+ |
+
82 | ++ |
+ #'+ |
+
83 | ++ |
+ ext01_lyt <- function(arm_var,+ |
+
84 | ++ |
+ summaryvars,+ |
+
85 | ++ |
+ summaryvars_lbls,+ |
+
86 | ++ |
+ row_split_var,+ |
+
87 | ++ |
+ row_split_lbl,+ |
+
88 | ++ |
+ lbl_overall,+ |
+
89 | ++ |
+ page_var,+ |
+
90 | ++ |
+ map) {+ |
+
91 | +9x | +
+ page_by <- get_page_by(page_var, c(row_split_var))+ |
+
92 | +9x | +
+ label_pos <- dplyr::if_else(page_by, "hidden", "topleft")+ |
+
93 | +9x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
94 | +9x | +
+ split_cols_by(var = arm_var) %>%+ |
+
95 | +9x | +
+ add_colcounts() %>%+ |
+
96 | +9x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
97 | +9x | +
+ split_rows_by_recurive(+ |
+
98 | +9x | +
+ row_split_var,+ |
+
99 | +9x | +
+ split_label = row_split_lbl, label_pos = label_pos, page_by = page_by+ |
+
100 | ++ |
+ ) %>%+ |
+
101 | +9x | +
+ split_rows_by(+ |
+
102 | +9x | +
+ "PARAMCD",+ |
+
103 | +9x | +
+ labels_var = "PARAM",+ |
+
104 | +9x | +
+ split_fun = split_fun_map(map)+ |
+
105 | ++ |
+ ) %>%+ |
+
106 | +9x | +
+ summarize_vars(+ |
+
107 | +9x | +
+ vars = summaryvars,+ |
+
108 | +9x | +
+ var_labels = summaryvars_lbls,+ |
+
109 | +9x | +
+ show_labels = "hidden",+ |
+
110 | +9x | +
+ .formats = list(count_fraction = format_count_fraction_fixed_dp)+ |
+
111 | ++ |
+ )+ |
+
112 | ++ |
+ }+ |
+
113 | ++ | + + | +
114 | ++ |
+ #' @describeIn ext01 Preprocessing+ |
+
115 | ++ |
+ #'+ |
+
116 | ++ |
+ #' @inheritParams gen_args+ |
+
117 | ++ |
+ #' @export+ |
+
118 | ++ |
+ #'+ |
+
119 | ++ |
+ ext01_pre <- function(adam_db,+ |
+
120 | ++ |
+ ...) {+ |
+
121 | +2x | +
+ adam_db$adex <- adam_db$adex %>%+ |
+
122 | +2x | +
+ filter(.data$PARCAT1 == "OVERALL") %>%+ |
+
123 | +2x | +
+ filter(.data$PARAMCD %in% c("TDURD", "TDOSE"))+ |
+
124 | ++ | + + | +
125 | +2x | +
+ adam_db+ |
+
126 | ++ |
+ }+ |
+
127 | ++ |
+ #' @describeIn ext01 Postprocessing+ |
+
128 | ++ |
+ #'+ |
+
129 | ++ |
+ #' @inheritParams gen_args+ |
+
130 | ++ |
+ #'+ |
+
131 | ++ |
+ #'+ |
+
132 | ++ |
+ #' @export+ |
+
133 | ++ |
+ ext01_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
134 | +2x | +
+ if (prune_0) tlg <- smart_prune(tlg)+ |
+
135 | +2x | +
+ std_postprocess(tlg)+ |
+
136 | ++ |
+ }+ |
+
137 | ++ | + + | +
138 | ++ |
+ #' `EXT01` Exposure Summary Table.+ |
+
139 | ++ |
+ #'+ |
+
140 | ++ |
+ #' The `EXT01` table provides an overview of the of the exposure of the+ |
+
141 | ++ |
+ #' patients in terms of Total dose administered or missed, and treatment duration.+ |
+
142 | ++ |
+ #'+ |
+
143 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
144 | ++ |
+ #' @export+ |
+
145 | ++ |
+ #'+ |
+
146 | ++ |
+ #' @examples+ |
+
147 | ++ |
+ #' run(ext01, syn_data)+ |
+
148 | ++ |
+ #' run(ext01, syn_data, summaryvars = c("AVAL", "AVALCAT1"), prune_0 = FALSE)+ |
+
149 | ++ |
+ #' levels(syn_data$adex$AVALCAT1) <- c(levels(syn_data$adex$AVALCAT1), "12 months")+ |
+
150 | ++ |
+ #' map <- data.frame(+ |
+
151 | ++ |
+ #' PARAMCD = "TDURD",+ |
+
152 | ++ |
+ #' AVALCAT1 = c("< 1 month", "1 to <3 months", ">=6 months", "3 to <6 months", "12 months")+ |
+
153 | ++ |
+ #' )+ |
+
154 | ++ |
+ #' run(ext01, syn_data, summaryvars = c("AVAL", "AVALCAT1"), prune_0 = FALSE, map = map)+ |
+
155 | ++ |
+ ext01 <- chevron_t(+ |
+
156 | ++ |
+ main = ext01_main,+ |
+
157 | ++ |
+ preprocess = ext01_pre,+ |
+
158 | ++ |
+ postprocess = ext01_post+ |
+
159 | ++ |
+ )+ |
+
1 | ++ |
+ # aet03 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn aet03 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' @details+ |
+
8 | ++ |
+ #' * Default Adverse Events by Greatest Intensity table.+ |
+
9 | ++ |
+ #' * Numbers represent absolute numbers of patients and fraction of `N`.+ |
+
10 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
11 | ++ |
+ #' * Split columns by arm.+ |
+
12 | ++ |
+ #' * Does not include a total column by default.+ |
+
13 | ++ |
+ #' * Sort by Body System or Organ Class (`SOC`) and Dictionary-Derived Term (`PT`).+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @note+ |
+
16 | ++ |
+ #' * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"`, `"AEDECOD"` and `"ASEV"`.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @export+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ aet03_main <- function(adam_db,+ |
+
21 | ++ |
+ arm_var = "ACTARM",+ |
+
22 | ++ |
+ lbl_overall = NULL,+ |
+
23 | ++ |
+ ...) {+ |
+
24 | +1x | +
+ assert_all_tablenames(adam_db, "adsl", "adae")+ |
+
25 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
26 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
27 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
28 | +1x | +
+ assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD", "ASEV"), types = list(c("character", "factor")))+ |
+
29 | +1x | +
+ assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
30 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)+ |
+
31 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
32 | +1x | +
+ intensity_grade <- levels(adam_db$adae[["ASEV"]])+ |
+
33 | +1x | +
+ lbl_aebodsys <- var_labels_for(adam_db$adae, "AEBODSYS")+ |
+
34 | +1x | +
+ lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")+ |
+
35 | +1x | +
+ lyt <- aet03_lyt(+ |
+
36 | +1x | +
+ arm_var = arm_var,+ |
+
37 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
38 | +1x | +
+ lbl_aebodsys = lbl_aebodsys,+ |
+
39 | +1x | +
+ lbl_aedecod = lbl_aedecod,+ |
+
40 | +1x | +
+ intensity_grade = intensity_grade+ |
+
41 | ++ |
+ )+ |
+
42 | ++ | + + | +
43 | +1x | +
+ tbl <- build_table(lyt, df = adam_db$adae, alt_counts_df = adam_db$adsl)+ |
+
44 | ++ | + + | +
45 | +1x | +
+ tbl+ |
+
46 | ++ |
+ }+ |
+
47 | ++ | + + | +
48 | ++ |
+ #' `aet03` Layout+ |
+
49 | ++ |
+ #'+ |
+
50 | ++ |
+ #' @inheritParams gen_args+ |
+
51 | ++ |
+ #'+ |
+
52 | ++ |
+ #' @param lbl_aebodsys (`string`) text label for `AEBODSYS`.+ |
+
53 | ++ |
+ #' @param lbl_aedecod (`string`) text label for `AEDECOD`.+ |
+
54 | ++ |
+ #' @param intensity_grade (`character`) describing the intensity levels present in the dataset.+ |
+
55 | ++ |
+ #'+ |
+
56 | ++ |
+ #' @keywords internal+ |
+
57 | ++ |
+ #'+ |
+
58 | ++ |
+ aet03_lyt <- function(arm_var,+ |
+
59 | ++ |
+ lbl_overall,+ |
+
60 | ++ |
+ lbl_aebodsys,+ |
+
61 | ++ |
+ lbl_aedecod,+ |
+
62 | ++ |
+ intensity_grade) {+ |
+
63 | +4x | +
+ all_grade_groups <- list("- Any Intensity -" = intensity_grade)+ |
+
64 | ++ | + + | +
65 | +4x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
66 | +4x | +
+ split_cols_by(var = arm_var) %>%+ |
+
67 | +4x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
68 | +4x | +
+ count_occurrences_by_grade(+ |
+
69 | +4x | +
+ var = "ASEV",+ |
+
70 | +4x | +
+ grade_groups = all_grade_groups,+ |
+
71 | +4x | +
+ .formats = c("count_fraction" = format_count_fraction_fixed_dp)+ |
+
72 | ++ |
+ ) %>%+ |
+
73 | +4x | +
+ split_rows_by(+ |
+
74 | +4x | +
+ "AEBODSYS",+ |
+
75 | +4x | +
+ child_labels = "visible",+ |
+
76 | +4x | +
+ nested = TRUE,+ |
+
77 | +4x | +
+ split_fun = drop_split_levels,+ |
+
78 | +4x | +
+ label_pos = "topleft",+ |
+
79 | +4x | +
+ split_label = lbl_aebodsys+ |
+
80 | ++ |
+ ) %>%+ |
+
81 | +4x | +
+ summarize_occurrences_by_grade(+ |
+
82 | +4x | +
+ var = "ASEV",+ |
+
83 | +4x | +
+ grade_groups = all_grade_groups,+ |
+
84 | +4x | +
+ .formats = c("count_fraction" = format_count_fraction_fixed_dp)+ |
+
85 | ++ |
+ ) %>%+ |
+
86 | +4x | +
+ split_rows_by(+ |
+
87 | +4x | +
+ "AEDECOD",+ |
+
88 | +4x | +
+ child_labels = "visible",+ |
+
89 | +4x | +
+ nested = TRUE,+ |
+
90 | +4x | +
+ indent_mod = -1L,+ |
+
91 | +4x | +
+ split_fun = drop_split_levels,+ |
+
92 | +4x | +
+ label_pos = "topleft",+ |
+
93 | +4x | +
+ split_label = lbl_aedecod+ |
+
94 | ++ |
+ ) %>%+ |
+
95 | +4x | +
+ summarize_num_patients(+ |
+
96 | +4x | +
+ var = "USUBJID",+ |
+
97 | +4x | +
+ .stats = "unique",+ |
+
98 | +4x | +
+ .labels = c("- Any Intensity -")+ |
+
99 | ++ |
+ ) %>%+ |
+
100 | +4x | +
+ count_occurrences_by_grade(+ |
+
101 | +4x | +
+ var = "ASEV",+ |
+
102 | +4x | +
+ .indent_mods = -1L+ |
+
103 | ++ |
+ )+ |
+
104 | ++ |
+ }+ |
+
105 | ++ | + + | +
106 | ++ |
+ #' @describeIn aet03 Preprocessing+ |
+
107 | ++ |
+ #'+ |
+
108 | ++ |
+ #' @inheritParams gen_args+ |
+
109 | ++ |
+ #'+ |
+
110 | ++ |
+ #' @export+ |
+
111 | ++ |
+ #'+ |
+
112 | ++ |
+ aet03_pre <- function(adam_db, ...) {+ |
+
113 | +1x | +
+ asev_lvls <- c("MILD", "MODERATE", "SEVERE")+ |
+
114 | +1x | +
+ adam_db$adae <- adam_db$adae %>%+ |
+
115 | +1x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
116 | +1x | +
+ mutate(+ |
+
117 | +1x | +
+ AEBODSYS = reformat(.data$AEBODSYS, nocoding),+ |
+
118 | +1x | +
+ AEDECOD = reformat(.data$AEDECOD, nocoding),+ |
+
119 | +1x | +
+ ASEV = factor(.data$ASEV, levels = asev_lvls)+ |
+
120 | ++ |
+ ) %>%+ |
+
121 | +1x | +
+ filter(!is.na(.data$ASEV))+ |
+
122 | ++ | + + | +
123 | +1x | +
+ adam_db+ |
+
124 | ++ |
+ }+ |
+
125 | ++ | + + | +
126 | ++ |
+ #' @describeIn aet03 Postprocessing+ |
+
127 | ++ |
+ #'+ |
+
128 | ++ |
+ #' @inheritParams gen_args+ |
+
129 | ++ |
+ #'+ |
+
130 | ++ |
+ #' @export+ |
+
131 | ++ |
+ aet03_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
132 | +1x | +
+ tlg <- tlg %>%+ |
+
133 | +1x | +
+ tlg_sort_by_vars(+ |
+
134 | +1x | +
+ c("AEBODSYS", "AEDECOD"),+ |
+
135 | +1x | +
+ scorefun = cont_n_allcols+ |
+
136 | ++ |
+ )+ |
+
137 | +1x | +
+ if (prune_0) tlg <- trim_rows(tlg)+ |
+
138 | +1x | +
+ std_postprocess(tlg)+ |
+
139 | ++ |
+ }+ |
+
140 | ++ | + + | +
141 | ++ |
+ #' `AET03` Table 1 (Default) Advert Events by Greatest Intensity Table 1.+ |
+
142 | ++ |
+ #'+ |
+
143 | ++ |
+ #' An adverse events table categorized by System+ |
+
144 | ++ |
+ #' Organ Class, Dictionary-Derived Term and Greatest intensity.+ |
+
145 | ++ |
+ #'+ |
+
146 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
147 | ++ |
+ #' @export+ |
+
148 | ++ |
+ #'+ |
+
149 | ++ |
+ #' @examples+ |
+
150 | ++ |
+ #' run(aet03, syn_data)+ |
+
151 | ++ |
+ aet03 <- chevron_t(+ |
+
152 | ++ |
+ main = aet03_main,+ |
+
153 | ++ |
+ preprocess = aet03_pre,+ |
+
154 | ++ |
+ postprocess = aet03_post+ |
+
155 | ++ |
+ )+ |
+
1 | ++ |
+ # rspt01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn rspt01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param dataset (`string`) the name of a table in the `adam_db` object.+ |
+
7 | ++ |
+ #' @param ref_group (`string`) The name of the reference group, the value should+ |
+
8 | ++ |
+ #' be identical to the values in `arm_var`, if not specified, it will by default+ |
+
9 | ++ |
+ #' use the first level or value of `arm_var`.+ |
+
10 | ++ |
+ #' @param odds_ratio (`flag`) should the odds ratio be calculated, default is `TRUE`+ |
+
11 | ++ |
+ #' @param perform_analysis (`string`) option to display statistical comparisons using stratified analyses,+ |
+
12 | ++ |
+ #' or unstratified analyses, or both, e.g. `c("unstrat", "strat")`. Only unstratified will be displayed by default+ |
+
13 | ++ |
+ #' @param strata (`string`) stratification factors, e.g. `strata = c("STRATA1", "STRATA2")`, by default as NULL+ |
+
14 | ++ |
+ #' @param conf_level (`numeric`) the level of confidence interval, default is 0.95.+ |
+
15 | ++ |
+ #' @param methods (`list`) a named list, use a named list to control, for example:+ |
+
16 | ++ |
+ #' `methods = list(prop_conf_method = "wald",+ |
+
17 | ++ |
+ #' diff_conf_method = "wald",+ |
+
18 | ++ |
+ #' strat_diff_conf_method = "ha",+ |
+
19 | ++ |
+ #' diff_pval_method = "fisher",+ |
+
20 | ++ |
+ #' strat_diff_pval_method = "schouten")`+ |
+
21 | ++ |
+ #' `prop_conf_method` controls the methods of calculating proportion confidence interval,+ |
+
22 | ++ |
+ #' `diff_conf_method` controls the methods of calculating unstratified difference confidence interval,+ |
+
23 | ++ |
+ #' `strat_diff_conf_method` controls the methods of calculating stratified difference confidence interval,+ |
+
24 | ++ |
+ #' `diff_pval_method` controls the methods of calculating unstratified p-value for odds ratio,+ |
+
25 | ++ |
+ #' `strat_diff_pval_method` controls the methods of calculating stratified p-value for odds ratio,+ |
+
26 | ++ |
+ #' see more details in `tern`+ |
+
27 | ++ |
+ #'+ |
+
28 | ++ |
+ #' @details+ |
+
29 | ++ |
+ #' * No overall value.+ |
+
30 | ++ |
+ #'+ |
+
31 | ++ |
+ #' @export+ |
+
32 | ++ |
+ #'+ |
+
33 | ++ |
+ #'+ |
+
34 | ++ |
+ rspt01_main <- function(adam_db,+ |
+
35 | ++ |
+ dataset = "adrs",+ |
+
36 | ++ |
+ arm_var = "ARM",+ |
+
37 | ++ |
+ ref_group = NULL,+ |
+
38 | ++ |
+ odds_ratio = TRUE,+ |
+
39 | ++ |
+ perform_analysis = "unstrat",+ |
+
40 | ++ |
+ strata = NULL,+ |
+
41 | ++ |
+ conf_level = 0.95,+ |
+
42 | ++ |
+ methods = list(),+ |
+
43 | ++ |
+ ...) {+ |
+
44 | +1x | +
+ checkmate::assert_string(dataset)+ |
+
45 | +1x | +
+ assert_all_tablenames(adam_db, "adsl", dataset)+ |
+
46 | +1x | +
+ checkmate::assert_string(ref_group, null.ok = TRUE)+ |
+
47 | +1x | +
+ checkmate::assert_flag(odds_ratio)+ |
+
48 | +1x | +
+ checkmate::assert_subset(perform_analysis, c("unstrat", "strat"))+ |
+
49 | +1x | +
+ checkmate::assert_character(+ |
+
50 | +1x | +
+ strata,+ |
+
51 | +1x | +
+ null.ok = !"strat" %in% perform_analysis,+ |
+
52 | +1x | +
+ min.len = as.integer(!"strat" %in% perform_analysis)+ |
+
53 | ++ |
+ )+ |
+
54 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
55 | +1x | +
+ df_label <- sprintf("adam_db$%s", dataset)+ |
+
56 | +1x | +
+ assert_valid_variable(+ |
+
57 | +1x | +
+ adam_db$adsl, c("USUBJID", arm_var),+ |
+
58 | +1x | +
+ types = list(c("character", "factor"))+ |
+
59 | ++ |
+ )+ |
+
60 | +1x | +
+ assert_valid_variable(+ |
+
61 | +1x | +
+ adam_db[[dataset]], c("USUBJID", arm_var, "RSP_LAB"),+ |
+
62 | +1x | +
+ types = list(c("character", "factor")), label = df_label+ |
+
63 | ++ |
+ )+ |
+
64 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], "IS_RSP", types = list("logical"), label = df_label)+ |
+
65 | +1x | +
+ assert_valid_variable(+ |
+
66 | +1x | +
+ adam_db[[dataset]], c("PARAMCD", "PARAM"),+ |
+
67 | +1x | +
+ types = list(c("character", "factor")), label = df_label+ |
+
68 | ++ |
+ )+ |
+
69 | +1x | +
+ assert_single_value(adam_db[[dataset]]$PARAMCD, label = sprintf("adam_db$%s$PARAMCD", dataset))+ |
+
70 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db[[dataset]], arm_var)+ |
+
71 | +1x | +
+ checkmate::assert_subset(ref_group, lvls(adam_db[[dataset]][[arm_var]]))+ |
+
72 | ++ | + + | +
73 | +1x | +
+ ref_group <- ref_group %||% lvls(adam_db[[dataset]][[arm_var]])[1]+ |
+
74 | ++ | + + | +
75 | +1x | +
+ lyt <- rspt01_lyt(+ |
+
76 | +1x | +
+ arm_var = arm_var,+ |
+
77 | +1x | +
+ ref_group = ref_group,+ |
+
78 | +1x | +
+ odds_ratio = odds_ratio,+ |
+
79 | +1x | +
+ perform_analysis = perform_analysis,+ |
+
80 | +1x | +
+ strata = strata,+ |
+
81 | +1x | +
+ conf_level = conf_level,+ |
+
82 | +1x | +
+ methods = methods,+ |
+
83 | +1x | +
+ rsp_var = "IS_RSP"+ |
+
84 | ++ |
+ )+ |
+
85 | ++ | + + | +
86 | +1x | +
+ tbl <- build_table(lyt, adam_db[[dataset]], alt_counts_df = adam_db$adsl)+ |
+
87 | ++ | + + | +
88 | +1x | +
+ tbl+ |
+
89 | ++ |
+ }+ |
+
90 | ++ | + + | +
91 | ++ |
+ #' `rspt01` Layout+ |
+
92 | ++ |
+ #'+ |
+
93 | ++ |
+ #' @inheritParams gen_args+ |
+
94 | ++ |
+ #'+ |
+
95 | ++ |
+ #' @keywords internal+ |
+
96 | ++ |
+ #'+ |
+
97 | ++ |
+ rspt01_lyt <- function(arm_var,+ |
+
98 | ++ |
+ ref_group,+ |
+
99 | ++ |
+ odds_ratio,+ |
+
100 | ++ |
+ perform_analysis,+ |
+
101 | ++ |
+ strata,+ |
+
102 | ++ |
+ conf_level,+ |
+
103 | ++ |
+ methods,+ |
+
104 | ++ |
+ rsp_var) {+ |
+
105 | +7x | +
+ lyt01 <- basic_table(show_colcounts = TRUE) %>%+ |
+
106 | +7x | +
+ split_cols_by(var = arm_var, ref_group = ref_group) %>%+ |
+
107 | +7x | +
+ estimate_proportion(+ |
+
108 | +7x | +
+ vars = rsp_var,+ |
+
109 | +7x | +
+ conf_level = conf_level,+ |
+
110 | +7x | +
+ method = methods[["prop_conf_method"]] %||% "waldcc",+ |
+
111 | +7x | +
+ table_names = "est_prop"+ |
+
112 | ++ |
+ )+ |
+
113 | ++ | + + | +
114 | +7x | +
+ for (perform in perform_analysis) {+ |
+
115 | +8x | +
+ lyt01 <- lyt01 %>%+ |
+
116 | +8x | +
+ proportion_lyt(+ |
+
117 | +8x | +
+ arm_var = arm_var,+ |
+
118 | +8x | +
+ odds_ratio = odds_ratio,+ |
+
119 | +8x | +
+ strata = if (perform == "strat") strata else NULL,+ |
+
120 | +8x | +
+ conf_level = conf_level,+ |
+
121 | +8x | +
+ methods = methods,+ |
+
122 | +8x | +
+ rsp_var = rsp_var+ |
+
123 | ++ |
+ )+ |
+
124 | ++ |
+ }+ |
+
125 | ++ | + + | +
126 | +7x | +
+ lyt <- lyt01 %>%+ |
+
127 | +7x | +
+ estimate_multinomial_response(+ |
+
128 | +7x | +
+ var = "RSP_LAB",+ |
+
129 | +7x | +
+ conf_level = conf_level,+ |
+
130 | +7x | +
+ method = methods[["prop_conf_method"]] %||% "waldcc"+ |
+
131 | ++ |
+ )+ |
+
132 | ++ | + + | +
133 | +7x | +
+ return(lyt)+ |
+
134 | ++ |
+ }+ |
+
135 | ++ | + + | +
136 | ++ |
+ #' @describeIn rspt01 Preprocessing+ |
+
137 | ++ |
+ #'+ |
+
138 | ++ |
+ #' @inheritParams gen_args+ |
+
139 | ++ |
+ #'+ |
+
140 | ++ |
+ #' @export+ |
+
141 | ++ |
+ #'+ |
+
142 | ++ |
+ rspt01_pre <- function(adam_db, ...) {+ |
+
143 | +1x | +
+ adam_db$adrs <- adam_db$adrs %>%+ |
+
144 | +1x | +
+ mutate(RSP_LAB = tern::d_onco_rsp_label(.data$AVALC)) %>%+ |
+
145 | +1x | +
+ mutate(IS_RSP = .data$AVALC %in% c("CR", "PR"))+ |
+
146 | +1x | +
+ adam_db+ |
+
147 | ++ |
+ }+ |
+
148 | ++ | + + | +
149 | ++ |
+ #' @describeIn rspt01 Postprocessing+ |
+
150 | ++ |
+ #'+ |
+
151 | ++ |
+ #' @inheritParams gen_args+ |
+
152 | ++ |
+ #'+ |
+
153 | ++ |
+ #'+ |
+
154 | ++ |
+ #' @export+ |
+
155 | ++ |
+ rspt01_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
156 | +! | +
+ if (prune_0) {+ |
+
157 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
158 | ++ |
+ }+ |
+
159 | +! | +
+ std_postprocess(tlg)+ |
+
160 | ++ |
+ }+ |
+
161 | ++ | + + | +
162 | ++ |
+ #' `RSPT01` Binary Outcomes Summary+ |
+
163 | ++ |
+ #'+ |
+
164 | ++ |
+ #' `RSPT01` template may be used to summarize any binary outcome or response variable at+ |
+
165 | ++ |
+ #' a single time point. Typical application for oncology+ |
+
166 | ++ |
+ #'+ |
+
167 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
168 | ++ |
+ #' @export+ |
+
169 | ++ |
+ #'+ |
+
170 | ++ |
+ #' @examples+ |
+
171 | ++ |
+ #' library(dplyr)+ |
+
172 | ++ |
+ #' library(dunlin)+ |
+
173 | ++ |
+ #'+ |
+
174 | ++ |
+ #' syn_data2 <- log_filter(syn_data, PARAMCD == "BESRSPI", "adrs")+ |
+
175 | ++ |
+ #' run(rspt01, syn_data2)+ |
+
176 | ++ |
+ #' run(rspt01, syn_data2,+ |
+
177 | ++ |
+ #' odds_ratio = FALSE, perform_analysis = c("unstrat", "strat"),+ |
+
178 | ++ |
+ #' strata = c("STRATA1", "STRATA2"), methods = list(diff_pval_method = "fisher")+ |
+
179 | ++ |
+ #' )+ |
+
180 | ++ |
+ rspt01 <- chevron_t(+ |
+
181 | ++ |
+ main = rspt01_main,+ |
+
182 | ++ |
+ preprocess = rspt01_pre,+ |
+
183 | ++ |
+ postprocess = rspt01_post+ |
+
184 | ++ |
+ )+ |
+
1 | ++ |
+ # mng01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn mng01 Main TLG Function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @details+ |
+
6 | ++ |
+ #' * No overall value.+ |
+
7 | ++ |
+ #' * Preprocessing filters for `ANL01FL` in the selected data set.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @inheritParams gen_args+ |
+
10 | ++ |
+ #' @param dataset (`string`) the name of a table in the `adam_db` object.+ |
+
11 | ++ |
+ #' @param x_var (`string`) the name of a column in the `dataset` to represent on the x-axis.+ |
+
12 | ++ |
+ #' @param y_var (`string`) the name of the variable to be represented on the y-axis.+ |
+
13 | ++ |
+ #' @param y_name (`string`) the variable name for `y`. Used for plot's subtitle.+ |
+
14 | ++ |
+ #' @param y_unit (`string`) the name of the variable with the units of `y`. Used for plot's subtitle. if `NULL`, only+ |
+
15 | ++ |
+ #' `y_name` is displayed as subtitle.+ |
+
16 | ++ |
+ #' @param center_fun (`string`) the function to compute the estimate value.+ |
+
17 | ++ |
+ #' @param interval_fun (`string`) the function defining the crossbar range.+ |
+
18 | ++ |
+ #' @param show_table (`flag`) should the summary statistic table be displayed.+ |
+
19 | ++ |
+ #' @param show_n (`flag`) should the number of observation be displayed int the table.+ |
+
20 | ++ |
+ #' @param jitter (`flag`) should data point be slightly spread on the x-axis.+ |
+
21 | ++ |
+ #' @param show_h_grid (`flag`) should horizontal grid be displayed.+ |
+
22 | ++ |
+ #' @param show_v_grid (`flag`) should vertical grid be displayed.+ |
+
23 | ++ |
+ #' @param legend_pos (`string`) the position of the legend.+ |
+
24 | ++ |
+ #' @param line_col (`character`) describing the colors to use for the lines or a named `character` associating values of+ |
+
25 | ++ |
+ #' `arm_var` with color names.+ |
+
26 | ++ |
+ #'+ |
+
27 | ++ |
+ #' @note+ |
+
28 | ++ |
+ #' * `adam_db` object must contain the table specified by `dataset` with the columns specified by `x_var`, `y_var`,+ |
+
29 | ++ |
+ #' `y_name`, `y_unit` and `arm_var`.+ |
+
30 | ++ |
+ #'+ |
+
31 | ++ |
+ #' @return a list of `ggplot` objects.+ |
+
32 | ++ |
+ #' @export+ |
+
33 | ++ |
+ mng01_main <- function(adam_db,+ |
+
34 | ++ |
+ dataset = "adlb",+ |
+
35 | ++ |
+ x_var = "AVISIT",+ |
+
36 | ++ |
+ y_var = "AVAL",+ |
+
37 | ++ |
+ y_name = "PARAM",+ |
+
38 | ++ |
+ y_unit = NULL,+ |
+
39 | ++ |
+ arm_var = "ACTARM",+ |
+
40 | ++ |
+ center_fun = "mean",+ |
+
41 | ++ |
+ interval_fun = "mean_ci",+ |
+
42 | ++ |
+ show_table = TRUE,+ |
+
43 | ++ |
+ jitter = TRUE,+ |
+
44 | ++ |
+ show_n = TRUE,+ |
+
45 | ++ |
+ show_h_grid = TRUE,+ |
+
46 | ++ |
+ show_v_grid = FALSE,+ |
+
47 | ++ |
+ legend_pos = "top",+ |
+
48 | ++ |
+ line_col = nestcolor::color_palette(),+ |
+
49 | ++ |
+ ...) {+ |
+
50 | +3x | +
+ assert_all_tablenames(adam_db, c(dataset, "adsl"))+ |
+
51 | +3x | +
+ checkmate::assert_character(x_var)+ |
+
52 | +3x | +
+ checkmate::assert_string(y_var)+ |
+
53 | +3x | +
+ checkmate::assert_string(y_name)+ |
+
54 | +3x | +
+ checkmate::assert_string(y_unit, null.ok = TRUE)+ |
+
55 | +3x | +
+ checkmate::assert_string(arm_var)+ |
+
56 | +3x | +
+ checkmate::assert_string(center_fun)+ |
+
57 | +3x | +
+ checkmate::assert_string(interval_fun)+ |
+
58 | +3x | +
+ checkmate::assert_names(center_fun, subset.of = c("mean", "median"))+ |
+
59 | +3x | +
+ checkmate::assert_choice(interval_fun, c("mean_ci", "mean_sei", "mean_sdi", "median_ci", "quantiles", "range"))+ |
+
60 | +3x | +
+ checkmate::assert_flag(show_table)+ |
+
61 | +3x | +
+ checkmate::assert_flag(jitter)+ |
+
62 | +3x | +
+ checkmate::assert_flag(show_n)+ |
+
63 | +3x | +
+ checkmate::assert_flag(show_h_grid)+ |
+
64 | +3x | +
+ checkmate::assert_flag(show_v_grid)+ |
+
65 | +3x | +
+ checkmate::assert_choice(legend_pos, c("top", "bottom", "right", "left"))+ |
+
66 | +3x | +
+ checkmate::assert_character(line_col, null.ok = TRUE)+ |
+
67 | +3x | +
+ assert_valid_variable(adam_db[[dataset]], x_var)+ |
+
68 | +3x | +
+ assert_valid_variable(adam_db[[dataset]], y_var, types = list(c("numeric")))+ |
+
69 | +3x | +
+ assert_valid_variable(adam_db[[dataset]], y_unit, types = list(c("character", "factor")))+ |
+
70 | +3x | +
+ assert_valid_variable(adam_db[[dataset]], arm_var, types = list(c("character", "factor")), na_ok = FALSE)+ |
+
71 | +3x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
72 | +3x | +
+ assert_valid_variable(adam_db[[dataset]], "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
73 | +3x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db[[dataset]], arm_var)+ |
+
74 | ++ | + + | +
75 | +3x | +
+ df <- adam_db[[dataset]]+ |
+
76 | +3x | +
+ line_col <- unlist(line_col)+ |
+
77 | ++ | + + | +
78 | +3x | +
+ data_ls <- split(df, df$PARAM, drop = TRUE)+ |
+
79 | +3x | +
+ x_var <- paste(x_var, collapse = "_")+ |
+
80 | ++ | + + | +
81 | +3x | +
+ whiskers_fun <- switch(interval_fun,+ |
+
82 | +3x | +
+ "mean_ci" = c("mean_ci_lwr", "mean_ci_upr"),+ |
+
83 | +3x | +
+ "mean_sei" = c("mean_sei_lwr", "mean_sei_upr"),+ |
+
84 | +3x | +
+ "mean_sdi" = c("mean_sdi_lwr", "mean_sdi_upr"),+ |
+
85 | +3x | +
+ "median_ci" = c("median_ci_lwr", "median_ci_upr"),+ |
+
86 | +3x | +
+ "quantiles" = c("quantiles_0.25", "quantile_0.75"),+ |
+
87 | +3x | +
+ "range" = c("min", "max")+ |
+
88 | ++ |
+ )+ |
+
89 | ++ | + + | +
90 | +3x | +
+ y_unit <- if (is.null(y_unit)) NA else y_unit+ |
+
91 | +3x | +
+ variables <- c(+ |
+
92 | +3x | +
+ x = x_var,+ |
+
93 | +3x | +
+ y = y_var,+ |
+
94 | +3x | +
+ strata = arm_var,+ |
+
95 | +3x | +
+ paramcd = y_name,+ |
+
96 | +3x | +
+ y_unit = y_unit+ |
+
97 | ++ |
+ )+ |
+
98 | ++ | + + | +
99 | +3x | +
+ n_func <- if (show_n) "n" else NULL+ |
+
100 | ++ | + + | +
101 | +3x | +
+ table <- if (show_table) c(n_func, center_fun, interval_fun) else NULL+ |
+
102 | ++ | + + | +
103 | +3x | +
+ ggtheme <- ggplot2::theme_bw() ++ |
+
104 | +3x | +
+ ggplot2::theme(legend.position = legend_pos) ++ |
+
105 | +3x | +
+ ggplot2::theme(axis.title.x = ggplot2::element_blank())+ |
+
106 | ++ | + + | +
107 | +3x | +
+ ggtheme <- if (!show_v_grid) {+ |
+
108 | +3x | +
+ ggtheme + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank())+ |
+
109 | ++ |
+ } else {+ |
+
110 | +! | +
+ ggtheme + ggplot2::theme(panel.grid.major.x = ggplot2::element_line(linewidth = 1))+ |
+
111 | ++ |
+ }+ |
+
112 | ++ | + + | +
113 | +3x | +
+ ggtheme <- if (!show_h_grid) {+ |
+
114 | +1x | +
+ ggtheme + ggplot2::theme(+ |
+
115 | +1x | +
+ panel.grid.minor.y = ggplot2::element_blank(),+ |
+
116 | +1x | +
+ panel.grid.major.y = ggplot2::element_blank()+ |
+
117 | ++ |
+ )+ |
+
118 | ++ |
+ } else {+ |
+
119 | +2x | +
+ ggtheme + ggplot2::theme(+ |
+
120 | +2x | +
+ panel.grid.minor.y = ggplot2::element_line(linewidth = 1),+ |
+
121 | +2x | +
+ panel.grid.major.y = ggplot2::element_line(linewidth = 1)+ |
+
122 | ++ |
+ )+ |
+
123 | ++ |
+ }+ |
+
124 | ++ | + + | +
125 | +3x | +
+ if (!is.null(names(line_col))) {+ |
+
126 | +2x | +
+ color_lvl <- sort(unique(df[[arm_var]]))+ |
+
127 | +2x | +
+ col <- line_col[as.character(color_lvl)]+ |
+
128 | ++ | + + | +
129 | +2x | +
+ if (anyNA(col)) {+ |
+
130 | +1x | +
+ missing_col <- setdiff(color_lvl, names(col))+ |
+
131 | +1x | +
+ stop(paste("Missing color matching for", toString(missing_col)))+ |
+
132 | ++ |
+ }+ |
+
133 | ++ | + + | +
134 | +1x | +
+ col <- unname(col)+ |
+
135 | ++ |
+ } else {+ |
+
136 | +1x | +
+ col <- line_col+ |
+
137 | ++ |
+ }+ |
+
138 | ++ | + + | +
139 | +2x | +
+ ret <- lapply(+ |
+
140 | +2x | +
+ data_ls,+ |
+
141 | +2x | +
+ tern::g_lineplot,+ |
+
142 | +2x | +
+ alt_count = adam_db[["adsl"]],+ |
+
143 | +2x | +
+ variables = variables,+ |
+
144 | +2x | +
+ mid = center_fun,+ |
+
145 | +2x | +
+ interval = interval_fun,+ |
+
146 | +2x | +
+ whiskers = whiskers_fun,+ |
+
147 | +2x | +
+ position = ggplot2::position_dodge(width = ifelse(jitter, 0.3, 0)),+ |
+
148 | +2x | +
+ title = NULL,+ |
+
149 | +2x | +
+ table = table,+ |
+
150 | +2x | +
+ ggtheme = ggtheme,+ |
+
151 | +2x | +
+ col = col,+ |
+
152 | +2x | +
+ subtitle_add_unit = !is.na(y_unit)+ |
+
153 | ++ |
+ )+ |
+
154 | +2x | +
+ do_call(gg_list, ret)+ |
+
155 | ++ |
+ }+ |
+
156 | ++ | + + | +
157 | ++ |
+ #' @describeIn mng01 Preprocessing+ |
+
158 | ++ |
+ #'+ |
+
159 | ++ |
+ #' @inheritParams mng01_main+ |
+
160 | ++ |
+ #'+ |
+
161 | ++ |
+ #' @export+ |
+
162 | ++ |
+ mng01_pre <- function(adam_db, dataset, x_var = "AVISIT", ...) {+ |
+
163 | +2x | +
+ adam_db[[dataset]] <- adam_db[[dataset]] %>%+ |
+
164 | +2x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
165 | +2x | +
+ mutate(+ |
+
166 | +2x | +
+ AVISIT = reorder(.data$AVISIT, .data$AVISITN),+ |
+
167 | +2x | +
+ AVISIT = with_label(.data$AVISIT, "Visit")+ |
+
168 | ++ |
+ )+ |
+
169 | ++ | + + | +
170 | +2x | +
+ dunlin::ls_unite(adam_db, dataset, cols = x_var, sep = "_")+ |
+
171 | ++ |
+ }+ |
+
172 | ++ | + + | +
173 | ++ |
+ #' @describeIn mng01 Postprocessing+ |
+
174 | ++ |
+ #'+ |
+
175 | ++ |
+ #' @inheritParams gen_args+ |
+
176 | ++ |
+ #'+ |
+
177 | ++ |
+ mng01_post <- function(tlg, ...) {+ |
+
178 | +2x | +
+ tlg+ |
+
179 | ++ |
+ }+ |
+
180 | ++ | + + | +
181 | ++ |
+ # `mng01` Pipeline ----+ |
+
182 | ++ | + + | +
183 | ++ |
+ #' `MNG01` Mean Plot Graph.+ |
+
184 | ++ |
+ #'+ |
+
185 | ++ |
+ #' Overview of a summary statistics across time and arm for a selected data set.+ |
+
186 | ++ |
+ #'+ |
+
187 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
188 | ++ |
+ #' @export+ |
+
189 | ++ |
+ #'+ |
+
190 | ++ |
+ #' @examples+ |
+
191 | ++ |
+ #' col <- c(+ |
+
192 | ++ |
+ #' "A: Drug X" = "black",+ |
+
193 | ++ |
+ #' "B: Placebo" = "blue",+ |
+
194 | ++ |
+ #' "C: Combination" = "gray"+ |
+
195 | ++ |
+ #' )+ |
+
196 | ++ |
+ #'+ |
+
197 | ++ |
+ #' run(mng01, syn_data, dataset = "adlb", x_var = c("AVISIT", "AVISITN"), line_col = col)+ |
+
198 | ++ |
+ mng01 <- chevron_g(+ |
+
199 | ++ |
+ main = mng01_main,+ |
+
200 | ++ |
+ preproces = mng01_pre,+ |
+
201 | ++ |
+ postprocess = mng01_post+ |
+
202 | ++ |
+ )+ |
+
1 | ++ |
+ # rmpt01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn rmpt01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param summaryvars (`string`) variables to be analyzed. The label attribute of the corresponding columns in `adex`+ |
+
7 | ++ |
+ #' table of `adam_db` is used as label.+ |
+
8 | ++ |
+ #' @param show_tot (`flag`) whether to display the cumulative total.+ |
+
9 | ++ |
+ #' @param row_split_var (`string`) the name of the column that containing variable to split exposure by.+ |
+
10 | ++ |
+ #' @param col_split_var (`string`) additional column splitting variable.+ |
+
11 | ++ |
+ #' @param overall_col_lbl (`string`) name of the overall column. If `NULL`, no overall level is added.+ |
+
12 | ++ |
+ #'+ |
+
13 | ++ |
+ #' @details+ |
+
14 | ++ |
+ #' * Person time is the sum of exposure across all patients.+ |
+
15 | ++ |
+ #' * Summary statistics are by default based on the number of patients in the corresponding `N` row+ |
+
16 | ++ |
+ #' (number of non-missing values).+ |
+
17 | ++ |
+ #' * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ #' @note+ |
+
20 | ++ |
+ #' * `adam_db` object must contain an `adex` table with `"AVAL"` and the columns specified by `summaryvars`.+ |
+
21 | ++ |
+ #' @export+ |
+
22 | ++ |
+ #'+ |
+
23 | ++ |
+ rmpt01_main <- function(adam_db,+ |
+
24 | ++ |
+ summaryvars = "AVALCAT1",+ |
+
25 | ++ |
+ show_tot = TRUE,+ |
+
26 | ++ |
+ row_split_var = NULL,+ |
+
27 | ++ |
+ col_split_var = NULL,+ |
+
28 | ++ |
+ overall_col_lbl = NULL,+ |
+
29 | ++ |
+ ...) {+ |
+
30 | +4x | +
+ assert_all_tablenames(adam_db, c("adsl", "adex"))+ |
+
31 | +4x | +
+ checkmate::assert_string(summaryvars)+ |
+
32 | +4x | +
+ checkmate::assert_flag(show_tot)+ |
+
33 | +4x | +
+ checkmate::assert_string(col_split_var, null.ok = TRUE)+ |
+
34 | +4x | +
+ checkmate::assert_string(overall_col_lbl, null.ok = TRUE)+ |
+
35 | +4x | +
+ assert_valid_variable(adam_db$adex, summaryvars, types = list(c("factor", "character")), empty_ok = FALSE)+ |
+
36 | +4x | +
+ assert_valid_variable(adam_db$adex, "AVAL", types = list("numeric"))+ |
+
37 | +4x | +
+ assert_valid_variable(adam_db$adex, row_split_var, types = list(c("factor", "numeric")), empty_ok = TRUE)+ |
+
38 | +4x | +
+ assert_valid_variable(adam_db$adex, col_split_var, types = list(c("factor", "character")))+ |
+
39 | +4x | +
+ checkmate::assert_string(overall_col_lbl, null.ok = TRUE)+ |
+
40 | ++ | + + | +
41 | +4x | +
+ assert_valid_variable(adam_db$adex, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
42 | +4x | +
+ assert_valid_variable(adam_db$adsl, "USUBJID", types = list(c("character", "factor")))+ |
+
43 | ++ | + + | +
44 | +4x | +
+ lbl_summaryvars <- var_labels_for(adam_db$adex, summaryvars)+ |
+
45 | ++ | + + | +
46 | +4x | +
+ lyt <- rmpt01_lyt(+ |
+
47 | +4x | +
+ summaryvars = summaryvars,+ |
+
48 | +4x | +
+ lbl_summaryvars = lbl_summaryvars,+ |
+
49 | +4x | +
+ show_tot = show_tot,+ |
+
50 | +4x | +
+ row_split_var = row_split_var,+ |
+
51 | +4x | +
+ col_split_var = col_split_var,+ |
+
52 | +4x | +
+ overall_col_lbl = overall_col_lbl+ |
+
53 | ++ |
+ )+ |
+
54 | ++ | + + | +
55 | +4x | +
+ build_table(lyt, adam_db$adex, alt_counts_df = adam_db$adsl)+ |
+
56 | ++ |
+ }+ |
+
57 | ++ | + + | +
58 | ++ | + + | +
59 | ++ |
+ #' `rmpt01` Layout+ |
+
60 | ++ |
+ #'+ |
+
61 | ++ |
+ #' @inheritParams gen_args+ |
+
62 | ++ |
+ #' @inheritParams rmpt01_main+ |
+
63 | ++ |
+ #' @param lbl_summaryvars (`character`) label associated with the analyzed variables.+ |
+
64 | ++ |
+ #'+ |
+
65 | ++ |
+ #' @keywords internal+ |
+
66 | ++ |
+ #'+ |
+
67 | ++ |
+ rmpt01_lyt <- function(summaryvars,+ |
+
68 | ++ |
+ lbl_summaryvars,+ |
+
69 | ++ |
+ show_tot,+ |
+
70 | ++ |
+ row_split_var,+ |
+
71 | ++ |
+ col_split_var,+ |
+
72 | ++ |
+ overall_col_lbl) {+ |
+
73 | +12x | +
+ lyt <- basic_table(show_colcounts = TRUE) %>%+ |
+
74 | +12x | +
+ ifneeded_split_col(+ |
+
75 | +12x | +
+ col_split_var,+ |
+
76 | +12x | +
+ split_fun = if (!is.null(overall_col_lbl)) add_overall_level("ALL", overall_col_lbl)+ |
+
77 | ++ |
+ ) %>%+ |
+
78 | +12x | +
+ split_cols_by_multivar(+ |
+
79 | +12x | +
+ vars = c("AVAL", "AVAL"),+ |
+
80 | +12x | +
+ varlabels = c(n_patients = render_safe("{Patient_label}"), sum_exposure = "Person time"),+ |
+
81 | +12x | +
+ extra_args = list(.stats = c("n_patients", "sum_exposure"))+ |
+
82 | ++ |
+ ) %>%+ |
+
83 | +12x | +
+ analyze_patients_exposure_in_cols(+ |
+
84 | +12x | +
+ var = summaryvars,+ |
+
85 | +12x | +
+ col_split = FALSE,+ |
+
86 | +12x | +
+ add_total_level = show_tot,+ |
+
87 | +12x | +
+ custom_label = render_safe("Total {patient_label} number/person time")+ |
+
88 | ++ |
+ )+ |
+
89 | ++ | + + | +
90 | +12x | +
+ if (!is.null(row_split_var)) {+ |
+
91 | +! | +
+ lyt %>%+ |
+
92 | +! | +
+ split_rows_by(row_split_var) %>%+ |
+
93 | +! | +
+ analyze_patients_exposure_in_cols(+ |
+
94 | +! | +
+ .indent_mods = -1L,+ |
+
95 | +! | +
+ var = summaryvars,+ |
+
96 | +! | +
+ col_split = FALSE,+ |
+
97 | +! | +
+ add_total_level = show_tot,+ |
+
98 | +! | +
+ custom_label = render_safe("Total {patient_label} number/person time")+ |
+
99 | ++ |
+ ) %>%+ |
+
100 | +! | +
+ append_topleft(c("", lbl_summaryvars))+ |
+
101 | ++ |
+ } else {+ |
+
102 | +12x | +
+ lyt %>%+ |
+
103 | +12x | +
+ append_topleft(c("", lbl_summaryvars))+ |
+
104 | ++ |
+ }+ |
+
105 | ++ |
+ }+ |
+
106 | ++ | + + | +
107 | ++ |
+ #' @describeIn rmpt01 Preprocessing+ |
+
108 | ++ |
+ #'+ |
+
109 | ++ |
+ #' @inheritParams gen_args+ |
+
110 | ++ |
+ #' @inheritParams rmpt01_main+ |
+
111 | ++ |
+ #'+ |
+
112 | ++ |
+ #' @export+ |
+
113 | ++ |
+ #'+ |
+
114 | ++ |
+ rmpt01_pre <- function(adam_db,+ |
+
115 | ++ |
+ summaryvars = "AVALCAT1",+ |
+
116 | ++ |
+ ...) {+ |
+
117 | +4x | +
+ adam_db$adex <- adam_db$adex %>%+ |
+
118 | +4x | +
+ filter(.data$PARAMCD == "TDURD")+ |
+
119 | ++ | + + | +
120 | +4x | +
+ adam_db$adex$AVALCAT1 <- droplevels(adam_db$adex$AVALCAT1)+ |
+
121 | ++ | + + | +
122 | +4x | +
+ adam_db$adex <- adam_db$adex %>%+ |
+
123 | +4x | +
+ mutate(+ |
+
124 | +4x | +
+ AVALCAT1 = with_label(.data$AVALCAT1, "Duration of exposure")+ |
+
125 | ++ |
+ )+ |
+
126 | ++ | + + | +
127 | +4x | +
+ adam_db$adex[[summaryvars]] <- reformat(adam_db$adex[[summaryvars]], missing_rule)+ |
+
128 | +4x | +
+ if (!"<Missing>" %in% adam_db$adex[[summaryvars]] && summaryvars %in% colnames(adam_db$adex)) {+ |
+
129 | +4x | +
+ adam_db$adex[[summaryvars]] <- forcats::fct_drop(adam_db$adex[[summaryvars]], only = "<Missing>")+ |
+
130 | ++ |
+ }+ |
+
131 | ++ | + + | +
132 | +4x | +
+ adam_db+ |
+
133 | ++ |
+ }+ |
+
134 | ++ | + + | +
135 | ++ |
+ #' @describeIn rmpt01 Postprocessing+ |
+
136 | ++ |
+ #'+ |
+
137 | ++ |
+ #' @inheritParams gen_args+ |
+
138 | ++ |
+ #'+ |
+
139 | ++ |
+ #' @export+ |
+
140 | ++ |
+ #'+ |
+
141 | ++ |
+ rmpt01_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
142 | +4x | +
+ if (prune_0) {+ |
+
143 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
144 | ++ |
+ }+ |
+
145 | +4x | +
+ std_postprocess(tlg)+ |
+
146 | ++ |
+ }+ |
+
147 | ++ | + + | +
148 | ++ |
+ #' `RMPT01`Duration of Exposure for Risk Management Plan Table.+ |
+
149 | ++ |
+ #'+ |
+
150 | ++ |
+ #' The `RMPT01` table provides an overview of duration of exposure.+ |
+
151 | ++ |
+ #'+ |
+
152 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
153 | ++ |
+ #' @export+ |
+
154 | ++ |
+ #'+ |
+
155 | ++ |
+ #' @examples+ |
+
156 | ++ |
+ #' run(rmpt01, syn_data, col_split_var = "SEX")+ |
+
157 | ++ |
+ rmpt01 <- chevron_t(+ |
+
158 | ++ |
+ main = rmpt01_main,+ |
+
159 | ++ |
+ preprocess = rmpt01_pre,+ |
+
160 | ++ |
+ postprocess = rmpt01_post+ |
+
161 | ++ |
+ )+ |
+
1 | ++ |
+ # lbt06 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn lbt06 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param arm_var (`string`) the arm variable used for arm splitting.+ |
+
7 | ++ |
+ #'+ |
+
8 | ++ |
+ #' @details+ |
+
9 | ++ |
+ #' * Only count `"LOW"` or `"HIGH"` values for `ANRIND` and `BNRIND`.+ |
+
10 | ++ |
+ #' * Lab test results with missing `ANRIND` values are excluded.+ |
+
11 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
12 | ++ |
+ #' * Keep zero count rows by default.+ |
+
13 | ++ |
+ #'+ |
+
14 | ++ |
+ #' @note+ |
+
15 | ++ |
+ #' * `adam_db` object must contain an `adlb` table with columns `"AVISIT"`, `"ANRIND"`, `"BNRIND"`,+ |
+
16 | ++ |
+ #' `"ONTRTFL"`, and `"PARCAT2"`, and column specified by `arm_var`.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @export+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ lbt06_main <- function(adam_db,+ |
+
21 | ++ |
+ arm_var = "ACTARM",+ |
+
22 | ++ |
+ ...) {+ |
+
23 | +2x | +
+ assert_all_tablenames(adam_db, c("adsl", "adlb"))+ |
+
24 | +2x | +
+ checkmate::assert_string(arm_var)+ |
+
25 | +2x | +
+ assert_valid_variable(adam_db$adlb, c(arm_var, "PARAM", "AVISIT"), types = list("characater", "factor"))+ |
+
26 | +2x | +
+ assert_valid_variable(adam_db$adlb, c("ANRIND", "BNRIND"), types = list(c("character", "factor")))+ |
+
27 | +2x | +
+ assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")))+ |
+
28 | +2x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))+ |
+
29 | +2x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)+ |
+
30 | +2x | +
+ lbl_param <- var_labels_for(adam_db$adlb, "PARAM")+ |
+
31 | +2x | +
+ lbl_visit <- var_labels_for(adam_db$adlb, "AVISIT")+ |
+
32 | +2x | +
+ lbl_anrind <- var_labels_for(adam_db$adlb, "ANRIND")+ |
+
33 | +2x | +
+ lbl_bnrind <- var_labels_for(adam_db$adlb, "BNRIND")+ |
+
34 | ++ | + + | +
35 | +2x | +
+ lyt <- lbt06_lyt(+ |
+
36 | +2x | +
+ arm_var = arm_var,+ |
+
37 | +2x | +
+ param = "PARAM",+ |
+
38 | +2x | +
+ visitvar = "AVISIT",+ |
+
39 | +2x | +
+ anrind_var = "ANRIND",+ |
+
40 | +2x | +
+ bnrind_var = "BNRIND",+ |
+
41 | +2x | +
+ lbl_param = lbl_param,+ |
+
42 | +2x | +
+ lbl_visit = lbl_visit,+ |
+
43 | +2x | +
+ lbl_anrind = lbl_anrind,+ |
+
44 | +2x | +
+ lbl_bnrind = lbl_bnrind+ |
+
45 | ++ |
+ )+ |
+
46 | ++ | + + | +
47 | +2x | +
+ tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)+ |
+
48 | ++ | + + | +
49 | +2x | +
+ tbl+ |
+
50 | ++ |
+ }+ |
+
51 | ++ | + + | +
52 | ++ |
+ #' `lbt06` Layout+ |
+
53 | ++ |
+ #'+ |
+
54 | ++ |
+ #' @inheritParams gen_args+ |
+
55 | ++ |
+ #'+ |
+
56 | ++ |
+ #' @param param (`string`) the variable for parameter code.+ |
+
57 | ++ |
+ #' @param anrind_var (`string`) the variable for analysis reference range indicator.+ |
+
58 | ++ |
+ #' @param bnrind_var (`string`) the variable for baseline reference range indicator.+ |
+
59 | ++ |
+ #' @param lbl_param (`string`) text label of the `PARAM` variable.+ |
+
60 | ++ |
+ #' @param lbl_visit (`string`) text label of the `AVISIT` variable.+ |
+
61 | ++ |
+ #' @param lbl_anrind (`string`) text label of the `ANRIND` variable.+ |
+
62 | ++ |
+ #' @param lbl_bnrind (`string`) text label of the `BNRIND` variable.+ |
+
63 | ++ |
+ #'+ |
+
64 | ++ |
+ #' @keywords internal+ |
+
65 | ++ |
+ #'+ |
+
66 | ++ |
+ lbt06_lyt <- function(arm_var,+ |
+
67 | ++ |
+ param,+ |
+
68 | ++ |
+ visitvar,+ |
+
69 | ++ |
+ anrind_var,+ |
+
70 | ++ |
+ bnrind_var,+ |
+
71 | ++ |
+ lbl_param,+ |
+
72 | ++ |
+ lbl_visit,+ |
+
73 | ++ |
+ lbl_anrind,+ |
+
74 | ++ |
+ lbl_bnrind) {+ |
+
75 | +2x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
76 | +2x | +
+ split_cols_by(arm_var) %>%+ |
+
77 | +2x | +
+ split_rows_by(+ |
+
78 | +2x | +
+ var = param,+ |
+
79 | +2x | +
+ split_fun = drop_split_levels,+ |
+
80 | +2x | +
+ label_pos = "topleft",+ |
+
81 | +2x | +
+ split_label = lbl_param+ |
+
82 | ++ |
+ ) %>%+ |
+
83 | +2x | +
+ split_rows_by(+ |
+
84 | +2x | +
+ var = visitvar,+ |
+
85 | +2x | +
+ split_fun = drop_split_levels,+ |
+
86 | +2x | +
+ label_pos = "topleft",+ |
+
87 | +2x | +
+ split_label = lbl_visit+ |
+
88 | ++ |
+ ) %>%+ |
+
89 | +2x | +
+ count_abnormal_by_baseline(+ |
+
90 | +2x | +
+ var = anrind_var,+ |
+
91 | +2x | +
+ abnormal = c(Low = "LOW", High = "HIGH"),+ |
+
92 | +2x | +
+ variables = list(id = "USUBJID", baseline = bnrind_var),+ |
+
93 | +2x | +
+ .indent_mods = 4L+ |
+
94 | ++ |
+ ) %>%+ |
+
95 | +2x | +
+ append_topleft(paste0(" ", lbl_anrind)) %>%+ |
+
96 | +2x | +
+ append_topleft(paste0(" ", lbl_bnrind))+ |
+
97 | ++ |
+ }+ |
+
98 | ++ | + + | +
99 | ++ |
+ #' @describeIn lbt06 Preprocessing+ |
+
100 | ++ |
+ #'+ |
+
101 | ++ |
+ #' @inheritParams gen_args+ |
+
102 | ++ |
+ #'+ |
+
103 | ++ |
+ #' @export+ |
+
104 | ++ |
+ #'+ |
+
105 | ++ |
+ lbt06_pre <- function(adam_db, ...) {+ |
+
106 | +3x | +
+ missing_rule <- rule("<Missing>" = c("", NA, "<Missing>"))+ |
+
107 | ++ | + + | +
108 | +3x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
109 | +3x | +
+ filter(+ |
+
110 | +3x | +
+ .data$ONTRTFL == "Y",+ |
+
111 | +3x | +
+ .data$PARCAT2 == "SI"+ |
+
112 | ++ |
+ ) %>%+ |
+
113 | +3x | +
+ mutate(+ |
+
114 | +3x | +
+ across(all_of(c("ANRIND", "BNRIND")), ~ reformat(.x, .env$missing_rule)),+ |
+
115 | +3x | +
+ AVISIT = reorder(.data$AVISIT, .data$AVISITN),+ |
+
116 | +3x | +
+ AVISIT = with_label(.data$AVISIT, "Visit"),+ |
+
117 | +3x | +
+ ANRIND = with_label(.data$ANRIND, "Abnormality at Visit"),+ |
+
118 | +3x | +
+ BNRIND = with_label(.data$BNRIND, "Baseline Status")+ |
+
119 | ++ |
+ )+ |
+
120 | ++ | + + | +
121 | +2x | +
+ adam_db+ |
+
122 | ++ |
+ }+ |
+
123 | ++ | + + | +
124 | ++ |
+ #' @describeIn lbt06 Postprocessing+ |
+
125 | ++ |
+ #'+ |
+
126 | ++ |
+ #' @inheritParams gen_args+ |
+
127 | ++ |
+ #'+ |
+
128 | ++ |
+ #' @export+ |
+
129 | ++ |
+ #'+ |
+
130 | ++ |
+ lbt06_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
131 | +! | +
+ if (prune_0) {+ |
+
132 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
133 | ++ |
+ }+ |
+
134 | +! | +
+ std_postprocess(tlg)+ |
+
135 | ++ |
+ }+ |
+
136 | ++ | + + | +
137 | ++ |
+ #' `LBT06` Table 1 (Default) Laboratory Abnormalities by Visit and Baseline Status Table 1.+ |
+
138 | ++ |
+ #'+ |
+
139 | ++ |
+ #' The `LBT06` table produces the standard laboratory abnormalities by visit and+ |
+
140 | ++ |
+ #' baseline status summary.+ |
+
141 | ++ |
+ #'+ |
+
142 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
143 | ++ |
+ #' @export+ |
+
144 | ++ |
+ #'+ |
+
145 | ++ |
+ #' @examples+ |
+
146 | ++ |
+ #' run(lbt06, syn_data)+ |
+
147 | ++ |
+ lbt06 <- chevron_t(+ |
+
148 | ++ |
+ main = lbt06_main,+ |
+
149 | ++ |
+ preprocess = lbt06_pre,+ |
+
150 | ++ |
+ postprocess = lbt06_post+ |
+
151 | ++ |
+ )+ |
+
1 | ++ |
+ # kmg01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn kmg01 Main TLG Function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @details+ |
+
6 | ++ |
+ #' * No overall value.+ |
+
7 | ++ |
+ #'+ |
+
8 | ++ |
+ #' @inheritParams gen_args+ |
+
9 | ++ |
+ #' @param dataset (`string`) the name of a table in the `adam_db` object.+ |
+
10 | ++ |
+ #' @param ... Further arguments passed to `g_km` and `control_coxph`. For details, see+ |
+
11 | ++ |
+ #' the documentation in `tern`.+ |
+
12 | ++ |
+ #' Commonly used arguments include `col`, `pval_method`, `ties`, `conf_level`, `conf_type`,+ |
+
13 | ++ |
+ #' `annot_coxph`, `annot_stats`, etc.+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @note+ |
+
16 | ++ |
+ #' * `adam_db` object must contain the table specified by `dataset` with the columns specified by `arm_var`.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @return a `gTree` object.+ |
+
19 | ++ |
+ #' @export+ |
+
20 | ++ |
+ kmg01_main <- function(adam_db,+ |
+
21 | ++ |
+ dataset = "adtte",+ |
+
22 | ++ |
+ arm_var = "ARM",+ |
+
23 | ++ |
+ ...) {+ |
+
24 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", dataset))+ |
+
25 | +1x | +
+ df_lbl <- paste0("adam_db$", dataset)+ |
+
26 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], "AVAL", types = list("numeric"), lower = 0, label = df_lbl)+ |
+
27 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], "is_event", types = list("logical"), label = df_lbl)+ |
+
28 | +1x | +
+ assert_valid_variable(+ |
+
29 | +1x | +
+ adam_db[[dataset]],+ |
+
30 | +1x | +
+ c("PARAMCD", arm_var),+ |
+
31 | +1x | +
+ types = list(c("character", "factor")),+ |
+
32 | +1x | +
+ na_ok = FALSE,+ |
+
33 | +1x | +
+ label = df_lbl+ |
+
34 | ++ |
+ )+ |
+
35 | +1x | +
+ assert_single_value(adam_db[[dataset]]$PARAMCD, label = paste0(df_lbl, "$PARAMCD"))+ |
+
36 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
37 | +1x | +
+ variables <- list(tte = "AVAL", is_event = "is_event", arm = arm_var)+ |
+
38 | ++ | + + | +
39 | +1x | +
+ control_cox <- execute_with_args(control_coxph, ...)+ |
+
40 | +1x | +
+ control_surv <- execute_with_args(control_surv_timepoint, ...)+ |
+
41 | +1x | +
+ execute_with_args(+ |
+
42 | +1x | +
+ g_km,+ |
+
43 | +1x | +
+ df = adam_db[[dataset]],+ |
+
44 | +1x | +
+ variables = variables,+ |
+
45 | +1x | +
+ control_surv = control_surv,+ |
+
46 | +1x | +
+ control_coxph_pw = control_cox,+ |
+
47 | ++ |
+ ...+ |
+
48 | ++ |
+ )+ |
+
49 | ++ |
+ }+ |
+
50 | ++ | + + | +
51 | ++ |
+ #' @describeIn kmg01 Preprocessing+ |
+
52 | ++ |
+ #'+ |
+
53 | ++ |
+ #' @inheritParams kmg01_main+ |
+
54 | ++ |
+ #'+ |
+
55 | ++ |
+ #' @export+ |
+
56 | ++ |
+ kmg01_pre <- function(adam_db, dataset = "adtte", ...) {+ |
+
57 | +1x | +
+ adam_db[[dataset]] <- adam_db[[dataset]] %>%+ |
+
58 | +1x | +
+ mutate(is_event = .data$CNSR == 0)+ |
+
59 | ++ | + + | +
60 | +1x | +
+ adam_db+ |
+
61 | ++ |
+ }+ |
+
62 | ++ | + + | +
63 | ++ |
+ #' @describeIn kmg01 Postprocessing+ |
+
64 | ++ |
+ #'+ |
+
65 | ++ |
+ #' @inheritParams gen_args+ |
+
66 | ++ |
+ #'+ |
+
67 | ++ |
+ #' @export+ |
+
68 | ++ |
+ kmg01_post <- function(tlg, ...) {+ |
+
69 | +! | +
+ tlg+ |
+
70 | ++ |
+ }+ |
+
71 | ++ | + + | +
72 | ++ |
+ # `kmg01` Pipeline ----+ |
+
73 | ++ | + + | +
74 | ++ |
+ #' `KMG01` Kaplan-Meier Plot 1.+ |
+
75 | ++ |
+ #'+ |
+
76 | ++ |
+ #'+ |
+
77 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
78 | ++ |
+ #' @export+ |
+
79 | ++ |
+ #'+ |
+
80 | ++ |
+ #' @examples+ |
+
81 | ++ |
+ #' library(dplyr)+ |
+
82 | ++ |
+ #' library(dunlin)+ |
+
83 | ++ |
+ #'+ |
+
84 | ++ |
+ #' col <- c(+ |
+
85 | ++ |
+ #' "A: Drug X" = "black",+ |
+
86 | ++ |
+ #' "B: Placebo" = "blue",+ |
+
87 | ++ |
+ #' "C: Combination" = "gray"+ |
+
88 | ++ |
+ #' )+ |
+
89 | ++ |
+ #'+ |
+
90 | ++ |
+ #' syn_data2 <- log_filter(syn_data, PARAMCD == "OS", "adtte")+ |
+
91 | ++ |
+ #' run(kmg01, syn_data2, dataset = "adtte", line_col = col)+ |
+
92 | ++ |
+ #'+ |
+
93 | ++ |
+ #' syn_data3 <- log_filter(syn_data, PARAMCD == "AEREPTTE", "adaette")+ |
+
94 | ++ |
+ #' run(kmg01, syn_data3, dataset = "adaette")+ |
+
95 | ++ |
+ kmg01 <- chevron_g(+ |
+
96 | ++ |
+ main = kmg01_main,+ |
+
97 | ++ |
+ preproces = kmg01_pre,+ |
+
98 | ++ |
+ postprocess = kmg01_post+ |
+
99 | ++ |
+ )+ |
+
1 | ++ |
+ # egt02_1 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn egt02_1 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param exclude_base_abn (`flag`) whether baseline abnormality should be excluded.+ |
+
7 | ++ |
+ #'+ |
+
8 | ++ |
+ #' @details+ |
+
9 | ++ |
+ #' * Only count LOW or HIGH values.+ |
+
10 | ++ |
+ #' * Results of "LOW LOW" are treated as the same as "LOW", and "HIGH HIGH" the same as "HIGH".+ |
+
11 | ++ |
+ #' * Does not include a total column by default.+ |
+
12 | ++ |
+ #' * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.+ |
+
13 | ++ |
+ #'+ |
+
14 | ++ |
+ #' @note+ |
+
15 | ++ |
+ #' * `adam_db` object must contain an `adeg` table with the `"PARAM"`, `"ANRIND"` and `"BNRIND"` columns.+ |
+
16 | ++ |
+ #'+ |
+
17 | ++ |
+ #' @export+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ egt02_1_main <- function(adam_db,+ |
+
20 | ++ |
+ arm_var = "ACTARM",+ |
+
21 | ++ |
+ lbl_overall = NULL,+ |
+
22 | ++ |
+ exclude_base_abn = FALSE,+ |
+
23 | ++ |
+ ...) {+ |
+
24 | +2x | +
+ assert_all_tablenames(adam_db, c("adsl", "adeg"))+ |
+
25 | +2x | +
+ assert_valid_variable(adam_db$adeg, c("PARAM"), types = list(c("character", "factor")), na_ok = FALSE)+ |
+
26 | +2x | +
+ assert_valid_variable(adam_db$adeg, c("ANRIND", "BNRIND"), types = list(c("character", "factor")), na_ok = TRUE)+ |
+
27 | +2x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
28 | +2x | +
+ checkmate::assert_flag(exclude_base_abn)+ |
+
29 | +2x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)+ |
+
30 | +2x | +
+ assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
31 | +2x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
32 | +2x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
33 | +2x | +
+ lyt <- egt02_lyt(+ |
+
34 | +2x | +
+ arm_var = arm_var,+ |
+
35 | +2x | +
+ lbl_vs_assessment = "Assessment",+ |
+
36 | +2x | +
+ lbl_vs_abnormality = "Abnormality",+ |
+
37 | +2x | +
+ lbl_overall = lbl_overall,+ |
+
38 | +2x | +
+ exclude_base_abn = exclude_base_abn+ |
+
39 | ++ |
+ )+ |
+
40 | ++ | + + | +
41 | +2x | +
+ tbl <- build_table(lyt, adam_db$adeg, alt_counts_df = adam_db$adsl)+ |
+
42 | ++ | + + | +
43 | +2x | +
+ tbl+ |
+
44 | ++ |
+ }+ |
+
45 | ++ | + + | +
46 | ++ |
+ #' `egt02` Layout+ |
+
47 | ++ |
+ #'+ |
+
48 | ++ |
+ #' @inheritParams gen_args+ |
+
49 | ++ |
+ #' @param lbl_vs_assessment (`string`) the label of the assessment variable.+ |
+
50 | ++ |
+ #' @param lbl_vs_abnormality (`string`) the label of the abnormality variable.+ |
+
51 | ++ |
+ #' @param exclude_base_abn (`flag`) whether to exclude subjects with baseline abnormality from numerator and+ |
+
52 | ++ |
+ #' denominator.+ |
+
53 | ++ |
+ #'+ |
+
54 | ++ |
+ #' @keywords internal+ |
+
55 | ++ |
+ #'+ |
+
56 | ++ |
+ egt02_lyt <- function(arm_var = "ACTARM",+ |
+
57 | ++ |
+ lbl_vs_assessment = "Assessment",+ |
+
58 | ++ |
+ lbl_vs_abnormality = "Abnormality",+ |
+
59 | ++ |
+ lbl_overall,+ |
+
60 | ++ |
+ exclude_base_abn) {+ |
+
61 | +4x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
62 | +4x | +
+ split_cols_by(var = arm_var) %>%+ |
+
63 | +4x | +
+ add_colcounts() %>%+ |
+
64 | +4x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
65 | +4x | +
+ split_rows_by("PARAM", split_fun = drop_split_levels, label_pos = "topleft", split_label = lbl_vs_assessment) %>%+ |
+
66 | +4x | +
+ count_abnormal(+ |
+
67 | +4x | +
+ "ANRIND",+ |
+
68 | +4x | +
+ abnormal = list(Low = "LOW", High = "HIGH"),+ |
+
69 | +4x | +
+ variables = list(id = "USUBJID", baseline = "BNRIND"),+ |
+
70 | +4x | +
+ exclude_base_abn = exclude_base_abn+ |
+
71 | ++ |
+ ) %>%+ |
+
72 | +4x | +
+ append_topleft(paste0(" ", lbl_vs_abnormality))+ |
+
73 | ++ |
+ }+ |
+
74 | ++ | + + | +
75 | ++ | + + | +
76 | ++ |
+ #' @describeIn egt02_1 Preprocessing+ |
+
77 | ++ |
+ #'+ |
+
78 | ++ |
+ #' @inheritParams gen_args+ |
+
79 | ++ |
+ #'+ |
+
80 | ++ |
+ #' @export+ |
+
81 | ++ |
+ #'+ |
+
82 | ++ |
+ egt02_pre <- function(adam_db, ...) {+ |
+
83 | +2x | +
+ assert_all_tablenames(adam_db, c("adsl", "adeg"))+ |
+
84 | +2x | +
+ adam_db$adeg <- adam_db$adeg %>%+ |
+
85 | +2x | +
+ mutate(ANRIND = factor(.data$ANRIND, levels = c("LOW", "NORMAL", "HIGH"))) %>%+ |
+
86 | +2x | +
+ filter(!is.na(.data$ANRIND)) %>%+ |
+
87 | +2x | +
+ filter(.data$ONTRTFL == "Y")+ |
+
88 | ++ | + + | +
89 | +2x | +
+ adam_db+ |
+
90 | ++ |
+ }+ |
+
91 | ++ | + + | +
92 | ++ |
+ #' @describeIn egt02_1 Postprocessing+ |
+
93 | ++ |
+ #'+ |
+
94 | ++ |
+ #' @inheritParams gen_args+ |
+
95 | ++ |
+ #'+ |
+
96 | ++ |
+ #' @export+ |
+
97 | ++ |
+ #'+ |
+
98 | ++ |
+ egt02_post <- function(tlg, ...) {+ |
+
99 | +2x | +
+ std_postprocess(tlg)+ |
+
100 | ++ |
+ }+ |
+
101 | ++ | + + | +
102 | ++ |
+ #' `EGT02` ECG Abnormalities Table.+ |
+
103 | ++ |
+ #'+ |
+
104 | ++ |
+ #' ECG Parameters outside Normal Limits Regardless of Abnormality at Baseline Table.+ |
+
105 | ++ |
+ #'+ |
+
106 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
107 | ++ |
+ #' @export+ |
+
108 | ++ |
+ #'+ |
+
109 | ++ |
+ #' @examples+ |
+
110 | ++ |
+ #' run(egt02_1, syn_data)+ |
+
111 | ++ |
+ egt02_1 <- chevron_t(+ |
+
112 | ++ |
+ main = egt02_1_main,+ |
+
113 | ++ |
+ preprocess = egt02_pre,+ |
+
114 | ++ |
+ postprocess = egt02_post+ |
+
115 | ++ |
+ )+ |
+
116 | ++ | + + | +
117 | ++ |
+ # egt02_2 ----+ |
+
118 | ++ | + + | +
119 | ++ |
+ #' @describeIn egt02_2 Main TLG function+ |
+
120 | ++ |
+ #'+ |
+
121 | ++ |
+ #' @inherit egt02_1_main+ |
+
122 | ++ |
+ #' @export+ |
+
123 | ++ |
+ #'+ |
+
124 | ++ |
+ egt02_2_main <- modify_default_args(egt02_1_main, exclude_base_abn = TRUE)+ |
+
125 | ++ | + + | +
126 | ++ |
+ #' `EGT02_2` ECG Abnormalities Table.+ |
+
127 | ++ |
+ #'+ |
+
128 | ++ |
+ #' ECG Parameters outside Normal Limits Among Patients without Abnormality at Baseline Table.+ |
+
129 | ++ |
+ #'+ |
+
130 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
131 | ++ |
+ #' @export+ |
+
132 | ++ |
+ #'+ |
+
133 | ++ |
+ #' @examples+ |
+
134 | ++ |
+ #' run(egt02_2, syn_data)+ |
+
135 | ++ |
+ egt02_2 <- chevron_t(+ |
+
136 | ++ |
+ main = egt02_2_main,+ |
+
137 | ++ |
+ preprocess = egt02_pre,+ |
+
138 | ++ |
+ postprocess = egt02_post+ |
+
139 | ++ |
+ )+ |
+
1 | ++ |
+ # dst01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn dst01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param arm_var (`string`) variable. Usually one of `ARM`, `ACTARM`, `TRT01A`, or `TRT01A`.+ |
+
7 | ++ |
+ #' @param study_status_var (`string`) variable used to define patient status. Default is `EOSSTT`, however can also be a+ |
+
8 | ++ |
+ #' variable name with the pattern `EOPxxSTT` where `xx` must be substituted by 2 digits referring to the analysis+ |
+
9 | ++ |
+ #' period.+ |
+
10 | ++ |
+ #' @param detail_vars Named (`list`) of grouped display of `study_status_var`. The names must be subset of unique levels+ |
+
11 | ++ |
+ #' of `study_status_var`.+ |
+
12 | ++ |
+ #' @param trt_status_var (`string`) variable of treatment status.+ |
+
13 | ++ |
+ #' @details+ |
+
14 | ++ |
+ #' * Default patient disposition table summarizing the reasons for patients withdrawal.+ |
+
15 | ++ |
+ #' * Numbers represent absolute numbers of patients and fraction of `N`.+ |
+
16 | ++ |
+ #' * Remove zero-count rows.+ |
+
17 | ++ |
+ #' * Split columns by arm.+ |
+
18 | ++ |
+ #' * Include a total column by default.+ |
+
19 | ++ |
+ #' * Sort withdrawal reasons by alphabetic order.+ |
+
20 | ++ |
+ #'+ |
+
21 | ++ |
+ #' @note+ |
+
22 | ++ |
+ #' * `adam_db` object must contain an `adsl` table with the columns specified by `status_var` and `disc_reason_var`.+ |
+
23 | ++ |
+ #'+ |
+
24 | ++ |
+ #' @export+ |
+
25 | ++ |
+ #'+ |
+
26 | ++ |
+ dst01_main <- function(adam_db,+ |
+
27 | ++ |
+ arm_var = "ARM",+ |
+
28 | ++ |
+ study_status_var = "EOSSTT",+ |
+
29 | ++ |
+ detail_vars = list(+ |
+
30 | ++ |
+ Discontinued = c("DCSREAS")+ |
+
31 | ++ |
+ ),+ |
+
32 | ++ |
+ trt_status_var = NULL,+ |
+
33 | ++ |
+ lbl_overall = "All {Patient_label}",+ |
+
34 | ++ |
+ ...) {+ |
+
35 | +1x | +
+ assert_all_tablenames(adam_db, "adsl")+ |
+
36 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
37 | +1x | +
+ checkmate::assert_string(study_status_var)+ |
+
38 | +1x | +
+ checkmate::assert_string(trt_status_var, null.ok = TRUE)+ |
+
39 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
40 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
41 | +1x | +
+ assert_valid_variable(+ |
+
42 | +1x | +
+ adam_db$adsl,+ |
+
43 | +1x | +
+ arm_var,+ |
+
44 | +1x | +
+ types = list(c("character", "factor")), na_ok = TRUE+ |
+
45 | ++ |
+ )+ |
+
46 | +1x | +
+ assert_valid_variable(+ |
+
47 | +1x | +
+ adam_db$adsl, study_status_var,+ |
+
48 | +1x | +
+ types = list(c("character", "factor")), na_ok = TRUE,+ |
+
49 | +1x | +
+ empty_ok = FALSE, min_chars = 1L+ |
+
50 | ++ |
+ )+ |
+
51 | +1x | +
+ assert_valid_variable(+ |
+
52 | +1x | +
+ adam_db$adsl, trt_status_var,+ |
+
53 | +1x | +
+ types = list(c("character", "factor")), na_ok = TRUE,+ |
+
54 | +1x | +
+ empty_ok = TRUE, min_chars = 0L+ |
+
55 | ++ |
+ )+ |
+
56 | +1x | +
+ status_var_lvls <- lvls(adam_db$adsl[[study_status_var]])+ |
+
57 | +1x | +
+ checkmate::assert_subset(names(detail_vars), choice = status_var_lvls)+ |
+
58 | +1x | +
+ assert_valid_variable(+ |
+
59 | +1x | +
+ adam_db$adsl,+ |
+
60 | +1x | +
+ unlist(detail_vars),+ |
+
61 | +1x | +
+ types = list(c("character", "factor")),+ |
+
62 | +1x | +
+ na_ok = TRUE,+ |
+
63 | +1x | +
+ empty_ok = TRUE,+ |
+
64 | +1x | +
+ min_chars = 0L+ |
+
65 | ++ |
+ )+ |
+
66 | +1x | +
+ detail_vars <- setNames(detail_vars[status_var_lvls], status_var_lvls)+ |
+
67 | +1x | +
+ lyt <- dst01_lyt(+ |
+
68 | +1x | +
+ arm_var = arm_var,+ |
+
69 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
70 | +1x | +
+ study_status_var = study_status_var,+ |
+
71 | +1x | +
+ detail_vars = detail_vars,+ |
+
72 | +1x | +
+ trt_status_var = trt_status_var+ |
+
73 | ++ |
+ )+ |
+
74 | +1x | +
+ build_table(lyt, adam_db$adsl)+ |
+
75 | ++ |
+ }+ |
+
76 | ++ | + + | +
77 | ++ |
+ #' `dst01` Layout+ |
+
78 | ++ |
+ #'+ |
+
79 | ++ |
+ #' @inheritParams dst01_main+ |
+
80 | ++ |
+ #' @param study_status_var (`string`) variable used to define patient status. Default is `EOSSTT`, however can also be a+ |
+
81 | ++ |
+ #' variable name with the pattern `EOPxxSTT` where `xx` must be substituted by 2 digits referring to the analysis+ |
+
82 | ++ |
+ #' period.+ |
+
83 | ++ |
+ #' @param detail_vars Named (`list`) of grouped display of `study_status_var`.+ |
+
84 | ++ | + + | +
85 | ++ |
+ #'+ |
+
86 | ++ |
+ #' @keywords internal+ |
+
87 | ++ |
+ #'+ |
+
88 | ++ |
+ dst01_lyt <- function(arm_var,+ |
+
89 | ++ |
+ study_status_var,+ |
+
90 | ++ |
+ detail_vars,+ |
+
91 | ++ |
+ trt_status_var,+ |
+
92 | ++ |
+ lbl_overall) {+ |
+
93 | +9x | +
+ lyt <- basic_table() %>%+ |
+
94 | +9x | +
+ split_cols_by(arm_var) %>%+ |
+
95 | +9x | +
+ add_colcounts() %>%+ |
+
96 | +9x | +
+ ifneeded_add_overall_col(lbl_overall)+ |
+
97 | +9x | +
+ for (n in names(detail_vars)) {+ |
+
98 | +27x | +
+ lyt <- lyt %>%+ |
+
99 | +27x | +
+ count_or_summarize(study_status_var, n, detail_vars[[n]])+ |
+
100 | ++ |
+ }+ |
+
101 | +9x | +
+ if (!is.null(trt_status_var)) {+ |
+
102 | +1x | +
+ lyt <- lyt %>%+ |
+
103 | +1x | +
+ summarize_vars(+ |
+
104 | +1x | +
+ trt_status_var,+ |
+
105 | +1x | +
+ .stats = "count_fraction",+ |
+
106 | +1x | +
+ denom = "N_col",+ |
+
107 | +1x | +
+ .formats = list(count_fraction = format_count_fraction_fixed_dp),+ |
+
108 | +1x | +
+ show_labels = "hidden",+ |
+
109 | +1x | +
+ nested = FALSE+ |
+
110 | ++ |
+ )+ |
+
111 | ++ |
+ }+ |
+
112 | +9x | +
+ lyt+ |
+
113 | ++ |
+ }+ |
+
114 | ++ | + + | +
115 | ++ |
+ #' @describeIn dst01 Preprocessing+ |
+
116 | ++ |
+ #'+ |
+
117 | ++ |
+ #' @inheritParams dst01_main+ |
+
118 | ++ |
+ #' @export+ |
+
119 | ++ |
+ #'+ |
+
120 | ++ |
+ dst01_pre <- function(adam_db,+ |
+
121 | ++ |
+ ...) {+ |
+
122 | +1x | +
+ study_status_format <- rule(+ |
+
123 | +1x | +
+ "Completed" = "COMPLETED",+ |
+
124 | +1x | +
+ "Ongoing" = "ONGOING",+ |
+
125 | +1x | +
+ "Discontinued" = "DISCONTINUED"+ |
+
126 | ++ |
+ )+ |
+
127 | +1x | +
+ trt_status_format <- rule(+ |
+
128 | +1x | +
+ "Completed Treatment" = "COMPLETED",+ |
+
129 | +1x | +
+ "Ongoing Treatment" = "ONGOING",+ |
+
130 | +1x | +
+ "Discontinued Treatment" = "DISCONTINUED"+ |
+
131 | ++ |
+ )+ |
+
132 | +1x | +
+ dcsreas_grp_format <- rule(+ |
+
133 | +1x | +
+ "Safety" = c("ADVERSE EVENT", "DEATH"),+ |
+
134 | +1x | +
+ "Non-Safety" = c(+ |
+
135 | +1x | +
+ "WITHDRAWAL BY SUBJECT", "LACK OF EFFICACY", "PROTOCOL VIOLATION",+ |
+
136 | +1x | +
+ "WITHDRAWAL BY PARENT/GUARDIAN", "PHYSICIAN DECISION"+ |
+
137 | ++ |
+ )+ |
+
138 | ++ |
+ )+ |
+
139 | +1x | +
+ adam_db$adsl <- adam_db$adsl %>%+ |
+
140 | +1x | +
+ mutate(+ |
+
141 | +1x | +
+ EOSSTT = reformat(.data$EOSSTT, study_status_format),+ |
+
142 | +1x | +
+ EOTSTT = reformat(.data$EOTSTT, trt_status_format),+ |
+
143 | +1x | +
+ DCSREASGP = reformat(.data$DCSREAS, dcsreas_grp_format),+ |
+
144 | +1x | +
+ DCSREAS = reformat(.data$DCSREAS, empty_rule),+ |
+
145 | +1x | +
+ STDONS = factor(+ |
+
146 | +1x | +
+ case_when(+ |
+
147 | +1x | +
+ EOTSTT == "Ongoing Treatment" & EOSSTT == "Ongoing" ~ "Alive: Ongoing",+ |
+
148 | +1x | +
+ EOTSTT != "Ongoing Treatment" & EOSSTT == "Ongoing" ~ "Alive: In Follow-up",+ |
+
149 | +1x | +
+ TRUE ~ NA_character_+ |
+
150 | ++ |
+ ),+ |
+
151 | +1x | +
+ levels = c("Alive: Ongoing", "Alive: In Follow-up")+ |
+
152 | ++ |
+ )+ |
+
153 | ++ |
+ )+ |
+
154 | +1x | +
+ adam_db+ |
+
155 | ++ |
+ }+ |
+
156 | ++ | + + | +
157 | ++ |
+ #' @describeIn dst01 Postprocessing+ |
+
158 | ++ |
+ #'+ |
+
159 | ++ |
+ #' @inheritParams gen_args+ |
+
160 | ++ |
+ #'+ |
+
161 | ++ |
+ #'+ |
+
162 | ++ |
+ #' @export+ |
+
163 | ++ |
+ dst01_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
164 | +1x | +
+ if (prune_0) {+ |
+
165 | +1x | +
+ tlg <- tlg %>%+ |
+
166 | +1x | +
+ smart_prune()+ |
+
167 | ++ |
+ }+ |
+
168 | +1x | +
+ std_postprocess(tlg)+ |
+
169 | ++ |
+ }+ |
+
170 | ++ | + + | +
171 | ++ |
+ #' DST01 Table 1 (Default) Patient Disposition Table 1.+ |
+
172 | ++ |
+ #'+ |
+
173 | ++ |
+ #' The DST01 Disposition Table provides an overview of patients+ |
+
174 | ++ |
+ #' study completion. For patients who discontinued the study a reason is provided.+ |
+
175 | ++ |
+ #'+ |
+
176 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
177 | ++ |
+ #' @export+ |
+
178 | ++ |
+ #'+ |
+
179 | ++ |
+ #' @examples+ |
+
180 | ++ |
+ #' run(dst01, syn_data, detail_vars = list(Ongoing = "STDONS"))+ |
+
181 | ++ |
+ #' run(dst01, syn_data, detail_vars = list(Discontinued = "DCSREAS", Ongoing = "STDONS"))+ |
+
182 | ++ |
+ #' run(+ |
+
183 | ++ |
+ #' dst01, syn_data,+ |
+
184 | ++ |
+ #' detail_vars = list(+ |
+
185 | ++ |
+ #' Discontinued = c("DCSREASGP", "DCSREAS"),+ |
+
186 | ++ |
+ #' Ongoing = "STDONS"+ |
+
187 | ++ |
+ #' )+ |
+
188 | ++ |
+ #' )+ |
+
189 | ++ |
+ dst01 <- chevron_t(+ |
+
190 | ++ |
+ main = dst01_main,+ |
+
191 | ++ |
+ preprocess = dst01_pre,+ |
+
192 | ++ |
+ postprocess = dst01_post+ |
+
193 | ++ |
+ )+ |
+
1 | ++ |
+ # lbt07 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn lbt07 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param param_var (`string`) the name of the column storing the parameters name.+ |
+
7 | ++ |
+ #' @param grad_dir_var (`string`) the name of the column storing the grade direction variable which is required in+ |
+
8 | ++ |
+ #' order to obtain the correct denominators when building the layout as it is used to define row splitting.+ |
+
9 | ++ |
+ #' @param grad_anl_var (`string`) the name of the column storing toxicity grade variable where all negative values from+ |
+
10 | ++ |
+ #' `ATOXGR` are replaced by their absolute values.+ |
+
11 | ++ |
+ #'+ |
+
12 | ++ |
+ #' @details+ |
+
13 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @note+ |
+
16 | ++ |
+ #' * `adam_db` object must contain an `adlb` table with columns `"USUBJID"`, `"ATOXGR"`,+ |
+
17 | ++ |
+ #' `"ONTRTFL"` and column specified by `arm_var`.+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ #' @export+ |
+
20 | ++ |
+ #'+ |
+
21 | ++ |
+ lbt07_main <- function(adam_db,+ |
+
22 | ++ |
+ arm_var = "ACTARM",+ |
+
23 | ++ |
+ lbl_overall = NULL,+ |
+
24 | ++ |
+ param_var = "PARAM",+ |
+
25 | ++ |
+ grad_dir_var = "GRADE_DIR",+ |
+
26 | ++ |
+ grad_anl_var = "GRADE_ANL",+ |
+
27 | ++ |
+ ...) {+ |
+
28 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", "adlb"))+ |
+
29 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
30 | +1x | +
+ checkmate::assert_string(param_var)+ |
+
31 | +1x | +
+ checkmate::assert_string(grad_dir_var)+ |
+
32 | +1x | +
+ checkmate::assert_string(grad_anl_var)+ |
+
33 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
34 | +1x | +
+ assert_valid_variable(+ |
+
35 | +1x | +
+ adam_db$adlb, c("ATOXGR", param_var, grad_dir_var, grad_anl_var),+ |
+
36 | +1x | +
+ types = list(c("character", "factor"))+ |
+
37 | ++ |
+ )+ |
+
38 | +1x | +
+ assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
39 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))+ |
+
40 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)+ |
+
41 | ++ | + + | +
42 | +1x | +
+ lbl_param_var <- var_labels_for(adam_db$adlb, param_var)+ |
+
43 | +1x | +
+ lbl_grad_dir_var <- var_labels_for(adam_db$adlb, grad_dir_var)+ |
+
44 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
45 | +1x | +
+ map <- expand.grid(+ |
+
46 | +1x | +
+ PARAM = levels(adam_db$adlb[[param_var]]),+ |
+
47 | +1x | +
+ GRADE_DIR = c("LOW", "HIGH"),+ |
+
48 | +1x | +
+ GRADE_ANL = as.character(1:4),+ |
+
49 | +1x | +
+ stringsAsFactors = FALSE+ |
+
50 | ++ |
+ ) %>%+ |
+
51 | +1x | +
+ arrange(.data$PARAM, desc(.data$GRADE_DIR), .data$GRADE_ANL)+ |
+
52 | ++ | + + | +
53 | +1x | +
+ names(map) <- c(param_var, grad_dir_var, grad_anl_var)+ |
+
54 | ++ | + + | +
55 | +1x | +
+ lyt <- lbt07_lyt(+ |
+
56 | +1x | +
+ arm_var = arm_var,+ |
+
57 | +1x | +
+ param_var = param_var,+ |
+
58 | +1x | +
+ grad_dir_var = grad_dir_var,+ |
+
59 | +1x | +
+ grad_anl_var = grad_anl_var,+ |
+
60 | +1x | +
+ lbl_param_var = lbl_param_var,+ |
+
61 | +1x | +
+ lbl_grad_dir_var = lbl_grad_dir_var,+ |
+
62 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
63 | +1x | +
+ map = map+ |
+
64 | ++ |
+ )+ |
+
65 | ++ | + + | +
66 | +1x | +
+ tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)+ |
+
67 | ++ | + + | +
68 | +1x | +
+ tbl+ |
+
69 | ++ |
+ }+ |
+
70 | ++ | + + | +
71 | ++ |
+ #' `lbt07` Layout+ |
+
72 | ++ |
+ #'+ |
+
73 | ++ |
+ #' @inheritParams gen_args+ |
+
74 | ++ |
+ #' @inheritParams lbt07_main+ |
+
75 | ++ |
+ #'+ |
+
76 | ++ |
+ #' @param lbl_param_var (`string`) label of the `param_var` variable.+ |
+
77 | ++ |
+ #' @param lbl_grad_dir_var (`string`) label for the `grad_dir_var` variable.+ |
+
78 | ++ |
+ #' @param map (`data.frame`) mapping of `PARAM`s to directions of abnormality.+ |
+
79 | ++ |
+ #'+ |
+
80 | ++ |
+ #' @keywords internal+ |
+
81 | ++ |
+ #'+ |
+
82 | ++ |
+ lbt07_lyt <- function(arm_var,+ |
+
83 | ++ |
+ param_var,+ |
+
84 | ++ |
+ grad_dir_var,+ |
+
85 | ++ |
+ grad_anl_var,+ |
+
86 | ++ |
+ lbl_param_var,+ |
+
87 | ++ |
+ lbl_grad_dir_var,+ |
+
88 | ++ |
+ lbl_overall,+ |
+
89 | ++ |
+ map) {+ |
+
90 | +2x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
91 | +2x | +
+ split_cols_by(arm_var) %>%+ |
+
92 | +2x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
93 | +2x | +
+ split_rows_by(+ |
+
94 | +2x | +
+ param_var,+ |
+
95 | +2x | +
+ label_pos = "topleft",+ |
+
96 | +2x | +
+ split_label = lbl_param_var+ |
+
97 | ++ |
+ ) %>%+ |
+
98 | +2x | +
+ summarize_num_patients(+ |
+
99 | +2x | +
+ var = "USUBJID",+ |
+
100 | +2x | +
+ required = "ATOXGR",+ |
+
101 | +2x | +
+ .stats = "unique_count"+ |
+
102 | ++ |
+ ) %>%+ |
+
103 | +2x | +
+ split_rows_by(+ |
+
104 | +2x | +
+ grad_dir_var,+ |
+
105 | +2x | +
+ label_pos = "topleft",+ |
+
106 | +2x | +
+ split_label = lbl_grad_dir_var,+ |
+
107 | +2x | +
+ split_fun = trim_levels_to_map(map)+ |
+
108 | ++ |
+ ) %>%+ |
+
109 | +2x | +
+ count_abnormal_by_worst_grade(+ |
+
110 | +2x | +
+ var = grad_anl_var,+ |
+
111 | +2x | +
+ variables = list(id = "USUBJID", param = param_var, grade_dir = grad_dir_var),+ |
+
112 | +2x | +
+ .formats = list(count_fraction = tern::format_count_fraction_fixed_dp),+ |
+
113 | +2x | +
+ .indent_mods = 4L+ |
+
114 | ++ |
+ ) %>%+ |
+
115 | +2x | +
+ append_topleft(" Highest NCI CTCAE Grade")+ |
+
116 | ++ |
+ }+ |
+
117 | ++ | + + | +
118 | ++ |
+ #' @describeIn lbt07 Preprocessing+ |
+
119 | ++ |
+ #'+ |
+
120 | ++ |
+ #' @inheritParams gen_args+ |
+
121 | ++ |
+ #'+ |
+
122 | ++ |
+ #' @export+ |
+
123 | ++ |
+ #'+ |
+
124 | ++ |
+ lbt07_pre <- function(adam_db, ...) {+ |
+
125 | +1x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
126 | +1x | +
+ mutate(+ |
+
127 | +1x | +
+ ATOXGR = reformat(.data$ATOXGR, missing_rule)+ |
+
128 | ++ |
+ ) %>%+ |
+
129 | +1x | +
+ filter(+ |
+
130 | +1x | +
+ .data$ATOXGR != "<Missing>",+ |
+
131 | +1x | +
+ .data$ONTRTFL == "Y",+ |
+
132 | +1x | +
+ .data$WGRLOFL == "Y" | .data$WGRHIFL == "Y"+ |
+
133 | ++ |
+ ) %>%+ |
+
134 | +1x | +
+ mutate(+ |
+
135 | +1x | +
+ GRADE_DIR = factor(+ |
+
136 | +1x | +
+ case_when(+ |
+
137 | +1x | +
+ ATOXGR %in% c("-1", "-2", "-3", "-4") & .data$WGRLOFL == "Y" ~ "LOW",+ |
+
138 | +1x | +
+ ATOXGR == "0" ~ "ZERO",+ |
+
139 | +1x | +
+ ATOXGR %in% c("1", "2", "3", "4") & .data$WGRHIFL == "Y" ~ "HIGH",+ |
+
140 | +1x | +
+ TRUE ~ "NONE"+ |
+
141 | ++ |
+ ),+ |
+
142 | +1x | +
+ levels = c("LOW", "ZERO", "HIGH", "NONE")+ |
+
143 | ++ |
+ ),+ |
+
144 | +1x | +
+ GRADE_ANL = factor(.data$ATOXGR, levels = c(-4:4), labels = abs(c(-4:4))),+ |
+
145 | +1x | +
+ PARAM = as.factor(trimws(stringr::str_remove_all(.data$PARAM, "\\(.+?\\)")))+ |
+
146 | ++ |
+ )+ |
+
147 | ++ | + + | +
148 | +1x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
149 | +1x | +
+ mutate(+ |
+
150 | +1x | +
+ PARAM = with_label(.data$PARAM, "Parameter"),+ |
+
151 | +1x | +
+ GRADE_DIR = with_label(.data$GRADE_DIR, "Direction of Abnormality"),+ |
+
152 | +1x | +
+ GRADE_ANL = with_label(.data$GRADE_ANL, "Toxicity Grade")+ |
+
153 | ++ |
+ )+ |
+
154 | ++ | + + | +
155 | +1x | +
+ adam_db+ |
+
156 | ++ |
+ }+ |
+
157 | ++ | + + | +
158 | ++ |
+ #' @describeIn lbt07 Postprocessing+ |
+
159 | ++ |
+ #'+ |
+
160 | ++ |
+ #' @inheritParams gen_args+ |
+
161 | ++ |
+ #'+ |
+
162 | ++ |
+ #' @export+ |
+
163 | ++ |
+ #'+ |
+
164 | ++ |
+ lbt07_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
165 | +1x | +
+ if (prune_0) {+ |
+
166 | +1x | +
+ tlg <- smart_prune(tlg)+ |
+
167 | ++ |
+ }+ |
+
168 | +1x | +
+ std_postprocess(tlg)+ |
+
169 | ++ |
+ }+ |
+
170 | ++ | + + | +
171 | ++ |
+ #' `LBT07` Table 1 (Default) Laboratory Test Results and Change from Baseline by Visit.+ |
+
172 | ++ |
+ #'+ |
+
173 | ++ |
+ #' The `LBT07` table provides an+ |
+
174 | ++ |
+ #' overview of the analysis values and its change from baseline of each respective arm over the course of the trial.+ |
+
175 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
176 | ++ |
+ #' @export+ |
+
177 | ++ |
+ #'+ |
+
178 | ++ |
+ #' @examples+ |
+
179 | ++ |
+ #' run(lbt07, syn_data)+ |
+
180 | ++ |
+ lbt07 <- chevron_t(+ |
+
181 | ++ |
+ main = lbt07_main,+ |
+
182 | ++ |
+ preprocess = lbt07_pre,+ |
+
183 | ++ |
+ postprocess = lbt07_post+ |
+
184 | ++ |
+ )+ |
+
1 | ++ |
+ # lbt05 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn lbt05 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' @details+ |
+
8 | ++ |
+ #' * Does not remove rows with zero counts by default.+ |
+
9 | ++ |
+ #' * Lab test results with missing `AVAL` values are excluded.+ |
+
10 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
11 | ++ |
+ #'+ |
+
12 | ++ |
+ #' @note+ |
+
13 | ++ |
+ #' * `adam_db` object must contain an `adlb` table with columns `"ONTRTFL"`, `"PARCAT2"`, `"PARAM"`, `"ANRIND"`,+ |
+
14 | ++ |
+ #' `"AVALCAT1"`, and column specified by `arm_var`.+ |
+
15 | ++ |
+ #'+ |
+
16 | ++ |
+ #' @export+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ lbt05_main <- function(adam_db,+ |
+
19 | ++ |
+ arm_var = "ACTARM",+ |
+
20 | ++ |
+ lbl_overall = NULL,+ |
+
21 | ++ |
+ ...) {+ |
+
22 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", "adlb"))+ |
+
23 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
24 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
25 | +1x | +
+ assert_valid_variable(adam_db$adlb, c("PARAM", "AVALCAT1", "ABN_DIR"), types = list(c("character", "factor")))+ |
+
26 | +1x | +
+ assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
27 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))+ |
+
28 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)+ |
+
29 | ++ | + + | +
30 | +1x | +
+ lbl_anrind <- var_labels_for(adam_db$adlb, "ABN_DIR")+ |
+
31 | +1x | +
+ lbl_param <- var_labels_for(adam_db$adlb, "PARAM")+ |
+
32 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
33 | +1x | +
+ map <- expand.grid(+ |
+
34 | +1x | +
+ PARAM = levels(adam_db$adlb$PARAM),+ |
+
35 | +1x | +
+ ABN_DIR = c("Low", "High"),+ |
+
36 | +1x | +
+ stringsAsFactors = FALSE+ |
+
37 | ++ |
+ ) %>%+ |
+
38 | +1x | +
+ arrange(.data$PARAM, desc(.data$ABN_DIR))+ |
+
39 | ++ | + + | +
40 | +1x | +
+ lyt <- lbt05_lyt(+ |
+
41 | +1x | +
+ arm_var = arm_var,+ |
+
42 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
43 | +1x | +
+ lbl_param = lbl_param,+ |
+
44 | +1x | +
+ lbl_anrind = lbl_anrind,+ |
+
45 | +1x | +
+ map = map+ |
+
46 | ++ |
+ )+ |
+
47 | ++ | + + | +
48 | +1x | +
+ tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)+ |
+
49 | ++ | + + | +
50 | +1x | +
+ tbl+ |
+
51 | ++ |
+ }+ |
+
52 | ++ | + + | +
53 | ++ |
+ #' `lbt05` Layout+ |
+
54 | ++ |
+ #'+ |
+
55 | ++ |
+ #' @inheritParams gen_args+ |
+
56 | ++ |
+ #'+ |
+
57 | ++ |
+ #' @param lbl_param (`string`) label of the `PARAM` variable.+ |
+
58 | ++ |
+ #' @param lbl_anrind (`string`) label of the `ANRIND` variable.+ |
+
59 | ++ |
+ #' @param map (`data.frame`) mapping of `PARAM`s to directions of abnormality.+ |
+
60 | ++ |
+ #'+ |
+
61 | ++ |
+ #' @keywords internal+ |
+
62 | ++ |
+ #'+ |
+
63 | ++ |
+ lbt05_lyt <- function(arm_var,+ |
+
64 | ++ |
+ lbl_overall,+ |
+
65 | ++ |
+ lbl_param,+ |
+
66 | ++ |
+ lbl_anrind,+ |
+
67 | ++ |
+ map) {+ |
+
68 | +4x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
69 | +4x | +
+ split_cols_by(arm_var) %>%+ |
+
70 | +4x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
71 | +4x | +
+ split_rows_by(+ |
+
72 | +4x | +
+ "PARAM",+ |
+
73 | +4x | +
+ label_pos = "topleft",+ |
+
74 | +4x | +
+ split_label = lbl_param+ |
+
75 | ++ |
+ ) %>%+ |
+
76 | +4x | +
+ summarize_num_patients(var = "USUBJID", .stats = "unique_count") %>%+ |
+
77 | +4x | +
+ split_rows_by("ABN_DIR", split_fun = trim_levels_to_map(map)) %>%+ |
+
78 | +4x | +
+ count_abnormal_by_marked(+ |
+
79 | +4x | +
+ var = "AVALCAT1",+ |
+
80 | +4x | +
+ variables = list(id = "USUBJID", param = "PARAM", direction = "ABN_DIR"),+ |
+
81 | +4x | +
+ .formats = c("count_fraction" = format_count_fraction_fixed_dp)+ |
+
82 | ++ |
+ ) %>%+ |
+
83 | +4x | +
+ append_topleft(paste(" ", lbl_anrind))+ |
+
84 | ++ |
+ }+ |
+
85 | ++ | + + | +
86 | ++ |
+ #' @describeIn lbt05 Preprocessing+ |
+
87 | ++ |
+ #'+ |
+
88 | ++ |
+ #' @inheritParams gen_args+ |
+
89 | ++ |
+ #'+ |
+
90 | ++ |
+ #' @export+ |
+
91 | ++ |
+ #'+ |
+
92 | ++ |
+ lbt05_pre <- function(adam_db, ...) {+ |
+
93 | +1x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
94 | +1x | +
+ filter(+ |
+
95 | +1x | +
+ .data$ONTRTFL == "Y",+ |
+
96 | +1x | +
+ .data$PARCAT2 == "LS",+ |
+
97 | +1x | +
+ !is.na(.data$AVAL)+ |
+
98 | ++ |
+ ) %>%+ |
+
99 | +1x | +
+ mutate(ABN_DIR = factor(case_when(+ |
+
100 | +1x | +
+ ANRIND == "LOW LOW" ~ "Low",+ |
+
101 | +1x | +
+ ANRIND == "HIGH HIGH" ~ "High",+ |
+
102 | +1x | +
+ TRUE ~ ""+ |
+
103 | +1x | +
+ ), levels = c("Low", "High"))) %>%+ |
+
104 | +1x | +
+ mutate(+ |
+
105 | +1x | +
+ ABN_DIR = with_label(.data$ABN_DIR, "Direction of Abnormality"),+ |
+
106 | +1x | +
+ PARAM = with_label(.data$PARAM, "Laboratory Test")+ |
+
107 | ++ |
+ ) %>%+ |
+
108 | +1x | +
+ mutate(+ |
+
109 | +1x | +
+ across(all_of(c("AVALCAT1", "ABN_DIR")), ~ reformat(.x, .env$missing_rule))+ |
+
110 | ++ |
+ )+ |
+
111 | ++ | + + | +
112 | ++ | + + | +
113 | +1x | +
+ adam_db+ |
+
114 | ++ |
+ }+ |
+
115 | ++ | + + | +
116 | ++ | + + | +
117 | ++ |
+ #' @describeIn lbt05 Postprocessing+ |
+
118 | ++ |
+ #'+ |
+
119 | ++ |
+ #' @inheritParams gen_args+ |
+
120 | ++ |
+ #'+ |
+
121 | ++ |
+ #' @export+ |
+
122 | ++ |
+ #'+ |
+
123 | ++ |
+ lbt05_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
124 | +1x | +
+ if (prune_0) {+ |
+
125 | +! | +
+ has_lbl <- function(lbl) CombinationFunction(function(tr) obj_label(tr) == lbl)+ |
+
126 | +! | +
+ tlg <- prune_table(tlg, keep_rows(has_lbl("Any Abnormality")))+ |
+
127 | ++ | + + | +
128 | +! | +
+ if (is.null(prune_table(tlg))) {+ |
+
129 | +! | +
+ tlg <- build_table(rtables::basic_table(), df = data.frame())+ |
+
130 | +! | +
+ col_info(tlg) <- col_info(tlg)+ |
+
131 | ++ |
+ }+ |
+
132 | ++ |
+ }+ |
+
133 | ++ | + + | +
134 | +1x | +
+ std_postprocess(tlg)+ |
+
135 | ++ |
+ }+ |
+
136 | ++ | + + | +
137 | ++ |
+ #' `LBT05` Table 1 (Default) Laboratory Abnormalities with Single and Replicated Marked.+ |
+
138 | ++ |
+ #'+ |
+
139 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
140 | ++ |
+ #' @export+ |
+
141 | ++ |
+ #'+ |
+
142 | ++ |
+ #' @examples+ |
+
143 | ++ |
+ #' run(lbt05, syn_data)+ |
+
144 | ++ |
+ lbt05 <- chevron_t(+ |
+
145 | ++ |
+ main = lbt05_main,+ |
+
146 | ++ |
+ preprocess = lbt05_pre,+ |
+
147 | ++ |
+ postprocess = lbt05_post+ |
+
148 | ++ |
+ )+ |
+
1 | ++ |
+ # egt05_qtcat ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn egt05_qtcat Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param summaryvars (`character`) variables to be analyzed. The label attribute of the corresponding column in `adeg`+ |
+
7 | ++ |
+ #' table of `adam_db` is used as name.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' * The `Value at Visit` column, displays the categories of the specific `"PARAMCD"` value for patients.+ |
+
11 | ++ |
+ #' * The `Change from Baseline` column, displays the categories of the specific `"PARAMCD"` value+ |
+
12 | ++ |
+ #' change from baseline for patients.+ |
+
13 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
14 | ++ |
+ #' * Split columns by arm, typically `"ACTARM"`.+ |
+
15 | ++ |
+ #' * Does not include a total column by default.+ |
+
16 | ++ |
+ #' * Sorted based on factor level; by chronological time point given by `"AVISIT"`+ |
+
17 | ++ |
+ #' or user-defined visit incorporating `"ATPT"`.+ |
+
18 | ++ |
+ #' Re-level to customize order.+ |
+
19 | ++ |
+ #' * Please note that it is preferable to convert `summaryvars` to factor.+ |
+
20 | ++ |
+ #'+ |
+
21 | ++ |
+ #' @note+ |
+
22 | ++ |
+ #' * `adam_db` object must contain an `adeg` table with column specified in `visitvar`.+ |
+
23 | ++ |
+ #' For `summaryvars`, please make sure `AVALCAT1` and `CHGCAT1` columns existed in input data sets.+ |
+
24 | ++ |
+ #'+ |
+
25 | ++ |
+ #' @export+ |
+
26 | ++ |
+ #'+ |
+
27 | ++ |
+ egt05_qtcat_main <- function(adam_db,+ |
+
28 | ++ |
+ arm_var = "ACTARM",+ |
+
29 | ++ |
+ summaryvars = c("AVALCAT1", "CHGCAT1"),+ |
+
30 | ++ |
+ lbl_overall = NULL,+ |
+
31 | ++ |
+ row_split_var = NULL,+ |
+
32 | ++ |
+ page_var = NULL,+ |
+
33 | ++ |
+ visitvar = "AVISIT",+ |
+
34 | ++ |
+ ...) {+ |
+
35 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", "adeg"))+ |
+
36 | +1x | +
+ checkmate::assert_string(visitvar)+ |
+
37 | +1x | +
+ assert_valid_variable(adam_db$adeg, visitvar, types = list("character", "factor"))+ |
+
38 | +1x | +
+ assert_valid_variable(adam_db$adeg, c("PARAM", "PARAMCD"), types = list(c("character", "factor")), na_ok = FALSE)+ |
+
39 | +1x | +
+ assert_valid_variable(adam_db$adeg, summaryvars, types = list(c("factor", "character")), na_ok = TRUE)+ |
+
40 | +1x | +
+ checkmate::assert_character(row_split_var, null.ok = TRUE)+ |
+
41 | +1x | +
+ checkmate::assert_disjunct(row_split_var, c("PARAMCD", "PARAM", visitvar))+ |
+
42 | +1x | +
+ checkmate::assert_string(page_var, null.ok = TRUE)+ |
+
43 | +1x | +
+ checkmate::assert_subset(page_var, c(row_split_var, "PARAMCD"))+ |
+
44 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adeg, arm_var)+ |
+
45 | +1x | +
+ assert_valid_variable(adam_db$adeg, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
46 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
47 | ++ | + + | +
48 | +1x | +
+ summaryvars_lbls <- var_labels_for(adam_db$adeg, summaryvars) # Value at visit / change from baseline+ |
+
49 | +1x | +
+ lbl_avisit <- var_labels_for(adam_db$adeg, visitvar)+ |
+
50 | +1x | +
+ lbl_param <- var_labels_for(adam_db$adeg, "PARAM")+ |
+
51 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
52 | +1x | +
+ row_split_lbl <- var_labels_for(adam_db$adeg, row_split_var)+ |
+
53 | ++ | + + | +
54 | +1x | +
+ lyt <- egt05_qtcat_lyt(+ |
+
55 | +1x | +
+ arm_var = arm_var,+ |
+
56 | +1x | +
+ summaryvars = summaryvars,+ |
+
57 | +1x | +
+ summaryvars_lbls = summaryvars_lbls,+ |
+
58 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
59 | +1x | +
+ visitvar = visitvar,+ |
+
60 | +1x | +
+ row_split_var = row_split_var,+ |
+
61 | +1x | +
+ row_split_lbl = row_split_lbl,+ |
+
62 | +1x | +
+ page_var = page_var,+ |
+
63 | +1x | +
+ lbl_avisit = lbl_avisit,+ |
+
64 | +1x | +
+ lbl_param = lbl_param,+ |
+
65 | +1x | +
+ lbl_cat = "Category"+ |
+
66 | ++ |
+ )+ |
+
67 | ++ | + + | +
68 | +1x | +
+ build_table(+ |
+
69 | +1x | +
+ lyt,+ |
+
70 | +1x | +
+ df = adam_db$adeg,+ |
+
71 | +1x | +
+ alt_counts_df = adam_db$adsl+ |
+
72 | ++ |
+ )+ |
+
73 | ++ |
+ }+ |
+
74 | ++ | + + | +
75 | ++ |
+ #' `EGT05_QTCAT` Layout+ |
+
76 | ++ |
+ #'+ |
+
77 | ++ |
+ #' @inheritParams gen_args+ |
+
78 | ++ |
+ #'+ |
+
79 | ++ |
+ #' @param summaryvars (`character`) the variables to be analyzed. `AVALCAT1` and `CHGCAT1` by default.+ |
+
80 | ++ |
+ #' @param summaryvars_lbls (`character`) the label of the variables to be analyzed.+ |
+
81 | ++ |
+ #' @param visitvar (`string`) typically `"AVISIT"` or user-defined visit incorporating `"ATPT"`.+ |
+
82 | ++ |
+ #' @param lbl_avisit (`string`) label of the `visitvar` variable.+ |
+
83 | ++ |
+ #' @param lbl_param (`string`) label of the `PARAM` variable.+ |
+
84 | ++ |
+ #' @param lbl_cat (`string`) label of the Category of `summaryvars` variable. Default as `Category`.+ |
+
85 | ++ |
+ #'+ |
+
86 | ++ |
+ #' @keywords internal+ |
+
87 | ++ |
+ egt05_qtcat_lyt <- function(arm_var,+ |
+
88 | ++ |
+ summaryvars,+ |
+
89 | ++ |
+ summaryvars_lbls,+ |
+
90 | ++ |
+ lbl_overall,+ |
+
91 | ++ |
+ row_split_var,+ |
+
92 | ++ |
+ row_split_lbl,+ |
+
93 | ++ |
+ visitvar,+ |
+
94 | ++ |
+ page_var,+ |
+
95 | ++ |
+ lbl_avisit,+ |
+
96 | ++ |
+ lbl_param,+ |
+
97 | ++ |
+ lbl_cat) {+ |
+
98 | +3x | +
+ page_by <- get_page_by(page_var, c(row_split_var, "PARAMCD"))+ |
+
99 | +3x | +
+ label_pos <- dplyr::if_else(page_by, "hidden", "topleft")+ |
+
100 | +3x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
101 | +3x | +
+ split_cols_by(arm_var) %>%+ |
+
102 | +3x | +
+ add_colcounts() %>%+ |
+
103 | +3x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
104 | +3x | +
+ split_rows_by_recurive(+ |
+
105 | +3x | +
+ row_split_var,+ |
+
106 | +3x | +
+ split_label = row_split_lbl,+ |
+
107 | +3x | +
+ label_pos = head(label_pos, -1L), page_by = head(page_by, -1L)+ |
+
108 | ++ |
+ ) %>%+ |
+
109 | +3x | +
+ split_rows_by(+ |
+
110 | +3x | +
+ var = "PARAMCD",+ |
+
111 | +3x | +
+ labels_var = "PARAM",+ |
+
112 | +3x | +
+ split_fun = drop_split_levels,+ |
+
113 | +3x | +
+ label_pos = tail(label_pos, 1L),+ |
+
114 | +3x | +
+ split_label = lbl_param,+ |
+
115 | +3x | +
+ page_by = tail(page_by, 1L)+ |
+
116 | ++ |
+ ) %>%+ |
+
117 | +3x | +
+ split_rows_by(+ |
+
118 | +3x | +
+ visitvar,+ |
+
119 | +3x | +
+ split_fun = drop_split_levels,+ |
+
120 | +3x | +
+ split_label = lbl_avisit,+ |
+
121 | +3x | +
+ label_pos = "topleft"+ |
+
122 | ++ |
+ ) %>%+ |
+
123 | +3x | +
+ summarize_vars_allow_na(+ |
+
124 | +3x | +
+ vars = summaryvars,+ |
+
125 | +3x | +
+ var_labels = summaryvars_lbls,+ |
+
126 | +3x | +
+ inclNAs = FALSE+ |
+
127 | ++ |
+ ) %>%+ |
+
128 | +3x | +
+ append_topleft(paste0(stringr::str_dup(" ", sum(!page_by) * 2 + 2), lbl_cat))+ |
+
129 | ++ |
+ }+ |
+
130 | ++ | + + | +
131 | ++ |
+ #' @describeIn egt05_qtcat Preprocessing+ |
+
132 | ++ |
+ #'+ |
+
133 | ++ |
+ #' @inheritParams gen_args+ |
+
134 | ++ |
+ #'+ |
+
135 | ++ |
+ #' @export+ |
+
136 | ++ |
+ #'+ |
+
137 | ++ |
+ egt05_qtcat_pre <- function(adam_db, ...) {+ |
+
138 | +1x | +
+ adam_db$adeg <- adam_db$adeg %>%+ |
+
139 | +1x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
140 | +1x | +
+ mutate(+ |
+
141 | +1x | +
+ AVALCAT1 = reformat(.data$AVALCAT1, empty_rule),+ |
+
142 | +1x | +
+ CHGCAT1 = reformat(.data$CHGCAT1, empty_rule),+ |
+
143 | +1x | +
+ AVISIT = reorder(.data$AVISIT, .data$AVISITN),+ |
+
144 | +1x | +
+ AVISIT = with_label(.data$AVISIT, "Analysis Visit")+ |
+
145 | ++ |
+ )+ |
+
146 | +1x | +
+ adam_db+ |
+
147 | ++ |
+ }+ |
+
148 | ++ | + + | +
149 | ++ |
+ #' @describeIn egt05_qtcat Postprocessing+ |
+
150 | ++ |
+ #'+ |
+
151 | ++ |
+ #' @inheritParams gen_args+ |
+
152 | ++ |
+ #'+ |
+
153 | ++ |
+ #' @export+ |
+
154 | ++ |
+ egt05_qtcat_post <- function(tlg, prune_0 = TRUE, ...) {+ |
+
155 | +1x | +
+ if (prune_0) tlg <- smart_prune(tlg)+ |
+
156 | +1x | +
+ std_postprocess(tlg)+ |
+
157 | ++ |
+ }+ |
+
158 | ++ | + + | +
159 | ++ |
+ #' `EGT05_QTCAT` ECG Actual Values and Changes from Baseline by Visit Table.+ |
+
160 | ++ |
+ #'+ |
+
161 | ++ |
+ #' The `EGT05_QTCAT` table summarizes several electrocardiogram parameters and their evolution+ |
+
162 | ++ |
+ #' throughout the study.+ |
+
163 | ++ |
+ #'+ |
+
164 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
165 | ++ |
+ #' @export+ |
+
166 | ++ |
+ #'+ |
+
167 | ++ |
+ #' @examples+ |
+
168 | ++ |
+ #' run(egt05_qtcat, syn_data)+ |
+
169 | ++ |
+ egt05_qtcat <- chevron_t(+ |
+
170 | ++ |
+ main = egt05_qtcat_main,+ |
+
171 | ++ |
+ preprocess = egt05_qtcat_pre,+ |
+
172 | ++ |
+ postprocess = egt05_qtcat_post+ |
+
173 | ++ |
+ )+ |
+
1 | ++ |
+ # cmt01a ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn cmt01a Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param incl_n_treatment (`flag`) include total number of treatments per medication.+ |
+
7 | ++ |
+ #' @param row_split_var (`character`) the variable defining the medication category. By default `ATC2`.+ |
+
8 | ++ |
+ #' @param medname_var (`string`) variable name of medical treatment name.+ |
+
9 | ++ |
+ #'+ |
+
10 | ++ |
+ #' @details+ |
+
11 | ++ |
+ #' * Data should be filtered for concomitant medication. `(ATIREL == "CONCOMITANT")`.+ |
+
12 | ++ |
+ #' * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.+ |
+
13 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
14 | ++ |
+ #' * Split columns by arm.+ |
+
15 | ++ |
+ #' * Does not include a total column by default.+ |
+
16 | ++ |
+ #' * Sort by medication class alphabetically and within medication class by decreasing total number of patients with+ |
+
17 | ++ |
+ #' the specific medication.+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ #' @note+ |
+
20 | ++ |
+ #' * `adam_db` object must contain an `adcm` table with the columns specified in `row_split_var` and `medname_var`+ |
+
21 | ++ |
+ #' as well as `"CMSEQ"`.+ |
+
22 | ++ |
+ #'+ |
+
23 | ++ |
+ #' @export+ |
+
24 | ++ |
+ #'+ |
+
25 | ++ |
+ cmt01a_main <- function(adam_db,+ |
+
26 | ++ |
+ arm_var = "ARM",+ |
+
27 | ++ |
+ incl_n_treatment = TRUE,+ |
+
28 | ++ |
+ row_split_var = "ATC2",+ |
+
29 | ++ |
+ medname_var = "CMDECOD",+ |
+
30 | ++ |
+ lbl_overall = NULL,+ |
+
31 | ++ |
+ ...) {+ |
+
32 | +3x | +
+ assert_all_tablenames(adam_db, "adsl", "adcm")+ |
+
33 | +3x | +
+ checkmate::assert_string(arm_var)+ |
+
34 | +3x | +
+ checkmate::assert_flag(incl_n_treatment)+ |
+
35 | +3x | +
+ checkmate::assert_character(row_split_var, null.ok = TRUE)+ |
+
36 | +3x | +
+ assert_valid_variable(adam_db$adcm, c(arm_var, row_split_var, medname_var), types = list(c("character", "factor")))+ |
+
37 | +3x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
38 | +3x | +
+ assert_valid_variable(adam_db$adcm, c("USUBJID", "CMSEQ"), empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
39 | +3x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adcm, arm_var)+ |
+
40 | ++ | + + | +
41 | +3x | +
+ lbl_row_split <- var_labels_for(adam_db$adcm, row_split_var)+ |
+
42 | +3x | +
+ lbl_medname_var <- var_labels_for(adam_db$adcm, medname_var)+ |
+
43 | +3x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
44 | +3x | +
+ lyt <- cmt01a_lyt(+ |
+
45 | +3x | +
+ arm_var = arm_var,+ |
+
46 | +3x | +
+ incl_n_treatment = incl_n_treatment,+ |
+
47 | +3x | +
+ lbl_overall = lbl_overall,+ |
+
48 | +3x | +
+ row_split_var = row_split_var,+ |
+
49 | +3x | +
+ lbl_row_split = lbl_row_split,+ |
+
50 | +3x | +
+ medname_var = medname_var,+ |
+
51 | +3x | +
+ lbl_medname_var = lbl_medname_var+ |
+
52 | ++ |
+ )+ |
+
53 | ++ | + + | +
54 | +3x | +
+ tbl <- build_table(lyt, adam_db$adcm, alt_counts_df = adam_db$adsl)+ |
+
55 | ++ | + + | +
56 | +3x | +
+ tbl+ |
+
57 | ++ |
+ }+ |
+
58 | ++ | + + | +
59 | ++ |
+ #' `cmt01a` Layout+ |
+
60 | ++ |
+ #'+ |
+
61 | ++ |
+ #' @inheritParams gen_args+ |
+
62 | ++ |
+ #' @inheritParams cmt01a_main+ |
+
63 | ++ |
+ #' @param lbl_medname_var (`string`) label for the variable defining the medication name.+ |
+
64 | ++ |
+ #' @keywords internal+ |
+
65 | ++ |
+ #'+ |
+
66 | ++ |
+ cmt01a_lyt <- function(arm_var,+ |
+
67 | ++ |
+ lbl_overall,+ |
+
68 | ++ |
+ incl_n_treatment = TRUE,+ |
+
69 | ++ |
+ row_split_var,+ |
+
70 | ++ |
+ lbl_row_split,+ |
+
71 | ++ |
+ medname_var,+ |
+
72 | ++ |
+ lbl_medname_var) {+ |
+
73 | +9x | +
+ if (incl_n_treatment) {+ |
+
74 | +8x | +
+ stats <- c("unique", "nonunique")+ |
+
75 | +8x | +
+ labels <- c(+ |
+
76 | +8x | +
+ render_safe("Total number of {patient_label} with at least one treatment"),+ |
+
77 | +8x | +
+ "Total number of treatments"+ |
+
78 | ++ |
+ )+ |
+
79 | ++ |
+ } else {+ |
+
80 | +1x | +
+ stats <- c("unique")+ |
+
81 | +1x | +
+ labels <- c(+ |
+
82 | +1x | +
+ render_safe("Total number of {patient_label} with at least one treatment")+ |
+
83 | ++ |
+ )+ |
+
84 | ++ |
+ }+ |
+
85 | +9x | +
+ lyt <- basic_table() %>%+ |
+
86 | +9x | +
+ split_cols_by(var = arm_var) %>%+ |
+
87 | +9x | +
+ add_colcounts() %>%+ |
+
88 | +9x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
89 | +9x | +
+ analyze_num_patients(+ |
+
90 | +9x | +
+ vars = "USUBJID",+ |
+
91 | +9x | +
+ count_by = "CMSEQ",+ |
+
92 | +9x | +
+ .stats = c("unique", "nonunique"),+ |
+
93 | +9x | +
+ show_labels = "hidden",+ |
+
94 | +9x | +
+ .labels = c(+ |
+
95 | +9x | +
+ unique = render_safe("Total number of {patient_label} with at least one treatment"),+ |
+
96 | +9x | +
+ nonunique = "Total number of treatments"+ |
+
97 | ++ |
+ )+ |
+
98 | ++ |
+ )+ |
+
99 | +9x | +
+ for (k in seq_len(length(row_split_var))) {+ |
+
100 | +5x | +
+ lyt <- split_and_summ_num_patients(lyt, row_split_var[k], lbl_row_split[k], stats, labels, count_by = "CMSEQ")+ |
+
101 | ++ |
+ }+ |
+
102 | +9x | +
+ lyt %>%+ |
+
103 | +9x | +
+ count_occurrences(+ |
+
104 | +9x | +
+ vars = medname_var,+ |
+
105 | +9x | +
+ drop = length(row_split_var) > 0,+ |
+
106 | +9x | +
+ .indent_mods = -1L+ |
+
107 | ++ |
+ ) %>%+ |
+
108 | +9x | +
+ append_topleft(paste0(stringr::str_dup(" ", 2 * length(row_split_var)), lbl_medname_var))+ |
+
109 | ++ |
+ }+ |
+
110 | ++ | + + | +
111 | ++ |
+ #' @describeIn cmt01a Preprocessing+ |
+
112 | ++ |
+ #'+ |
+
113 | ++ |
+ #' @inheritParams cmt01a_main+ |
+
114 | ++ |
+ #'+ |
+
115 | ++ |
+ #' @export+ |
+
116 | ++ |
+ #'+ |
+
117 | ++ |
+ cmt01a_pre <- function(adam_db, ...) {+ |
+
118 | +3x | +
+ adam_db$adcm <- adam_db$adcm %>%+ |
+
119 | +3x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
120 | +3x | +
+ mutate(+ |
+
121 | +3x | +
+ CMDECOD = with_label(reformat(.data$CMDECOD, nocoding), "Other Treatment"),+ |
+
122 | +3x | +
+ ATC2 = reformat(.data$ATC2, nocoding),+ |
+
123 | +3x | +
+ CMSEQ = as.character(.data$CMSEQ)+ |
+
124 | ++ |
+ )+ |
+
125 | +3x | +
+ adam_db+ |
+
126 | ++ |
+ }+ |
+
127 | ++ | + + | +
128 | ++ |
+ #' @describeIn cmt01a Postprocessing+ |
+
129 | ++ |
+ #'+ |
+
130 | ++ |
+ #' @inheritParams cmt01a_main+ |
+
131 | ++ |
+ #' @inheritParams gen_args+ |
+
132 | ++ |
+ #' @param sort_by_freq (`flag`) whether to sort medication class by frequency.+ |
+
133 | ++ |
+ #'+ |
+
134 | ++ |
+ #' @export+ |
+
135 | ++ |
+ #'+ |
+
136 | ++ |
+ cmt01a_post <- function(+ |
+
137 | ++ |
+ tlg, prune_0 = TRUE,+ |
+
138 | ++ |
+ sort_by_freq = FALSE, row_split_var = "ATC2",+ |
+
139 | ++ |
+ medname_var = "CMDECOD", ...) {+ |
+
140 | +3x | +
+ if (sort_by_freq) {+ |
+
141 | +1x | +
+ tlg <- tlg %>%+ |
+
142 | +1x | +
+ tlg_sort_by_var(+ |
+
143 | +1x | +
+ var = row_split_var,+ |
+
144 | +1x | +
+ scorefun = cont_n_allcols+ |
+
145 | ++ |
+ )+ |
+
146 | ++ |
+ }+ |
+
147 | +3x | +
+ tlg <- tlg %>%+ |
+
148 | +3x | +
+ tlg_sort_by_var(+ |
+
149 | +3x | +
+ var = c(row_split_var, medname_var),+ |
+
150 | +3x | +
+ scorefun = score_occurrences+ |
+
151 | ++ |
+ )+ |
+
152 | +3x | +
+ if (prune_0) {+ |
+
153 | +3x | +
+ tlg <- smart_prune(tlg)+ |
+
154 | ++ |
+ }+ |
+
155 | +3x | +
+ std_postprocess(tlg)+ |
+
156 | ++ |
+ }+ |
+
157 | ++ | + + | +
158 | ++ |
+ #' `CMT01A` Concomitant Medication by Medication Class and Preferred Name.+ |
+
159 | ++ |
+ #'+ |
+
160 | ++ |
+ #' A concomitant medication+ |
+
161 | ++ |
+ #' table with the number of subjects and the total number of treatments by medication class.+ |
+
162 | ++ |
+ #'+ |
+
163 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
164 | ++ |
+ #' @export+ |
+
165 | ++ |
+ #'+ |
+
166 | ++ |
+ #' @examples+ |
+
167 | ++ |
+ #' library(dplyr)+ |
+
168 | ++ |
+ #'+ |
+
169 | ++ |
+ #' proc_data <- syn_data+ |
+
170 | ++ |
+ #' proc_data$adcm <- proc_data$adcm %>%+ |
+
171 | ++ |
+ #' filter(ATIREL == "CONCOMITANT")+ |
+
172 | ++ |
+ #'+ |
+
173 | ++ |
+ #' run(cmt01a, proc_data)+ |
+
174 | ++ |
+ cmt01a <- chevron_t(+ |
+
175 | ++ |
+ main = cmt01a_main,+ |
+
176 | ++ |
+ lyt = cmt01a_lyt,+ |
+
177 | ++ |
+ preprocess = cmt01a_pre,+ |
+
178 | ++ |
+ postprocess = cmt01a_post+ |
+
179 | ++ |
+ )+ |
+
1 | ++ |
+ #' @include utils.R+ |
+
2 | ++ | + + | +
3 | ++ |
+ # Chevron_tlg ----+ |
+
4 | ++ | + + | +
5 | ++ |
+ #' `chevron_tlg` class+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' The `chevron_tlg` class associates a `preprocess` function, a main `tlg` function and `AdAM` tables names and+ |
+
8 | ++ |
+ #' optionally a `postprocess` function.+ |
+
9 | ++ |
+ #'+ |
+
10 | ++ |
+ #' @slot main (`function`) returning a `tlg`. Typically one of the `*_main` function from `chevron`.+ |
+
11 | ++ |
+ #' @slot preprocess (`function`) returning a pre-processed `list` of `data.frames` amenable to `tlg` creation. Typically+ |
+
12 | ++ |
+ #' one of the `*_pre` function from `chevron`.+ |
+
13 | ++ |
+ #' @slot postprocess (`function`) returning a post-processed `tlg`.+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @format NULL+ |
+
16 | ++ |
+ #'+ |
+
17 | ++ |
+ #' @note To ensure the correct execution of the workflow additional validation criteria are:+ |
+
18 | ++ |
+ #' * the first argument of the `main` function must be `adam_db`, the input `list` of `data.frames` to pre-process. The+ |
+
19 | ++ |
+ #' `...` argument is mandatory.+ |
+
20 | ++ |
+ #' * the first argument of the `preprocess` function must be `adam_db`, the input `list` of `data.frames` to create+ |
+
21 | ++ |
+ #' `tlg` output. The `...` argument is mandatory.+ |
+
22 | ++ |
+ #' * the first argument of the `postprocess` function must be `tlg`, the input `TableTree` object to post-process. The+ |
+
23 | ++ |
+ #' `...` argument is mandatory.+ |
+
24 | ++ |
+ #'+ |
+
25 | ++ |
+ #' @name chevron_tlg-class+ |
+
26 | ++ |
+ #' @exportClass chevron_tlg+ |
+
27 | ++ |
+ .chevron_tlg <- setClass(+ |
+
28 | ++ |
+ "chevron_tlg",+ |
+
29 | ++ |
+ contains = "VIRTUAL",+ |
+
30 | ++ |
+ slots = c(+ |
+
31 | ++ |
+ main = "function",+ |
+
32 | ++ |
+ preprocess = "function",+ |
+
33 | ++ |
+ postprocess = "function"+ |
+
34 | ++ |
+ )+ |
+
35 | ++ |
+ )+ |
+
36 | ++ | + + | +
37 | ++ |
+ # Validation ----+ |
+
38 | ++ | + + | +
39 | ++ |
+ methods::setValidity("chevron_tlg", function(object) {+ |
+
40 | ++ |
+ coll <- checkmate::makeAssertCollection()+ |
+
41 | ++ |
+ checkmate::assert_function(object@main, args = c("adam_db"), ordered = TRUE, add = coll)+ |
+
42 | ++ |
+ checkmate::assert_function(object@main, args = "...", add = coll)+ |
+
43 | ++ |
+ checkmate::assert_function(object@preprocess, args = c("adam_db"), ordered = TRUE, add = coll)+ |
+
44 | ++ |
+ checkmate::assert_function(object@preprocess, args = "...", add = coll)+ |
+
45 | ++ |
+ checkmate::assert_function(object@postprocess, args = c("tlg"), ordered = TRUE, add = coll)+ |
+
46 | ++ |
+ checkmate::assert_function(object@postprocess, args = "...", add = coll)+ |
+
47 | ++ |
+ checkmate::reportAssertions(coll)+ |
+
48 | ++ |
+ })+ |
+
49 | ++ | + + | +
50 | ++ |
+ # Subclasses ----+ |
+
51 | ++ | + + | +
52 | ++ |
+ ## chevron_t ----+ |
+
53 | ++ | + + | +
54 | ++ |
+ #' `chevron_t`+ |
+
55 | ++ |
+ #'+ |
+
56 | ++ |
+ #' `chevron_t`, a subclass of [chevron::chevron_tlg-class] with specific validation criteria to handle table creation+ |
+
57 | ++ |
+ #'+ |
+
58 | ++ |
+ #' @aliases chevron_table+ |
+
59 | ++ |
+ #' @rdname chevron_tlg-class+ |
+
60 | ++ |
+ #' @exportClass chevron_t+ |
+
61 | ++ |
+ .chevron_t <- setClass(+ |
+
62 | ++ |
+ "chevron_t",+ |
+
63 | ++ |
+ contains = "chevron_tlg"+ |
+
64 | ++ |
+ )+ |
+
65 | ++ | + + | +
66 | ++ |
+ methods::setValidity("chevron_t", function(object) {+ |
+
67 | ++ |
+ coll <- checkmate::makeAssertCollection()+ |
+
68 | ++ |
+ checkmate::assert_function(object@main, args = c("adam_db"), ordered = TRUE, add = coll)+ |
+
69 | ++ |
+ checkmate::reportAssertions(coll)+ |
+
70 | ++ |
+ })+ |
+
71 | ++ | + + | +
72 | ++ |
+ ## chevron_l ----+ |
+
73 | ++ | + + | +
74 | ++ |
+ #' `chevron_l`+ |
+
75 | ++ |
+ #'+ |
+
76 | ++ |
+ #' `chevron_l`, a subclass of [chevron::chevron_tlg-class] with specific validation criteria to handle listing creation+ |
+
77 | ++ |
+ #'+ |
+
78 | ++ |
+ #' @aliases chevron_listing+ |
+
79 | ++ |
+ #' @rdname chevron_tlg-class+ |
+
80 | ++ |
+ #' @exportClass chevron_l+ |
+
81 | ++ |
+ .chevron_l <- setClass(+ |
+
82 | ++ |
+ "chevron_l",+ |
+
83 | ++ |
+ contains = "chevron_tlg"+ |
+
84 | ++ |
+ )+ |
+
85 | ++ | + + | +
86 | ++ |
+ methods::setValidity("chevron_l", function(object) {+ |
+
87 | ++ |
+ coll <- checkmate::makeAssertCollection()+ |
+
88 | ++ |
+ checkmate::assert_function(object@main, args = c("adam_db"), ordered = TRUE, add = coll)+ |
+
89 | ++ |
+ checkmate::reportAssertions(coll)+ |
+
90 | ++ |
+ })+ |
+
91 | ++ | + + | +
92 | ++ |
+ ## chevron_g ----+ |
+
93 | ++ | + + | +
94 | ++ |
+ #' `chevron_g`+ |
+
95 | ++ |
+ #'+ |
+
96 | ++ |
+ #' `chevron_g`, a subclass of [chevron::chevron_tlg-class] with specific validation criteria to handle graph creation+ |
+
97 | ++ |
+ #'+ |
+
98 | ++ |
+ #' @aliases chevron_graph+ |
+
99 | ++ |
+ #' @rdname chevron_tlg-class+ |
+
100 | ++ |
+ #' @exportClass chevron_g+ |
+
101 | ++ |
+ .chevron_g <- setClass(+ |
+
102 | ++ |
+ "chevron_g",+ |
+
103 | ++ |
+ contains = "chevron_tlg"+ |
+
104 | ++ |
+ )+ |
+
105 | ++ | + + | +
106 | ++ |
+ methods::setValidity("chevron_g", function(object) {+ |
+
107 | ++ |
+ coll <- checkmate::makeAssertCollection()+ |
+
108 | ++ |
+ checkmate::assert_function(object@main, args = c("adam_db"), ordered = TRUE, add = coll)+ |
+
109 | ++ |
+ checkmate::reportAssertions(coll)+ |
+
110 | ++ |
+ })+ |
+
111 | ++ | + + | +
112 | ++ | + + | +
113 | ++ |
+ # Sub Constructor ----+ |
+
114 | ++ | + + | +
115 | ++ |
+ #' `chevron_t` constructor+ |
+
116 | ++ |
+ #'+ |
+
117 | ++ |
+ #' @rdname chevron_tlg-class+ |
+
118 | ++ |
+ #'+ |
+
119 | ++ |
+ #' @inheritParams gen_args+ |
+
120 | ++ |
+ #' @param ... not used+ |
+
121 | ++ |
+ #'+ |
+
122 | ++ |
+ #' @export+ |
+
123 | ++ |
+ #'+ |
+
124 | ++ |
+ #' @examples+ |
+
125 | ++ |
+ #' chevron_t_obj <- chevron_t()+ |
+
126 | ++ |
+ #' chevron_t_obj <- chevron_t(postprocess = function(tlg, indent, ...) {+ |
+
127 | ++ |
+ #' rtables::table_inset(tlg) <- indent+ |
+
128 | ++ |
+ #' tlg+ |
+
129 | ++ |
+ #' })+ |
+
130 | ++ |
+ #'+ |
+
131 | ++ |
+ chevron_t <- function(main = function(adam_db, ...) build_table(basic_table(), adam_db[[1]]),+ |
+
132 | ++ |
+ preprocess = function(adam_db, ...) adam_db,+ |
+
133 | ++ |
+ postprocess = report_null,+ |
+
134 | ++ |
+ ...) {+ |
+
135 | +2x | +
+ res <- .chevron_t(+ |
+
136 | +2x | +
+ main = main,+ |
+
137 | +2x | +
+ preprocess = preprocess,+ |
+
138 | +2x | +
+ postprocess = postprocess+ |
+
139 | ++ |
+ )+ |
+
140 | ++ | + + | +
141 | +2x | +
+ res+ |
+
142 | ++ |
+ }+ |
+
143 | ++ | + + | +
144 | ++ |
+ #' `chevron_l` constructor+ |
+
145 | ++ |
+ #'+ |
+
146 | ++ |
+ #' @rdname chevron_tlg-class+ |
+
147 | ++ |
+ #'+ |
+
148 | ++ |
+ #' @inheritParams gen_args+ |
+
149 | ++ |
+ #' @param ... not used+ |
+
150 | ++ |
+ #'+ |
+
151 | ++ |
+ #' @export+ |
+
152 | ++ |
+ #'+ |
+
153 | ++ |
+ #' @examples+ |
+
154 | ++ |
+ #' chevron_l_obj <- chevron_l()+ |
+
155 | ++ |
+ #'+ |
+
156 | ++ |
+ chevron_l <- function(main = function(adam_db, ...) data.frame(),+ |
+
157 | ++ |
+ preprocess = function(adam_db, ...) adam_db,+ |
+
158 | ++ |
+ postprocess = function(tlg, ...) tlg,+ |
+
159 | ++ |
+ ...) {+ |
+
160 | +1x | +
+ res <- .chevron_l(+ |
+
161 | +1x | +
+ main = main,+ |
+
162 | +1x | +
+ preprocess = preprocess,+ |
+
163 | +1x | +
+ postprocess = postprocess+ |
+
164 | ++ |
+ )+ |
+
165 | ++ | + + | +
166 | +1x | +
+ res+ |
+
167 | ++ |
+ }+ |
+
168 | ++ | + + | +
169 | ++ |
+ #' `chevron_g` constructor+ |
+
170 | ++ |
+ #'+ |
+
171 | ++ |
+ #' @rdname chevron_tlg-class+ |
+
172 | ++ |
+ #' @param ... not used+ |
+
173 | ++ |
+ #'+ |
+
174 | ++ |
+ #' @inheritParams gen_args+ |
+
175 | ++ |
+ #'+ |
+
176 | ++ |
+ #' @export+ |
+
177 | ++ |
+ #'+ |
+
178 | ++ |
+ #' @examples+ |
+
179 | ++ |
+ #' chevron_g_obj <- chevron_g()+ |
+
180 | ++ |
+ #' chevron_g_obj <- chevron_g(+ |
+
181 | ++ |
+ #' postprocess = function(tlg, title, ...) tlg + ggplot2::labs(main = title)+ |
+
182 | ++ |
+ #' )+ |
+
183 | ++ |
+ #'+ |
+
184 | ++ |
+ chevron_g <- function(main = function(adam_db, ...) ggplot2::ggplot(),+ |
+
185 | ++ |
+ preprocess = function(adam_db, ...) adam_db,+ |
+
186 | ++ |
+ postprocess = function(tlg, ...) tlg,+ |
+
187 | ++ |
+ ...) {+ |
+
188 | +1x | +
+ res <- .chevron_g(+ |
+
189 | +1x | +
+ main = main,+ |
+
190 | +1x | +
+ preprocess = preprocess,+ |
+
191 | +1x | +
+ postprocess = postprocess+ |
+
192 | ++ |
+ )+ |
+
193 | ++ | + + | +
194 | +1x | +
+ res+ |
+
195 | ++ |
+ }+ |
+
1 | ++ |
+ # pdt01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn pdt01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param dvcode_var (`string`) the variable defining the protocol deviation coded term. By default `DVDECOD`.+ |
+
7 | ++ |
+ #' @param dvterm_var (`string`) the variable defining the protocol deviation term. By default `DVTERM`.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' * Data should be filtered for major protocol deviations. `(DVCAT == "MAJOR")`.+ |
+
11 | ++ |
+ #' * Numbers represent absolute numbers of subjects and fraction of `N`, or absolute numbers when specified.+ |
+
12 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
13 | ++ |
+ #' * Split columns by arm.+ |
+
14 | ++ |
+ #' * Does not include a total column by default.+ |
+
15 | ++ |
+ #' * Sort by medication class alphabetically and within medication class by decreasing total number of patients with+ |
+
16 | ++ |
+ #' the specific medication.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @note+ |
+
19 | ++ |
+ #' * `adam_db` object must contain an `addv` table with the columns specified in `dvcode_var` and `dvterm_var` as well+ |
+
20 | ++ |
+ #' as `"DVSEQ"`.+ |
+
21 | ++ |
+ #'+ |
+
22 | ++ |
+ #' @export+ |
+
23 | ++ |
+ #'+ |
+
24 | ++ |
+ pdt01_main <- function(adam_db,+ |
+
25 | ++ |
+ arm_var = "ARM",+ |
+
26 | ++ |
+ dvcode_var = "DVDECOD",+ |
+
27 | ++ |
+ dvterm_var = "DVTERM",+ |
+
28 | ++ |
+ lbl_overall = NULL,+ |
+
29 | ++ |
+ ...) {+ |
+
30 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", "addv"))+ |
+
31 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
32 | +1x | +
+ checkmate::assert_string(dvcode_var)+ |
+
33 | +1x | +
+ checkmate::assert_string(dvterm_var)+ |
+
34 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
35 | +1x | +
+ assert_valid_variable(adam_db$addv, c(dvcode_var, dvterm_var), types = list(c("character", "factor")))+ |
+
36 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
37 | +1x | +
+ assert_valid_variable(adam_db$addv, "USUBJID", types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
38 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$addv, arm_var)+ |
+
39 | ++ | + + | +
40 | +1x | +
+ lbl_dvcode_var <- var_labels_for(adam_db$addv, dvcode_var)+ |
+
41 | +1x | +
+ lbl_dvterm_var <- var_labels_for(adam_db$addv, dvterm_var)+ |
+
42 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
43 | +1x | +
+ lyt <- pdt01_lyt(+ |
+
44 | +1x | +
+ arm_var = arm_var,+ |
+
45 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
46 | +1x | +
+ dvcode_var = dvcode_var,+ |
+
47 | +1x | +
+ lbl_dvcode_var = lbl_dvcode_var,+ |
+
48 | +1x | +
+ dvterm_var = dvterm_var,+ |
+
49 | +1x | +
+ lbl_dvterm_var = lbl_dvterm_var+ |
+
50 | ++ |
+ )+ |
+
51 | ++ | + + | +
52 | +1x | +
+ tbl <- build_table(lyt, adam_db$addv, alt_counts_df = adam_db$adsl)+ |
+
53 | ++ | + + | +
54 | +1x | +
+ tbl+ |
+
55 | ++ |
+ }+ |
+
56 | ++ | + + | +
57 | ++ |
+ #' `pdt01` Layout+ |
+
58 | ++ |
+ #'+ |
+
59 | ++ |
+ #' @inheritParams gen_args+ |
+
60 | ++ |
+ #' @inheritParams pdt01_main+ |
+
61 | ++ |
+ #' @param lbl_dvcode_var (`string`) label for the variable defining the protocol deviation coded term.+ |
+
62 | ++ |
+ #' @param lbl_dvterm_var (`string`) label for the variable defining the protocol deviation term.+ |
+
63 | ++ |
+ #'+ |
+
64 | ++ |
+ #' @keywords internal+ |
+
65 | ++ |
+ #'+ |
+
66 | ++ |
+ pdt01_lyt <- function(arm_var,+ |
+
67 | ++ |
+ lbl_overall,+ |
+
68 | ++ |
+ dvcode_var,+ |
+
69 | ++ |
+ lbl_dvcode_var,+ |
+
70 | ++ |
+ dvterm_var,+ |
+
71 | ++ |
+ lbl_dvterm_var) {+ |
+
72 | +4x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
73 | +4x | +
+ split_cols_by(var = arm_var) %>%+ |
+
74 | +4x | +
+ add_colcounts() %>%+ |
+
75 | +4x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
76 | +4x | +
+ summarize_num_patients(+ |
+
77 | +4x | +
+ var = "USUBJID",+ |
+
78 | +4x | +
+ .stats = c("unique", "nonunique"),+ |
+
79 | +4x | +
+ .labels = c(+ |
+
80 | +4x | +
+ unique = render_safe("Total number of {patient_label} with at least one major protocol deviation"),+ |
+
81 | +4x | +
+ nonunique = "Total number of major protocol deviations"+ |
+
82 | ++ |
+ ),+ |
+
83 | +4x | +
+ .formats = list(unique = format_count_fraction_fixed_dp)+ |
+
84 | ++ |
+ ) %>%+ |
+
85 | +4x | +
+ split_rows_by(+ |
+
86 | +4x | +
+ dvcode_var,+ |
+
87 | +4x | +
+ child_labels = "visible",+ |
+
88 | +4x | +
+ nested = FALSE,+ |
+
89 | +4x | +
+ indent_mod = -1L,+ |
+
90 | +4x | +
+ split_fun = drop_split_levels,+ |
+
91 | +4x | +
+ label_pos = "topleft",+ |
+
92 | +4x | +
+ split_label = lbl_dvterm_var+ |
+
93 | ++ |
+ ) %>%+ |
+
94 | +4x | +
+ count_occurrences(vars = dvterm_var) %>%+ |
+
95 | +4x | +
+ append_topleft(paste0(" Description"))+ |
+
96 | ++ |
+ }+ |
+
97 | ++ | + + | +
98 | ++ |
+ #' @describeIn pdt01 Preprocessing+ |
+
99 | ++ |
+ #'+ |
+
100 | ++ |
+ #' @inheritParams pdt01_main+ |
+
101 | ++ |
+ #'+ |
+
102 | ++ |
+ #' @export+ |
+
103 | ++ |
+ #'+ |
+
104 | ++ |
+ pdt01_pre <- function(adam_db, ...) {+ |
+
105 | +1x | +
+ adam_db$addv <- adam_db$addv %>%+ |
+
106 | +1x | +
+ mutate(across(all_of(c("DVDECOD", "DVTERM")), ~ reformat(.x, nocoding))) %>%+ |
+
107 | +1x | +
+ mutate(+ |
+
108 | +1x | +
+ DVDECOD = with_label(.data$DVDECOD, "Protocol Deviation Coded Term"),+ |
+
109 | +1x | +
+ DVTERM = with_label(.data$DVTERM, "Category")+ |
+
110 | ++ |
+ )+ |
+
111 | ++ | + + | +
112 | +1x | +
+ adam_db+ |
+
113 | ++ |
+ }+ |
+
114 | ++ | + + | +
115 | ++ |
+ #' @describeIn pdt01 Postprocessing+ |
+
116 | ++ |
+ #'+ |
+
117 | ++ |
+ #' @inheritParams pdt01_main+ |
+
118 | ++ |
+ #' @inheritParams gen_args+ |
+
119 | ++ |
+ #'+ |
+
120 | ++ |
+ #' @export+ |
+
121 | ++ |
+ #'+ |
+
122 | ++ |
+ pdt01_post <- function(tlg, prune_0 = TRUE, dvcode_var = "DVDECOD", dvterm_var = "DVTERM", ...) {+ |
+
123 | +1x | +
+ if (prune_0) {+ |
+
124 | +1x | +
+ tlg <- smart_prune(tlg)+ |
+
125 | ++ |
+ }+ |
+
126 | ++ | + + | +
127 | +1x | +
+ tbl_sorted <- tlg %>%+ |
+
128 | +1x | +
+ sort_at_path(+ |
+
129 | +1x | +
+ path = c(dvcode_var, "*", dvterm_var),+ |
+
130 | +1x | +
+ scorefun = score_occurrences+ |
+
131 | ++ |
+ )+ |
+
132 | ++ | + + | +
133 | +1x | +
+ std_postprocess(tbl_sorted)+ |
+
134 | ++ |
+ }+ |
+
135 | ++ | + + | +
136 | ++ |
+ #' `pdt01` Major Protocol Deviations Table.+ |
+
137 | ++ |
+ #'+ |
+
138 | ++ |
+ #' A major protocol deviations+ |
+
139 | ++ |
+ #' table with the number of subjects and the total number of treatments by medication class sorted alphabetically and+ |
+
140 | ++ |
+ #' medication name sorted by frequencies.+ |
+
141 | ++ |
+ #'+ |
+
142 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
143 | ++ |
+ #' @export+ |
+
144 | ++ |
+ #'+ |
+
145 | ++ |
+ #' @examples+ |
+
146 | ++ |
+ #' library(dplyr)+ |
+
147 | ++ |
+ #'+ |
+
148 | ++ |
+ #' proc_data <- syn_data+ |
+
149 | ++ |
+ #' proc_data$addv <- proc_data$addv %>%+ |
+
150 | ++ |
+ #' filter(DVCAT == "MAJOR")+ |
+
151 | ++ |
+ #'+ |
+
152 | ++ |
+ #' run(pdt01, proc_data)+ |
+
153 | ++ |
+ pdt01 <- chevron_t(+ |
+
154 | ++ |
+ main = pdt01_main,+ |
+
155 | ++ |
+ lyt = pdt01_lyt,+ |
+
156 | ++ |
+ preprocess = pdt01_pre,+ |
+
157 | ++ |
+ postprocess = pdt01_post+ |
+
158 | ++ |
+ )+ |
+
1 | ++ |
+ # lbt04 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn lbt04 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param analysis_abn_var (`string`) column describing anomaly magnitude+ |
+
7 | ++ |
+ #' @param baseline_abn_var (`string`) column describing anomaly at baseline.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' * Only count LOW or HIGH values.+ |
+
11 | ++ |
+ #' * Lab test results with missing `analysis_abn_var` values are excluded.+ |
+
12 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
13 | ++ |
+ #' * Does not include a total column by default.+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @note+ |
+
16 | ++ |
+ #' * `adam_db` object must contain an `adlb` table with columns `"PARCAT1"`, `"PARCAT2"`, `"PARAM"`, `"ANRIND"`,+ |
+
17 | ++ |
+ #' and column specified by `arm_var`.+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ #' @export+ |
+
20 | ++ |
+ #'+ |
+
21 | ++ |
+ lbt04_main <- function(adam_db,+ |
+
22 | ++ |
+ arm_var = "ACTARM",+ |
+
23 | ++ |
+ analysis_abn_var = "ANRIND",+ |
+
24 | ++ |
+ baseline_abn_var = "BNRIND",+ |
+
25 | ++ |
+ ...) {+ |
+
26 | +2x | +
+ assert_all_tablenames(adam_db, c("adsl", "adlb"))+ |
+
27 | +2x | +
+ checkmate::assert_string(arm_var)+ |
+
28 | +2x | +
+ assert_valid_variable(+ |
+
29 | +2x | +
+ adam_db$adlb, c("PARAM", "PARCAT1"),+ |
+
30 | +2x | +
+ types = list("characater", "factor")+ |
+
31 | ++ |
+ )+ |
+
32 | +2x | +
+ assert_valid_variable(adam_db$adlb, c("AVALCAT1", analysis_abn_var), na_ok = TRUE, empty_ok = TRUE, min_chars = 0L)+ |
+
33 | +2x | +
+ assert_valid_variable(adam_db$adlb, c("USUBJID"), types = list(c("character", "factor")), empty_ok = TRUE)+ |
+
34 | +2x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID"), types = list(c("character", "factor")))+ |
+
35 | +2x | +
+ assert_valid_variable(+ |
+
36 | +2x | +
+ adam_db$adlb,+ |
+
37 | +2x | +
+ baseline_abn_var,+ |
+
38 | +2x | +
+ types = list(c("character", "factor")),+ |
+
39 | +2x | +
+ na_ok = TRUE, empty_ok = TRUE, min_chars = 0L+ |
+
40 | ++ |
+ )+ |
+
41 | +2x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adlb, arm_var)+ |
+
42 | +2x | +
+ lbl_abn_var <- var_labels_for(adam_db$adlb, analysis_abn_var)+ |
+
43 | +2x | +
+ lbl_param <- var_labels_for(adam_db$adlb, "PARAM")+ |
+
44 | ++ | + + | +
45 | +2x | +
+ lyt <- lbt04_lyt(+ |
+
46 | +2x | +
+ arm_var = arm_var,+ |
+
47 | +2x | +
+ var_parcat = "PARCAT1",+ |
+
48 | +2x | +
+ var_param = "PARAM",+ |
+
49 | +2x | +
+ lbl_param = lbl_param,+ |
+
50 | +2x | +
+ analysis_abn_var = analysis_abn_var,+ |
+
51 | +2x | +
+ lbl_abn_var = lbl_abn_var,+ |
+
52 | +2x | +
+ variables = list(id = "USUBJID", baseline = baseline_abn_var)+ |
+
53 | ++ |
+ )+ |
+
54 | ++ | + + | +
55 | +2x | +
+ tbl <- build_table(lyt, adam_db$adlb, alt_counts_df = adam_db$adsl)+ |
+
56 | ++ | + + | +
57 | +2x | +
+ tbl+ |
+
58 | ++ |
+ }+ |
+
59 | ++ | + + | +
60 | ++ |
+ #' `lbt04` Layout+ |
+
61 | ++ |
+ #'+ |
+
62 | ++ |
+ #' @inheritParams gen_args+ |
+
63 | ++ |
+ #'+ |
+
64 | ++ |
+ #' @param lbl_param (`string`) label of the `PARAM` variable.+ |
+
65 | ++ |
+ #' @param lbl_abn_var (`string`) label of the `analysis_abn_var` variable.+ |
+
66 | ++ |
+ #' @param variables (`list`) see [tern::count_abnormal]+ |
+
67 | ++ |
+ #'+ |
+
68 | ++ |
+ #' @keywords internal+ |
+
69 | ++ |
+ #'+ |
+
70 | ++ |
+ lbt04_lyt <- function(arm_var,+ |
+
71 | ++ |
+ var_parcat,+ |
+
72 | ++ |
+ var_param,+ |
+
73 | ++ |
+ lbl_param,+ |
+
74 | ++ |
+ analysis_abn_var,+ |
+
75 | ++ |
+ lbl_abn_var,+ |
+
76 | ++ |
+ variables) {+ |
+
77 | +10x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
78 | +10x | +
+ split_cols_by(arm_var) %>%+ |
+
79 | +10x | +
+ split_rows_by(+ |
+
80 | +10x | +
+ var_parcat,+ |
+
81 | +10x | +
+ split_fun = drop_split_levels+ |
+
82 | ++ |
+ ) %>%+ |
+
83 | +10x | +
+ split_rows_by(+ |
+
84 | +10x | +
+ var_param,+ |
+
85 | +10x | +
+ split_fun = drop_split_levels,+ |
+
86 | +10x | +
+ label_pos = "topleft",+ |
+
87 | +10x | +
+ split_label = lbl_param,+ |
+
88 | +10x | +
+ indent_mod = 0L+ |
+
89 | ++ |
+ ) %>%+ |
+
90 | +10x | +
+ count_abnormal(+ |
+
91 | +10x | +
+ var = analysis_abn_var,+ |
+
92 | +10x | +
+ abnormal = list(Low = c("LOW", "LOW LOW"), High = c("HIGH", "HIGH HIGH")),+ |
+
93 | +10x | +
+ exclude_base_abn = TRUE,+ |
+
94 | +10x | +
+ variables = variables,+ |
+
95 | +10x | +
+ .formats = list(fraction = format_fraction_fixed_dp)+ |
+
96 | ++ |
+ ) %>%+ |
+
97 | +10x | +
+ append_topleft(paste(" ", lbl_abn_var))+ |
+
98 | ++ |
+ }+ |
+
99 | ++ | + + | +
100 | ++ |
+ #' @describeIn lbt04 Preprocessing+ |
+
101 | ++ |
+ #'+ |
+
102 | ++ |
+ #' @inheritParams gen_args+ |
+
103 | ++ |
+ #'+ |
+
104 | ++ |
+ #' @export+ |
+
105 | ++ |
+ #'+ |
+
106 | ++ |
+ lbt04_pre <- function(adam_db, ...) {+ |
+
107 | +1x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
108 | +1x | +
+ filter(+ |
+
109 | +1x | +
+ .data$ONTRTFL == "Y",+ |
+
110 | +1x | +
+ .data$PARCAT2 == "SI",+ |
+
111 | +1x | +
+ !is.na(.data$ANRIND)+ |
+
112 | ++ |
+ ) %>%+ |
+
113 | +1x | +
+ mutate(+ |
+
114 | +1x | +
+ PARAM = with_label(.data$PARAM, "Laboratory Test"),+ |
+
115 | +1x | +
+ ANRIND = with_label(.data$ANRIND, "Direction of Abnormality")+ |
+
116 | ++ |
+ ) %>%+ |
+
117 | +1x | +
+ mutate(+ |
+
118 | +1x | +
+ ANRIND = reformat(+ |
+
119 | +1x | +
+ .data$ANRIND,+ |
+
120 | +1x | +
+ rule(+ |
+
121 | +1x | +
+ "HIGH HIGH" = "HIGH HIGH",+ |
+
122 | +1x | +
+ "HIGH" = "HIGH",+ |
+
123 | +1x | +
+ "LOW" = "LOW",+ |
+
124 | +1x | +
+ "LOW LOW" = "LOW LOW",+ |
+
125 | +1x | +
+ "NORMAL" = "NORMAL"+ |
+
126 | ++ |
+ )+ |
+
127 | ++ |
+ )+ |
+
128 | ++ |
+ )+ |
+
129 | ++ | + + | +
130 | +1x | +
+ adam_db+ |
+
131 | ++ |
+ }+ |
+
132 | ++ | + + | +
133 | ++ |
+ #' @describeIn lbt04 Postprocessing+ |
+
134 | ++ |
+ #'+ |
+
135 | ++ |
+ #' @inheritParams gen_args+ |
+
136 | ++ |
+ #'+ |
+
137 | ++ |
+ #' @export+ |
+
138 | ++ |
+ #'+ |
+
139 | ++ |
+ lbt04_post <- function(tlg, ...) {+ |
+
140 | +2x | +
+ std_postprocess(tlg)+ |
+
141 | ++ |
+ }+ |
+
142 | ++ | + + | +
143 | ++ |
+ #' `LBT04` Laboratory Abnormalities Not Present at Baseline Table.+ |
+
144 | ++ |
+ #'+ |
+
145 | ++ |
+ #' The `LBT04` table provides an+ |
+
146 | ++ |
+ #' overview of laboratory abnormalities not present at baseline.+ |
+
147 | ++ |
+ #'+ |
+
148 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
149 | ++ |
+ #' @export+ |
+
150 | ++ |
+ #'+ |
+
151 | ++ |
+ #' @examples+ |
+
152 | ++ |
+ #' run(lbt04, syn_data)+ |
+
153 | ++ |
+ lbt04 <- chevron_t(+ |
+
154 | ++ |
+ main = lbt04_main,+ |
+
155 | ++ |
+ preprocess = lbt04_pre,+ |
+
156 | ++ |
+ postprocess = lbt04_post+ |
+
157 | ++ |
+ )+ |
+
1 | ++ |
+ # coxt01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn coxt01 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param arm_var (`string`) the arm variable used for arm splitting.+ |
+
7 | ++ |
+ #' @param time_var (`string`) the time variable in a Cox proportional hazards regression model.+ |
+
8 | ++ |
+ #' @param event_var (`string`) the event variable in a Cox proportional hazards regression model.+ |
+
9 | ++ |
+ #' @param covariates (`character`) will be fitted and the corresponding effect will be estimated.+ |
+
10 | ++ |
+ #' @param strata (`character`) will be fitted for the stratified analysis.+ |
+
11 | ++ |
+ #' @param lbl_vars (`string`) text label for the a Cox regression model variables.+ |
+
12 | ++ |
+ #' @param multivar (`flag`) indicator of whether multivariate cox regression is conducted.+ |
+
13 | ++ |
+ #' @param ... Further arguments passed to `tern::control_coxreg()`.+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @details+ |
+
16 | ++ |
+ #' * The reference arm will always the first level of `arm_var`. Please change the level if you want to+ |
+
17 | ++ |
+ #' change the reference arms.+ |
+
18 | ++ |
+ #' * The table allows confidence level to be adjusted, default is two-sided 95%.+ |
+
19 | ++ |
+ #' * The stratified analysis is with DISCRETE tie handling (equivalent to `tern::control_coxreg(ties = "exact")` in R).+ |
+
20 | ++ |
+ #' * Model includes treatment plus specified covariate(s) as factor(s) or numeric(s),+ |
+
21 | ++ |
+ #' with `"SEX"`, `"RACE"` and `"AAGE"` as default candidates.+ |
+
22 | ++ |
+ #' * The selection of the covariates and whether or not there is a selection process+ |
+
23 | ++ |
+ #' (vs. a fixed, pre-specified list) needs to be pre-specified.+ |
+
24 | ++ |
+ #' * For pairwise comparisons using the hazard ratio, the value for the control group is the denominator.+ |
+
25 | ++ |
+ #' * Keep zero-count rows unless overridden with `prune_0 = TRUE`.+ |
+
26 | ++ |
+ #'+ |
+
27 | ++ |
+ #' @note+ |
+
28 | ++ |
+ #' * `adam_db` object must contain an `adtte` table with `"PARAMCD"`, `"ARM"`,+ |
+
29 | ++ |
+ #' `"AVAL"`, `"CNSR`, and the columns specified by `"covariates"` which is denoted as+ |
+
30 | ++ |
+ #' `c("SEX", "RACE", "AAGE")` by default.+ |
+
31 | ++ |
+ #'+ |
+
32 | ++ |
+ #' @export+ |
+
33 | ++ |
+ #'+ |
+
34 | ++ |
+ coxt01_main <- function(adam_db,+ |
+
35 | ++ |
+ arm_var = "ARM",+ |
+
36 | ++ |
+ time_var = "AVAL",+ |
+
37 | ++ |
+ event_var = "EVENT",+ |
+
38 | ++ |
+ covariates = c("SEX", "RACE", "AAGE"),+ |
+
39 | ++ |
+ strata = NULL,+ |
+
40 | ++ |
+ lbl_vars = "Effect/Covariate Included in the Model",+ |
+
41 | ++ |
+ multivar = FALSE,+ |
+
42 | ++ |
+ ...) {+ |
+
43 | +2x | +
+ assert_all_tablenames(adam_db, "adtte")+ |
+
44 | +2x | +
+ checkmate::assert_string(arm_var)+ |
+
45 | +2x | +
+ checkmate::assert_string(time_var)+ |
+
46 | +2x | +
+ checkmate::assert_string(event_var)+ |
+
47 | +2x | +
+ checkmate::assert_character(covariates, null.ok = TRUE)+ |
+
48 | +2x | +
+ checkmate::assert_character(strata, null.ok = TRUE)+ |
+
49 | +2x | +
+ checkmate::assert_flag(multivar)+ |
+
50 | +2x | +
+ assert_valid_variable(adam_db$adtte, arm_var, types = list("factor"), n.levels = if (!multivar) 2L)+ |
+
51 | +2x | +
+ assert_valid_variable(adam_db$adtte, c("USUBJID", arm_var, "PARAMCD"), types = list(c("character", "factor")))+ |
+
52 | +2x | +
+ assert_valid_variable(adam_db$adtte, strata, types = list(c("factor", "integer", "character")), na_ok = TRUE)+ |
+
53 | +2x | +
+ assert_valid_variable(adam_db$adtte, covariates, na_ok = TRUE)+ |
+
54 | +2x | +
+ assert_valid_variable(adam_db$adtte, event_var, types = list("numeric"), integerish = TRUE, lower = 0L, upper = 1L)+ |
+
55 | +2x | +
+ assert_valid_variable(adam_db$adtte, time_var, types = list("numeric"), lower = 0)+ |
+
56 | +2x | +
+ assert_single_value(adam_db$adtte$PARAMCD)+ |
+
57 | +2x | +
+ control <- execute_with_args(control_coxreg, ...)+ |
+
58 | ++ | + + | +
59 | +2x | +
+ variables <- list(+ |
+
60 | +2x | +
+ time = time_var,+ |
+
61 | +2x | +
+ event = event_var,+ |
+
62 | +2x | +
+ arm = arm_var,+ |
+
63 | +2x | +
+ covariates = covariates,+ |
+
64 | +2x | +
+ strata = strata+ |
+
65 | ++ |
+ )+ |
+
66 | ++ | + + | +
67 | +2x | +
+ lyt <- coxt01_lyt(+ |
+
68 | +2x | +
+ variables = variables,+ |
+
69 | +2x | +
+ col_split = if (!multivar) "COL_LABEL",+ |
+
70 | +2x | +
+ lbl_vars = lbl_vars,+ |
+
71 | +2x | +
+ multivar = multivar,+ |
+
72 | +2x | +
+ control = control,+ |
+
73 | ++ |
+ ...+ |
+
74 | ++ |
+ )+ |
+
75 | +2x | +
+ col_split <- "Treatment Effect Adjusted for Covariate"+ |
+
76 | +2x | +
+ adam_db$adtte$COL_LABEL <- factor(rep(col_split, nrow(adam_db$adtte)), levels = col_split)+ |
+
77 | +2x | +
+ tbl <- build_table(lyt, adam_db$adtte)+ |
+
78 | ++ | + + | +
79 | +2x | +
+ tbl+ |
+
80 | ++ |
+ }+ |
+
81 | ++ | + + | +
82 | ++ |
+ #' `COXT01` Layout+ |
+
83 | ++ |
+ #'+ |
+
84 | ++ |
+ #' @inheritParams coxt01_main+ |
+
85 | ++ |
+ #' @param variables (`list`) list of variables in a Cox proportional hazards regression model.+ |
+
86 | ++ |
+ #'+ |
+
87 | ++ |
+ #' @keywords internal+ |
+
88 | ++ |
+ #'+ |
+
89 | ++ |
+ coxt01_lyt <- function(variables,+ |
+
90 | ++ |
+ col_split,+ |
+
91 | ++ |
+ lbl_vars,+ |
+
92 | ++ |
+ control,+ |
+
93 | ++ |
+ multivar,+ |
+
94 | ++ |
+ ...) {+ |
+
95 | +4x | +
+ lyt <- basic_table() %>%+ |
+
96 | +4x | +
+ ifneeded_split_col(col_split)+ |
+
97 | +4x | +
+ lyt <- execute_with_args(+ |
+
98 | +4x | +
+ summarize_coxreg,+ |
+
99 | +4x | +
+ lyt = lyt, variables = variables, control = control, multivar = multivar, ...+ |
+
100 | ++ |
+ )+ |
+
101 | +4x | +
+ lyt %>%+ |
+
102 | +4x | +
+ append_topleft(lbl_vars)+ |
+
103 | ++ |
+ }+ |
+
104 | ++ | + + | +
105 | ++ |
+ #' @describeIn coxt01 Preprocessing+ |
+
106 | ++ |
+ #'+ |
+
107 | ++ |
+ #' @inheritParams gen_args+ |
+
108 | ++ |
+ #'+ |
+
109 | ++ |
+ #' @export+ |
+
110 | ++ |
+ #'+ |
+
111 | ++ |
+ coxt01_pre <- function(adam_db, ...) {+ |
+
112 | +2x | +
+ adam_db$adtte <- adam_db$adtte %>%+ |
+
113 | +2x | +
+ mutate(EVENT = 1 - .data$CNSR)+ |
+
114 | ++ | + + | +
115 | +2x | +
+ adam_db+ |
+
116 | ++ |
+ }+ |
+
117 | ++ | + + | +
118 | ++ |
+ #' @describeIn coxt01 Postprocessing+ |
+
119 | ++ |
+ #'+ |
+
120 | ++ |
+ #' @inheritParams gen_args+ |
+
121 | ++ |
+ #'+ |
+
122 | ++ |
+ #' @export+ |
+
123 | ++ |
+ #'+ |
+
124 | ++ |
+ coxt01_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
125 | +2x | +
+ if (prune_0) {+ |
+
126 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
127 | ++ |
+ }+ |
+
128 | +2x | +
+ std_postprocess(tlg)+ |
+
129 | ++ |
+ }+ |
+
130 | ++ | + + | +
131 | ++ |
+ #' `COXT01` (Default) Cox Regression Model Table.+ |
+
132 | ++ |
+ #'+ |
+
133 | ++ |
+ #' Cox models are the most commonly used methods to estimate the magnitude of the effect in survival analyses.+ |
+
134 | ++ |
+ #' It assumes proportional hazards; that is, it assumes that the ratio of the hazards+ |
+
135 | ++ |
+ #' of the two groups (e.g. two arms) is constant over time.+ |
+
136 | ++ |
+ #' This ratio is referred to as the "hazard ratio" and is one of the most commonly reported metrics+ |
+
137 | ++ |
+ #' to describe the effect size in survival analysis.+ |
+
138 | ++ |
+ #'+ |
+
139 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
140 | ++ |
+ #' @export+ |
+
141 | ++ |
+ #'+ |
+
142 | ++ |
+ #' @examples+ |
+
143 | ++ |
+ #' library(dunlin)+ |
+
144 | ++ |
+ #'+ |
+
145 | ++ |
+ #' proc_data <- log_filter(syn_data, PARAMCD == "CRSD", "adtte")+ |
+
146 | ++ |
+ #' proc_data <- log_filter(proc_data, ARMCD != "ARM C", "adsl")+ |
+
147 | ++ |
+ #' proc_data$adtte$ARM <- droplevels(proc_data$adtte$ARM)+ |
+
148 | ++ |
+ #' run(coxt01, proc_data)+ |
+
149 | ++ |
+ #'+ |
+
150 | ++ |
+ #' run(coxt01, proc_data, covariates = c("SEX", "AAGE"), strata = c("RACE"), conf_level = 0.90)+ |
+
151 | ++ |
+ coxt01 <- chevron_t(+ |
+
152 | ++ |
+ main = coxt01_main,+ |
+
153 | ++ |
+ preprocess = coxt01_pre,+ |
+
154 | ++ |
+ postprocess = coxt01_post+ |
+
155 | ++ |
+ )+ |
+
1 | ++ |
+ #' Check that all names are among column names+ |
+
2 | ++ |
+ #'+ |
+
3 | ++ |
+ #' @param df (`data.frame`)+ |
+
4 | ++ |
+ #' @param x (`character`) the names of the columns to be checked.+ |
+
5 | ++ |
+ #' @param null_ok (`flag`) can `x` be NULL.+ |
+
6 | ++ |
+ #' @param qualifier (`string`) to be returned if the check fails.+ |
+
7 | ++ |
+ #'+ |
+
8 | ++ |
+ #' @keywords internal+ |
+
9 | ++ |
+ #'+ |
+
10 | ++ |
+ #' @examples+ |
+
11 | ++ |
+ #' \dontrun{+ |
+
12 | ++ |
+ #' check_all_colnames(mtcars, c("x", "y"))+ |
+
13 | ++ |
+ #' }+ |
+
14 | ++ |
+ check_all_colnames <- function(df, x, null_ok = TRUE, qualifier = NULL) {+ |
+
15 | +2x | +
+ checkmate::assert_data_frame(df)+ |
+
16 | +2x | +
+ checkmate::assert_character(x, null.ok = null_ok)+ |
+
17 | +2x | +
+ checkmate::assert_string(qualifier, null.ok = TRUE)+ |
+
18 | ++ | + + | +
19 | +2x | +
+ diff <- setdiff(x, colnames(df))+ |
+
20 | ++ | + + | +
21 | +2x | +
+ if (length(diff) == 0) {+ |
+
22 | +1x | +
+ invisible(NULL)+ |
+
23 | ++ |
+ } else {+ |
+
24 | +1x | +
+ paste(qualifier, "Expected column names:", toString(diff), "not in", deparse(substitute(df)))+ |
+
25 | ++ |
+ }+ |
+
26 | ++ |
+ }+ |
+
27 | ++ | + + | +
28 | ++ |
+ #' Check that at least one name is among column names+ |
+
29 | ++ |
+ #'+ |
+
30 | ++ |
+ #' @param df (`data.frame`)+ |
+
31 | ++ |
+ #' @param x (`character`) the names of the columns to be checked.+ |
+
32 | ++ |
+ #' @param null_ok (`flag`) can `x` be NULL.+ |
+
33 | ++ |
+ #' @param qualifier (`string`) to be returned if the check fails.+ |
+
34 | ++ |
+ #'+ |
+
35 | ++ |
+ #' @keywords internal+ |
+
36 | ++ |
+ #'+ |
+
37 | ++ |
+ #' @examples+ |
+
38 | ++ |
+ #' \dontrun{+ |
+
39 | ++ |
+ #' check_all_colnames(mtcars, c("x", "y"))+ |
+
40 | ++ |
+ #' }+ |
+
41 | ++ |
+ check_one_colnames <- function(df, x, null_ok = TRUE, qualifier = NULL) {+ |
+
42 | +2x | +
+ checkmate::assert_data_frame(df)+ |
+
43 | +2x | +
+ checkmate::assert_character(x, null.ok = null_ok)+ |
+
44 | +2x | +
+ checkmate::assert_string(qualifier, null.ok = TRUE)+ |
+
45 | ++ | + + | +
46 | +2x | +
+ common <- intersect(x, colnames(df))+ |
+
47 | ++ | + + | +
48 | +2x | +
+ if (length(common) > 0) {+ |
+
49 | +1x | +
+ invisible(NULL)+ |
+
50 | ++ |
+ } else {+ |
+
51 | +1x | +
+ paste(qualifier, "At least one of:", toString(x), "is expected to be a column name of", deparse(substitute(df)))+ |
+
52 | ++ |
+ }+ |
+
53 | ++ |
+ }+ |
+
1 | ++ |
+ # aet10 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn aet10 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' @details+ |
+
8 | ++ |
+ #' * Numbers represent absolute numbers of subject and fraction of `N`, or absolute number of event when specified.+ |
+
9 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
10 | ++ |
+ #' * Split columns by arm.+ |
+
11 | ++ |
+ #' * Does not include a total column by default.+ |
+
12 | ++ |
+ #' * Sort Dictionary-Derived Code (`AEDECOD`) by highest overall frequencies.+ |
+
13 | ++ |
+ #' * Missing values in `AEDECOD` are labeled by `No Coding Available`.+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @note+ |
+
16 | ++ |
+ #' * `adam_db` object must contain an `adae` table with the columns `"AEDECOD"`.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @export+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ aet10_main <- function(adam_db,+ |
+
21 | ++ |
+ arm_var = "ACTARM",+ |
+
22 | ++ |
+ lbl_overall = NULL,+ |
+
23 | ++ |
+ ...) {+ |
+
24 | +1x | +
+ assert_all_tablenames(adam_db, "adsl", "adae")+ |
+
25 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
26 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
27 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
28 | +1x | +
+ assert_valid_variable(adam_db$adae, c(arm_var, "AEBODSYS", "AEDECOD"), types = list(c("character", "factor")))+ |
+
29 | +1x | +
+ assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
30 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)+ |
+
31 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
32 | +1x | +
+ lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")+ |
+
33 | +1x | +
+ lyt <- aet10_lyt(+ |
+
34 | +1x | +
+ arm_var = arm_var,+ |
+
35 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
36 | +1x | +
+ lbl_aedecod = lbl_aedecod+ |
+
37 | ++ |
+ )+ |
+
38 | ++ | + + | +
39 | +1x | +
+ tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)+ |
+
40 | ++ | + + | +
41 | +1x | +
+ tbl+ |
+
42 | ++ |
+ }+ |
+
43 | ++ | + + | +
44 | ++ |
+ #' `aet10` Layout+ |
+
45 | ++ |
+ #'+ |
+
46 | ++ |
+ #' @inheritParams gen_args+ |
+
47 | ++ |
+ #' @param lbl_aedecod (`character`) text label for `AEDECOD`.+ |
+
48 | ++ |
+ #'+ |
+
49 | ++ |
+ #' @keywords internal+ |
+
50 | ++ |
+ #'+ |
+
51 | ++ |
+ aet10_lyt <- function(arm_var,+ |
+
52 | ++ |
+ lbl_overall,+ |
+
53 | ++ |
+ lbl_aedecod) {+ |
+
54 | +3x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
55 | +3x | +
+ split_cols_by(var = arm_var) %>%+ |
+
56 | +3x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
57 | +3x | +
+ count_occurrences(+ |
+
58 | +3x | +
+ vars = "AEDECOD",+ |
+
59 | +3x | +
+ .indent_mods = -1L+ |
+
60 | ++ |
+ ) %>%+ |
+
61 | +3x | +
+ append_topleft(paste0("\n", lbl_aedecod))+ |
+
62 | ++ |
+ }+ |
+
63 | ++ | + + | +
64 | ++ |
+ #' @describeIn aet10 Preprocessing+ |
+
65 | ++ |
+ #'+ |
+
66 | ++ |
+ #' @inheritParams gen_args+ |
+
67 | ++ |
+ #'+ |
+
68 | ++ |
+ #' @export+ |
+
69 | ++ |
+ #'+ |
+
70 | ++ |
+ aet10_pre <- function(adam_db, ...) {+ |
+
71 | +1x | +
+ adam_db$adae <- adam_db$adae %>%+ |
+
72 | +1x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
73 | +1x | +
+ mutate(AEDECOD = reformat(.data$AEDECOD, nocoding))+ |
+
74 | +1x | +
+ return(adam_db)+ |
+
75 | ++ |
+ }+ |
+
76 | ++ | + + | +
77 | ++ |
+ #' @describeIn aet10 Postprocessing+ |
+
78 | ++ |
+ #'+ |
+
79 | ++ |
+ #' @inheritParams gen_args+ |
+
80 | ++ |
+ #' @param atleast given cut-off in numeric format, default is `0.05`+ |
+
81 | ++ |
+ #'+ |
+
82 | ++ |
+ #' @export+ |
+
83 | ++ |
+ #'+ |
+
84 | ++ |
+ aet10_post <- function(tlg, atleast = 0.05, ...) {+ |
+
85 | +1x | +
+ checkmate::assert_number(atleast, lower = 0, upper = 1)+ |
+
86 | +1x | +
+ tbl_sorted <- tlg %>%+ |
+
87 | +1x | +
+ sort_at_path(+ |
+
88 | +1x | +
+ path = c("AEDECOD"),+ |
+
89 | +1x | +
+ scorefun = score_occurrences+ |
+
90 | ++ |
+ )+ |
+
91 | ++ | + + | +
92 | +1x | +
+ tlg_prune <- prune_table(+ |
+
93 | +1x | +
+ tt = tbl_sorted,+ |
+
94 | +1x | +
+ prune_func = keep_rows(+ |
+
95 | +1x | +
+ has_fraction_in_any_col(+ |
+
96 | +1x | +
+ atleast = atleast+ |
+
97 | ++ |
+ )+ |
+
98 | ++ |
+ )+ |
+
99 | ++ |
+ )+ |
+
100 | ++ | + + | +
101 | +1x | +
+ std_postprocess(tlg_prune)+ |
+
102 | ++ |
+ }+ |
+
103 | ++ | + + | +
104 | ++ |
+ #' `AET10` Table 1 (Default) Most Common (xx%) Adverse Events Preferred Terms Table 1+ |
+
105 | ++ |
+ #'+ |
+
106 | ++ |
+ #' The `AET10` table Include Adverse Events occurring with user-specified threshold X% in at least+ |
+
107 | ++ |
+ #' one of the treatment groups. Standard table summarized by preferred term (PT).+ |
+
108 | ++ |
+ #' Order the data by total column frequency from most to least frequently reported PT (regardless of SOC).+ |
+
109 | ++ |
+ #'+ |
+
110 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
111 | ++ |
+ #' @export+ |
+
112 | ++ |
+ #'+ |
+
113 | ++ |
+ #' @examples+ |
+
114 | ++ |
+ #' run(aet10, syn_data)+ |
+
115 | ++ |
+ aet10 <- chevron_t(+ |
+
116 | ++ |
+ main = aet10_main,+ |
+
117 | ++ |
+ lyt = aet10_lyt,+ |
+
118 | ++ |
+ preprocess = aet10_pre,+ |
+
119 | ++ |
+ postprocess = aet10_post+ |
+
120 | ++ |
+ )+ |
+
1 | ++ |
+ # aet02 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn aet02 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' @details+ |
+
8 | ++ |
+ #' * Numbers represent absolute numbers of subject and fraction of `N`, or absolute number of event when specified.+ |
+
9 | ++ |
+ #' * Remove zero-count rows unless overridden with `prune_0 = FALSE`.+ |
+
10 | ++ |
+ #' * Split columns by arm.+ |
+
11 | ++ |
+ #' * Does not include a total column by default.+ |
+
12 | ++ |
+ #' * Sort Dictionary-Derived Code (`AEDECOD`) by highest overall frequencies.+ |
+
13 | ++ |
+ #' * Missing values in `AEBODSYS`, and `AEDECOD` are labeled by `No Coding Available`.+ |
+
14 | ++ |
+ #'+ |
+
15 | ++ |
+ #' @note+ |
+
16 | ++ |
+ #' * `adam_db` object must contain an `adae` table with the columns `"AEBODSYS"` and `"AEDECOD"`.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ #' @export+ |
+
20 | ++ |
+ #'+ |
+
21 | ++ |
+ aet02_main <- function(adam_db,+ |
+
22 | ++ |
+ arm_var = "ACTARM",+ |
+
23 | ++ |
+ row_split_var = "AEBODSYS",+ |
+
24 | ++ |
+ lbl_overall = NULL,+ |
+
25 | ++ |
+ ...) {+ |
+
26 | +1x | +
+ assert_all_tablenames(adam_db, "adsl", "adae")+ |
+
27 | +1x | +
+ checkmate::assert_character(row_split_var, null.ok = TRUE)+ |
+
28 | +1x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
29 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
30 | +1x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
31 | +1x | +
+ assert_valid_variable(adam_db$adae, c(arm_var, row_split_var, "AEDECOD"), types = list(c("character", "factor")))+ |
+
32 | +1x | +
+ assert_valid_variable(adam_db$adae, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
33 | +1x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adae, arm_var)+ |
+
34 | ++ | + + | +
35 | +1x | +
+ lbl_row_split <- var_labels_for(adam_db$adae, row_split_var)+ |
+
36 | +1x | +
+ lbl_aedecod <- var_labels_for(adam_db$adae, "AEDECOD")+ |
+
37 | +1x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
38 | +1x | +
+ lyt <- aet02_lyt(+ |
+
39 | +1x | +
+ arm_var = arm_var,+ |
+
40 | +1x | +
+ lbl_overall = lbl_overall,+ |
+
41 | +1x | +
+ row_split_var = row_split_var,+ |
+
42 | +1x | +
+ lbl_row_split = lbl_row_split,+ |
+
43 | +1x | +
+ lbl_aedecod = lbl_aedecod+ |
+
44 | ++ |
+ )+ |
+
45 | ++ | + + | +
46 | +1x | +
+ tbl <- build_table(lyt, adam_db$adae, alt_counts_df = adam_db$adsl)+ |
+
47 | ++ | + + | +
48 | +1x | +
+ tbl+ |
+
49 | ++ |
+ }+ |
+
50 | ++ | + + | +
51 | ++ |
+ #' `aet02` Layout+ |
+
52 | ++ |
+ #'+ |
+
53 | ++ |
+ #' @inheritParams aet02_main+ |
+
54 | ++ |
+ #' @param lbl_row_split (`character`) label for `row_split_var`.+ |
+
55 | ++ |
+ #' @param lbl_aedecod (`string`) text label for `AEDECOD`.+ |
+
56 | ++ |
+ #'+ |
+
57 | ++ |
+ #' @keywords internal+ |
+
58 | ++ |
+ #'+ |
+
59 | ++ |
+ aet02_lyt <- function(arm_var,+ |
+
60 | ++ |
+ lbl_overall,+ |
+
61 | ++ |
+ row_split_var,+ |
+
62 | ++ |
+ lbl_row_split,+ |
+
63 | ++ |
+ lbl_aedecod) {+ |
+
64 | +5x | +
+ lyt <- basic_table(show_colcounts = TRUE) %>%+ |
+
65 | +5x | +
+ split_cols_by(var = arm_var) %>%+ |
+
66 | +5x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
67 | +5x | +
+ analyze_num_patients(+ |
+
68 | +5x | +
+ vars = "USUBJID",+ |
+
69 | +5x | +
+ .stats = c("unique", "nonunique"),+ |
+
70 | +5x | +
+ show_labels = "hidden",+ |
+
71 | +5x | +
+ .labels = c(+ |
+
72 | +5x | +
+ unique = render_safe("Total number of {patient_label} with at least one adverse event"),+ |
+
73 | +5x | +
+ nonunique = "Overall total number of events"+ |
+
74 | ++ |
+ )+ |
+
75 | ++ |
+ )+ |
+
76 | +5x | +
+ for (k in seq_len(length(row_split_var))) {+ |
+
77 | +5x | +
+ lyt <- split_and_summ_num_patients(lyt, row_split_var[k], lbl_row_split[k],+ |
+
78 | +5x | +
+ stats = c("unique", "nonunique"),+ |
+
79 | +5x | +
+ summarize_labels = render_safe(+ |
+
80 | +5x | +
+ c("Total number of {patient_label} with at least one adverse event", "Total number of events")+ |
+
81 | ++ |
+ )+ |
+
82 | ++ |
+ )+ |
+
83 | ++ |
+ }+ |
+
84 | +5x | +
+ lyt %>%+ |
+
85 | +5x | +
+ count_occurrences(+ |
+
86 | +5x | +
+ vars = "AEDECOD",+ |
+
87 | +5x | +
+ drop = length(row_split_var) > 0,+ |
+
88 | +5x | +
+ .indent_mods = -1L+ |
+
89 | ++ |
+ ) %>%+ |
+
90 | +5x | +
+ append_topleft(paste0(stringr::str_dup(" ", 2 * length(row_split_var)), lbl_aedecod))+ |
+
91 | ++ |
+ }+ |
+
92 | ++ | + + | +
93 | ++ |
+ #' @describeIn aet02 Preprocessing+ |
+
94 | ++ |
+ #'+ |
+
95 | ++ |
+ #' @inheritParams gen_args+ |
+
96 | ++ |
+ #'+ |
+
97 | ++ |
+ #' @export+ |
+
98 | ++ |
+ #'+ |
+
99 | ++ |
+ aet02_pre <- function(adam_db, row_split_var = "AEBODSYS", ...) {+ |
+
100 | +1x | +
+ adam_db$adae <- adam_db$adae %>%+ |
+
101 | +1x | +
+ filter(.data$ANL01FL == "Y") %>%+ |
+
102 | +1x | +
+ mutate(AEDECOD = reformat(.data$AEDECOD, nocoding)) %>%+ |
+
103 | +1x | +
+ mutate(across(all_of(row_split_var), ~ reformat(.x, nocoding)))+ |
+
104 | ++ | + + | +
105 | +1x | +
+ adam_db+ |
+
106 | ++ |
+ }+ |
+
107 | ++ | + + | +
108 | ++ |
+ #' @describeIn aet02 Postprocessing+ |
+
109 | ++ |
+ #'+ |
+
110 | ++ |
+ #' @inheritParams gen_args+ |
+
111 | ++ |
+ #'+ |
+
112 | ++ |
+ #' @export+ |
+
113 | ++ |
+ #'+ |
+
114 | ++ |
+ aet02_post <- function(tlg, row_split_var = "AEBODSYS", prune_0 = TRUE, ...) {+ |
+
115 | +1x | +
+ tlg <- tlg %>%+ |
+
116 | +1x | +
+ tlg_sort_by_vars(row_split_var, cont_n_allcols) %>%+ |
+
117 | +1x | +
+ valid_sort_at_path(+ |
+
118 | +1x | +
+ path = c(get_sort_path(c(row_split_var, "AEDECOD"))),+ |
+
119 | +1x | +
+ scorefun = score_occurrences+ |
+
120 | ++ |
+ )+ |
+
121 | +1x | +
+ if (prune_0) {+ |
+
122 | +1x | +
+ tlg <- smart_prune(tlg)+ |
+
123 | ++ |
+ }+ |
+
124 | +1x | +
+ std_postprocess(tlg)+ |
+
125 | ++ |
+ }+ |
+
126 | ++ | + + | +
127 | ++ |
+ #' `AET02` Table 1 (Default) Adverse Events by System Organ Class and Preferred Term Table 1+ |
+
128 | ++ |
+ #'+ |
+
129 | ++ |
+ #' The `AET02` table provides an overview of the number of subjects experiencing adverse events and the number of advert+ |
+
130 | ++ |
+ #' events categorized by Body System and Dictionary-Derived Term.+ |
+
131 | ++ |
+ #'+ |
+
132 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
133 | ++ |
+ #' @export+ |
+
134 | ++ |
+ #'+ |
+
135 | ++ |
+ #' @examples+ |
+
136 | ++ |
+ #' run(aet02, syn_data)+ |
+
137 | ++ |
+ aet02 <- chevron_t(+ |
+
138 | ++ |
+ main = aet02_main,+ |
+
139 | ++ |
+ preprocess = aet02_pre,+ |
+
140 | ++ |
+ postprocess = aet02_post+ |
+
141 | ++ |
+ )+ |
+
1 | ++ |
+ # vst02_1 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn vst02_1 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param exclude_base_abn (`flag`) whether baseline abnormality should be excluded.+ |
+
7 | ++ |
+ #'+ |
+
8 | ++ |
+ #' @details+ |
+
9 | ++ |
+ #' * Only count LOW or HIGH values.+ |
+
10 | ++ |
+ #' * Results of "LOW LOW" are treated as the same as "LOW", and "HIGH HIGH" the same as "HIGH".+ |
+
11 | ++ |
+ #' * Does not include a total column by default.+ |
+
12 | ++ |
+ #' * Does not remove zero-count rows unless overridden with `prune_0 = TRUE`.+ |
+
13 | ++ |
+ #'+ |
+
14 | ++ |
+ #' @note+ |
+
15 | ++ |
+ #' * `adam_db` object must contain an `advs` table with the `"PARAM"`, `"ANRIND"` and `"BNRIND"` columns.+ |
+
16 | ++ |
+ #'+ |
+
17 | ++ |
+ #' @export+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ vst02_1_main <- function(adam_db,+ |
+
20 | ++ |
+ arm_var = "ACTARM",+ |
+
21 | ++ |
+ lbl_overall = NULL,+ |
+
22 | ++ |
+ exclude_base_abn = FALSE,+ |
+
23 | ++ |
+ ...) {+ |
+
24 | +2x | +
+ assert_all_tablenames(adam_db, "adsl", "advs")+ |
+
25 | +2x | +
+ checkmate::assert_string(arm_var)+ |
+
26 | +2x | +
+ checkmate::assert_flag(exclude_base_abn)+ |
+
27 | +2x | +
+ checkmate::assert_string(lbl_overall, null.ok = TRUE)+ |
+
28 | ++ | + + | +
29 | +2x | +
+ assert_valid_variable(adam_db$advs, c(arm_var, "PARAM", "ANRIND", "BNRIND"), types = list(c("character", "factor")))+ |
+
30 | +2x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
31 | +2x | +
+ assert_valid_variable(adam_db$advs, "USUBJID", empty_ok = TRUE, types = list(c("character", "factor")))+ |
+
32 | +2x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$advs, arm_var)+ |
+
33 | ++ | + + | +
34 | +2x | +
+ lbl_vs_assessment <- var_labels_for(adam_db$advs, "PARAM")+ |
+
35 | +2x | +
+ lbl_vs_abnormality <- var_labels_for(adam_db$advs, "ANRIND")+ |
+
36 | +2x | +
+ lbl_overall <- render_safe(lbl_overall)+ |
+
37 | +2x | +
+ lyt <- vst02_lyt(+ |
+
38 | +2x | +
+ arm_var = arm_var,+ |
+
39 | +2x | +
+ exclude_base_abn = exclude_base_abn,+ |
+
40 | +2x | +
+ lbl_vs_assessment = lbl_vs_assessment,+ |
+
41 | +2x | +
+ lbl_vs_abnormality = lbl_vs_abnormality,+ |
+
42 | +2x | +
+ lbl_overall = lbl_overall+ |
+
43 | ++ |
+ )+ |
+
44 | ++ | + + | +
45 | +2x | +
+ tbl <- build_table(lyt, adam_db$advs, alt_counts_df = adam_db$adsl)+ |
+
46 | +2x | +
+ tbl+ |
+
47 | ++ |
+ }+ |
+
48 | ++ | + + | +
49 | ++ |
+ #' `vst02_1` Layout+ |
+
50 | ++ |
+ #'+ |
+
51 | ++ |
+ #' @inheritParams gen_args+ |
+
52 | ++ |
+ #' @param lbl_vs_assessment (`string`) the label of the assessment variable.+ |
+
53 | ++ |
+ #' @param lbl_vs_abnormality (`string`) the label of the abnormality variable.+ |
+
54 | ++ |
+ #' @param exclude_base_abn (`flag`) whether to exclude subjects with baseline abnormality from numerator and+ |
+
55 | ++ |
+ #' denominator.+ |
+
56 | ++ |
+ #'+ |
+
57 | ++ |
+ #' @keywords internal+ |
+
58 | ++ |
+ #'+ |
+
59 | ++ |
+ vst02_lyt <- function(arm_var,+ |
+
60 | ++ |
+ exclude_base_abn,+ |
+
61 | ++ |
+ lbl_vs_assessment,+ |
+
62 | ++ |
+ lbl_vs_abnormality,+ |
+
63 | ++ |
+ lbl_overall) {+ |
+
64 | +4x | +
+ basic_table(show_colcounts = TRUE) %>%+ |
+
65 | +4x | +
+ split_cols_by(var = arm_var) %>%+ |
+
66 | +4x | +
+ add_colcounts() %>%+ |
+
67 | +4x | +
+ ifneeded_add_overall_col(lbl_overall) %>%+ |
+
68 | +4x | +
+ split_rows_by("PARAM", split_fun = drop_split_levels, label_pos = "topleft", split_label = lbl_vs_assessment) %>%+ |
+
69 | +4x | +
+ count_abnormal(+ |
+
70 | +4x | +
+ "ANRIND",+ |
+
71 | +4x | +
+ abnormal = list(Low = "LOW", High = "HIGH"),+ |
+
72 | +4x | +
+ variables = list(id = "USUBJID", baseline = "BNRIND"),+ |
+
73 | +4x | +
+ exclude_base_abn = exclude_base_abn+ |
+
74 | ++ |
+ ) %>%+ |
+
75 | +4x | +
+ append_topleft(paste0(" ", lbl_vs_abnormality))+ |
+
76 | ++ |
+ }+ |
+
77 | ++ | + + | +
78 | ++ |
+ #' @describeIn vst02_1 Preprocessing+ |
+
79 | ++ |
+ #'+ |
+
80 | ++ |
+ #' @inheritParams gen_args+ |
+
81 | ++ |
+ #'+ |
+
82 | ++ |
+ #' @export+ |
+
83 | ++ |
+ #'+ |
+
84 | ++ |
+ vst02_pre <- function(adam_db, ...) {+ |
+
85 | +2x | +
+ high_low_format <- rule(+ |
+
86 | +2x | +
+ HIGH = c("HIGH HIGH", "HIGH"),+ |
+
87 | +2x | +
+ LOW = c("LOW LOW", "LOW")+ |
+
88 | ++ |
+ )+ |
+
89 | +2x | +
+ adam_db$advs <- adam_db$advs %>%+ |
+
90 | +2x | +
+ filter(.data$ONTRTFL == "Y") %>%+ |
+
91 | +2x | +
+ mutate(+ |
+
92 | +2x | +
+ PARAM = with_label(.data$PARAM, "Assessment"),+ |
+
93 | +2x | +
+ ANRIND = with_label(reformat(.data$ANRIND, high_low_format), "Abnormality"),+ |
+
94 | +2x | +
+ BNRIND = reformat(.data$BNRIND, high_low_format)+ |
+
95 | ++ |
+ )+ |
+
96 | +2x | +
+ adam_db+ |
+
97 | ++ |
+ }+ |
+
98 | ++ | + + | +
99 | ++ |
+ #' @describeIn vst02_1 Postprocessing+ |
+
100 | ++ |
+ #'+ |
+
101 | ++ |
+ #' @inheritParams gen_args+ |
+
102 | ++ |
+ #'+ |
+
103 | ++ |
+ #' @export+ |
+
104 | ++ |
+ #'+ |
+
105 | ++ |
+ vst02_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
106 | +2x | +
+ if (prune_0) {+ |
+
107 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
108 | ++ |
+ }+ |
+
109 | +2x | +
+ std_postprocess(tlg)+ |
+
110 | ++ |
+ }+ |
+
111 | ++ | + + | +
112 | ++ |
+ #' `VST02` Vital Sign Abnormalities Table.+ |
+
113 | ++ |
+ #'+ |
+
114 | ++ |
+ #' Vital Sign Parameters outside Normal Limits Regardless of Abnormality at Baseline.+ |
+
115 | ++ |
+ #'+ |
+
116 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
117 | ++ |
+ #' @export+ |
+
118 | ++ |
+ #'+ |
+
119 | ++ |
+ #' @examples+ |
+
120 | ++ |
+ #' run(vst02_1, syn_data)+ |
+
121 | ++ |
+ vst02_1 <- chevron_t(+ |
+
122 | ++ |
+ main = vst02_1_main,+ |
+
123 | ++ |
+ preprocess = vst02_pre,+ |
+
124 | ++ |
+ postprocess = vst02_post+ |
+
125 | ++ |
+ )+ |
+
126 | ++ | + + | +
127 | ++ |
+ # vst02_2 ----+ |
+
128 | ++ | + + | +
129 | ++ |
+ #' @describeIn vst02_2 Main TLG function+ |
+
130 | ++ |
+ #' @inherit vst02_1_main+ |
+
131 | ++ |
+ #' @export+ |
+
132 | ++ |
+ #'+ |
+
133 | ++ |
+ vst02_2_main <- modify_default_args(vst02_1_main, exclude_base_abn = TRUE)+ |
+
134 | ++ |
+ #' `VST02` Vital Sign Abnormalities Table.+ |
+
135 | ++ |
+ #'+ |
+
136 | ++ |
+ #' Vital Sign Parameters outside Normal Limits Among Patients without Abnormality at Baseline.+ |
+
137 | ++ |
+ #'+ |
+
138 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
139 | ++ |
+ #' @export+ |
+
140 | ++ |
+ #'+ |
+
141 | ++ |
+ #' @examples+ |
+
142 | ++ |
+ #' run(vst02_2, syn_data)+ |
+
143 | ++ |
+ vst02_2 <- chevron_t(+ |
+
144 | ++ |
+ main = vst02_2_main,+ |
+
145 | ++ |
+ preprocess = vst02_pre,+ |
+
146 | ++ |
+ postprocess = vst02_post+ |
+
147 | ++ |
+ )+ |
+
1 | ++ |
+ # ael01_nollt ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn ael01_nollt Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param dataset (`character`) the name of a table in the `adam_db` object.+ |
+
7 | ++ |
+ #' @param default_formatting (`list`) the default format of the listing columns. See [`rlistings::as_listing`].+ |
+
8 | ++ |
+ #' @param col_formatting (`list`) the format of specific listing columns. See [`rlistings::as_listing`].+ |
+
9 | ++ |
+ #'+ |
+
10 | ++ |
+ #' @details+ |
+
11 | ++ |
+ #' * Removes duplicate rows.+ |
+
12 | ++ |
+ #' * By default, uses dataset `adae`, sorting by key columns `AEBODSYS` and `AEDECOD`.+ |
+
13 | ++ |
+ #' * If using with a dataset other than `adae`, be sure to specify the desired labels for variables in+ |
+
14 | ++ |
+ #' `key_cols` and `disp_cols`, and pre-process missing data.+ |
+
15 | ++ |
+ #'+ |
+
16 | ++ |
+ #' @note+ |
+
17 | ++ |
+ #' * `adam_db` object must contain the `dataset` table with columns specified by `key_cols` and `disp_cols`.+ |
+
18 | ++ |
+ #'+ |
+
19 | ++ |
+ #' @export+ |
+
20 | ++ |
+ #'+ |
+
21 | ++ |
+ ael01_nollt_main <- function(adam_db,+ |
+
22 | ++ |
+ dataset = "adae",+ |
+
23 | ++ |
+ key_cols = c("AEBODSYS", "AEDECOD"),+ |
+
24 | ++ |
+ disp_cols = "AETERM",+ |
+
25 | ++ |
+ default_formatting = list(+ |
+
26 | ++ |
+ all = formatters::fmt_config(align = "left"),+ |
+
27 | ++ |
+ numeric = formatters::fmt_config(align = "center")+ |
+
28 | ++ |
+ ),+ |
+
29 | ++ |
+ col_formatting = NULL,+ |
+
30 | ++ |
+ ...) {+ |
+
31 | +1x | +
+ assert_all_tablenames(adam_db, dataset)+ |
+
32 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], c(key_cols, disp_cols), label = paste0("adam_db$", dataset))+ |
+
33 | +1x | +
+ checkmate::assert_list(default_formatting)+ |
+
34 | +1x | +
+ checkmate::assert_list(col_formatting, null.ok = TRUE)+ |
+
35 | ++ | + + | +
36 | +1x | +
+ as_listing(+ |
+
37 | +1x | +
+ adam_db[[dataset]],+ |
+
38 | +1x | +
+ key_cols = key_cols,+ |
+
39 | +1x | +
+ disp_cols = disp_cols,+ |
+
40 | +1x | +
+ default_formatting = default_formatting,+ |
+
41 | +1x | +
+ col_formatting = col_formatting+ |
+
42 | ++ |
+ )+ |
+
43 | ++ |
+ }+ |
+
44 | ++ | + + | +
45 | ++ |
+ #' @describeIn ael01_nollt Preprocessing+ |
+
46 | ++ |
+ #'+ |
+
47 | ++ |
+ #' @inheritParams ael01_nollt_main+ |
+
48 | ++ |
+ #'+ |
+
49 | ++ |
+ #' @export+ |
+
50 | ++ |
+ #'+ |
+
51 | ++ |
+ ael01_nollt_pre <- function(adam_db,+ |
+
52 | ++ |
+ dataset = "adae",+ |
+
53 | ++ |
+ key_cols = c("AEBODSYS", "AEDECOD"),+ |
+
54 | ++ |
+ disp_cols = "AETERM",+ |
+
55 | ++ |
+ ...) {+ |
+
56 | +1x | +
+ adam_db[[dataset]] <- adam_db[[dataset]] %>%+ |
+
57 | +1x | +
+ select(all_of(c(key_cols, disp_cols))) %>%+ |
+
58 | +1x | +
+ distinct() %>%+ |
+
59 | +1x | +
+ mutate(+ |
+
60 | +1x | +
+ across(all_of(c(key_cols, disp_cols)), ~ reformat(.x, nocoding))+ |
+
61 | ++ |
+ ) %>%+ |
+
62 | +1x | +
+ arrange(pick(all_of(c(key_cols, disp_cols))))+ |
+
63 | ++ | + + | +
64 | +1x | +
+ adam_db+ |
+
65 | ++ |
+ }+ |
+
66 | ++ | + + | +
67 | ++ |
+ #' @describeIn ael01_nollt Postprocessing+ |
+
68 | ++ |
+ #'+ |
+
69 | ++ |
+ #' @inheritParams gen_args+ |
+
70 | ++ |
+ #'+ |
+
71 | ++ |
+ ael01_nollt_post <- function(tlg, ...) {+ |
+
72 | +! | +
+ if (nrow(tlg) == 0) tlg <- null_listing+ |
+
73 | ++ | + + | +
74 | +1x | +
+ tlg+ |
+
75 | ++ |
+ }+ |
+
76 | ++ | + + | +
77 | ++ |
+ #' `AEL01_NOLLT` Listing 1 (Default) Glossary of Preferred Terms and Investigator-Specified Terms.+ |
+
78 | ++ |
+ #'+ |
+
79 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
80 | ++ |
+ #' @export+ |
+
81 | ++ |
+ #'+ |
+
82 | ++ |
+ #' @examples+ |
+
83 | ++ |
+ #' run(ael01_nollt, syn_data)+ |
+
84 | ++ |
+ ael01_nollt <- chevron_l(+ |
+
85 | ++ |
+ main = ael01_nollt_main,+ |
+
86 | ++ |
+ preprocess = ael01_nollt_pre,+ |
+
87 | ++ |
+ postprocess = ael01_nollt_post+ |
+
88 | ++ |
+ )+ |
+
1 | ++ |
+ # fstg01 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn fstg01 Main TLG Function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @details+ |
+
6 | ++ |
+ #' * No overall value.+ |
+
7 | ++ |
+ #' * Keep zero count rows by default.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @inheritParams gen_args+ |
+
10 | ++ |
+ #' @param dataset (`string`) the name of a table in the `adam_db` object.+ |
+
11 | ++ |
+ #' @param arm_var (`string`) the arm variable name used for group splitting.+ |
+
12 | ++ |
+ #' @param rsp_var (`string`) the response variable name to flag whether each subject is a binary response or not.+ |
+
13 | ++ |
+ #' @param subgroups (`character`) the subgroups variable name to list baseline risk factors.+ |
+
14 | ++ |
+ #' @param strata_var (`character`) required if stratified analysis is performed.+ |
+
15 | ++ |
+ #' @param ... Further arguments passed to `g_forest` and `extract_rsp_subgroups` (a wrapper for+ |
+
16 | ++ |
+ #' `h_odds_ratio_subgroups_df` and `h_proportion_subgroups_df`). For details, see the documentation in `tern`.+ |
+
17 | ++ |
+ #' Commonly used arguments include `col_symbol_size`, `col`, `vline`, `groups_lists`, `conf_level`,+ |
+
18 | ++ |
+ #' `method`, `label_all`, etc.+ |
+
19 | ++ |
+ #'+ |
+
20 | ++ |
+ #' @note+ |
+
21 | ++ |
+ #' * `adam_db` object must contain the table specified by `dataset` with `"PARAMCD"`, `"ARM"`,+ |
+
22 | ++ |
+ #' `"AVALC"`, and the columns specified by `subgroups` which is denoted as+ |
+
23 | ++ |
+ #' `c("SEX", "AGEGR1", "RACE")` by default.+ |
+
24 | ++ |
+ #'+ |
+
25 | ++ |
+ #' @return a `gTree` object.+ |
+
26 | ++ |
+ #' @export+ |
+
27 | ++ |
+ fstg01_main <- function(adam_db,+ |
+
28 | ++ |
+ dataset = "adrs",+ |
+
29 | ++ |
+ arm_var = "ARM",+ |
+
30 | ++ |
+ rsp_var = "is_rsp",+ |
+
31 | ++ |
+ subgroups = c("SEX", "AGEGR1", "RACE"),+ |
+
32 | ++ |
+ strata_var = NULL,+ |
+
33 | ++ |
+ ...) {+ |
+
34 | +1x | +
+ assert_all_tablenames(adam_db, c("adsl", dataset))+ |
+
35 | +1x | +
+ df_lbl <- paste0("adam_db$", dataset)+ |
+
36 | +1x | +
+ checkmate::assert_string(arm_var)+ |
+
37 | +1x | +
+ checkmate::assert_string(rsp_var)+ |
+
38 | +1x | +
+ checkmate::assert_character(subgroups, null.ok = TRUE)+ |
+
39 | +1x | +
+ checkmate::assert_character(strata_var, null.ok = TRUE)+ |
+
40 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], arm_var, types = list("factor"), n.levels = 2, label = df_lbl)+ |
+
41 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], c("USUBJID", "PARAMCD"),+ |
+
42 | +1x | +
+ types = list(c("character", "factor")),+ |
+
43 | +1x | +
+ label = df_lbl+ |
+
44 | ++ |
+ )+ |
+
45 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], rsp_var, types = list("logical"), label = df_lbl)+ |
+
46 | +1x | +
+ assert_valid_variable(adam_db[[dataset]], c(subgroups, strata_var),+ |
+
47 | +1x | +
+ types = list(c("factor")), na_ok = TRUE,+ |
+
48 | +1x | +
+ label = df_lbl+ |
+
49 | ++ |
+ )+ |
+
50 | +1x | +
+ assert_single_value(adam_db[[dataset]]$PARAMCD, label = df_lbl)+ |
+
51 | ++ | + + | +
52 | +1x | +
+ variables <- list(+ |
+
53 | +1x | +
+ arm = arm_var,+ |
+
54 | +1x | +
+ rsp = rsp_var,+ |
+
55 | +1x | +
+ subgroups = subgroups,+ |
+
56 | +1x | +
+ strata_var = strata_var+ |
+
57 | ++ |
+ )+ |
+
58 | ++ | + + | +
59 | +1x | +
+ df <- execute_with_args(extract_rsp_subgroups,+ |
+
60 | +1x | +
+ variables = variables,+ |
+
61 | +1x | +
+ data = adam_db[[dataset]],+ |
+
62 | ++ |
+ ...+ |
+
63 | ++ |
+ )+ |
+
64 | ++ | + + | +
65 | +1x | +
+ result <- basic_table() %>%+ |
+
66 | +1x | +
+ tabulate_rsp_subgroups(df, vars = c("n_tot", "n", "n_rsp", "prop", "or", "ci"))+ |
+
67 | ++ | + + | +
68 | +1x | +
+ execute_with_args(+ |
+
69 | +1x | +
+ g_forest,+ |
+
70 | +1x | +
+ tbl = result,+ |
+
71 | ++ |
+ ...+ |
+
72 | ++ |
+ )+ |
+
73 | ++ |
+ }+ |
+
74 | ++ | + + | +
75 | ++ |
+ #' @describeIn fstg01 Preprocessing+ |
+
76 | ++ |
+ #'+ |
+
77 | ++ |
+ #' @inheritParams fstg01_main+ |
+
78 | ++ |
+ #'+ |
+
79 | ++ |
+ #' @export+ |
+
80 | ++ |
+ fstg01_pre <- function(adam_db, ...) {+ |
+
81 | +1x | +
+ adam_db$adrs <- adam_db$adrs %>%+ |
+
82 | +1x | +
+ mutate(+ |
+
83 | +1x | +
+ ARM = droplevels(.data$ARM),+ |
+
84 | +1x | +
+ is_rsp = .data$AVALC %in% c("CR", "PR")+ |
+
85 | ++ |
+ )+ |
+
86 | +1x | +
+ adam_db+ |
+
87 | ++ |
+ }+ |
+
88 | ++ | + + | +
89 | ++ |
+ #' @describeIn fstg01 Postprocessing+ |
+
90 | ++ |
+ #'+ |
+
91 | ++ |
+ #' @inheritParams gen_args+ |
+
92 | ++ |
+ #'+ |
+
93 | ++ |
+ #' @export+ |
+
94 | ++ |
+ fstg01_post <- function(tlg, ...) {+ |
+
95 | +! | +
+ tlg+ |
+
96 | ++ |
+ }+ |
+
97 | ++ | + + | +
98 | ++ |
+ # `fstg01` Pipeline ----+ |
+
99 | ++ | + + | +
100 | ++ |
+ #' `FSTG01` Subgroup Analysis of Best Overall Response.+ |
+
101 | ++ |
+ #'+ |
+
102 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
103 | ++ |
+ #' @export+ |
+
104 | ++ |
+ #'+ |
+
105 | ++ |
+ #' @examples+ |
+
106 | ++ |
+ #' library(dplyr)+ |
+
107 | ++ |
+ #' library(dunlin)+ |
+
108 | ++ |
+ #'+ |
+
109 | ++ |
+ #' proc_data <- log_filter(+ |
+
110 | ++ |
+ #' syn_data,+ |
+
111 | ++ |
+ #' PARAMCD == "BESRSPI" & ARM %in% c("A: Drug X", "B: Placebo"), "adrs"+ |
+
112 | ++ |
+ #' )+ |
+
113 | ++ |
+ #' run(fstg01, proc_data,+ |
+
114 | ++ |
+ #' subgroups = c("SEX", "AGEGR1", "RACE"),+ |
+
115 | ++ |
+ #' conf_level = 0.90, dataset = "adrs"+ |
+
116 | ++ |
+ #' )+ |
+
117 | ++ |
+ fstg01 <- chevron_g(+ |
+
118 | ++ |
+ main = fstg01_main,+ |
+
119 | ++ |
+ preproces = fstg01_pre,+ |
+
120 | ++ |
+ postprocess = fstg01_post+ |
+
121 | ++ |
+ )+ |
+
1 | ++ |
+ # aet05 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn aet05 Main TLG function+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #' @param arm_var (`string`) the arm variable used for arm splitting.+ |
+
7 | ++ |
+ #' @param ... Further arguments passed to `tern::control_incidence_rate()`.+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ #' @details+ |
+
10 | ++ |
+ #' * Total patient-years at risk is the sum over all patients of the time intervals (in years).+ |
+
11 | ++ |
+ #' * Split columns by arm, typically `ACTARM`.+ |
+
12 | ++ |
+ #' * Split rows by parameter code.+ |
+
13 | ++ |
+ #' * `AVAL` is patient-years at risk.+ |
+
14 | ++ |
+ #' * `n_events` is the number of adverse events observed.+ |
+
15 | ++ |
+ #' * The table allows confidence level to be adjusted, default is 95%.+ |
+
16 | ++ |
+ #' * Keep zero count rows by default.+ |
+
17 | ++ |
+ #'+ |
+
18 | ++ |
+ #' @note+ |
+
19 | ++ |
+ #' * `adam_db` object must contain an `adaette` table with the columns `"PARAMCD"`, `"PARAM"`, `"AVAL"`, and `"CNSR"`.+ |
+
20 | ++ |
+ #'+ |
+
21 | ++ |
+ #'+ |
+
22 | ++ |
+ #' @export+ |
+
23 | ++ |
+ #'+ |
+
24 | ++ |
+ aet05_main <- function(adam_db,+ |
+
25 | ++ |
+ arm_var = "ACTARM",+ |
+
26 | ++ |
+ ...) {+ |
+
27 | +2x | +
+ assert_all_tablenames(adam_db, c("adsl", "adaette"))+ |
+
28 | +2x | +
+ checkmate::assert_string(arm_var)+ |
+
29 | +2x | +
+ assert_valid_variable(adam_db$adsl, c("USUBJID", arm_var), types = list(c("character", "factor")))+ |
+
30 | +2x | +
+ assert_valid_variable(adam_db$adaette, c("USUBJID", arm_var, "PARAMCD", "PARAM"),+ |
+
31 | +2x | +
+ types = list(c("character", "factor"))+ |
+
32 | ++ |
+ )+ |
+
33 | +2x | +
+ assert_valid_variable(adam_db$adaette, "AVAL", types = list("numeric"), lower = 0, na_ok = TRUE)+ |
+
34 | +2x | +
+ assert_valid_variable(adam_db$adaette, "n_events", types = list("numeric"), integerish = TRUE, lower = 0L)+ |
+
35 | +2x | +
+ assert_valid_var_pair(adam_db$adsl, adam_db$adaette, arm_var)+ |
+
36 | +2x | +
+ control <- execute_with_args(control_incidence_rate, ...)+ |
+
37 | ++ | + + | +
38 | +2x | +
+ lyt <- aet05_lyt(+ |
+
39 | +2x | +
+ arm_var = arm_var,+ |
+
40 | +2x | +
+ param_label = "PARAM",+ |
+
41 | +2x | +
+ vars = "AVAL",+ |
+
42 | +2x | +
+ n_events = "n_events",+ |
+
43 | +2x | +
+ control = control+ |
+
44 | ++ |
+ )+ |
+
45 | ++ | + + | +
46 | +2x | +
+ tbl <- build_table(lyt, adam_db$adaette, alt_counts_df = adam_db$adsl)+ |
+
47 | ++ | + + | +
48 | +2x | +
+ tbl+ |
+
49 | ++ |
+ }+ |
+
50 | ++ | + + | +
51 | ++ |
+ #' `aet05` Layout+ |
+
52 | ++ |
+ #'+ |
+
53 | ++ |
+ #' @inheritParams gen_args+ |
+
54 | ++ |
+ #' @param param_label (`string`) variable for parameter code.+ |
+
55 | ++ |
+ #' @param vars (`string`) variable for the primary analysis variable to be iterated over.+ |
+
56 | ++ |
+ #' @param n_events (`string`) variable to count the number of events observed.+ |
+
57 | ++ |
+ #' @param control (`list`) parameters for estimation details, specified by using the helper function+ |
+
58 | ++ |
+ #' control_incidence_rate().+ |
+
59 | ++ |
+ #'+ |
+
60 | ++ |
+ #' @keywords internal+ |
+
61 | ++ |
+ #'+ |
+
62 | ++ |
+ aet05_lyt <- function(arm_var,+ |
+
63 | ++ |
+ param_label,+ |
+
64 | ++ |
+ vars,+ |
+
65 | ++ |
+ n_events,+ |
+
66 | ++ |
+ control) {+ |
+
67 | +6x | +
+ lyt <- basic_table(show_colcounts = TRUE) %>%+ |
+
68 | +6x | +
+ split_cols_by(arm_var) %>%+ |
+
69 | +6x | +
+ split_rows_by(param_label, split_fun = drop_split_levels) %>%+ |
+
70 | +6x | +
+ estimate_incidence_rate(+ |
+
71 | +6x | +
+ vars = vars,+ |
+
72 | +6x | +
+ n_events = n_events,+ |
+
73 | +6x | +
+ control = control+ |
+
74 | ++ |
+ )+ |
+
75 | ++ |
+ }+ |
+
76 | ++ | + + | +
77 | ++ |
+ #' @describeIn aet05 Preprocessing+ |
+
78 | ++ |
+ #'+ |
+
79 | ++ |
+ #' @inheritParams gen_args+ |
+
80 | ++ |
+ #'+ |
+
81 | ++ |
+ #' @export+ |
+
82 | ++ |
+ #'+ |
+
83 | ++ |
+ aet05_pre <- function(adam_db, ...) {+ |
+
84 | +1x | +
+ adam_db$adaette <- adam_db$adaette %>%+ |
+
85 | +1x | +
+ filter(grepl("AETTE", .data$PARAMCD)) %>%+ |
+
86 | +1x | +
+ mutate(+ |
+
87 | +1x | +
+ n_events = as.integer(.data$CNSR == 0)+ |
+
88 | ++ |
+ )+ |
+
89 | ++ | + + | +
90 | +1x | +
+ adam_db+ |
+
91 | ++ |
+ }+ |
+
92 | ++ | + + | +
93 | ++ |
+ #' @describeIn aet05 Postprocessing+ |
+
94 | ++ |
+ #'+ |
+
95 | ++ |
+ #' @inheritParams gen_args+ |
+
96 | ++ |
+ #'+ |
+
97 | ++ |
+ #' @export+ |
+
98 | ++ |
+ #'+ |
+
99 | ++ |
+ aet05_post <- function(tlg, prune_0 = FALSE, ...) {+ |
+
100 | +2x | +
+ if (prune_0) {+ |
+
101 | +! | +
+ tlg <- smart_prune(tlg)+ |
+
102 | ++ |
+ }+ |
+
103 | +2x | +
+ std_postprocess(tlg)+ |
+
104 | ++ |
+ }+ |
+
105 | ++ | + + | +
106 | ++ |
+ #' `AET05` Table 1 (Default) Adverse Event Rate Adjusted for Patient-Years at Risk - First Occurrence.+ |
+
107 | ++ |
+ #'+ |
+
108 | ++ |
+ #' The `AET05` table produces the standard adverse event rate adjusted for patient-years at risk summary+ |
+
109 | ++ |
+ #' considering first occurrence.+ |
+
110 | ++ |
+ #'+ |
+
111 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
112 | ++ |
+ #' @export+ |
+
113 | ++ |
+ #'+ |
+
114 | ++ |
+ #' @examples+ |
+
115 | ++ |
+ #' library(dplyr)+ |
+
116 | ++ |
+ #' library(dunlin)+ |
+
117 | ++ |
+ #'+ |
+
118 | ++ |
+ #' proc_data <- log_filter(syn_data, PARAMCD == "AETTE1", "adaette")+ |
+
119 | ++ |
+ #'+ |
+
120 | ++ |
+ #' run(aet05, proc_data)+ |
+
121 | ++ |
+ #'+ |
+
122 | ++ |
+ #' run(aet05, proc_data, conf_level = 0.90, conf_type = "exact")+ |
+
123 | ++ |
+ aet05 <- chevron_t(+ |
+
124 | ++ |
+ main = aet05_main,+ |
+
125 | ++ |
+ preprocess = aet05_pre,+ |
+
126 | ++ |
+ postprocess = aet05_post,+ |
+
127 | ++ |
+ adam_datasets = c("adsl", "adaette")+ |
+
128 | ++ |
+ )+ |
+
1 | ++ |
+ #' No Coding Available rule+ |
+
2 | ++ |
+ #' @export+ |
+
3 | ++ |
+ nocoding <- rule("No Coding Available" = c("", NA))+ |
+
4 | ++ |
+ #' Missing rule+ |
+
5 | ++ |
+ #' @export+ |
+
6 | ++ |
+ missing_rule <- rule("<Missing>" = c("", NA))+ |
+
7 | ++ |
+ #' Empty rule+ |
+
8 | ++ |
+ #' @export+ |
+
9 | ++ |
+ empty_rule <- rule(.to_NA = "")+ |
+
10 | ++ |
+ #' Get grade rule+ |
+
11 | ++ |
+ #' @param direction (`string`) of abnormality direction.+ |
+
12 | ++ |
+ #' @param missing (`string`) method to deal with missing+ |
+
13 | ++ |
+ #' @export+ |
+
14 | ++ |
+ get_grade_rule <- function(direction = "high", missing = "incl") {+ |
+
15 | +14x | +
+ rule_arg <- list()+ |
+
16 | +14x | +
+ if (direction == "high") {+ |
+
17 | +6x | +
+ rule_arg[["Not High"]] <- c("0", "-1", "-2", "-3", "-4")+ |
+
18 | +6x | +
+ rule_arg[as.character(1:4)] <- as.character(1:4)+ |
+
19 | ++ |
+ } else {+ |
+
20 | +8x | +
+ rule_arg[["Not Low"]] <- c("0", "1", "2", "3", "4")+ |
+
21 | +8x | +
+ rule_arg[as.character(1:4)] <- as.character(-1:-4)+ |
+
22 | ++ |
+ }+ |
+
23 | +14x | +
+ if (missing == "incl") {+ |
+
24 | +8x | +
+ rule_arg$Missing <- c(NA, "")+ |
+
25 | +6x | +
+ } else if (missing == "gr_0") {+ |
+
26 | +3x | +
+ rule_arg[[1]] <- c(rule_arg[[1]], NA, "")+ |
+
27 | ++ |
+ }+ |
+
28 | +14x | +
+ rule(.lst = rule_arg)+ |
+
29 | ++ |
+ }+ |
+
1 | ++ |
+ # aet05_all ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn aet05_all Preprocessing+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' @export+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ aet05_all_pre <- function(adam_db, ...) {+ |
+
10 | +1x | +
+ anl_tte <- adam_db$adaette %>%+ |
+
11 | +1x | +
+ filter(.data$PARAMCD == "AEREPTTE") %>%+ |
+
12 | +1x | +
+ select(all_of(c("USUBJID", "AVAL")))+ |
+
13 | ++ | + + | +
14 | +1x | +
+ adam_db$adaette <- adam_db$adaette %>%+ |
+
15 | +1x | +
+ filter(grepl("TOT", .data$PARAMCD)) %>%+ |
+
16 | +1x | +
+ mutate(+ |
+
17 | +1x | +
+ n_events = as.integer(.data$AVAL)+ |
+
18 | ++ |
+ ) %>%+ |
+
19 | +1x | +
+ select(-c("AVAL")) %>%+ |
+
20 | +1x | +
+ left_join(anl_tte, by = c("USUBJID"))+ |
+
21 | ++ | + + | +
22 | +1x | +
+ adam_db+ |
+
23 | ++ |
+ }+ |
+
24 | ++ | + + | +
25 | ++ |
+ #' `AET05_ALL` Table 1 (Default) Adverse Event Rate Adjusted for Patient-Years at Risk - All Occurrences.+ |
+
26 | ++ |
+ #'+ |
+
27 | ++ |
+ #' The `AET05_ALL` table produces the standard adverse event rate adjusted for patient-years at risk summary+ |
+
28 | ++ |
+ #' considering all occurrences.+ |
+
29 | ++ |
+ #'+ |
+
30 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
31 | ++ |
+ #' @export+ |
+
32 | ++ |
+ #'+ |
+
33 | ++ |
+ #' @examples+ |
+
34 | ++ |
+ #' library(dplyr)+ |
+
35 | ++ |
+ #' library(dunlin)+ |
+
36 | ++ |
+ #'+ |
+
37 | ++ |
+ #' proc_data <- log_filter(syn_data, PARAMCD == "AETOT1" | PARAMCD == "AEREPTTE", "adaette")+ |
+
38 | ++ |
+ #'+ |
+
39 | ++ |
+ #' run(aet05_all, proc_data)+ |
+
40 | ++ |
+ #'+ |
+
41 | ++ |
+ #' run(aet05_all, proc_data, conf_level = 0.90, conf_type = "exact")+ |
+
42 | ++ |
+ aet05_all <- chevron_t(+ |
+
43 | ++ |
+ main = aet05_main,+ |
+
44 | ++ |
+ preprocess = aet05_all_pre,+ |
+
45 | ++ |
+ postprocess = aet05_post,+ |
+
46 | ++ |
+ adam_datasets = c("adsl", "adaette")+ |
+
47 | ++ |
+ )+ |
+
1 | ++ |
+ # lbt15 ----+ |
+
2 | ++ | + + | +
3 | ++ |
+ #' @describeIn lbt15 Preprocessing+ |
+
4 | ++ |
+ #'+ |
+
5 | ++ |
+ #' @inheritParams gen_args+ |
+
6 | ++ |
+ #'+ |
+
7 | ++ |
+ #' @export+ |
+
8 | ++ |
+ #'+ |
+
9 | ++ |
+ lbt15_pre <- function(adam_db, ...) {+ |
+
10 | +1x | +
+ format <- rule(+ |
+
11 | +1x | +
+ "LOW" = c("-3", "-4"),+ |
+
12 | +1x | +
+ "MODERATE/NORMAL" = c("-2", "-1", "0", "1", "2"),+ |
+
13 | +1x | +
+ "HIGH" = c("3", "4")+ |
+
14 | ++ |
+ )+ |
+
15 | ++ | + + | +
16 | +1x | +
+ adam_db$adlb <- adam_db$adlb %>%+ |
+
17 | +1x | +
+ filter(+ |
+
18 | +1x | +
+ .data$ONTRTFL == "Y",+ |
+
19 | +1x | +
+ .data$PARCAT2 == "SI"+ |
+
20 | ++ |
+ ) %>%+ |
+
21 | +1x | +
+ mutate(+ |
+
22 | +1x | +
+ PARAM = with_label(.data$PARAM, "Laboratory Test"),+ |
+
23 | +1x | +
+ ANRIND = with_label(.data$ANRIND, "Direction of Abnormality")+ |
+
24 | ++ |
+ ) %>%+ |
+
25 | +1x | +
+ mutate(+ |
+
26 | +1x | +
+ ANRIND = reformat(.data$ATOXGR, .env$format),+ |
+
27 | +1x | +
+ BNRIND = reformat(.data$BTOXGR, .env$format)+ |
+
28 | ++ |
+ )+ |
+
29 | ++ | + + | +
30 | +1x | +
+ adam_db+ |
+
31 | ++ |
+ }+ |
+
32 | ++ | + + | +
33 | ++ |
+ #' `LBT15` Laboratory Test Shifts to `NCI-CTCAE` Grade 3-4 Post-Baseline Table.+ |
+
34 | ++ |
+ #' @source `lbt04.R`+ |
+
35 | ++ |
+ #'+ |
+
36 | ++ |
+ #' @include chevron_tlg-S4class.R+ |
+
37 | ++ |
+ #' @export+ |
+
38 | ++ |
+ #'+ |
+
39 | ++ |
+ #' @examples+ |
+
40 | ++ |
+ #' run(lbt15, syn_data)+ |
+
41 | ++ |
+ lbt15 <- chevron_t(+ |
+
42 | ++ |
+ main = lbt04_main,+ |
+
43 | ++ |
+ preprocess = lbt15_pre,+ |
+
44 | ++ |
+ postprocess = lbt04_post+ |
+
45 | ++ |
+ )+ |
+
"+y.value+"
";t=p.firstChild.firstChild;p.firstChild.cN=s.cN;s.parentNode.replaceChild(p.firstChild,s)}else{t.innerHTML=y.value}t.className=u;t.result={language:v,kw:y.keyword_count,re:y.r};if(y.second_best){t.second_best={language:y.second_best.language,kw:y.second_best.keyword_count,re:y.second_best.r}}}function o(){if(o.called){return}o.called=true;var r=document.getElementsByTagName("pre");for(var p=0;p