---
title: "Creating ADRS with IMWG Criteria"
output: 
  rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Creating ADRS with IMWG Criteria}
  %\VignetteEncoding{UTF-8}
  %\VignetteEngine{knitr::rmarkdown}
---

```{r setup, include = FALSE}
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(admiraldev)
```

# Introduction

This article describes creating an `ADRS` ADaM dataset in multiple myeloma (MM) studies
based on International Myeloma Working Group (IMWG) criteria. 
It shows a similar way of deriving the endpoints 
presented in [Creating ADRS (Including Non-standard Endpoints)](adrs.html). 
Most of the endpoints are derived by calling `admiral::derive_extreme_event()`.

The hallmark of MM is the production of monoclonal immunoglobulins 
and/or light chains by the clonal plasma cells.
Numerous parameters need to be considered while assessing response:

1. Monoclonal protein level (confirmatory assessment required):
    + SPEP - serum protein electrophoresis,
    + SIFE - serum immunofixation electrophoresis,
    + UPEP - urine protein electrophoresis,
    + UIFE - urine immunofixation electrophoresis, 
    + SFLC - serum free light chains.
2. Marrow plasma cells: bone marrow aspirate/biopsy.
3. Plasmacytoma: imaging (PET/CT, CT or MRI).
4. Bone lesions: skeletal survey.

It is worth to mention:  
*Whenever more than one parameter is used to assess response, the overall 
assigned level of response is determined by the lowest level of response.*  
*If a critical data point to establish a level of response is missing, 
the evaluation is downgraded to the next lower level.*

