---
title: "CTNote Library: Abstinence 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: Abstinence 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 == "Abstinence") %>% 
  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
outcomesAbs_df <- udsOutcomes_df


###  Examples  ###
examplePeople_int <- c(1, 163, 210, 242, 4, 17, 13, 1103, 233, 2089)
outcomesAbs_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>

# Abstinence from Substance Use Endpoints


## CTN-0094 Abstinence
Our [CTN-0094 research group](http://ctndisseminationlibrary.org/protocols/ctn0094.htm) has one abstinence outcome, which we consider a "fair" metric for end-of-treatment abstinence. **Definition**: in the last four weeks of treatment, 0 positive and no more than 1 missing UDS. *Note*: we intend this definition as a measure of "soft" abstinence; specifically, we allow the participant to miss one of the scheduled meetings in their last four weeks of treatment, as long as the UDS pattern for the remaining three weeks is all present and negative.
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  # mixed results != abstinence
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
			missing_is = "*"
		)
	) %>% 
	mutate(
		Ab_ctnNinetyFour_2023 = any(
		  detect_subpattern(
			  use_pattern = udsPattern,
			  subpattern = c("----", "o---", "-o--", "--o-", "---o"),
			  start = 12,
			  end = 15
		  )
		)
	) %>% 
	select(who, Ab_ctnNinetyFour_2023) %>% 
	left_join(outcomesAbs_df, ., by = "who")

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_ctnNinetyFour_2023)
```



## @fiellin_counseling_2006
**Definition**: `r defns_char["Fiellin et al., 2006"]`; missing is positive
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
		)
	) %>% 
  # mixed results != abstinence
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
  # We did not code this definition with an "end", so participants with longer
  #   stays in treatment could have higher scores
	mutate(
		Ab_fiellin_2006 = count_matches(
			use_pattern = udsPattern,
			match_is = "-"
		)
	) %>% 
	select(who, Ab_fiellin_2006) %>% 
	left_join(outcomesAbs_df, ., by = "who")

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_fiellin_2006)
```


## @kosten_buprenorphine_1993
**Definition**: `r defns_char["Kosten et al., 1993"]`
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  mutate(
		Ab_kosten_1993 = detect_subpattern(
			usePatternUDS,
			subpattern = "---" 
		)
	) %>% 
	select(who, Ab_kosten_1993) %>% 
	left_join(outcomesAbs_df, ., by = "who")

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_kosten_1993)
```


## @krupitsky_injectable_2011 (A) and (B)
```{r, include=FALSE}
whichKrupitsky_idx <- which(
  names(defns_char) == "Krupitsky et al., 2011"
)
```

There are two definitions from [this paper](https://doi.org/DOI:10.1016/S0140-6736(11)60358-9) which we include in the reduction section our library: `r defns_char[[whichKrupitsky_idx[1]]]` and `r defns_char[[whichKrupitsky_idx[2]]]`. 

### Krupitsky et al., 2011 (A)
**Definition**: `r defns_char[[whichKrupitsky_idx[1]]]`

A comment on our algorithm: we do not know how long each protocol is exactly, so a pattern match approach (while intuitive at first) would not work. We will instead recode the use pattern as "negative" or "non-negative", and then check that the proportion of non-negative UDS is 0%.
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		useProp = count_matches(
			use_pattern = udsPattern,
			match_is = "+",
			start = 5L,
			# Set this to the length of your protocol, or 24, whichever is shorter
			end = 15L,
			proportion = TRUE
		)
	) %>% 
	mutate(Ab_krupitskyA_2011 = useProp == 0) %>% 
	select(who, Ab_krupitskyA_2011) %>% 
	left_join(outcomesAbs_df, ., by = "who")

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_krupitskyA_2011)
```

### Krupitsky et al., 2011 (B)
**Definition**: `r defns_char[[whichKrupitsky_idx[2]]]`
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		Ab_krupitskyB_2011 = count_matches(
			use_pattern = udsPattern,
			match_is = "-",
			start = 5L,
			# This trial protocol has a clear end date; we adjust it to our data
			end = 15L
		)
	) %>% 
	select(who, Ab_krupitskyB_2011) %>% 
	left_join(outcomesAbs_df, ., by = "who")

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_krupitskyB_2011)
```


## @ling_buprenorphine_1998
**Definition**: `r defns_char["Ling et al., 1998"]`; urine was screened 3 times per week
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  mutate(
		Ab_ling_1998 = detect_subpattern(
			use_pattern = usePatternUDS,
			# 13 consecutive UDS at 3x per week is 4.3 weeks
			subpattern = "----"
		)
	) %>% 
	select(who, Ab_ling_1998) %>% 
	left_join(outcomesAbs_df, ., by = "who")
  

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_ling_1998)
```


