---
title: FSTG01
subtitle: Subgroup Analysis of Best Overall Response
---
------------------------------------------------------------------------
{{< include ../../_utils/envir_hook.qmd >}}
:::: {.panel-tabset}
```{r setup, echo = FALSE}
library(dplyr)
library(tern)
library(nestcolor)
adsl_f <- random.cdisc.data::cadsl %>%
select(STUDYID, USUBJID, ARMCD, ARM, SEX, BMRKR2, STRATA1, STRATA2)
adrs_f <- random.cdisc.data::cadrs %>%
filter(PARAMCD == "INVET") %>%
select(STUDYID, USUBJID, PARAMCD, AVISIT, AVALC)
anl <- inner_join(adsl_f, adrs_f, by = c("STUDYID", "USUBJID"))
anl <- df_explicit_na(anl)
anl_labels <- var_labels(anl)
anl_rsp_arms_ab <- anl %>%
mutate(is_rsp = AVALC %in% c("CR", "PR")) %>%
filter(ARMCD %in% c("ARM B", "ARM A")) %>%
mutate(
ARMCD = relevel(ARMCD, ref = "ARM B") %>%
droplevels(),
ARM = relevel(ARM, ref = "B: Placebo") %>%
droplevels()
) %>%
droplevels()
var_labels(anl_rsp_arms_ab) <- c(anl_labels, is_rsp = "Is Responder")
```
## Standard Plot
::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview
<!-- skip strict because of https://github.com/therneau/survival/issues/240 -->
<!-- skip strict because of https://github.com/insightsengineering/tern/issues/1186 -->
```{r plot1, test = list(plot_v1 = "plot"), fig.width = 20, fig.height = 5, opts.label = ifelse(packageVersion("survival") < "3.5-8" || packageVersion("tern") < "0.9.3.9018", "skip_test_strict", "")}
df <- extract_rsp_subgroups(
variables = list(
rsp = "is_rsp",
arm = "ARM",
subgroups = c("SEX", "BMRKR2"),
strata = "STRATA2"
),
data = anl_rsp_arms_ab,
conf_level = 0.95
)
result <- basic_table() %>%
tabulate_rsp_subgroups(df, vars = c("n_tot", "n", "n_rsp", "prop", "or", "ci"))
plot <- g_forest(tbl = result)
plot
```
`r webr_code_labels <- c("setup", "plot1")`
{{< include ../../_utils/webr.qmd >}}
:::
## Plot Specifying Class Variables and <br/> Options for the Treatment Variable
::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview
<!-- skip strict because of https://github.com/therneau/survival/issues/240 -->
<!-- skip strict because of https://github.com/insightsengineering/tern/issues/1186 -->
```{r plot2, test = list(plot_v2 = "plot"), fig.width = 20, fig.height = 5, opts.label = ifelse(packageVersion("survival") < "3.5-8" || packageVersion("tern") < "0.9.3.9018", "skip_test_strict", "")}
anl_rsp_comb_arms_ac <- anl %>%
mutate(is_rsp = AVALC %in% c("CR", "PR")) %>%
filter(ARMCD %in% c("ARM B", "ARM A", "ARM C")) %>%
mutate(
ARMCD = relevel(ARMCD, ref = "ARM B") %>%
droplevels() %>%
combine_levels(levels = c("ARM A", "ARM C")),
ARM = relevel(ARM, ref = "B: Placebo") %>%
droplevels() %>%
combine_levels(levels = c("A: Drug X", "C: Combination")),
# reorder levels of SEX
SEX = forcats::fct_relevel(SEX, "M", "F"),
# reorder levels of STRATA1 by frequency
STRATA1 = forcats::fct_infreq(STRATA1)
) %>%
droplevels()
var_labels(anl_rsp_comb_arms_ac) <- c(anl_labels, is_rsp = "Is Responder")
df <- extract_rsp_subgroups(
variables = list(
rsp = "is_rsp",
arm = "ARMCD",
subgroups = c("SEX", "BMRKR2"),
strata = "STRATA2"
),
data = anl_rsp_comb_arms_ac,
conf_level = 0.95
)
result <- basic_table() %>%
tabulate_rsp_subgroups(df, vars = c("n_tot", "n", "n_rsp", "prop", "or", "ci"))
plot <- g_forest(tbl = result)
plot
```
`r webr_code_labels <- c("setup", "plot2")`
{{< include ../../_utils/webr.qmd >}}
:::
## Plot Selecting Columns and <br/> Changing the Alpha Level
::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview
<!-- skip strict because of https://github.com/therneau/survival/issues/240 -->
<!-- skip strict because of https://github.com/insightsengineering/tern/issues/1186 -->
```{r plot3, test = list(plot_v3 = "plot"), fig.width = 10, fig.height = 4, opts.label = ifelse(packageVersion("survival") < "3.5-8" || packageVersion("tern") < "0.9.3.9018", "skip_test_strict", "")}
df <- extract_rsp_subgroups(
variables = list(
rsp = "is_rsp",
arm = "ARM",
subgroups = c("SEX", "BMRKR2"),
strata = "STRATA2"
),
data = anl_rsp_arms_ab,
conf_level = 0.90
)
result <- basic_table() %>%
tabulate_rsp_subgroups(df, vars = c("n_tot", "or", "ci"))
plot <- g_forest(tbl = result)
plot
```
`r webr_code_labels <- c("setup", "plot3")`
{{< include ../../_utils/webr.qmd >}}
:::
## Plot with Fixed <br/> Symbol Size
::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview
<!-- skip strict because of https://github.com/therneau/survival/issues/240 -->
<!-- skip strict because of https://github.com/insightsengineering/tern/issues/1186 -->
```{r plot4, test = list(plot_v4 = "plot"), fig.width = 20, fig.height = 5, opts.label = ifelse(packageVersion("survival") < "3.5-8" || packageVersion("tern") < "0.9.3.9018", "skip_test_strict", "")}
df <- extract_rsp_subgroups(
variables = list(
rsp = "is_rsp",
arm = "ARM",
subgroups = c("SEX", "BMRKR2"),
strata = "STRATA2"
),
data = anl_rsp_arms_ab,
conf_level = 0.95
)
result <- basic_table() %>%
tabulate_rsp_subgroups(df, vars = c("n_tot", "n", "n_rsp", "prop", "or", "ci"))
plot <- g_forest(
tbl = result,
col_symbol_size = NULL
)
plot
```
`r webr_code_labels <- c("setup", "plot4")`
{{< include ../../_utils/webr.qmd >}}
:::
## Plot of CR Only, Setting <br/> Values Indicating Response
::: {.panel-tabset .nav-justified group="webr"}
## {{< fa regular file-lines sm fw >}} Preview
<!-- skip strict because of https://github.com/therneau/survival/issues/240 -->
<!-- skip strict because of https://github.com/insightsengineering/tern/issues/1186 -->
```{r plot5, test = list(plot_v5 = "plot"), fig.width = 20, fig.height = 5, opts.label = ifelse(packageVersion("survival") < "3.5-8" || packageVersion("tern") < "0.9.3.9018", "skip_test_strict", "")}
anl_cr_arms_ab <- anl %>%
mutate(is_rsp = AVALC == "CR") %>%
filter(ARMCD %in% c("ARM B", "ARM A")) %>%
mutate(
ARMCD = relevel(ARMCD, ref = "ARM B") %>%
droplevels(),
ARM = relevel(ARM, ref = "B: Placebo") %>%
droplevels()
) %>%
droplevels()
var_labels(anl_cr_arms_ab) <- c(anl_labels, is_rsp = "Is CR")
df <- extract_rsp_subgroups(
variables = list(
rsp = "is_rsp",
arm = "ARM",
subgroups = c("SEX", "BMRKR2"),
strata = "STRATA2"
),
data = anl_cr_arms_ab,
conf_level = 0.95
)
result <- basic_table() %>%
tabulate_rsp_subgroups(df, vars = c("n_tot", "n", "n_rsp", "prop", "or", "ci"))
plot <- g_forest(tbl = result)
plot
```
```{r test parameters, test = list(width = "width", height = "height"), echo = FALSE}
width <- 20
height <- 5
```
`r webr_code_labels <- c("setup", "plot5")`
{{< include ../../_utils/webr.qmd >}}
:::
## Data Setup
```{r setup}
#| code-fold: show
```
::::
{{< include ../../_utils/save_results.qmd >}}
## `teal` App
::: {.panel-tabset .nav-justified}
## {{< fa regular file-lines fa-sm fa-fw >}} Preview
```{r teal, opts.label = c("skip_if_testing", "app")}
library(teal.modules.clinical)
## Data reproducible code
data <- teal_data()
data <- within(data, {
ADSL <- random.cdisc.data::cadsl
ADRS <- random.cdisc.data::cadrs
})
datanames <- c("ADSL", "ADRS")
datanames(data) <- datanames
join_keys(data) <- default_cdisc_join_keys[datanames]
arm_ref_comp <- list(
ARM = list(
ref = "B: Placebo",
comp = c("A: Drug X", "C: Combination")
),
ARMCD = list(
ref = "ARM B",
comp = c("ARM A", "ARM C")
)
)
## Reusable Configuration For Modules
ADSL <- data[["ADSL"]]
ADRS <- data[["ADRS"]]
## Setup App
app <- init(
data = data,
modules = modules(
tm_g_forest_rsp(
label = "Forest Response",
dataname = "ADRS",
arm_var = choices_selected(
variable_choices(ADSL, c("ARM", "ARMCD")),
"ARMCD"
),
arm_ref_comp = arm_ref_comp,
paramcd = choices_selected(
value_choices(ADRS, "PARAMCD", "PARAM"),
"BESRSPI"
),
subgroup_var = choices_selected(
variable_choices(ADSL, names(ADSL)),
c("BMRKR2", "SEX")
),
strata_var = choices_selected(
variable_choices(ADSL, c("STRATA1", "STRATA2")),
"STRATA2"
),
plot_height = c(600L, 200L, 2000L),
plot_width = c(1100L, 200L, 2000L)
)
)
)
shinyApp(app$ui, app$server)
```
{{< include ../../_utils/shinylive.qmd >}}
:::
{{< include ../../repro.qmd >}}