Skip to content
New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

219 scales parameter for facet_wrap in g_spaghettiplot #201

Merged
merged 14 commits into from
Jul 21, 2023

Conversation

m7pr
Copy link
Contributor

@m7pr m7pr commented Jul 19, 2023

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
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>
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
Copy link
Contributor

github-actions bot commented Jul 19, 2023

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>
# for free to join this conversation on GitHub. Already have an account? # to comment
Labels
Projects
None yet
Development

Successfully merging this pull request may close these issues.

2 participants