---
title: "CTNote Library: Relapse Outcomes"
author: "Gabriel Odom, Laura Brandt, Sean Luo, and Ray Balise"
date: "`r Sys.Date()`"
output:
  rmarkdown::html_vignette:
    toc: true
    toc_depth: 2
    code_folding: hide
bibliography: bib/Brandt_Opioids.bib
vignette: >
  %\VignetteIndexEntry{CTNote Library: Relapse Outcomes}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

```{r, load-packages, include=FALSE}
library(CTNote)
library(readxl)
library(kableExtra)
library(tidyverse)
```



# Introduction
This document contains the algorithms necessary to code all the outcomes which measure "abstinence from substance use" or "relapse to substance use". We only include outcomes which result in a single value per subject. These outcomes are:
```{r, import-table-one, include=FALSE}
pathToTable1_char <- system.file(
  "suppl_docs", "definitions_20221123.xlsx", package = "CTNote", mustWork = TRUE
)
tab1_df <- readxl::read_xlsx(pathToTable1_char) 
```

```{r, tidy-table-one, include=FALSE}
tabTidy1_df <- 
  tab1_df %>% 
  select(-`Frequency of UOS`, -`Coded column name`, -DOI) %>% 
  rename(
    Group = `Outcome Group`,
    Endpoint = `Primary Endpoint`,
    Class = `Numeric Class`,
    Definition = `Definition/Assessment of Outcome`,
    `Missing is` = `Missing UOS coded as`
  ) %>% 
  mutate(
    Group = case_when(
      str_detect(Group, "Abstinence") ~ "Abstinence",
      str_detect(Group, "Relapse") ~ "Relapse",
      str_detect(Group, "Reduction") ~ "Reduction",
    )
  ) %>% 
  filter(Group == "Relapse") %>% 
  arrange(Reference)

defns_char <- tabTidy1_df$Definition
names(defns_char) <- tabTidy1_df$Reference
```


```{r, show-table-one-reduction, results='asis', echo=FALSE}
tabTidy1_df  %>% 
  kable("html") %>%
  column_spec(1:4, width = "3cm") %>%
  column_spec(5, width = "5cm") %>%
  kable_styling("striped", font_size = 11) %>%
  kable_minimal() %>% 
  # All styling and spec calls have to come BEFORE this line.
  scroll_box(width = "1000px", height = "500px") 
```

We will use the table of participant opioid use patterns from the `ctn0094DataExtra` package to calculate these endpoints (we have a copy of the endpoints in the dataset `outcomesCTN0094`). Importantly, if you wish to apply these algorithms to calculate endpoints for your data, the participants' substance use patterns must be stored in the "substance use pattern word" format shown here. We also show a subset of the data to visualize a variety of different real substance use patterns.

We first define the following five-value legend:

- **+**: positive for the substance(s) in a specified window of time (a day, week, month, etc.) by urine screen (or participant self report, if such data are of interest)
- **–**: negative for the substance(s)
- **o**: subject failed to provide a urine sample
- <b>*</b>: inconclusive results or mixed results (e.g. subject provided more than one urine sample in the time interval and they did not agree)
- <b>_</b>: no specimens required (weekends, holidays, pre-randomization period, alternating visit days/weeks)

```{r}
###  Full Data  ###
udsOutcomes_df <- 
	CTNote::outcomesCTN0094 %>% 
  select(who, usePatternUDS)

# Make a copy
outcomesRel_df <- udsOutcomes_df


###  Examples  ###
examplePeople_int <- c(1, 163, 210, 242, 4, 17, 13, 1103, 233, 2089)
outcomesRel_df %>% 
  filter(who %in% examplePeople_int)
```

For example, participant 1 has a use pattern `ooooooooooooooo` (all missing UDS), which means that they dropped out of the study. In contrast, participant 233 has a use pattern `*+++++++++++o++++++++++o` (nearly all positive UDS): they did not drop out of the study, but the treatment was completely ineffective for them. Participant 2089 started the study in a rough patch, but greatly improved in treatment over time (`++++---+--------------o-`).



*******************************************************************************
</br>

# "Relapse to Substance Use" Endpoints

## CTN-0094 Endpoints
```{r, include=FALSE}
which0094_idx <- which(
  names(defns_char) == "CTN-0094"
)
```

