Skip to content

219 scales parameter for facet_wrap in g_spaghettiplot - #201

Merged
m7pr merged 14 commits into
mainfrom
219_scales_for_spaghettiplot@main
Jul 21, 2023
Merged

219 scales parameter for facet_wrap in g_spaghettiplot#201
m7pr merged 14 commits into
mainfrom
219_scales_for_spaghettiplot@main

Conversation

@m7pr

@m7pr m7pr commented Jul 19, 2023

Copy link
Copy Markdown
Contributor

Fix for insightsengineering/teal.goshawk#219 and continued here insightsengineering/teal.goshawk#227

Data

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'

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

Free scales for x - facet_scales = 'free_x'

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

@m7pr m7pr added the core label Jul 19, 2023
@m7pr
m7pr requested a review from a team July 19, 2023 10:48
Comment thread R/g_spaghettiplot.R Outdated
Comment thread R/g_spaghettiplot.R Outdated
m7pr and others added 4 commits July 19, 2023 13:35
Co-authored-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com>
Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
Comment thread NEWS.md Outdated
m7pr and others added 2 commits July 19, 2023 13:43
Co-authored-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com>
Signed-off-by: Marcin <133694481+m7pr@users.noreply.github.com>
@m7pr
m7pr marked this pull request as ready for review July 19, 2023 11:57
@m7pr
m7pr requested a review from chlebowa July 19, 2023 11:57
@github-actions

github-actions Bot commented Jul 19, 2023

Copy link
Copy Markdown
Contributor

badge

Code Coverage Summary

Filename                           Stmts    Miss  Cover    Missing
-------------------------------  -------  ------  -------  ---------
R/g_boxplot.R                        108     108  0.00%    148-303
R/g_correlationplot.R                129     129  0.00%    251-413
R/g_density_distribution_plot.R       86      86  0.00%    125-236
R/g_lineplot.R                       256     256  0.00%    261-586
R/g_scatterplot.R                    123     123  0.00%    142-303
R/g_spaghettiplot.R                  101     101  0.00%    242-375
R/geom_axes_line.R                   167     167  0.00%    48-370
R/t_summarytable.R                   102     102  0.00%    87-224
R/utils.R                             68      68  0.00%    18-134
TOTAL                               1140    1140  0.00%

Diff against main

Filename               Stmts    Miss  Cover
-------------------  -------  ------  --------
R/g_spaghettiplot.R       +1      +1  +100.00%
TOTAL                     +1      +1  +100.00%

Results for commit: fcfa8e1

Minimum allowed coverage is 80%

♻️ This comment has been updated with latest results

@m7pr
m7pr merged commit 17e3a25 into main Jul 21, 2023
@m7pr
m7pr deleted the 219_scales_for_spaghettiplot@main branch July 21, 2023 07:06
m7pr added a commit to insightsengineering/teal.goshawk that referenced this pull request Jul 21, 2023
Closes #219 

With this PR I extended `Plot Aesthetic Settings` foldable UI with an
option to pass `scales` parameter to `ggplot2::facet_wrap`. This also
required a change in
insightsengineering/goshawk#201

