Skip to content

Commit

Permalink
289 possibility to pass custom axis label for g_lineplot and `g_s…
Browse files Browse the repository at this point in the history
…phagettiplot` (#259)

Alternative to #250 ,
related to
insightsengineering/teal.goshawk#289

<details><summary> Code for g_lineplot </summary>

```r
# Example using ADaM structure analysis dataset.

library(stringr)
library(dplyr)
library(nestcolor)

# original ARM value = dose value
arm_mapping <- list(
  "A: Drug X" = "150mg QD", "B: Placebo" = "Placebo", "C: Combination" = "Combination"
)
color_manual <- c("150mg QD" = "thistle", "Placebo" = "orange", "Combination" = "steelblue")
type_manual <- c("150mg QD" = "solid", "Placebo" = "dashed", "Combination" = "dotted")

ADSL <- rADSL %>% filter(!(ARM == "B: Placebo" & AGE < 40))
ADLB <- rADLB
ADLB <- right_join(ADLB, ADSL[, c("STUDYID", "USUBJID")])
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))
attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]

attr(ADLB[["AVISITCDN"]], "label") <- "CUSTOM LABEL FOR THE AXIS LABEL"
g_lineplot(
  label = "Line Plot",
  data = ADLB,
  biomarker_var = "PARAMCD",
  biomarker = "CRP",
  value_var = "AVAL",
  trt_group = "ARM",
  shape = NULL,
  time = "AVISITCDN",
  color_manual = color_manual,
  line_type = type_manual,
  median = FALSE,
  hline_arb = c(.9, 1.1, 1.2, 1.5),
  hline_arb_color = c("green", "red", "blue", "pink"),
  hline_arb_label = c("A", "B", "C", "D"),
  xtick = c(0, 1, 5),
  xlabel = c("Baseline", "Week 1", "Week 5"),
  rotate_xlab = FALSE,
  plot_height = 600
)

attr(ADLB[["AVISITCDN"]], "label") <- NULL
g_lineplot(
  label = "Line Plot",
  data = ADLB,
  biomarker_var = "PARAMCD",
  biomarker = "CRP",
  value_var = "AVAL",
  trt_group = "ARM",
  shape = NULL,
  time = "AVISITCDN",
  color_manual = color_manual,
  line_type = type_manual,
  median = FALSE,
  hline_arb = c(.9, 1.1, 1.2, 1.5),
  hline_arb_color = c("green", "red", "blue", "pink"),
  hline_arb_label = c("A", "B", "C", "D"),
  xtick = c(0, 1, 5),
  xlabel = c("Baseline", "Week 1", "Week 5"),
  rotate_xlab = FALSE,
  plot_height = 600
)

```

</details>

<details><summary>Code for `g_sphagettiplot` </summary>

```r
# Example using ADaM structure analysis dataset.

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 <- 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, "LOQFL")
ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
attr(ADLB[["AVISITCD"]], "label") <- "CUSTOM LABEL FOR THE AXIS LABEL"

g_spaghettiplot(
  data = ADLB,
  subj_id = "USUBJID",
  biomarker_var = "PARAMCD",
  biomarker = "CRP",
  value_var = "AVAL",
  trt_group = "ARM",
  time = "AVISITCD",
  color_manual = color_manual,
  color_comb = "#39ff14",
  alpha = .02,
  xtick = c("BL", "W 1", "W 4"),
  xlabel = c("Baseline", "Week 1", "Week 4"),
  rotate_xlab = FALSE,
  group_stats = "median",
  hline_vars = c("ANRHI", "ANRLO"),
  hline_vars_colors = c("pink", "brown")
)

```

</details>


# lineplot

### Custom label from attribute

<img width="460" alt="image"
src="https://github.com/user-attachments/assets/bd1e12ed-1b57-4ebf-bd0f-813e90d59fd1">

### No attribute, so take column name

<img width="455" alt="image"
src="https://github.com/user-attachments/assets/11ee8d32-2def-4063-9b37-41b6d1299c16">

# sphagettiplot

### Custom label from attribute

<img width="356" alt="image"
src="https://github.com/user-attachments/assets/b55e1ec7-e57e-41c9-badd-4dc7cb9b06d3">

### No attribute, so take column name

<img width="353" alt="image"
src="https://github.com/user-attachments/assets/f31da42f-aa09-4c60-a3bf-e624f173d1c1">
  • Loading branch information
m7pr authored Oct 16, 2024
1 parent d8439aa commit 19b2c67
Show file tree
Hide file tree
Showing 2 changed files with 3 additions and 2 deletions.
3 changes: 2 additions & 1 deletion R/g_lineplot.R
Original file line number Diff line number Diff line change
Expand Up @@ -390,6 +390,7 @@ g_lineplot <- function(label = "Line Plot",

gtitle <- paste0(biomarker1, unit1, stringr::str_to_title(line), " by Treatment @ Visits")
gylab <- paste0(biomarker1, " ", stringr::str_to_title(line), " of ", value_var, " Values")
gxlab <- if (is.null(attr(data[[time]], "label"))) time else attr(data[[time]], "label")

# Setup legend label
trt_label <- `if`(is.null(attr(data[[trt_group]], "label")), "Dose", attr(data[[trt_group]], "label"))
Expand Down Expand Up @@ -463,7 +464,7 @@ g_lineplot <- function(label = "Line Plot",
"For median, the bar denotes the first to third quartile.\n",
caption_loqs_label
)) +
ggplot2::xlab(time) +
ggplot2::xlab(gxlab) +
ggplot2::ylab(gylab) +
ggplot2::theme(
legend.box = "vertical",
Expand Down
2 changes: 1 addition & 1 deletion R/g_spaghettiplot.R
Original file line number Diff line number Diff line change
Expand Up @@ -259,6 +259,7 @@ g_spaghettiplot <- function(data,


xtype <- ifelse(is.factor(data[[time]]) | is.character(data[[time]]), "discrete", "continuous")
gxlab <- if (is.null(attr(data[[time]], "label"))) time else attr(data[[time]], "label")
if (xtype == "discrete") {
data[[time]] <- if (!is.null(time_level)) {
factor(data[[time]], levels = time_level)
Expand All @@ -280,7 +281,6 @@ g_spaghettiplot <- function(data,
unique() %>%
magrittr::extract2(1)
gtitle <- paste0(biomarker1, unit1, " Values by Treatment @ Visits")
gxlab <- if (is.null(attr(data[[time]], "label"))) time else attr(data[[time]], "label")
gylab <- paste0(biomarker1, " ", value_var, " Values")

# Setup legend label
Expand Down

0 comments on commit 19b2c67

Please sign in to comment.