Our [CTN-0094 research group](http://ctndisseminationlibrary.org/protocols/ctn0094.htm) has two relapse outcomes: `r defns_char[[which0094_idx[1]]]` and `r defns_char[[which0094_idx[2]]]`.

### CTN-0094 Relapse
**Definition**: `r defns_char[[which0094_idx[1]]]`; missing is positive
```{r}
outcomesRel_df <- 
	outcomesRel_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS
		)
	) %>%
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
  mutate(
		ctn0094_relapse = detect_in_window(
			use_pattern = udsPattern,
			window_width = 4L,
			threshold = 4L
		)
	) %>% 
	unnest(cols = "ctn0094_relapse", names_sep = "_") %>% 
	select(who, starts_with("ctn0094_relapse")) %>% 
  rename(
    RsT_ctnNinetyFour_2023 = ctn0094_relapse_time,
    RsE_ctnNinetyFour_2023 = ctn0094_relapse_event
  ) %>% 
	left_join(outcomesRel_df, ., by = "who")

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, RsT_ctnNinetyFour_2023, RsE_ctnNinetyFour_2023)
```

### CTN-0094 Dropout
**Definition**: `r defns_char[[which0094_idx[2]]]`
```{r}
outcomesRel_df <- 
	outcomesRel_df %>%
  rowwise() %>% 
  # do NOT recode any missing visits
  mutate(
		ctn0094_dropout = detect_in_window(
			use_pattern = usePatternUDS,
			window_width = 4L,
			threshold = 4L,
			match_is = "o"
		)
	) %>% 
	unnest(cols = "ctn0094_dropout", names_sep = "_") %>% 
	select(who, starts_with("ctn0094_dropout")) %>% 
  rename(
    DrT_ctnNinetyFour_2023 = ctn0094_dropout_time,
    DrE_ctnNinetyFour_2023 = ctn0094_dropout_event
  ) %>% 
	left_join(outcomesRel_df, ., by = "who")

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, DrT_ctnNinetyFour_2023, DrE_ctnNinetyFour_2023)
```


## @johnson_controlled_1992
**Definition**: `r defns_char["Johnson, Jaffe, & Fudala, 1992"]`; missing is positive
```{r}
outcomesRel_df <- 
	outcomesRel_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		Rs_johnson_1992 = detect_subpattern(
			use_pattern = udsPattern,
			subpattern = "++",
			# Starting at 4 weeks of treatment
			start = 4L
		)
	) %>% 
	select(who, Rs_johnson_1992) %>% 
	left_join(outcomesRel_df, ., by = "who")

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Rs_johnson_1992)
```


## @krupitsky_naltrexone_2004 and @krupitsky_naltrexone_2006
**Definition**: `r defns_char["Krupitsky et al., 2004"]`; missing is positive (their papers do not explicitly state what to do with missing UDS, but their previous protocols treated missing as positive).
```{r}
outcomesRel_df <- 
	outcomesRel_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		Rs_krupitsky_2004 = detect_subpattern(
			use_pattern = udsPattern,
			subpattern = "+++"
		)
	) %>% 
	select(who, Rs_krupitsky_2004) %>% 
	left_join(outcomesRel_df, ., by = "who")

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Rs_krupitsky_2004)
```


## @lee_extended-release_2016
**Definition**: `r defns_char["Lee et al., 2016"]`; missing is positive

We interpret their outcome as "two or more positive weekly UDS in a 4-week window".
```{r}
outcomesRel_df <- 
	outcomesRel_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		lee2016_rel = detect_in_window(
			use_pattern = udsPattern,
			window_width = 4L,
			threshold = 2L
		)
	) %>% 
	unnest(cols = "lee2016_rel", names_sep = "_") %>% 
	select(who, starts_with("lee2016_rel")) %>% 
  rename(
    RsT_lee_2016 = lee2016_rel_time,
    RsE_lee_2016 = lee2016_rel_event
  ) %>% 
	left_join(outcomesRel_df, ., by = "who")

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, contains("lee_2016"))
```


## @lee_comparative_2018 [CTN-0051]
**Definition**: `r defns_char["Lee et al., 2018 CTN-0051"]`; missing is positive

```{r}
outcomesRel_df <- 
	outcomesRel_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		udsPatternTrimmed = str_sub(udsPattern, start = 3L)
	) %>% 
	rowwise() %>% 
	mutate(
		lee2018_rel = detect_in_window(
			use_pattern = udsPatternTrimmed,
			window_width = 4L,
			threshold = 4L
		)
	) %>% 
	unnest(cols = "lee2018_rel", names_sep = "_") %>% 
	mutate(lee2018_rel_time = lee2018_rel_time + 2) %>% 
	select(who, starts_with("lee2018_rel")) %>% 
  rename(
    RsT_ctnFiftyOne_2018 = lee2018_rel_time,
    RsE_ctnFiftyOne_2018 = lee2018_rel_event
  ) %>% 
	left_join(outcomesRel_df, ., by = "who")

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, contains("ctnFiftyOne_2018"))
```


## @schottenfeld_maintenance_2008
**Definition**: `r defns_char["Schottenfeld et al., 2008"]`; missing is positive
```{r}
outcomesRel_df <- 
	outcomesRel_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		schottenfeld2008_rel = detect_in_window(
			use_pattern = udsPattern,
			window_width = 3L,
			threshold = 3L
		)
	) %>% 
	unnest(cols = "schottenfeld2008_rel", names_sep = "_") %>% 
	select(who, starts_with("schottenfeld2008_rel")) %>% 
  rename(
    RsT_schottenfeld_2008 = schottenfeld2008_rel_time,
    RsE_schottenfeld_2008 = schottenfeld2008_rel_event
  ) %>% 
	left_join(outcomesRel_df, ., by = "who")

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, contains("schottenfeld_2008"))
```


*******************************************************************************
</br>



# Computing Environment

Here is the information concerning the system configuration, packages, and their versions used in this computation:

```{r}
sessionInfo()
```


```{r, include=FALSE, eval=FALSE}
# write_csv(
#   outcomesRel_df,
#   file = "../inst/extdata/outcomes_relapse_20221123.csv"
# )
```


# References