## @lofwall_weekly_2018
**Definition**: `r defns_char["Lofwall et al., 2018"]`

[In their paper](https://doi.org/10.1001/jamainternmed.2018.1052), abstinence was defined as 2 of 3 negative UDS for weeks 9, 10, and 11; negative UDS in week 12; and 5 or 6 UDS negative during weeks 13-24 (with alternating week visits, yielding 6 visits in this Phase II period). Because we have 15 weeks of data guaranteed, we scale this window and lattice. Their definition of abstinence is quite complex. Because we only have 15 weeks of data for most subjects, we shift their 12-week Phase I endpoint to week 7, and treat weeks 8-15 as Phase II. Also, we calculate these as proportions and not counts; this is so that these rules can be applied to windows of other sizes. The proportions would be the same---only the window of observation would change.
```{r}
###  Define 15-week Lattice  ###
lofwallLattice_char <- collapse_lattice(
	lattice_patterns = c("o", "_o"),
	# For the lattice as defined over 24 weeks, you need 12 weeks of weekly visits
	#   and 6 sets of alternating "no visit" and "visit" week pairs, or c(12, 6).
	#   For us, we want 7 weeks straight of weekly visits followed by 4 pairs of
	#   alternating visits (8 weeks) for a total of 15 weeks.
	times = c(7, 4)
)
lofwallLattice_char


###  Calculate Weighted Abstinence  ###
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  # Change mixed and missing results to positive
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
			missing_is = "*"
		)
	) %>% 
  mutate(
    udsPattern = recode_missing_visits(udsPattern)
  ) %>% 
  # "observe" only the UDS that would have been caught by the protocol
	mutate(
		udsLattice = view_by_lattice(
			use_pattern = udsPattern,
			lattice_pattern = str_sub(lofwallLattice_char, end = 15) # first 15 weeks
		)
	) %>% 
	# Impute the visits that were not "observed"
	mutate(
		udsLatticeLOCF = impute_missing_visits(
			use_pattern = udsLattice,
			method = "locf",
			missing_is = "_",
			quietly = TRUE
		)
	) %>% 
  # Count for Weeks 5-7; Week 8; and Weeks 9-15
	mutate(
		prop57 = count_matches(
			udsLatticeLOCF,
			match_is = "-",
			start = 5L,
			end = 7L,
			proportion = TRUE
		),
		clean8 = count_matches(
			udsLatticeLOCF,
			match_is = "-",
			start = 8L,
			end = 8L
		),
		prop915 = count_matches(
			udsLatticeLOCF,
			match_is = "-",
			start = 9L,
			end = 15L,
			proportion = TRUE
		),
	) %>% 
  # Check interval counts/proportions
	mutate(
		Ab_lofwall_2018 = (prop57 >= 2/3) & (clean8 == 1) & (prop915 >= 5/6)
	) %>% 
	select(who, Ab_lofwall_2018) %>% 
	left_join(outcomesAbs_df, ., by = "who")

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_lofwall_2018)
```


## @mokri_medical_2016
**Definition**: `r defns_char["Mokri, Chawarski, Taherinakhost, & Schottenfeld, 2016"]`; missing is positive
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS
		)
	) %>%
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>%
  # Find the number of weeks until the first "+"
	mutate(
		mokri2016_abs = detect_in_window(
			use_pattern = udsPattern,
			window_width = 1L,
			threshold = 1L
		)
	) %>%
	unnest(cols = "mokri2016_abs", names_sep = "_") %>%
	select(who, starts_with("mokri2016_abs")) %>%
  rename(
    AbT_mokri_2016 = mokri2016_abs_time,
    AbE_mokri_2016 = mokri2016_abs_event
  ) %>% 
	left_join(outcomesAbs_df, ., by = "who")
  
outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, contains("mokri_2016"))
```

If you are more comfortable using "survival" or "time-to-event" data structures, then the above definition can be modified by the following code:
```{r}
outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  mutate(
    mokri2016_wksAbst = survival::Surv(
      time = AbT_mokri_2016,
      event = AbE_mokri_2016
    )
  ) %>% 
  # FOR PRINTING THE TABLE ONLY. DO NOT USE NEXT LINE IN PRACTICE!!!
  mutate(mokri2016_wksAbst = as.character(mokri2016_wksAbst)) %>% 
  select(who, usePatternUDS, mokri2016_wksAbst)
