Skip to content

Commit

Permalink
219 scales parameter for facet_wrap in g_spaghettiplot (#201)
Browse files Browse the repository at this point in the history
Fix for insightsengineering/teal.goshawk#219
and continued here
insightsengineering/teal.goshawk#227

# Data
```{R}
library(stringr)

# original ARM value = dose value
arm_mapping <- list(
  "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
)
color_manual <- c("150mg QD" = "#000000", "Placebo" = "#3498DB", "Combination" = "#E74C3C")

ADLB <- goshawk::rADLB
var_labels <- lapply(ADLB, function(x) attributes(x)$label)
ADLB <- ADLB %>%
  mutate(AVISITCD = case_when(
    AVISIT == "SCREENING" ~ "SCR",
    AVISIT == "BASELINE" ~ "BL",
    grepl("WEEK", AVISIT) ~
      paste(
        "W",
        trimws(
          substr(
            AVISIT,
            start = 6,
            stop = str_locate(AVISIT, "DAY") - 1
          )
        )
      ),
    TRUE ~ NA_character_
  )) %>%
  mutate(AVISITCDN = case_when(
    AVISITCD == "SCR" ~ -2,
    AVISITCD == "BL" ~ 0,
    grepl("W", AVISITCD) ~ as.numeric(gsub("\\D+", "", AVISITCD)),
    TRUE ~ NA_real_
  )) %>%
  # use ARMCD values to order treatment in visualization legend
  mutate(TRTORD = ifelse(grepl("C", ARMCD), 1,
    ifelse(grepl("B", ARMCD), 2,
      ifelse(grepl("A", ARMCD), 3, NA)
    )
  )) %>%
  mutate(ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))])) %>%
  mutate(ARM = factor(ARM) %>%
    reorder(TRTORD)) %>%
  mutate(ANRLO = .5, ANRHI = 1) %>%
  rowwise() %>%
  group_by(PARAMCD) %>%
  mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
    paste("<", round(runif(1, min = .5, max = .7))), LBSTRESC
  )) %>%
  mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
    paste(">", round(runif(1, min = .9, max = 1.2))), LBSTRESC
  )) %>%
  ungroup()
attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"

# add LLOQ and ULOQ variables
ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB)
ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
```

# Show all scales - `facet_scales = 'fixed'`

```{R}
g_spaghettiplot(
  data = ADLB,
  subj_id = "USUBJID",
  biomarker_var = "PARAMCD",
  biomarker = "CRP",
  value_var = "AVAL",
  trt_group = "ARM",
  time = "RACE",
  color_manual = color_manual,
  color_comb = "#39ff14",
  alpha = .02,
  facet_scales = "fixed",
  rotate_xlab = FALSE,
  group_stats = "median",
  hline_arb = c(.5, .7, 1),
  hline_arb_color = c("blue", "red", "green"),
  hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
  hline_vars = c("ANRHI", "ANRLO")
)
```

![image](https://github.com/insightsengineering/goshawk/assets/133694481/5f2bcbda-4996-4f29-8b3b-deb1bdd26c7f)

## Free scales for x - `facet_scales = 'free_x'`

```{R}
g_spaghettiplot(
  data = ADLB,
  subj_id = "USUBJID",
  biomarker_var = "PARAMCD",
  biomarker = "CRP",
  value_var = "AVAL",
  trt_group = "ARM",
  time = "RACE",
  color_manual = color_manual,
  color_comb = "#39ff14",
  alpha = .02,
  facet_scales = "free_x",
  rotate_xlab = FALSE,
  group_stats = "median",
  hline_arb = c(.5, .7, 1),
  hline_arb_color = c("blue", "red", "green"),
  hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
  hline_vars = c("ANRHI", "ANRLO")
)
```


![image](https://github.com/insightsengineering/goshawk/assets/133694481/8b28e06f-b7c9-4192-9e1c-be39273834e5)

---------

Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
Co-authored-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
  • Loading branch information
4 people authored Jul 21, 2023
1 parent 119e9b2 commit 17e3a25
Show file tree
Hide file tree
Showing 3 changed files with 96 additions and 1 deletion.
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@
### Enhancements

* Implemented `nestcolor` with slight refactoring to `g_lineplot`, `g_density_distribution_plot` and added `nestcolor` in examples without custom color manuals.
* `g_spaghettiplot` has a new parameter `facet_scales` that allows for releasing scales in plot facets.

### Miscellaneous

Expand Down
49 changes: 48 additions & 1 deletion R/g_spaghettiplot.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,8 @@
#' if the default limits are not suitable.
#' @param alpha subject line transparency (0 = transparent, 1 = opaque)
#' @param facet_ncol number of facets per row.
#' @param facet_scales passed to `scales` in [`ggplot2::facet_wrap`]. Should scales be fixed (`"fixed"`,
#' the default), free (`"free"`), or free in one dimension (`"free_x"`, `"free_y"`)?
#' @param xtick a vector to define the tick values of time in x-axis.
#' Default value is `ggplot2::waiver()`.
#' @param xlabel vector with same length of `xtick` to define the label of x-axis tick values. Default
Expand Down Expand Up @@ -166,6 +168,49 @@
#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
#' hline_vars = c("ANRHI", "ANRLO")
#' )
#'
#' # removing missing levels from the plot with facet_scales
#'
#' g_spaghettiplot(
#' data = ADLB,
#' subj_id = "USUBJID",
#' biomarker_var = "PARAMCD",
#' biomarker = "CRP",
#' value_var = "AVAL",
#' trt_group = "ARM",
#' time = "RACE",
#' color_manual = color_manual,
#' color_comb = "#39ff14",
#' alpha = .02,
#' facet_scales = "fixed",
#' rotate_xlab = FALSE,
#' group_stats = "median",
#' hline_arb = c(.5, .7, 1),
#' hline_arb_color = c("blue", "red", "green"),
#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
#' hline_vars = c("ANRHI", "ANRLO")
#' )
#'
#' g_spaghettiplot(
#' data = ADLB,
#' subj_id = "USUBJID",
#' biomarker_var = "PARAMCD",
#' biomarker = "CRP",
#' value_var = "AVAL",
#' trt_group = "ARM",
#' time = "RACE",
#' color_manual = color_manual,
#' color_comb = "#39ff14",
#' alpha = .02,
#' facet_scales = "free_x",
#' rotate_xlab = FALSE,
#' group_stats = "median",
#' hline_arb = c(.5, .7, 1),
#' hline_arb_color = c("blue", "red", "green"),
#' hline_arb_label = c("Arb_Hori_line_A", "Arb_Hori_line_B", "Arb_Hori_line_C"),
#' hline_vars = c("ANRHI", "ANRLO")
#' )
#'
g_spaghettiplot <- function(data,
subj_id = "USUBJID",
biomarker_var = "PARAMCD",
Expand All @@ -182,6 +227,7 @@ g_spaghettiplot <- function(data,
ylim = c(NA, NA),
alpha = 1.0,
facet_ncol = 2,
facet_scales = c("fixed", "free", "free_x", "free_y"),
xtick = ggplot2::waiver(),
xlabel = xtick,
rotate_xlab = FALSE,
Expand All @@ -194,6 +240,7 @@ g_spaghettiplot <- function(data,
hline_vars_colors = "green",
hline_vars_labels = hline_vars) {
checkmate::assert_numeric(ylim, len = 2)
facet_scales <- match.arg(facet_scales)

## Pre-process data
label_trt_group <- attr(data[[trt_group]], "label")
Expand Down Expand Up @@ -242,7 +289,7 @@ g_spaghettiplot <- function(data,
) +
ggplot2::geom_point(size = 0.8, na.rm = TRUE) +
ggplot2::geom_line(size = 0.4, alpha = alpha, na.rm = TRUE) +
ggplot2::facet_wrap(trt_group, ncol = facet_ncol) +
ggplot2::facet_wrap(trt_group, ncol = facet_ncol, scales = facet_scales) +
ggplot2::labs(caption = caption_loqs_label) +
ggplot2::theme_bw() +
ggplot2::ggtitle(gtitle) +
Expand Down
47 changes: 47 additions & 0 deletions man/g_spaghettiplot.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 17e3a25

Please # to comment.