```{R}
library(dplyr)

# original ARM value = dose value
arm_mapping <- list(
  "A: Drug X" = "150mg QD",
  "B: Placebo" = "Placebo",
  "C: Combination" = "Combination"
)
set.seed(1)
ADSL <- goshawk::rADSL
ADLB <- goshawk::rADLB
var_labels <- lapply(ADLB, function(x) attributes(x)$label)
ADLB <- ADLB %>%
  dplyr::mutate(
    AVISITCD = dplyr::case_when(
      AVISIT == "SCREENING" ~ "SCR",
      AVISIT == "BASELINE" ~ "BL",
      grepl("WEEK", AVISIT) ~ paste("W", stringr::str_extract(AVISIT, "(?<=(WEEK ))[0-9]+")),
      TRUE ~ as.character(NA)
    ),
    AVISITCDN = dplyr::case_when(
      AVISITCD == "SCR" ~ -2,
      AVISITCD == "BL" ~ 0,
      grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]*", "", AVISITCD)),
      TRUE ~ as.numeric(NA)
    ),
    AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
    TRTORD = dplyr::case_when(
      ARMCD == "ARM C" ~ 1,
      ARMCD == "ARM B" ~ 2,
      ARMCD == "ARM A" ~ 3
    ),
    ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
    ARM = factor(ARM) %>% reorder(TRTORD),
    ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
    ACTARM = factor(ACTARM) %>% reorder(TRTORD),
    ANRLO = 30,
    ANRHI = 75
  ) %>%
  dplyr::rowwise() %>%
  dplyr::group_by(PARAMCD) %>%
  dplyr::mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
                                  paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC
  )) %>%
  dplyr::mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
                                  paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC
  )) %>%
  ungroup()
attr(ADLB[["ARM"]], "label") <- var_labels[["ARM"]]
attr(ADLB[["ACTARM"]], "label") <- var_labels[["ACTARM"]]
attr(ADLB[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
attr(ADLB[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"

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

app <- teal::init(
  data = teal.data::cdisc_data(
    teal.data::cdisc_dataset("ADSL", ADSL, code = "ADSL <- goshawk::rADSL"),
    teal.data::cdisc_dataset(
      "ADLB",
      ADLB,
      code = "set.seed(1)
              ADLB <- goshawk::rADLB
              var_labels <- lapply(ADLB, function(x) attributes(x)$label)
              ADLB <- ADLB %>%
                dplyr::mutate(AVISITCD = dplyr::case_when(
                    AVISIT == 'SCREENING' ~ 'SCR',
                    AVISIT == 'BASELINE' ~ 'BL',
                    grepl('WEEK', AVISIT) ~
                      paste('W', stringr::str_extract(AVISIT, '(?<=(WEEK ))[0-9]+')),
                    TRUE ~ as.character(NA)),
                  AVISITCDN = dplyr::case_when(
                    AVISITCD == 'SCR' ~ -2,
                    AVISITCD == 'BL' ~ 0,
                    grepl('W', AVISITCD) ~ as.numeric(gsub('[^0-9]*', '', AVISITCD)),
                    TRUE ~ as.numeric(NA)),
                  AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN),
                  TRTORD = dplyr::case_when(
                    ARMCD == 'ARM C' ~ 1,
                    ARMCD == 'ARM B' ~ 2,
                    ARMCD == 'ARM A' ~ 3),
                  ARM = as.character(arm_mapping[match(ARM, names(arm_mapping))]),
                  ARM = factor(ARM) %>% reorder(TRTORD),
                  ACTARM = as.character(arm_mapping[match(ACTARM, names(arm_mapping))]),
                  ACTARM = factor(ACTARM) %>% reorder(TRTORD),
                  ANRLO = 30,
                  ANRHI = 75) %>%
                  dplyr::rowwise() %>%
                  dplyr::group_by(PARAMCD) %>%
                  dplyr::mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
                  paste('<', round(runif(1, min = 25, max = 30))), LBSTRESC)) %>%
                  dplyr::mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE),
                  paste( '>', round(runif(1, min = 70, max = 75))), LBSTRESC)) %>%
                  ungroup
               attr(ADLB[['ARM']], 'label') <- var_labels[['ARM']]
               attr(ADLB[['ACTARM']], 'label') <- var_labels[['ACTARM']]
               attr(ADLB[['ANRLO']], 'label') <- 'Analysis Normal Range Lower Limit'
               attr(ADLB[['ANRHI']], 'label') <- 'Analysis Normal Range Upper Limit'
               ALB_LOQS <- goshawk:::h_identify_loq_values(ADLB)
               ADLB <- left_join(ADLB, ALB_LOQS, by = 'PARAM')",
      vars = list(arm_mapping = arm_mapping)
    ),
    check = FALSE
  ),
  modules = teal::modules(
    teal.goshawk::tm_g_gh_spaghettiplot(
      label = "Spaghetti Plot",
      dataname = "ADLB",
      param_var = "PARAMCD",
      param = choices_selected(c("ALT", "CRP", "IGA"), "ALT"),
      idvar = "USUBJID",
      xaxis_var = choices_selected(c("Analysis Visit Code" = "AVISITCD"), "AVISITCD"),
      yaxis_var = choices_selected(c("AVAL", "CHG", "PCHG"), "AVAL"),
      filter_var = choices_selected(
        c("None" = "NONE", "Screening" = "BASE2", "Baseline" = "BASE"),
        "NONE"
      ),
      trt_group = choices_selected(c("ARM", "ACTARM"), "ARM"),
      color_comb = "#39ff14",
      man_color = c(
        "Combination" = "#000000",
        "Placebo" = "#fce300",
        "150mg QD" = "#5a2f5f"
      ),
      hline_arb = c(60, 50),
      hline_arb_color = c("grey", "red"),
      hline_arb_label = c("default A", "default B"),
      hline_vars = c("ANRHI", "ANRLO", "ULOQN", "LLOQN"),
      hline_vars_colors = c("pink", "brown", "purple", "black"),
    )
  )
)
if (interactive()) {
  shinyApp(app$ui, app$server)
}
```


![image](https://github.com/insightsengineering/teal.goshawk/assets/133694481/52b43d7b-fed0-4244-bcd5-a8fce1829ec1)

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment

Labels

Projects

None yet

Development

Successfully merging this pull request may close these issues.

2 participants