For more information user may visit [International Myeloma Working Group consensus criteria for response and minimal residual disease assessment in multiple myeloma](https://doi.org/10.1016/S1470-2045(16)30206-6).

Examples are currently presented and tested using `ADSL` (ADaM), 
`RS` and `SUPPRS` (SDTM) inputs. However, other domains could be used. 

In IMWG criteria each status should be confirmed by second tests giving consistent
results. Confirmation should be obtained for biochemical markers but is not 
necessary for bone marrow or imaging studies.

Two scenarios of response data collection in a clinical trial are possible:

- `RS` contains Confirmed Response,  
- `RS` contains an unconfirmed response and the Confirmed Response should be derived.

In our example we will consider the second scenario.

**Note**: *All examples assume CDISC SDTM and/or ADaM format as input
unless otherwise specified.*

# Programming Workflow

-   [Read in Data](#readdata)
-   [Pre-processing of Input Records](#input)
-   [Derive Confirmed Response Parameter](#covr)
-   [Analysis flag derivation](#anlfl)
-   [Derive Progressive Disease Parameter](#pd)
-   [Define Events](#ev)
-   [Derive Response Parameter](#rsp)
-   [Derive Clinical Benefit Parameter](#cb)
-   [Derive Best Confirmed Overall Response Parameter](#cbor)
-   [Other Endpoints](#other)

## Read in Data {#readdata}

To start, all data frames needed for the creation of `ADRS` should be read into
the environment. This will be a company specific process. Some of the data
frames needed may be `ADSL`, `RS` and `TU`.
For this vignette we assume that `RS` provides the response values `sCR`, `CR`, `VGPR`, `PR`,`MR`, `SD`, `PD`, and `NE`.

Label for non-evaluable response can vary between studies, i.e. it can be `NE`, `NA`, `UTD`, etc.
In further considerations for non-evaluable responses, we use label `NE`. User will overwrite this value if necessary.

For example purpose, the SDTM and ADaM datasets (based on CDISC Pilot
test data)---which are included in `{pharmaversesdtm}` and `{pharmaverseadam}`---are used.

```{r message=FALSE}
library(admiral)
library(admiralonco)
library(dplyr)
library(pharmaverseadam)
library(pharmaversesdtm)
library(lubridate)
library(stringr)
library(metatools)
library(cli)
data("adsl")
# IMWG sdtm data
data("rs_onco_imwg")
data("supprs_onco_imwg")

rs <- rs_onco_imwg
supprs <- supprs_onco_imwg

rs <- combine_supp(rs, supprs)

rs <- convert_blanks_to_na(rs)
```

```{r, eval=TRUE, echo=FALSE}
dataset_vignette(
  rs,
  display_vars = exprs(USUBJID, RSTESTCD, RSSTRESC, VISIT, RSDTC, RSDY, PDOFL, DTHPDFL, NACTDT, PDIFL)
)
```

At this step, it may be useful to join `ADSL` to your `RS` domain. Only
the `ADSL` variables used for derivations are selected at this step. The
rest of the relevant `ADSL` variables would be added later.

```{r eval=TRUE}
adsl_vars <- exprs(RANDDT, TRTSDT)
adrs <- derive_vars_merged(
  rs,
  dataset_add = adsl,
  new_vars = adsl_vars,
  by_vars = get_admiral_option("subject_keys")
)
```

```{r, eval=TRUE, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, RSTESTCD, VISIT, RSDTC, RANDDT, TRTSDT)
)
```

## Pre-processing of Input Records {#input}

The first step involves company-specific pre-processing of records for
the required input to the downstream parameter functions. Note that this
could be needed multiple times (e.g. once for investigator and once for
Independent Review Facility (IRF)/Blinded Independent Central Review
(BICR) records). It could even involve merging input data from other
sources besides `RS`, such as `ADTR`/`TR`/`TU`.

This step would include any required selection/derivation of `ADT` or applying
any necessary partial date imputations and updating `AVAL` (e.g. this should be
ordered from worst to best response).

The below shows an example of a possible company-specific implementation
of this step.

### Select Overall Response Records and Set Parameter Details

In this case we use the overall response records from `RS` from the
investigator as our starting point. 
It is worth emphasizing again that responses are not confirmed. 
Confirmed values will be derived after further pre-processing.

The parameter details such as
`PARAMCD`, `PARAM` etc will always be company-specific, but an example
is shown below so that you can trace through how these records feed into
the other parameter derivations.

```{r}
adrs <- adrs %>%
  filter(RSEVAL == "INVESTIGATOR" & RSTESTCD == "OVRLRESP") %>%
  mutate(
    PARAMCD = "OVR",
    PARAM = "Overall Response by Investigator",
    PARCAT1 = "Investigator",
    PARCAT2 = "IMWG"
  )
```

```{r, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, VISIT, RSTESTCD, RSEVAL, PARAMCD, PARAM, PARCAT1, PARCAT2)
)
```

### Partial Date Imputation and Deriving `ADT`, `ADTF`, `AVISIT` etc

If your data collection allows for partial dates, you could apply a
company-specific imputation rule at this stage when deriving `ADT`. For
this example, here we impute missing day to last possible date.

```{r}
adrs <- adrs %>%
  derive_vars_dt(
    dtc = RSDTC,
    new_vars_prefix = "A",
    highest_imputation = "D",
    date_imputation = "last"
  ) %>%
  derive_vars_dy(
    reference_date = TRTSDT,
    source_vars = exprs(ADT)
  ) %>%
  derive_vars_dtm(
    dtc = RSDTC,
    new_vars_prefix = "A",
    highest_imputation = "D",
    date_imputation = "last",
    flag_imputation = "time"
  ) %>%
  mutate(AVISIT = VISIT)
```

```{r, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, PARAMCD, VISIT, AVISIT, RSDTC, ADT, ADTF, ADY)
)
```

### Derive `AVALC` and `AVAL`

Here we populate `AVALC` and create the numeric version as `AVAL`
(ordered from worst to best response, followed by `NE`). The `AVAL` values are not considered in
the parameter derivations below, and so changing `AVAL` here would not change
the result of those derivations. However, please note that the ordering of `AVAL` 
will be used to determine `ANL01FL` in the subsequent step, ensure that the appropriate 
`mode` is being set in the `admiral::derive_var_extreme_flag()`.

IMWG ordering will be used or if you'd like to provide your own company-specific ordering here you
could do this as follows:

```{r}
aval_resp_imwg <- function(arg) {
  case_match(
    arg,
    "NE" ~ 8,
    "sCR" ~ 7,
    "CR" ~ 6,
    "VGPR" ~ 5,
    "PR" ~ 4,
    "MR" ~ 3,
    "SD" ~ 2,
    "PD" ~ 1,
    NA ~ NA_real_
  )
}

adrs <- adrs %>%
  mutate(
    AVALC = RSSTRESC,
    AVAL = aval_resp_imwg(AVALC)
  )
```

```{r, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, PARAMCD, AVISIT, ADT, AVAL, AVALC)
)
```

## Derive Confirmed Response Parameter {#covr}

Confirmation of response require two consecutive readings of applicable disease 
parameters (biochemical analyses). No minimal time interval, but a different sample
is required for the confirmation assessment. Bone marrow assessments and imaging do not need to be confirmed. 

If `RS` contains unconfirmed response and confirmation is performed at 
next scheduled visit we can derive Confirmed Response based on 
response at subsequent visit.

While deriving Confirmed Response, the following should be taken into consideration:

**Note**: *Patients will continue in the last Confirmed Response category until there is confirmation of progression or improvement to a higher response status.*

Let's define a function `aval_resp_conf` that maps numerical values to the responses, so that `PD` is prioritized and concept of "higher response status" is understandable:

```{r}
aval_resp_conf <- function(arg) {
  case_match(
    arg,
    "PD" ~ 8,
    "sCR" ~ 7,
    "CR" ~ 6,
    "VGPR" ~ 5,
    "PR" ~ 4,
    "MR" ~ 3,
    "SD" ~ 2,
    "NE" ~ 1,
    NA ~ 0
  )
}
```

Below table provides a summary of the Confirmed Response status calculation at 
each time point. The maximum refers to numeric values previously defined in `aval_resp_conf` function.

```{r echo=FALSE}
list_resp <- tribble(
  ~"Response at 1st time point", ~"Response at 2nd time point",
  ~"Confirmed Response at 1st time point",
  "sCR", "sCR", "sCR",
  "CR", "sCR/CR", "max(CR, last Confirmed Response)",
  "VGPR", "sCR/CR/VGPR", "max(VGPR, last Confirmed Response)",
  "PR", "sCR/CR/VGPR/PR", "max(PR, last Confirmed Response)",
  "MR", "sCR/CR/VGPR/PR/MR", "max(MR, last Confirmed Response)",
  "sCR", "CR", "max(CR, last Confirmed Response)",
  "sCR/CR", "VGPR", "max(VGPR, last Confirmed Response)",
  "sCR/CR/VGPR", "PR", "max(PR, last Confirmed Response)",
  "sCR/CR/VGPR/PR", "MR", "max(MR, last Confirmed Response)",
  "sCR/CR/VGPR/PR/MR", "SD/PD/NE/NA", "max(SD, last Confirmed Response)",
  "SD", "any", "max(SD, last Confirmed Response)",
  "NE", "any", "max(NE, last Confirmed Response)",
  "PD reason imaging", "any", "PD",
  "PD reason serum/urine", "PD/death", "PD",
  "PD reason serum/urine", "sCR/CR/VGPR/PR/MR/SD/NE/NA", "max(NE, last Confirmed Response)",
)

knitr::kable(list_resp)
```

### Handling Non-Evaluable Responses {#ne}

IMWG criteria article does not define exactly what is the time interval needed to confirm a response and whether non-evaluable (`NE`) records can be ignored when confirming a response. Detailed guidelines on this topic should be specified in SAP.

We assumed in our next steps that non-evaluable records are ignored when deriving Confirmed Response. That is, to confirm response at a visit we use the response from the first subsequent visit, which had an answer other than `NE`.

### Additional Variables {#suppfl}

To derive Confirmed Response we are using variables from `SUPPRS` dataset included in  `{pharmaversesdtm}` package.

```{r echo=FALSE}
list_suppfl <- tribble(
  ~"Variable Name", ~"Variable Label",
  "PDOFL", "Progressive Disease: Other",
  "PDIFL", "Progressive Disease: Imaging",
  "DTHPDFL", "Death Due to Progressive Disease",
  "NACTDT", "New Anti-Cancer Therapy Date"
)

knitr::kable(list_suppfl)
```
User will overwrite variable names if necessary.

1. `PDOFL`, `PDIFL`, `DTHPDFL` variables are used in derivation of `PD` as Confirmed Response.
If `PD` comes from imaging assessment (`PDIFL = "Y"`) or participant died due to disease under study before further adequate assessment could be performed (`DTHPDFL = "Y"`) or `PD` comes from biochemical markers and is followed by another `PD` (`PDOFL = "Y" and AVALC.next = "PD"`), we report `PD` as Confirmed Progression.

2. `NACTDT` variable is used to [exclude]{.underline} assessments after start day of subsequent therapy while confirming responses (`sCR`, `CR`, `VGPR`. `PR`, `MR`). However, testing during subsequent therapy can be used to confirm `PD`.

### Definition of `derive_confirmed_response` Function {#dcrdef}

`derive_confirmed_response` function defined below takes as an argument dataset with Overall Responses and returns dataset with Confirmed Responses.

In brief, the function performs the following steps:

1. Remove records with response of `NE` and derive intermediate response. 
2. Display a warning if responses used for confirmation are more than `confirmed_period` apart. User can set `confirmed_period` freely - there is no time limit on the sample we use to confirm the response. 
3. Add records with response of `NE`. 
4. Derive best Confirmed Response so far. 
5. Assign `AVAL` and `AVALC`, remove unnecessary variables.

```{r}
confirmation_period <- 84

derive_confirmed_response <- function(datain) {
  data_adrs <- datain %>%
    arrange(USUBJID, ADTM) %>%
    filter(AVALC != "NE") %>%
    group_by(USUBJID) %>%
    mutate(
      AVALC.next = lead(AVALC),
      AVAL.next = lead(AVAL),
      ADT.next = lead(ADT)
    ) %>%
    ungroup() %>%
    mutate(AVALC.confirmed = case_when(
      # better response
      AVALC %in% c("sCR", "CR", "VGPR", "PR", "MR") &
        AVALC.next %in% c("sCR", "CR", "VGPR", "PR", "MR") &
        (is.na(NACTDT) | ADT.next <= NACTDT) &
        AVAL.next >= AVAL ~ AVALC,
      # worse response
      AVALC %in% c("sCR", "CR", "VGPR", "PR", "MR") &
        AVALC.next %in% c("sCR", "CR", "VGPR", "PR", "MR", "SD") &
        (is.na(NACTDT) | ADT.next <= NACTDT) &
        AVAL.next < AVAL ~ AVALC.next,
      # next assessment PD, NA or after subsequent therapy
      AVALC %in% c("sCR", "CR", "VGPR", "PR", "MR") &
        (AVALC.next == "PD" | is.na(AVALC.next) |
          !is.na(NACTDT) & ADT.next > NACTDT) ~ "SD",
      # no need to confirm SD
      AVALC %in% c("SD") ~ AVALC,
      # confirmed progression
      AVALC == "PD" &
        (PDIFL == "Y" | DTHPDFL == "Y" | PDOFL == "Y" & AVALC.next == "PD") ~
        AVALC,
      # unconfirmed progression
      AVALC == "PD" & is.na(DTHPDFL) & PDOFL == "Y" &
        (AVALC.next %in% c("sCR", "CR", "VGPR", "PR", "MR", "SD") |
          is.na(AVALC.next)) ~ "NE"
    ))

  data_adrs_check <- data_adrs %>%
    mutate(diff_days = as.numeric(difftime(ADT.next, ADT, units = "days"))) %>%
    filter(diff_days > confirmation_period) %>%
    mutate(warn = paste(
      "For USUBJID", USUBJID, "to confirm", AVISIT,
      "visit, a visit that took place", diff_days, "days later was used."
    )) %>%
    pull(warn)

  if (length(data_adrs_check) > 0) {
    cli_warn("{data_adrs_check}")
  }

  data_adrs_ne <- datain %>%
    filter(AVALC == "NE") %>%
    mutate(AVALC.confirmed = AVALC)

  data_adrs_all <- bind_rows(data_adrs, data_adrs_ne) %>%
    arrange(USUBJID, ADTM) %>%
    mutate(AVAL.confirmed = aval_resp_conf(AVALC.confirmed)) %>%
    group_by(USUBJID) %>%
    # best Confirmed Response so far
    mutate(AVAL.confirmed = cummax(AVAL.confirmed)) %>%
    ungroup(USUBJID)

  # char mapping to go back to AVALC values
  avalc_resp_conf <- function(arg) {
    case_match(
      arg,
      8 ~ "PD",
      7 ~ "sCR",
      6 ~ "CR",
      5 ~ "VGPR",
      4 ~ "PR",
      3 ~ "MR",
      2 ~ "SD",
      1 ~ "NE",
      NA_real_ ~ NA
    )
  }

  data_adrs_all <- data_adrs_all %>%
    mutate(AVALC.confirmed = avalc_resp_conf(AVAL.confirmed)) %>%
    select(
      -AVAL, -AVALC, -AVAL.next, -AVALC.next, -ADT.next,
      -AVAL.confirmed
    ) %>%
    rename(AVALC = AVALC.confirmed) %>%
    mutate(AVAL = aval_resp_imwg(AVALC)) %>%
    mutate(
      PARAMCD = "COVR",
      PARAM = "Confirmed Response at Time Point by Investigator",
      PARCAT1 = "Investigator",
      PARCAT2 = "IMWG"
    )
}
adrs_imwg <- derive_confirmed_response(adrs)
```

```{r, echo=FALSE}
dataset_vignette(
  adrs_imwg,
  display_vars = exprs(USUBJID, PARAMCD, AVISIT, ADT, AVALC)
)
```

### Check Number of `NE` Values Between Responses {#nenum}

If user would like to receive a warning that there is a certain number of `NE`s between responses, this can be done using `filter_consecutive_vals` function defined below.

```{r}
filter_consecutive_vals <- function(dataset, by_vars, order, var, val, n) {
  var <- enexpr(var)
  var_join <- sym(paste0(as.character(var), ".join"))
  data <- derive_var_obs_number(dataset, by_vars = by_vars, order = order, new_var = temp_seq)

  left_join(
    data, select(data, !!!by_vars, temp_seq, !!var),
    by = admiraldev::vars2chr(by_vars),
    suffix = c("", ".join"),
    relationship = "many-to-many"
  ) %>%
    filter(temp_seq <= temp_seq.join & !!var == !!val) %>%
    filter_relative(
      by_vars = c(by_vars, expr(temp_seq)),
      order = exprs(temp_seq.join),
      condition = !!var_join != !!val,
      mode = "first",
      selection = "before",
      keep_no_ref_groups = TRUE,
      inclusive = FALSE
    ) %>%
    derive_var_merged_summary(
      dataset = .,
      dataset_add = .,
      by_vars = c(by_vars, expr(temp_seq)),
      new_vars = exprs(nr_vals = n())
    ) %>%
    filter(nr_vals >= n) %>%
    filter_extreme(
      by_vars = c(by_vars, expr(temp_seq)),
      order = exprs(temp_seq.join),
      mode = "first",
      check_type = "none"
    ) %>%
    select(-temp_seq, -temp_seq.join, -!!var_join, -nr_vals)
}

# filter on three or more NEs in a row
many_nes <- filter_consecutive_vals(
  adrs,
  by_vars = get_admiral_option("subject_keys"),
  order = exprs(ADTM),
  var = AVALC,
  val = "NE",
  n = 3
)

if (nrow(many_nes) > 0) {
  cli_warn("There are subjects with more than three NEs in a row.")
}
```

## Analysis Flag Derivation {#anlfl}

### Flag One Assessment at Each Analysis Visit (`ANL01FL`)  {#anl01fl}

To get Confirm Responses on each visit, we took into account all assessments - 
including those that took place after a new therapy was started 
or after progression.

When deriving `ANL01FL` this is an opportunity to exclude any records
that should not contribute to any downstream parameter derivations.

Common options for `ANL01FL` would be to set null for invalid assessments or
those occurring after new anti-cancer therapy, or to only flag assessments on or
after date of first treatment/randomization, or rules to cover the case when a
patient has multiple observations per visit/date (e.g. by selecting the worst value).
Another consideration could be extra potential protocol-specific sources of
Progressive Disease such as radiological assessments, which could be
pre-processed here to create a PD record to feed downstream derivations.

For the derivation of the parameters it is expected that the subject
identifier variables (usually `STUDYID` and `USUBJID`) and `ADT` are a
unique key. 

In the below example we consider only valid assessments and
those occurring on or after randomization date. If there is more than
one assessment at a date, the worst one is flagged.

```{r}
adrs_imwg <- adrs_imwg %>%
  restrict_derivation(
    derivation = derive_var_extreme_flag,
    args = params(
      by_vars = exprs(!!!get_admiral_option("subject_keys"), ADT),
      order = exprs(AVAL, RSSEQ),
      new_var = ANL01FL,
      mode = "first"
    ),
    filter = !is.na(AVAL) & AVALC != "MISSING" & ADT >= RANDDT
  )
```

### Exclude Assessments After New Anti-Cancer Therapy (`ANL02FL`) {#anl02fl}

Here is an alternative example where those records occurring after new
anti-cancer therapy are additionally excluded (where `NACTDT` would be
pre-derived as first date of new anti-cancer therapy.   
In our example `NACTDT` is present in `SUPPRS` domain. If not available,
see `{admiralonco}`
[Creating and Using New Anti-Cancer Start Date](nactdt.html) for deriving this
variable).

```{r, eval=TRUE}
adrs_imwg <- adrs_imwg %>%
  mutate(
    ANL02FL = case_when(
      !is.na(AVAL) & ADT >= RANDDT & ADT < NACTDT ~ "Y",
      is.na(NACTDT) ~ "Y",
      TRUE ~ NA_character_
    )
  )
```

### Flag Assessments up to First PD (`ANL03FL`)  {#anl03fl}

To restrict response data up to and including first reported progressive disease
`ANL03FL` flag could be created by using `{admiral}` function
`admiral::derive_var_relative_flag()`.

```{r}
adrs_imwg <- adrs_imwg %>%
  derive_var_relative_flag(
    by_vars = get_admiral_option("subject_keys"),
    order = exprs(ADT, RSSEQ),
    new_var = ANL03FL,
    condition = AVALC == "PD",
    mode = "first",
    selection = "before",
    inclusive = TRUE
  )
```

```{r, echo=FALSE}
dataset_vignette(
  adrs_imwg,
  display_vars = exprs(USUBJID, AVISIT, PARAMCD, AVALC, ADT, ANL01FL, ANL02FL, ANL03FL)
)
```

### Select Source Assessments for Parameter derivations

For next parameter derivations we consider only Confirmed Responses (`PARAMCD = "COVR"`). 
We take post-baseline records (`ANL01FL = "Y"`)  before start of new anti-cancer therapy (`ANL02FL = "Y"`) and up to and including first PD (`ANL03FL = "Y"`).
```{r}
ovr <- filter(adrs_imwg, PARAMCD == "COVR" & ANL01FL == "Y" & ANL02FL == "Y" & ANL03FL == "Y")

adrs <- bind_rows(adrs, adrs_imwg)
```

```{r, echo=FALSE}
dataset_vignette(
  ovr,
  display_vars = exprs(USUBJID, AVISIT, AVALC, ADT, RANDDT)
)
```

## Derive Progressive Disease Parameter {#pd}

Now that we have the input records prepared above with any
company-specific requirements, we can start to derive new parameter
records. For the parameter derivations, all values except those
overwritten by `set_values_to` argument are kept from the earliest
occurring input record fulfilling the required criteria.

The function `admiral::derive_extreme_records()` can be used to find the date of
first PD.

```{r}
adrs <- adrs %>%
  derive_extreme_records(
    dataset_ref = adsl,
    dataset_add = ovr,
    by_vars = get_admiral_option("subject_keys"),
    filter_add = PARAMCD == "COVR" & AVALC == "PD",
    order = exprs(ADT),
    mode = "first",
    exist_flag = AVALC,
    false_value = "N",
    set_values_to = exprs(
      PARAMCD = "PD",
      PARAM = "Disease Progression by Investigator",
      PARCAT1 = "Investigator",
      PARCAT2 = "IMWG",
      AVAL = yn_to_numeric(AVALC),
      ANL01FL = "Y",
      ANL02FL = "Y",
      ANL03FL = "Y"
    )
  )
```

```{r, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, AVISIT, PARAMCD, AVALC, ADT),
  filter = PARAMCD == "PD"
)
```

For progressive disease and response shown in steps here and below, in our 
examples we show these as `ADRS` parameters, but they could equally be 
achieved via `ADSL` dates or `ADEVENT` parameters. If you prefer to store 
as an ADSL date, then the function `admiral::derive_var_extreme_dt()` 
could be used to find the date of first `PD` as a variable, rather than 
as a new parameter record.

## Define Events {#ev}

The building blocks for the events that contribute to deriving common endpoints
like what constitutes a responder, or a Best Overall Response of complete
response (CR), ... are predefined in admiralonco for RECIST 1.1 (see [Pre-Defined
Response Event Objects](../reference/event_objects.html)). 

New events need to be defined for the IMWG criteria.  
Below are definitions of non-response events used in the derivations of all parameters.   
Parameter-specific events are defined right before the parameter derivation.

```{r}
no_data_n <- event(
  description = "Define no response for all patients in adsl (should be used as last event)",
  dataset_name = "adsl",
  condition = TRUE,
  set_values_to = exprs(AVALC = "N"),
  keep_source_vars = adsl_vars
)

no_data_missing <- event(
  description = paste(
    "Define missing response (MISSING) for all patients in adsl (should be used",
    "as last event)"
  ),
  dataset_name = "adsl",
  condition = TRUE,
  set_values_to = exprs(AVALC = "MISSING"),
  keep_source_vars = adsl_vars
)
```

## Derive Response Parameter {#rsp}

The function `admiral::derive_extreme_event()` can then be used to find the date
of first response. In the below example, the response condition has been defined
as `PR` or better via the event `rsp_y_imwg` that was created for IMWG.

```{r}
rsp_y_imwg <- event(
  description = "Define sCR, CR, VGPR or PR as response",
  dataset_name = "ovr",
  condition = AVALC %in% c("sCR", "CR", "VGPR", "PR"),
  set_values_to = exprs(AVALC = "Y")
)

adrs <- adrs %>%
  derive_extreme_event(
    by_vars = get_admiral_option("subject_keys"),
    order = exprs(ADT),
    mode = "first",
    events = list(rsp_y_imwg, no_data_n),
    source_datasets = list(
      ovr = ovr,
      adsl = adsl
    ),
    set_values_to = exprs(
      PARAMCD = "RSP",
      PARAM = "IMWG Response by Investigator",
      PARCAT1 = "Investigator",
      PARCAT2 = "IMWG",
      AVAL = yn_to_numeric(AVALC),
      ANL01FL = "Y",
      ANL02FL = "Y",
      ANL03FL = "Y"
    )
  )
```

```{r, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, RSORRES, AVISIT, PARAMCD, AVALC, ADT),
  filter = PARAMCD == "RSP" & AVALC == "Y"
)
```

## Derive Clinical Benefit Parameter {#cb}

The function `admiral::derive_extreme_event()` can then be used to derive the
clinical benefit parameter, which we define as a patient having had a response
or a sustained period of time before first `PD`. This could also be known as
disease control. In this example the "sustained period" has been defined as 42
days after randomization date via the created `cb_y_imwg` event.

```{r}
sustained_period <- 42

cb_y_imwg <- event(
  description = paste(
    "Define sCR, CR, VGPR, PR, MR or SD occuring at least",
    sustained_period,
    "days after randomization as clinical benefit"
  ),
  dataset_name = "ovr",
  condition = AVALC %in% c("sCR", "CR", "VGPR", "PR", "MR", "SD") &
    ADT >= RANDDT + days(sustained_period),
  set_values_to = exprs(AVALC = "Y")
)
```

Please note that the result `AVALC = "Y"` is defined by the first _two_ events
specified for `events`. For subjects with observations fulfilling both events
the one with the earlier date should be selected (and not the first one in the
list). Thus `ignore_event_order` and `tmp_event_nr_var` are not specified.

```{r}
adrs <- adrs %>%
  derive_extreme_event(
    by_vars = get_admiral_option("subject_keys"),
    order = exprs(desc(AVALC), ADT),
    mode = "first",
    events = list(rsp_y_imwg, cb_y_imwg, no_data_n),
    source_datasets = list(
      ovr = ovr,
      adsl = adsl
    ),
    set_values_to = exprs(
      PARAMCD = "CB",
      PARAM = "IMWG Clinical Benefit by Investigator",
      PARCAT1 = "Investigator",
      PARCAT2 = "IMWG",
      AVAL = yn_to_numeric(AVALC),
      ANL01FL = "Y",
      ANL02FL = "Y",
      ANL03FL = "Y"
    ),
    check_type = "none"
  )
```

```{r, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, RSORRES, AVISIT, PARAMCD, AVALC, ADT),
  filter = PARAMCD == "CB" & AVALC == "Y"
)
```

Similarly, we can define the parameters:

* CR or better response (`PARAMCD` = `CRRSP`),  
* VGPR or better response (`PARAMCD` =`VGPRRSP`).

```{r}
cr_y_imwg <- event(
  description = "Define sCR or CR as response",
  dataset_name = "ovr",
  condition = AVALC %in% c("sCR", "CR"),
  set_values_to = exprs(AVALC = "Y")
)

adrs <- adrs %>%
  derive_extreme_event(
    by_vars = get_admiral_option("subject_keys"),
    order = exprs(desc(AVALC), ADT),
    mode = "first",
    events = list(cr_y_imwg, no_data_n),
    source_datasets = list(
      ovr = ovr,
      adsl = adsl
    ),
    set_values_to = exprs(
      PARAMCD = "CRRSP",
      PARAM = "IMWG Complete Response by Investigator",
      PARCAT1 = "Investigator",
      PARCAT2 = "IMWG",
      AVAL = yn_to_numeric(AVALC),
      ANL01FL = "Y",
      ANL02FL = "Y",
      ANL03FL = "Y"
    ),
    check_type = "none"
  )

vgpr_y_imwg <- event(
  description = "Define sCR, CR or VGPR as response",
  dataset_name = "ovr",
  condition = AVALC %in% c("sCR", "CR", "VGPR"),
  set_values_to = exprs(AVALC = "Y")
)

adrs <- adrs %>%
  derive_extreme_event(
    by_vars = get_admiral_option("subject_keys"),
    order = exprs(desc(AVALC), ADT),
    mode = "first",
    events = list(vgpr_y_imwg, no_data_n),
    source_datasets = list(
      ovr = ovr,
      adsl = adsl
    ),
    set_values_to = exprs(
      PARAMCD = "VGPRRSP",
      PARAM = "IMWG VGPR Response by Investigator",
      PARCAT1 = "Investigator",
      PARCAT2 = "IMWG",
      AVAL = yn_to_numeric(AVALC),
      ANL01FL = "Y",
      ANL02FL = "Y",
      ANL03FL = "Y"
    ),
    check_type = "none"
  )
```

```{r, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, RSORRES, AVISIT, PARAMCD, AVALC, ADT),
  filter = PARAMCD %in% c("CRRSP", "VGPRRSP") & AVALC == "Y"
)
```

## Derive Best Confirmed Overall Response Parameter {#cbor}

The function `admiral::derive_extreme_event()` can be used to derive the best
confirmed overall response parameter.

Please note that the order of the events specified for `events` is important.
For example, a subject with `PR`, `PR`, `CR` qualifies for both `bor_cr` and
`bor_pr`. As `bor_cr` is listed before `bor_pr`, `CR` is selected as best overall
response for this subject.

Some events such as `bor_cr`, `bor_pr` have been defined in {admiralonco}.
Missing events specific to IMWG criteria are defined below.  
**Note**: *For `SD`, it is not required as for RECIST1.1 that the response occurs after a protocol-defined number of days.*

```{r}
bor_scr <- event(
  description = "Define stringent complete response (sCR) for best overall response
  (BOR)",
  dataset_name = "ovr",
  condition = AVALC == "sCR",
  set_values_to = exprs(AVALC = "sCR")
)

bor_vgpr <- event(
  description = "Define very good partial response (VGPR) for best overall response
  (BOR)",
  dataset_name = "ovr",
  condition = AVALC == "VGPR",
  set_values_to = exprs(AVALC = "VGPR")
)

bor_mr <- event(
  description = "Define minimal response (MR) for best overall response (BOR)",
  dataset_name = "ovr",
  condition = AVALC == "MR",
  set_values_to = exprs(AVALC = "MR")
)

bor_sd_imwg <- event(
  description = "Define stable disease (SD) for best overall response (BOR)",
  dataset_name = "ovr",
  condition = AVALC == "SD",
  set_values_to = exprs(AVALC = "SD")
)

bor_ne_imwg <- event(
  description = "Define not evaluable (NE) for best overall response (BOR)",
  dataset_name = "ovr",
  condition = AVALC == "NE",
  set_values_to = exprs(AVALC = "NE")
)

adrs <- adrs %>%
  derive_extreme_event(
    by_vars = get_admiral_option("subject_keys"),
    tmp_event_nr_var = event_nr,
    order = exprs(event_nr, ADT),
    mode = "first",
    source_datasets = list(
      ovr = ovr,
      adsl = adsl
    ),
    events = list(
      bor_scr, bor_cr, bor_vgpr, bor_pr, bor_mr, bor_sd_imwg, bor_pd, bor_ne_imwg,
      no_data_missing
    ),
    set_values_to = exprs(
      PARAMCD = "CBOR",
      PARAM = "IMWG Best Confirmed Overall Response by Investigator",
      PARCAT1 = "Investigator",
      PARCAT2 = "IMWG",
      AVAL = aval_resp_imwg(AVALC),
      ANL01FL = "Y",
      ANL02FL = "Y",
      ANL03FL = "Y"
    )
  )
```

```{r, echo=FALSE}
dataset_vignette(
  adrs,
  display_vars = exprs(USUBJID, AVISIT, PARAMCD, AVALC, ADT),
  filter = PARAMCD == "CBOR" & AVALC != "MISSING"
)
```

## Other Endpoints {#other}

For examples on the additional endpoints, please see [Creating ADRS (Including Non-standard Endpoints)](adrs.html).
