## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(admiraldev)
library(gt)
library(ggplot2)

## ----pet-response-categories, echo=FALSE, message=FALSE-----------------------
pet_response_categories <- tibble::tribble(
  ~`PET-CT Response`, ~`Description`,
  "CMR", "Complete metabolic response",
  "PMR", "Partial metabolic response",
  "NMR or SMD", "No metabolic response or stable metabolic disease",
  "PMD", "Progressive metabolic disease",
  "NE", "Not evaluable",
  "ND", "Not done or not determined",
  "NED", "No evidence of FDG-avid disease, generally BICR or IRC only",
  "PSP", "Pseudoprogression"
)

pet_response_categories |>
  gt::gt() |>
  gt::tab_header(
    title = "Table 1: PET-CT Based Response Categories",
    subtitle = "Lugano 2014 response categories used in this vignette"
  )

## ----ct-response-categories, echo=FALSE, message=FALSE------------------------
ct_response_categories <- tibble::tribble(
  ~`CT Response`, ~`Description`,
  "CAR", "Complete anatomic response",
  "PAR", "Partial anatomic response",
  "SAD", "Stable anatomic disease",
  "PAD", "Progressive anatomic disease",
  "NE", "Not evaluable",
  "ND", "Not done or not determined",
  "NED", "No evidence of disease"
)

ct_response_categories |>
  gt::gt() |>
  gt::tab_header(
    title = "Table 2: CT-Based Response Categories",
    subtitle = "Anatomic response categories used in this vignette"
  )

## ----warning=FALSE, message=FALSE---------------------------------------------
library(admiral)
library(admiralonco)
library(pharmaversesdtm)
library(pharmaverseadam)
library(dplyr)
library(tibble)

## ----message=FALSE------------------------------------------------------------
# Lymphoma SDTM data
rs <- pharmaversesdtm::rs_onco_lymphoma

# Convert blanks to NA
rs <- convert_blanks_to_na(rs)

# ADaM data
adsl <- pharmaverseadam::adsl

## ----echo=FALSE---------------------------------------------------------------
# select subjects from adsl such that there is one subject without RS data
rs_subjects <- unique(rs$USUBJID)
adsl_subjects <- unique(adsl$USUBJID)
adsl <- filter(
  adsl,
  USUBJID %in% union(rs_subjects, setdiff(adsl_subjects, rs_subjects)[1])
)

## ----eval=TRUE, echo=FALSE----------------------------------------------------
dataset_vignette(
  rs,
  display_vars = exprs(USUBJID, RSTESTCD, RSCAT, RSSCAT, RSMETHOD, RSSTRESC, VISIT, VISITNUM, RSDTC)
)

## ----eval=TRUE----------------------------------------------------------------
adsl_vars <- exprs(TRTSDT)
adrs <- derive_vars_merged(
  rs,
  dataset_add = adsl,
  new_vars = adsl_vars,
  by_vars = get_admiral_option("subject_keys")
)

## -----------------------------------------------------------------------------
adrs <- adrs %>%
  derive_vars_dtm(
    dtc = RSDTC,
    new_vars_prefix = "A",
    highest_imputation = "D",
    date_imputation = "last"
  ) %>%
  derive_vars_dtm_to_dt(exprs(ADTM)) %>%
  derive_vars_dy(
    reference_date = TRTSDT,
    source_vars = exprs(ADT)
  ) %>%
  mutate(
    AVISIT = VISIT,
    AVISITN = VISITNUM
  )

## ----eval=TRUE, include=TRUE, message=FALSE-----------------------------------
# Prepare param_lookup for SDTM RSTESTCD and RSSCAT to add metadata
param_lookup <- tibble::tribble(
  ~RSTESTCD,  ~RSSCAT,                   ~PARAMCD, ~PARAM,            ~PARAMN,
  "OVRLRESP", "INCLUDING PET-CT SCAN",   "PETRSP", "PET-CT Response",       1,
  "OVRLRESP", "NOT INCLUDING PET SCAN",  "CTRSP",  "CT Response",           2
)

adrs <- adrs %>%
  derive_vars_merged_lookup(
    dataset_add = param_lookup,
    by_vars = exprs(RSTESTCD, RSSCAT)
  ) %>%
  mutate(
    PARCAT1 = RSCAT,
    AVALC = case_when(
      RSSTAT == "NOT DONE" ~ "ND",
      TRUE ~ RSSTRESC
    )
  )

## ----eval=TRUE, echo=FALSE----------------------------------------------------
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, PARAMCD, PARAM, AVALC, AVISIT, AVISITN, ADT)
)

