From 6cc17ff3fc43e632d081459a478a12762b5f81d4 Mon Sep 17 00:00:00 2001 From: Gabriel Becker Date: Fri, 31 Jul 2020 13:22:25 -0700 Subject: [PATCH] Final version for tagging v0.3.2.3 for JSM2020 --- DESCRIPTION | 2 +- R/split_funs.R | 56 +++++++++++++++------------- R/tt_dotabulation.R | 2 +- README.Rmd | 46 ++++++++++++++--------- README.md | 91 +++++++++++++++++++++++++++++++-------------- 5 files changed, 124 insertions(+), 73 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3065a384c..ab26c5536 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: rtables Title: Reporting Tables Date: 2019-10-11 -Version: 0.3.2.2 +Version: 0.3.2.3 Authors@R: c( person("Adrian", "Waddell", email = "adrian.waddell@roche.com", role = c("aut", "cre")), person("Gabriel", "Becker", email = "gabembecker@gmail.com", role = "aut"), diff --git a/R/split_funs.R b/R/split_funs.R index fd5352b9a..06bfb573b 100644 --- a/R/split_funs.R +++ b/R/split_funs.R @@ -129,6 +129,13 @@ do_split = function(spl, df, vals = NULL, labels = NULL, trim = FALSE) { vals = seq_along(extr) names(vals) = names(extr) } + + if(is.null(vals)) { + return(list(values = list(), + datasplit = list(), + labels = list(), + extras = list())) + } dpart = .applysplit_datapart(spl, df, vals) @@ -340,8 +347,8 @@ setMethod(".applysplit_extras", "Split", splex <- split_exargs(spl) nextr <- length(splex) nvals <- length(vals) - stopifnot(nvals > 0, - nextr <= nvals) + ## stopifnot(nvals > 0, + ## nextr <= nvals) lapply(seq_len(nvals), function(vpos) { one_ex <- lapply(splex, function(arg) { if(length(arg) >= vpos) @@ -494,30 +501,27 @@ reorder_split_levels = function(neworder, newlabels = neworder, drlevels = TRUE) #' @param innervar character(1). Variable whose factor levels should be trimmed (ie empty levels dropped) \emph{separately within each grouping defined at this point in the structure} #' @export trim_levels_in_group = function(innervar) { - myfun = function(df, spl, vals = NULL, labels = NULL, trim = FALSE) { - ret = .apply_split_inner(spl, df, vals = vals, labels = labels, trim = trim) - - ret$datasplit = lapply(ret$datasplit, function(x) { - coldat = x[[innervar]] - if(is(coldat, "character")) { - if(!is.null(vals)) - lvs = vals - else - lvs = unique(coldat) - coldat = factor(coldat, levels = lvs) ## otherwise - } else { - coldat = droplevels(coldat) - } - x[[innervar]] = coldat - - x - }) - - ret$labels <- as.character(ret$labels) # TODO - ret - } - myfun - + myfun = function(df, spl, vals = NULL, labels = NULL, trim = FALSE) { + ret = .apply_split_inner(spl, df, vals = vals, labels = labels, trim = trim) + + ret$datasplit = lapply(ret$datasplit, function(x) { + coldat = x[[innervar]] + if(is(coldat, "character")) { + if(!is.null(vals)) + lvs = vals + else + lvs = unique(coldat) + coldat = factor(coldat, levels = lvs) ## otherwise + } else { + coldat = droplevels(coldat) + } + x[[innervar]] = coldat + x + }) + ret$labels <- as.character(ret$labels) # TODO + ret + } + myfun } .add_combo_part_info = function(part, df, valuename, levels, label, extras, first = TRUE) { diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R index eb354be38..b5fc0c379 100644 --- a/R/tt_dotabulation.R +++ b/R/tt_dotabulation.R @@ -501,7 +501,7 @@ recursive_applysplit = function( df, stopifnot(length(newbaselines) == length(dataspl), - identical(unique(sapply(newbaselines, length)), length(col_exprs(cinfo)))) + length(newbaselines) == 0 || identical(unique(sapply(newbaselines, length)), length(col_exprs(cinfo)))) innerlev = lvl + (nrow(ctab) > 0 || is.na(make_lrow) || make_lrow) ## if(nonroot) ## innerlev = innerlev + 1L diff --git a/README.Rmd b/README.Rmd index ca9829a0f..f2dae6e56 100644 --- a/README.Rmd +++ b/README.Rmd @@ -38,6 +38,8 @@ requirements. We are looking for collaborators, see the next section. ## Collaboration and Planned API Changes +The `rtables` package is currently in the process of being reworked to address + The current state of the `rtables` functionality is a first rough prototype. We will be changing the API significantly in the coming months without maintaining backward compatibility. We will release the `rtable` package on @@ -51,16 +53,16 @@ repository and to send us pull requests with the suggested improvements. ## Installation -To install the stable release of `rtables` package run the following command in `R`: +To install a frozen pre-release version of `rtables` based on the new Layouting and Tabulation API as presented at user!2020 and JSM2020 run the following command in `R`: ```{r, eval = FALSE} -devtools::install_github("roche/rtables", ref="v0.1.1") +devtools::install_github("roche/rtables", ref="v0.3.2.3") ``` -To install the test version of `rtables` run +To install the latest development version of the new test version of `rtables` run ```{r, eval = FALSE} -devtools::install_github("roche/rtables") +devtools::install_github("roche/rtables", ref = "gabe_tabletree_work") ``` @@ -68,18 +70,26 @@ devtools::install_github("roche/rtables") ```{r} library(rtables) - -tbl <- rtable( - header = c("Treatement\nN=100", "Comparison\nN=300"), - format = "xx (xx.xx%)", - rrow("A", c(104, .2), c(100, .4)), - rrow("B", c(23, .4), c(43, .5)), - rrow(), - rrow("this is a very long section header"), - rrow("estimate", rcell(55.23, "xx.xx", colspan = 2)), - rrow("95% CI", indent = 1, rcell(c(44.8, 67.4), format = "(xx.x, xx.x)", colspan = 2)) -) -tbl +library(dplyr) + +## for simplicity grab non-sparse subset +ADSL = ex_adsl %>% filter(RACE %in% levels(RACE)[1:3]) +biomarker_ave = function(x, ...) { + val = if(length(x) > 0) round(mean(x), 2) else "no data" + in_rows( + "Biomarker 1 (mean)" = rcell(val) + ) +} + +basic_table() %>% + split_cols_by("ARM") %>% + split_cols_by("BMRKR2") %>% + add_colcounts() %>% + split_rows_by("RACE", split_fun = trim_levels_in_group("SEX")) %>% + split_rows_by("SEX") %>% + summarize_row_groups() %>% + analyze("BMRKR1", biomarker_ave) %>% + build_table(ADSL) ``` @@ -91,9 +101,9 @@ Daniel Sabanes Bove, Francois Collins, Tadeusz Lewandowski, Nick Paszty, Nina Qi ## Presentations -### New Layouting and Tabulation Framework (v.0.3+) +### New (Current) Layouting and Tabulation Framework (v.0.3+) -* [Presentation on v0.3.1.1 July 2020](https://www.youtube.com/watch?v=CBQzZ8ZhXLA) +* [useR!2020 Presentation (on v0.3.1.1) July 2020](https://www.youtube.com/watch?v=CBQzZ8ZhXLA) ### v0.1.0 and previous diff --git a/README.md b/README.md index 18023d1fa..337290f56 100644 --- a/README.md +++ b/README.md @@ -29,6 +29,9 @@ requirements. We are looking for collaborators, see the next section. ## Collaboration and Planned API Changes +The `rtables` package is currently in the process of being reworked to +address + The current state of the `rtables` functionality is a first rough prototype. We will be changing the API significantly in the coming months without maintaining backward compatibility. We will release the @@ -43,45 +46,72 @@ the suggested improvements. ## Installation -To install the stable release of `rtables` package run the following -command in `R`: +To install a frozen pre-release version of `rtables` based on the new +Layouting and Tabulation API as presented at user\!2020 and JSM2020 run +the following command in `R`: ``` r -devtools::install_github("roche/rtables", ref="v0.1.1") +devtools::install_github("roche/rtables", ref="v0.3.2.3") ``` -To install the test version of `rtables` run +To install the latest development version of the new test version of +`rtables` run ``` r -devtools::install_github("roche/rtables") +devtools::install_github("roche/rtables", ref = "gabe_tabletree_work") ``` ## Usage ``` r library(rtables) -#> Loading required package: magrittr - -tbl <- rtable( - header = c("Treatement\nN=100", "Comparison\nN=300"), - format = "xx (xx.xx%)", - rrow("A", c(104, .2), c(100, .4)), - rrow("B", c(23, .4), c(43, .5)), - rrow(), - rrow("this is a very long section header"), - rrow("estimate", rcell(55.23, "xx.xx", colspan = 2)), - rrow("95% CI", indent = 1, rcell(c(44.8, 67.4), format = "(xx.x, xx.x)", colspan = 2)) -) -tbl -#> Treatement Comparison -#> N=100 N=300 -#> ------------------------------------------------------------ -#> A 104 (20%) 100 (40%) -#> B 23 (40%) 43 (50%) -#> -#> this is a very long section header -#> estimate 55.23 -#> 95% CI (44.8, 67.4) +library(dplyr) + +## for simplicity grab non-sparse subset +ADSL = ex_adsl %>% filter(RACE %in% levels(RACE)[1:3]) +biomarker_ave = function(x, ...) { + val = if(length(x) > 0) round(mean(x), 2) else "no data" + in_rows( + "Biomarker 1 (mean)" = rcell(val) + ) +} + +basic_table() %>% + split_cols_by("ARM") %>% + split_cols_by("BMRKR2") %>% + add_colcounts() %>% + split_rows_by("RACE", split_fun = trim_levels_in_group("SEX")) %>% + split_rows_by("SEX") %>% + summarize_row_groups() %>% + analyze("BMRKR1", biomarker_ave) %>% + build_table(ADSL) +#> A: Drug X B: Placebo C: Combination +#> LOW MEDIUM HIGH LOW MEDIUM HIGH LOW MEDIUM HIGH +#> (N=45) (N=35) (N=46) (N=42) (N=48) (N=31) (N=40) (N=39) (N=47) +#> -------------------------------------------------------------------------------------------------------------------------------------------- +#> ASIAN +#> F 13 (28.9%) 9 (25.7%) 19 (41.3%) 9 (21.4%) 18 (37.5%) 9 (29%) 13 (32.5%) 9 (23.1%) 17 (36.2%) +#> Biomarker 1 (mean) 5.23 6.17 5.38 5.64 5.55 4.33 5.46 5.48 5.19 +#> M 8 (17.8%) 7 (20%) 10 (21.7%) 12 (28.6%) 10 (20.8%) 8 (25.8%) 5 (12.5%) 11 (28.2%) 16 (34%) +#> Biomarker 1 (mean) 6.77 6.06 5.54 4.9 4.98 6.81 6.53 5.47 4.98 +#> U 1 (2.2%) 1 (2.9%) 0 (0%) 0 (0%) 0 (0%) 1 (3.2%) 0 (0%) 1 (2.6%) 1 (2.1%) +#> Biomarker 1 (mean) 4.68 7.7 no data no data no data 6.97 no data 11.93 9.01 +#> BLACK OR AFRICAN AMERICAN +#> F 6 (13.3%) 3 (8.6%) 9 (19.6%) 6 (14.3%) 8 (16.7%) 2 (6.5%) 7 (17.5%) 4 (10.3%) 3 (6.4%) +#> Biomarker 1 (mean) 5.01 7.2 6.79 6.15 5.26 8.57 5.72 5.76 4.58 +#> M 5 (11.1%) 5 (14.3%) 2 (4.3%) 3 (7.1%) 5 (10.4%) 4 (12.9%) 4 (10%) 5 (12.8%) 5 (10.6%) +#> Biomarker 1 (mean) 6.92 5.82 11.66 4.46 6.14 8.47 6.16 5.25 4.83 +#> U 0 (0%) 0 (0%) 0 (0%) 0 (0%) 0 (0%) 0 (0%) 1 (2.5%) 1 (2.6%) 0 (0%) +#> Biomarker 1 (mean) no data no data no data no data no data no data 2.79 9.82 no data +#> UNDIFFERENTIATED 1 (2.2%) 0 (0%) 0 (0%) 0 (0%) 0 (0%) 0 (0%) 2 (5%) 0 (0%) 0 (0%) +#> Biomarker 1 (mean) 9.48 no data no data no data no data no data 6.46 no data no data +#> WHITE +#> F 6 (13.3%) 7 (20%) 4 (8.7%) 5 (11.9%) 6 (12.5%) 6 (19.4%) 6 (15%) 3 (7.7%) 2 (4.3%) +#> Biomarker 1 (mean) 4.43 7.83 4.52 6.42 5.07 7.83 6.71 5.87 10.7 +#> M 4 (8.9%) 3 (8.6%) 2 (4.3%) 6 (14.3%) 1 (2.1%) 1 (3.2%) 2 (5%) 5 (12.8%) 3 (6.4%) +#> Biomarker 1 (mean) 5.81 7.23 1.39 4.72 4.58 12.87 2.3 5.1 5.98 +#> U 1 (2.2%) 0 (0%) 0 (0%) 1 (2.4%) 0 (0%) 0 (0%) 0 (0%) 0 (0%) 0 (0%) +#> Biomarker 1 (mean) 3.94 no data no data 3.77 no data no data no data no data no data ``` # Acknowledgements @@ -95,6 +125,13 @@ Nina Qi, Jana Stoilova, Heng Wang. ## Presentations +### New (Current) Layouting and Tabulation Framework (v.0.3+) + + - [useR\!2020 Presentation (on v0.3.1.1) + July 2020](https://www.youtube.com/watch?v=CBQzZ8ZhXLA) + +### v0.1.0 and previous + - [Presentation on v0.1.0 April 2018](https://docs.google.com/presentation/d/1bpdBDp4PZdZ4hCsfaPkAuHDVnJmtp7WBIZ19oKMDq0M/edit?usp=sharing)