---
title: "CTNote Library: Reduction 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: Reduction 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 "substance use reduction". 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 == "Reduction") %>%
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
- *: inconclusive results or mixed results (e.g. subject provided more than one urine sample in the time interval and they did not agree)
- _: 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
outcomesRed_df <- udsOutcomes_df
### Examples ###
examplePeople_int <- c(1, 163, 210, 242, 4, 17, 13, 1103, 233, 2089)
outcomesRed_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-`).
*******************************************************************************
# Substance Use Reduction Endpoints
## @comer_injectable_2006
**Definition**: `r defns_char["Comer et al., 2006"]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_comer_2006 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
# first 8 weeks of treatment
start = 1, end = 8,
proportion = TRUE
)
) %>%
select(who, Rd_comer_2006) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_comer_2006)
```
## @eissenberg_dose-related_1997
**Definition**: `r defns_char["Eissenberg et al., 1997"]`
From [their paper](https://pubmed.ncbi.nlm.nih.gov/9200635/), we read "Where urinalysis data were missing for an entire week (5 of 1836 data points; 0.3%) the average of that patient's results from the 2 weeks surrounding the missing week was substituted for the missing value." Also, because some of our trials only retained subjects for 15-16 weeks, we changed the cutoff to 15 weeks in order to apply this definition to our data.
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Check for 15 weeks of participation
mutate(
completedProtocol = measure_retention(usePatternUDS) >= 15
) %>%
# Impute local missings
mutate(
useImputed = impute_missing_visits(
use_pattern = usePatternUDS,
method = "kNV",
knvWeights_num = c(`o` = NA, `+` = 1, `*` = 0.5, `-` = 0),
quietly = TRUE
)
) %>%
# detect 4 consecutive negative UDS
mutate(
consecNeg = detect_subpattern(
use_pattern = useImputed,
subpattern = "----",
# we use 15 weeks of study (instead of 17)
start = 1, end = 15
)
) %>%
# non-participation penalty: if the participant didn't stay in the study the
# whole time, then the treatment was a failure
mutate(
Rd_eissenberg_1997 = case_when(
completedProtocol ~ consecNeg,
!completedProtocol ~ FALSE
)
) %>%
select(who, Rd_eissenberg_1997) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_eissenberg_1997)
```
## @fiellin_counseling_2006
**Definition**: `r defns_char["Fiellin et al., 2006"]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_fiellin_2006 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
proportion = TRUE
)
) %>%
select(who, Rd_fiellin_2006) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_fiellin_2006)
```
## @fudala_office-based_2003
**Definition**: `r defns_char["Fudala et al., 2003"]`; they exclude missing values.
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Drop weeks with missing UDS
mutate(
usePatternPresent = recode_missing_visits(
usePatternUDS,
missing_becomes = ""
)
) %>%
mutate(
Rd_fudala_2003 = count_matches(
use_pattern = usePatternPresent,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
proportion = TRUE
)
) %>%
select(who, Rd_fudala_2003) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_fudala_2003)
```
## @haight_efficacy_2019
**Definition**: `r defns_char["Haight et al., 2019"]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_haight_2019 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
# The end-of-protocol for our trials is 15-16 weeks
start = 5, end = 15,
proportion = TRUE
)
) %>%
select(who, Rd_haight_2019) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_haight_2019)
```
## @jaffe_methadyl_1972
**Definition**: `r defns_char["Jaffe et al., 1972"]`; and missing values were imputed to the mode for each participant.
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Mark if participants completed 8 weeks of treatment; remove those who do not
# (but we will add them back in at the end)
mutate(lastWeek_idx = measure_retention(use_pattern = usePatternUDS)) %>%
filter(lastWeek_idx >= 8) %>%
# For participants who stayed in the trials at least 8 weeks, impute their
# missing weeks to their personal most common UDS result; in the event of a
# tie between a negative and a positive result for the mode, the tiebreaker
# is a positive result.
mutate(
usePatternImputed = impute_missing_visits(
use_pattern = usePatternUDS,
method = "mode"
)
) %>%
mutate(
Rd_jaffe_1972 = count_matches(
usePatternImputed,
match_is = "-",
mixed_results_are = "*",
mixed_weight = 0.5,
proportion = TRUE
)
) %>%
select(who, Rd_jaffe_1972) %>%
left_join(outcomesRed_df, ., by = "who") %>%
# Lots of NAs from the participants who did not make it to week 8; replace
# these NAs with 0
replace_na(list(Rd_jaffe_1972 = 0))
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_jaffe_1972)
```
## @johnson_controlled_1992
**Definitions**: `r defns_char["Johnson et al., 1992"]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_johnson_1992 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
proportion = TRUE
)
) %>%
select(who, Rd_johnson_1992) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_johnson_1992)
```
## @kosten_buprenorphine_1993
**Definition**: `r defns_char['Kosten et al., 1993']`; missing UDS are excluded
Note: there are multiple definitions of treatment failure in this paper; we provide an algorithm for the definition which results in a single value for each participant.
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Exclude missing visits
mutate(
usePatternPresent = recode_missing_visits(
usePatternUDS,
missing_becomes = ""
)
) %>%
mutate(
kosten1993B_prop = count_matches(
use_pattern = usePatternPresent,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
start = 1,
end = 15,
proportion = TRUE
)
) %>%
mutate(Rd_kostenB_1993 = kosten1993B_prop >= 0.7) %>%
select(who, Rd_kostenB_1993) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_kostenB_1993)
```
## @ling_buprenorphine_1998 (A) and (C)
```{r, include=FALSE}
whichLing_idx <- which(
names(defns_char) == "Ling et al., 1998"
)
```
There are two definitions from [this paper](https://pubmed.ncbi.nlm.nih.gov/9684386/) which we include in the reduction section our library: `r defns_char[[whichLing_idx[1]]]` and `r defns_char[[whichLing_idx[2]]]`. Both of these outcome definitions **exclude** missing UDS. We also include an abstinence endpoint from this paper in our "abstinence and relapse endpoints" section.
### Ling et al., 1998 (A)
**Definition**: `r defns_char[whichLing_idx[1]]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Exclude missing UDS
mutate(
usePatternPresent = recode_missing_visits(
usePatternUDS,
missing_becomes = ""
)
) %>%
mutate(
Rd_lingA_1998 = count_matches(
use_pattern = usePatternPresent,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
start = 1, end = 15,
proportion = TRUE
)
) %>%
select(who, Rd_lingA_1998) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_lingA_1998)
```
### Ling et al., 1998 (C)
**Definition**: `r defns_char[whichLing_idx[2]]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_lingC_1998 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
end = 15,
mixed_results_are = "*",
mixed_weight = 0.5
)
) %>%
select(who, Rd_lingC_1998) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_lingC_1998)
```
## @ling_buprenorphine_2010
**Definition**: `r defns_char["Ling et al., 2010"]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_ling_2010 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
# We only have 15 weeks of data from some arms
start = 1, end = 15,
proportion = TRUE
)
) %>%
select(who, Rd_ling_2010) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_ling_2010)
```
## @ling_methadyl_1976
**Definition**: `r defns_char["Ling, Charuvastra, Kaim, & Klett, 1976"]`
### Original
The definition in [this paper](https://doi.org/10.1001/archpsyc.1976.01770060043007) is quite complex, but very well thought out. It is one of our favorite MOUD treatment endpoints because of its flexibility.
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Rule 1: mark induction failures
# The Ling et al. protocol lasted 40 weeks while requiring 7 weeks of data for
# the subjects to be counted as "estimable participants"; our 3 studies each
# lasted at least 15 weeks. Therefore, we should require at least
# (7/40) * 15) ~= 3 weeks of data to consider a participant "estimable"
mutate(
inductFail = measure_retention(usePatternUDS) <= 3
) %>%
mutate(
usePatternTrunc = str_sub(usePatternUDS, end = 15)
) %>%
# Rules 2-4: weighting and scaling visits. The flexibility here is amazing.
# If we think that dropout is worse than positive, then we can reflect that
# in the weights. Ling et al. counted a missing visit as 0.22 of a positive;
# and they use a step function to increase the penalty of a positive UDS
# over time.
mutate(
ling1976o22_use = weight_positive_visits(
use_pattern = usePatternTrunc,
weights_num = c(`+` = 1.0, `*` = 0.5, `o` = 0.22, `-` = 0),
posPenalty_num = rep(1:5, each = 3) # step function for 15 weeks
)
) %>%
mutate(
ling1976o22_use = case_when(
inductFail ~ 120,
!inductFail ~ ling1976o22_use
),
Rd_lingA_1976 = 120 - ling1976o22_use
) %>%
select(who, Rd_lingA_1976) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_lingA_1976)
```
### A Variant
We also include a variant of this definition which includes a greater penalty for missing values and a smooth function to increase weights of positive UDS.
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
inductFail = measure_retention(usePatternUDS) <= 3
) %>%
mutate(
usePatternTrunc = str_sub(usePatternUDS, end = 15)
) %>%
mutate(
ling1976o100_use = weight_positive_visits(
use_pattern = usePatternTrunc,
# Higher weight for missing values
weights_num = c(`+` = 0.8, `*` = 0.4, `o` = 1.0, `-` = 0),
# Smooth penalty function for increasing positive UDS
posPenalty_num = seq(
from = 1, to = 5, length.out = str_length(usePatternTrunc)
)
)
) %>%
mutate(
ling1976o100_use = case_when(
inductFail ~ 120,
!inductFail ~ ling1976o100_use
),
Rd_lingB_1976 = 120 - ling1976o100_use
) %>%
select(who, Rd_lingB_1976) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_lingB_1976)
```
## @lofwall_weekly_2018
**Definition**: `r defns_char["Lofwall et al., 2018"]`; but urine screens are collected each week for the first 12 weeks, then every other week for weeks 13-24.
We project this onto a 15-16 week protocol by requiring UDS each week for the first 7 weeks, then every other week for the next 8. Then, we impute the skipped weeks to be whatever the value of the UDS was from the last visit.
```{r}
### Define a Visit Pattern (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 the Endpoint ###
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Mark all missing UDS as positive
mutate(
udsPattern = recode_missing_visits(usePatternUDS)
) %>%
# View the current use pattern "through" the Lofwall protocol
mutate(
udsLattice = view_by_lattice(
use_pattern = udsPattern,
lattice_pattern = str_sub(lofwallLattice_char, end = 15) # first 15 weeks
)
) %>%
# Impute the visits from the "unobserved" weeks to the last observed week
mutate(
udsLatticeLOCF = impute_missing_visits(
use_pattern = udsLattice,
method = "locf",
# This is only imputing values that we wouldn't have seen because of the
# protocol ("_" means missing by design; "o" means missing)
missing_is = "_",
quietly = TRUE
)
) %>%
mutate(
Rd_lofwall_2018 = count_matches(
use_pattern = udsLatticeLOCF,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
start = 1, end = 15, # first 15 weeks
proportion = TRUE
)
) %>%
select(who, Rd_lofwall_2018) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_lofwall_2018)
```
## @mattick_buprenorphine_2003 (A) and (B)
```{r, include=FALSE}
whichMattick_idx <- which(
names(defns_char) == "Mattick et al., 2003"
)
```
There are also two definitions from [this paper](https://pubmed.ncbi.nlm.nih.gov/12653814/) included in our library.
### Mattick et al., 2003 (A)
**Definition**: `r defns_char[whichMattick_idx[1]]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Find out how long the participant stayed in the study
mutate(lastWeek_idx = measure_retention(use_pattern = usePatternUDS)) %>%
mutate(
Rd_mattickA_2003 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
# Measure proportion of negative UDS only during study participation
start = 1, end = lastWeek_idx,
proportion = TRUE
)
) %>%
select(who, Rd_mattickA_2003) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_mattickA_2003)
```
### Mattick et al., 2003 (B)
**Definition**: `r defns_char[whichMattick_idx[2]]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_mattickB_2003 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
# They used a 13-week protocol
start = 1, end = 13,
proportion = TRUE
)
) %>%
select(who, Rd_mattickB_2003) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_mattickB_2003)
```
## @pani_buprenorphine_2000 (A) and (B)
```{r, include=FALSE}
whichPani_idx <- which(
names(defns_char) == "Pani, Maremmani, Pirastu, Tagliamonte, & Gessa, 2000"
)
```
There are also two definitions from [this paper](https://doi.org/10.1016/S0376-8716(00)80006-X) included in our library.
### Pani et al., 2000 (A)
**Definition**: `r defns_char[whichPani_idx[1]]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Remove weeks where participant failed to provide UDS
mutate(
usePatternPresent = recode_missing_visits(
usePatternUDS,
missing_becomes = ""
)
) %>%
mutate(
Rd_paniA_2000 = count_matches(
use_pattern = usePatternPresent,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
proportion = TRUE
)
) %>%
select(who, Rd_paniA_2000) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_paniA_2000)
```
### Pani et al., 2000 (B)
**Definition**: `r defns_char[whichPani_idx[2]]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_paniB_2000 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
proportion = TRUE
)
) %>%
select(who, Rd_paniB_2000) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_paniB_2000)
```
## @petitjean_double-blind_2001
**Definition**: `r defns_char["Petitjean et al., 2001"]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
udsPattern = recode_missing_visits(usePatternUDS)
) %>%
mutate(
petitjean2001_use = count_matches(
use_pattern = udsPattern,
match_is = "+",
mixed_results_are = "*",
proportion = TRUE
)
) %>%
mutate(
Rd_petitjean_2001 = 1 - petitjean2001_use
) %>%
select(who, Rd_petitjean_2001) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_petitjean_2001)
```
## @preston_methadone_2000
**Definition**: `r defns_char["Preston, Umbricht, & Epstein, 2000"]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_preston_2000 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
# 13-week protocol used
end = 13,
proportion = TRUE
)
) %>%
select(who, Rd_preston_2000) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_preston_2000)
```
## @schottenfeld_methadone_2005
**Definition**: `r defns_char["Schottenfeld et al., 2005"]`; exclude missing UDS
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Exclude missing
mutate(
usePatternPresent = recode_missing_visits(
usePatternUDS,
missing_becomes = ""
)
) %>%
# Count negative
mutate(
Rd_schottenfeld_2005 = count_matches(
use_pattern = usePatternPresent,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
proportion = TRUE
)
) %>%
select(who, Rd_schottenfeld_2005) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_schottenfeld_2005)
```
## @schwartz_randomized_2006
**Definition**: `r defns_char["Schwartz et al., 2006"]`
This definition is a cohort-level definition, not an individual definition. The individual endpoint would be "was this participant abstinent from the substance of interest at the 120-day follow-up? (17 weeks from randomization). Our participants do not uniformly have 17 weeks of data, so we will assess them at week 15 instead. NOTE: while the authors classified their outcome as a "reduction" metric (and therefore we include it here in the "reduction" section of the outcomes library), we label this outcome with the prefix "Ab" for abstinence.
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
schwartz2006_abs = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
start = 15, end = 15,
mixed_results_are = "*"
)
) %>%
ungroup() %>%
mutate(
Ab_schwartz_2006 = schwartz2006_abs == 1
) %>%
select(who, Ab_schwartz_2006) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Ab_schwartz_2006)
```
## @shufman_efficacy_1994
**Definition**: `r defns_char["Shufman et al., 1994"]`; missing is ignored
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Count "+" UDS; 0 could be complete dropout or all negative
mutate(
shufman1994_useP = count_matches(
use_pattern = usePatternUDS,
match_is = "+",
mixed_results_are = "*",
proportion = TRUE
)
) %>%
mutate(Rd_shufman_1994 = 1 - shufman1994_useP) %>%
select(who, Rd_shufman_1994) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_shufman_1994)
```
## @soyka_retention_2008
**Definition**: `r defns_char["Soyka, Zingg, Koller, & Kuefner, 2008"]`; missing is ignored
The paper is [here](https://pubmed.ncbi.nlm.nih.gov/18205978/).
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Ignore missing UDS
mutate(
udsPattern = recode_missing_visits(
use_pattern = usePatternUDS,
missing_becomes = ""
)
) %>%
# Count "+" UDS; 0 could be complete dropout or all negative
mutate(
soyka2008_use = count_matches(
use_pattern = udsPattern,
match_is = "+",
mixed_results_are = "*",
mixed_weight = 0.5,
proportion = TRUE
)
) %>%
mutate(Rd_soyka_2008 = 1 - soyka2008_use) %>%
ungroup() %>%
select(who, Rd_soyka_2008) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_soyka_2008)
```
## @strain_dose-response_1993
**Definition**: `r defns_char["Strain, Stitzer, Liebson, & Bigelow, 1993"]`; missing is not defined
Paper [here](https://doi.org/10.7326/0003-4819-119-1-199307010-00004)
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Count "+" UDS; 0 could be complete dropout or all negative
mutate(
strain1993_use = count_matches(
use_pattern = usePatternUDS,
match_is = "+",
# The stable dosing period began in week 6
start = 6, end = 15,
mixed_results_are = "*",
proportion = TRUE
)
) %>%
mutate(Rd_strain_1993 = 1 - strain1993_use) %>%
select(who, Rd_strain_1993) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_strain_1993)
```
## @strain_comparison_1994
**Definition**: `r defns_char["Strain, Stitzer, Liebson, & Bigelow, 1994"]`; missing is ignored
Paper [here](https://doi.org/10.1176/ajp.151.7.1025)
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Ignore missing
mutate(
udsPattern = recode_missing_visits(
use_pattern = usePatternUDS,
missing_becomes = ""
)
) %>%
# Count "+" UDS; 0 could be complete dropout or all negative
mutate(
strain1994_use = count_matches(
use_pattern = usePatternUDS,
match_is = "+",
mixed_results_are = "*",
proportion = TRUE
)
) %>%
mutate(Rd_strain_1994 = 1 - strain1994_use) %>%
select(who, Rd_strain_1994) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_strain_1994)
```
## @strain_buprenorphine_1996
**Definition**: `r defns_char["Strain, Stitzer, Liebson, & Bigelow, 1996"]`; missing is ignored
Because the "two-weeks blocks" definition results in more than one value per participant, we do not provide it in our library. This definition is now identical to that of Strain, Stitzer, Liebson, & Bigelow (1994).
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Ignore missing
mutate(
udsPattern = recode_missing_visits(
use_pattern = usePatternUDS,
missing_becomes = ""
)
) %>%
# Count "+" UDS; 0 could be complete dropout or all negative
mutate(
strain1996_use = count_matches(
use_pattern = udsPattern,
match_is = "+",
mixed_results_are = "*",
proportion = TRUE
)
) %>%
mutate(Rd_strain_1996 = 1 - strain1996_use) %>%
select(who, Rd_strain_1996) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_strain_1996)
```
## @strain_moderate-_1999
**Definition**: `r defns_char["Strain, Bigelow, Liebson, & Stitzer, 1999"]`
[This paper](https://doi.org/10.1001/jama.281.11.1000) gave no commentary on *how* the missing values would be processed, only that the statistical software SAS was capable of handling missing values. SAS, by default, [excludes missing values](https://documentation.sas.com/doc/en/pgmsascdc/9.4_3.5/proc/n026epq8bpz1f9n10oeb7zen7s1e.htm) from analyses. Therefore, this definition will also be identical to that of Strain, Stitzer, Liebson, & Bigelow (1994).
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Ignore missing
mutate(
udsPattern = recode_missing_visits(
use_pattern = usePatternUDS,
missing_becomes = ""
)
) %>%
# Count "+" UDS; 0 could be complete dropout or all negative
mutate(
strain1999_use = count_matches(
use_pattern = usePatternUDS,
match_is = "+",
mixed_results_are = "*",
proportion = TRUE
)
) %>%
mutate(Rd_strain_1999 = 1 - strain1999_use) %>%
select(who, Rd_strain_1999) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_strain_1999)
```
## @strang_supervised_2010
**Definitions**: `r defns_char["Strang et al., 2010"]`
Our protocols do not uniformly contain 26 weeks of data, so we apply this definition as "the last 12 weeks of the protocol."
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
cleanProp = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
# Syntax to select the LAST visits uses a negative sign; this means "12
# weeks before the end of the data" to "the last week of the data"
start = -12, end = -1,
proportion = TRUE
)
) %>%
mutate(Rd_strang_2010 = cleanProp >= 0.5) %>%
ungroup() %>%
select(who, Rd_strang_2010) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_strang_2010)
```
## @strang_extended-release_2019
**Definition**: `r defns_char["Strang et al., 2019"]`
Paper [here](https://pubmed.ncbi.nlm.nih.gov/30702059/)
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
mutate(
Rd_strang_2019 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
# Only look at the first 12 weeks after randomization
start = 1, end = 12,
proportion = TRUE
)
) %>%
select(who, Rd_strang_2019) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_strang_2019)
```
## @tanum_effectiveness_2017
**Definition**: `r defns_char["Tanum et al., 2017"]`
Note that this definition as written is a group outcome, not a participant outcome. Therefore, we calculate this for each subject as the "rate of negative UOS for the time that the patient remained in the study."
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# How long was each subject retained?
mutate(lastWeek_idx = measure_retention(use_pattern = usePatternUDS)) %>%
mutate(
Rd_tanum_2017 = count_matches(
use_pattern = usePatternUDS,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
start = 1, end = lastWeek_idx,
proportion = TRUE
)
) %>%
select(who, Rd_tanum_2017) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_tanum_2017)
```
## @wolstein_randomized_2009
**Definition**: `r defns_char["Wolstein et al., 2009"]`
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Because we are measuring outcomes only while "participating", remove missing
# weeks from the use pattern
mutate(
usePatternPresent = recode_missing_visits(
usePatternUDS,
missing_becomes = ""
)
) %>%
mutate(
Rd_wolstein_2009 = count_matches(
use_pattern = usePatternPresent,
match_is = "-",
# Mixed results weeks count as half of a negative week
mixed_results_are = "*", mixed_weight = 0.5,
proportion = TRUE
)
) %>%
select(who, Rd_wolstein_2009) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_wolstein_2009)
```
## @woody_extended_2008
**Definition**: `r defns_char["Woody et al., 2008"]`
[This paper](https://doi.org/10.1001/jama.2008.574) contains rather exotic methods for missing value imputation, but the authors remark that setting "missing is positive" did not change their final results. We may include their imputation method in future versions of this code library.
```{r}
### Define a Visit Pattern (Lattice) ###
woodyLattice_char <- collapse_lattice(lattice_patterns = "___o", times = 3)
woodyLattice_char
### Calculate the Endpoint ###
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Only observe scheduled UDS
mutate(
udsLattice = view_by_lattice(
use_pattern = usePatternUDS,
lattice_pattern = woodyLattice_char
)
) %>%
# Remove the non-protocol weeks
mutate(
udsLattice2 = recode_missing_visits(
use_pattern = udsLattice,
missing_is = "_",
missing_becomes = ""
)
) %>%
# Mark missing UDS as "+"
mutate(
udsLattice3 = recode_missing_visits(use_pattern = udsLattice2)
) %>%
# Count "+" UDS; 0 could be complete dropout or all negative
mutate(
woody2008_use = count_matches(
use_pattern = udsLattice3,
match_is = "+",
mixed_results_are = "*",
proportion = TRUE
)
) %>%
mutate(Rd_woody_2008 = 1 - woody2008_use) %>%
select(who, Rd_woody_2008) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_woody_2008)
```
## @zaks_levomethadyl_1972
**Definition**: `r defns_char["Zaks, Fink, & Freedman, 1972"]`; missing is ignored
```{r}
outcomesRed_df <-
outcomesRed_df %>%
rowwise() %>%
# Ignore missing
mutate(
udsPattern = recode_missing_visits(
use_pattern = usePatternUDS,
missing_becomes = ""
)
) %>%
# Count "+" UDS; 0 could be complete dropout or all negative
mutate(
zaks1972_use = count_matches(
use_pattern = udsPattern,
match_is = "+",
mixed_results_are = "*"
)
) %>%
# For each participant, the "abstinent" metric is the number of total weeks
# of study participation - the number of positive weeks
mutate(Rd_zaks_1972 = str_length(udsPattern) - zaks1972_use) %>%
ungroup() %>%
select(who, Rd_zaks_1972) %>%
left_join(outcomesRed_df, ., by = "who")
outcomesRed_df %>%
filter(who %in% examplePeople_int) %>%
select(who, usePatternUDS, Rd_zaks_1972)
```
*******************************************************************************
# 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(
# outcomesRed_df,
# file = "inst/extdata/outcomes_reduction_20221216.csv"
# )
```
# References