## ----eval=TRUE, include=TRUE, message=FALSE, echo=FALSE-----------------------
combined_lugano_table <- tibble::tribble(
  ~`PET-CT Response`,                         ~`CT Response`,                     ~`Combined Overall Response`,
  "CMR",                                      "Any",                              "CR",
  "PMR",                                      "Any",                              "PR",
  "NMR or SMD",                               "Any",                              "SD",
  "PMD",                                      "Any",                              "PD",
  "PSP",                                      "Any",                              "PSP",
  "NED",                                      "Any",                              "Use current CT response",
  "NE / ND, with prior evaluable PET-CT",     "CAR / PAR / SAD / NE / ND / NED",  "Carry forward prior PET-CT response",
  "NE / ND, with prior evaluable PET-CT",     "PAD",                              "PD",
  "NE / ND, no prior evaluable PET-CT",       "CAR / PAR / SAD / PAD / NED",      "Use current CT response",
  "NE / ND, no prior evaluable PET-CT",       "NE / ND / Missing",                "NE or ND",
  "Missing",                                  "Any",                              "Use current CT response",
  "Missing",                                  "Missing",                          "ND"
)

combined_lugano_table |>
  gt::gt() |>
  gt::tab_header(
    title = "Table 3: Combined Overall Timepoint Response",
    subtitle = "PET-CT, CT, and Combined Overall Response Mapping"
  ) |>
  gt::tab_source_note(
    source_note = "This table is example-only and should be aligned with the study protocol and statistical analysis plan."
  ) |>
  gt::tab_source_note(
    source_note = "For evaluable PET-CT responses CMR, PMR, NMR or SMD, and PMD, the PET-CT response determines the integrated response in this example."
  ) |>
  gt::tab_source_note(
    source_note = "When PET-CT is NE or ND and the current CT response is not progressive, prior evaluable PET-CT response may be carried forward."
  ) |>
  gt::tab_source_note(
    source_note = "When PET-CT is reported as NED, the integrated response generally defaults to the CT response if available. If both PET-CT and CT are NED, the integrated response is NED."
  ) |>
  gt::tab_source_note(
    source_note = "Pseudoprogression handling is study-specific and is not implemented further in this example."
  )

## ----eval=TRUE, include=TRUE, message=FALSE-----------------------------------
# Pre-processing for Overall values
map_pet_to_overall <- function(x) {
  recode_values(
    x,
    "CMR" ~ "CR",
    "PMR" ~ "PR",
    c("NMR", "SMD") ~ "SD",
    "PMD" ~ "PD",
    "NED" ~ "NED"
  )
}

map_ct_to_overall <- function(x) {
  recode_values(
    x,
    "CAR" ~ "CR",
    "PAR" ~ "PR",
    "SAD" ~ "SD",
    "PAD" ~ "PD",
    "NED" ~ "NED",
    "NE" ~ "NE",
    "ND" ~ "ND"
  )
}

## ----eval=TRUE, message=FALSE, include=TRUE-----------------------------------
adrs <- adrs %>%
  restrict_derivation(
    filter = PARAMCD == "PETRSP",
    derivation = derive_vars_joined,
    args = params(
      dataset_add = adrs,
      filter_add = PARAMCD == "PETRSP" &
        AVALC %in% c("CMR", "PMR", "NMR", "SMD", "PMD"),
      by_vars = get_admiral_option("subject_keys"),
      order = exprs(ADT, AVISITN),
      mode = "last",
      join_type = "before",
      filter_join = ADT.join < ADT,
      new_vars = exprs(
        AVALC_P = AVALC,
        ADT_P = ADT
      )
    )
  )

## ----eval=TRUE, message=FALSE, include=TRUE-----------------------------------
adrs <- derive_param_computed(
  dataset = adrs,
  by_vars = exprs(
    !!!get_admiral_option("subject_keys"), !!!adsl_vars, DOMAIN, ADT, ADY, ADTM,
    ADTF, VISIT, VISITNUM, AVISIT, AVISITN
  ),
  parameters = c("PETRSP", "CTRSP"),
  set_values_to = exprs(
    AVALC = case_when(
      # PET-CT evaluable: metabolic response determines overall response
      AVALC.PETRSP %in% c("CMR", "PMR", "NMR", "SMD", "PMD") ~
        map_pet_to_overall(AVALC.PETRSP),

      # PET-CT NED: default to CT if CT is available
      AVALC.PETRSP == "NED" &
        AVALC.CTRSP %in% c("CAR", "PAR", "SAD", "PAD", "NE", "ND", "NED") ~
        map_ct_to_overall(AVALC.CTRSP),

      # PET-CT NED and CT missing: keep NED
      AVALC.PETRSP == "NED" & is.na(AVALC.CTRSP) ~
        "NED",

      # PET-CT is NE or ND and CT indicates progression
      AVALC.PETRSP %in% c("NE", "ND") & AVALC.CTRSP == "PAD" ~
        "PD",

      # PET-CT is NE or ND and prior evaluable PET-CT exists
      AVALC.PETRSP %in% c("NE", "ND") &
        !is.na(AVALC_P.PETRSP) &
        AVALC.CTRSP %in% c("CAR", "PAR", "SAD", "NE", "ND", "NED") ~
        map_pet_to_overall(AVALC_P.PETRSP),

      # PET-CT is NE or ND and no prior evaluable PET-CT exists
      AVALC.PETRSP %in% c("NE", "ND") &
        is.na(AVALC_P.PETRSP) &
        AVALC.CTRSP %in% c("CAR", "PAR", "SAD", "PAD", "NED") ~
        map_ct_to_overall(AVALC.CTRSP),

      # PET-CT is NE and CT is also NE or ND or missing
      AVALC.PETRSP == "NE" &
        (AVALC.CTRSP %in% c("NE", "ND") | is.na(AVALC.CTRSP)) ~
        "NE",

      # PET-CT is ND and CT is also NE or ND or missing
      AVALC.PETRSP == "ND" &
        (AVALC.CTRSP %in% c("NE", "ND") | is.na(AVALC.CTRSP)) ~
        "ND",

      # PET-CT missing; use CT response if available
      is.na(AVALC.PETRSP) &
        AVALC.CTRSP %in% c("CAR", "PAR", "SAD", "PAD", "NED", "NE", "ND") ~
        map_ct_to_overall(AVALC.CTRSP),

      # No valid response available
      TRUE ~ "ND"
    ),
    PARAMCD = "OVRLRESC",
    PARAM = "Overall Response - Derived",
    PARAMN = 3,
    PARCAT1 = "LUGANO 2014"
  ),
  keep_nas = TRUE
)