```


## @schottenfeld_methadone_2005
**Definition**: `r defns_char["Schottenfeld et al., 2005"]`, missing is ignored
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  # Ignore missing visits
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
			missing_becomes = ""
		)
	) %>% 
  # Mixed are positive
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
  # Measure the length of the longest period of continuous abstinence
	mutate(
		Ab_schottenfeld_2005 = measure_abstinence_period(
			use_pattern_binary = udsPattern
		)
	) %>% 
	select(who, Ab_schottenfeld_2005) %>% 
	left_join(outcomesAbs_df, ., by = "who")
  

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_schottenfeld_2005)
```


## @schottenfeld_maintenance_2008 (A) and (B)

There are two definitions from [this paper](https://doi.org/10.1016/S0140-6736(08)60954-X) which we include in the reduction section our library: `r defns_char["Schottenfeld et al., 2008"]` and `r defns_char["Schottenfeld, Chawarski, & Mazlan, 2008"]`. 

### Schottenfeld, Chawarski, & Mazlan, 2008 (A)
**Definition**: `r defns_char["Schottenfeld, Chawarski, & Mazlan, 2008"]`, missing is positive
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		schottenfeld2008A_abs = detect_in_window(
			use_pattern = udsPattern,
			window_width = 1L,
			threshold = 1L
		)
	) %>% 
	unnest(cols = "schottenfeld2008A_abs", names_sep = "_") %>% 
	select(who, starts_with("schottenfeld2008A_abs")) %>% 
  rename(
    AbT_schottenfeldA_2008 = schottenfeld2008A_abs_time,
    AbE_schottenfeldA_2008 = schottenfeld2008A_abs_event
  ) %>% 
	left_join(outcomesAbs_df, ., by = "who")
  
outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, contains("schottenfeldA_2008"))
```


### Schottenfeld et al., 2008 (B)
**Definition**: `r defns_char["Schottenfeld et al., 2008"]`, missing is positive
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>%
	mutate(
		Ab_schottenfeldB_2008 = measure_abstinence_period(
			use_pattern_binary = udsPattern
		)
	) %>% 
	select(who, Ab_schottenfeldB_2008) %>% 
	left_join(outcomesAbs_df, ., by = "who")
  

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_schottenfeldB_2008)
```


## @shufman_efficacy_1994
**Definition**: `r defns_char["Shufman et al., 1994"]`, missing is ignored (but treated as negative in order to count the weeks properly)
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  # Set "o" to "-"
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
			missing_becomes = "-"
		)
	) %>% 
	# Set "*" to "+"
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		shufman1994_absN = detect_in_window(
			use_pattern = udsPattern,
			window_width = 1L,
			threshold = 1L
		)
	) %>% 
	unnest(cols = "shufman1994_absN", names_sep = "_") %>% 
	select(who, starts_with("shufman1994_absN")) %>% 
  rename(
    AbT_shufman_1994 = shufman1994_absN_time,
    AbE_shufman_1994 = shufman1994_absN_event
  ) %>% 
	left_join(outcomesAbs_df, ., by = "who")
  

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, contains("shufman_1994"))
```


## @weiss_adjunctive_2011 [CTN-0030]
**Definition**: `r defns_char["Weiss et al., 2011 CTN-0030"]`, missing is positive.

Note: this definition is looking for one of the following four abstinence patterns in last 4 weeks: `"----"`, `"+---"`, `"-+--"`, or `"--+-"`. This definition is just an insanely strict measure of study retention. The first part of the definition ("negative in the last week") already fails anyone who didn't stay in the study for the entire protocol period (because their last week UDS will automatically be `"o"`).
```{r}
outcomesAbs_df <- 
	outcomesAbs_df %>%
  rowwise() %>% 
  mutate(
		udsPattern = recode_missing_visits(
			use_pattern = usePatternUDS,
		)
	) %>% 
	mutate(
		udsPattern = recode_missing_visits(
			use_pattern = udsPattern,
			missing_is = "*"
		)
	) %>% 
	mutate(
		cleanLastWeek = detect_subpattern(
			use_pattern = udsPattern,
			subpattern = "-",
			start = -1,
			end = -1
		)
	) %>% 
	mutate(
		finalUseCount = count_matches(
			use_pattern = udsPattern,
			match_is = "+",
			# 3 weeks leading up to the last week
			start = -4L,
			end = -2L
		)
	) %>% 
	mutate(Ab_ctnThirty_2011 = cleanLastWeek & (finalUseCount <= 1)) %>% 
	select(who, Ab_ctnThirty_2011) %>% 
	left_join(outcomesAbs_df, ., by = "who")
  

outcomesAbs_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, Ab_ctnThirty_2011)
```



*******************************************************************************
</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(
#   outcomesAbs_df,
#   file = "inst/extdata/outcomes_abstinence_20230210.csv"
# )
```


# References