Skip to content

Commit

Permalink
Final version for tagging v0.3.2.3 for JSM2020
Browse files Browse the repository at this point in the history
  • Loading branch information
@gmbecker
gmbecker committed Jul 31, 2020
1 parent 59ea9d6 commit 6cc17ff
Show file tree
Hide file tree
Showing 5 changed files with 124 additions and 73 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -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 = "[email protected]", role = c("aut", "cre")),
person("Gabriel", "Becker", email = "[email protected]", role = "aut"),
Expand Down
56 changes: 30 additions & 26 deletions R/split_funs.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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) {
Expand Down
2 changes: 1 addition & 1 deletion R/tt_dotabulation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
46 changes: 28 additions & 18 deletions README.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -51,35 +53,43 @@ 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")
```


## Usage

```{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)
```


Expand All @@ -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

Expand Down
91 changes: 64 additions & 27 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)

Expand Down

0 comments on commit 6cc17ff

Please sign in to comment.