## ----echo=FALSE---------------------------------------------------------------
plot_response <- function(dataset, page, page_size = 4) {
  subjects <- unique(dataset$USUBJID)
  page_nrs <- subjects %>%
    rank() %>%
    `/`(page_size) %>%
    ceiling()

  ggplot(dataset %>%
    mutate(
      page_nr = recode_values(USUBJID, from = subjects, to = page_nrs),
      AVALC = replace_values(
        AVALC,
        c("CMR", "CAR", "CR") ~ "CMR, CAR, CR",
        c("PMR", "PAR", "PR") ~ "PMR, PAR, PR",
        c("NMR", "SAD", "SD") ~ "NMR, SAD, SD",
        c("PMD", "PAD", "PD") ~ "PMD, PAD, PD"
      ),
      Response = factor(
        AVALC,
        levels = c(
          "CMR, CAR, CR", "PMR, PAR, PR", "NMR, SAD, SD", "PMD, PAD, PD",
          "PSP", "NE", "NED", "ND"
        )
      ),
      Parameter = factor(
        PARAM,
        levels = c("PET-CT Response", "CT Response", "Overall Response - Derived")
      ),
      Visit = factor(
        AVISIT,
        levels = c("BASELINE", "WEEK 8", "WEEK 16", "WEEK 24")
      )
    ) %>%
    filter(page_nr == !!page)) +
    theme_classic() +
    theme(
      strip.background = element_blank(),
      axis.line.y = element_blank(),
      axis.ticks.y = element_blank(),
      legend.background = element_rect(fill = "whitesmoke")
    ) +
    geom_point(
      aes(
        x = Visit,
        y = Parameter,
        shape = Response,
        color = Response,
        fill = Response
      ),
      size = 4
    ) +
    scale_color_manual(
      values = c("CMR, CAR, CR" = "darkgreen", "PMR, PAR, PR" = "orange", "NMR, SAD, SD" = "blue", "PMD, PAD, PD" = "red", "NE" = "gray", "ND" = "black"), na.value = "lightgray"
    ) +
    scale_fill_manual(
      values = c("CMR, CAR, CR" = "darkgreen", "PMR, PAR, PR" = "orange", "NMR, SAD, SD" = "blue", "PMD, PAD, PD" = "red", "NE" = "gray", "ND" = "black"), na.value = "lightgray"
    ) +
    scale_shape_manual(
      values = c("CMR, CAR, CR" = 17, "PMR, PAR, PR" = 18, "NMR, SAD, SD" = 16, "PMD, PAD, PD" = 25, "NE" = 3, "ND" = 4),
      na.value = 22
    ) +
    facet_wrap(vars(paste("Subject", USUBJID)), ncol = 1)
}

for (i in 1:ceiling(length(unique(adrs$USUBJID)) / 4)) {
  print(plot_response(adrs, page = i))
}

## ----eval=TRUE, echo=FALSE----------------------------------------------------
dataset_vignette(
  adrs %>%
    filter(PARAMCD %in% c("OVRLRESC")) %>%
    arrange(!!!get_admiral_option("subject_keys"), AVISITN, PARAMN),
  display_vars = exprs(USUBJID, PARAMCD, PARAM, PARCAT1, AVALC, AVISIT, ADT)
)

## -----------------------------------------------------------------------------
adrs <- adrs %>%
  mutate(
    AVAL = recode_values(
      AVALC,
      c("CR", "CMR", "CAR") ~ 1,
      c("PR", "PMR", "PAR") ~ 2,
      c("SD", "NMR", "SMD", "SAD") ~ 3,
      c("PD", "PMD", "PAD") ~ 4,
      "NE" ~ 5,
      "NED" ~ 6,
      "ND" ~ 7
    )
  )

## ----echo=FALSE---------------------------------------------------------------
dataset_vignette(
  adrs %>%
    filter(PARAMCD %in% c("OVRLRESC")) %>%
    arrange(!!!get_admiral_option("subject_keys"), AVISITN, PARAMN),
  display_vars = exprs(USUBJID, PARAMCD, PARAM, PARCAT1, AVALC, AVAL, AVISIT, ADT)
)