CTNote Library: Reduction Outcomes

In CTNote: CTN Outcomes, Treatments, and Endpoints

knitr::opts_chunk$set(echo = TRUE)

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:

pathToTable1_char <- system.file(
  "suppl_docs", "definitions_20220405.xlsx", package = "CTNote", mustWork = TRUE
)
tab1_df <- readxl::read_xlsx(pathToTable1_char) 

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

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)

###  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"]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
    mutate(
        comer2006_red = 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, comer2006_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, comer2006_red)

@eissenberg_dose-related_1997

Definition: r defns_char["Eissenberg et al., 1997"]

From their paper, 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.

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(
        eissenberg1997_isAbs = case_when(
            completedProtocol  ~ consecNeg,
            !completedProtocol ~ FALSE
        )
    ) %>% 
    select(who, eissenberg1997_isAbs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, eissenberg1997_isAbs)

@fiellin_counseling_2006

Definition: r defns_char["Fiellin et al., 2006"]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        fiellin2006_red = 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, fiellin2006_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, fiellin2006_red)

@fudala_office-based_2003

Definition: r defns_char["Fudala et al., 2003"]; they exclude missing values.

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  # Drop weeks with missing UDS
  mutate(
        usePatternPresent = recode_missing_visits(
            usePatternUDS,
            missing_becomes = ""
        )
    ) %>%
    mutate(
        fudala2003_red = 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, fudala2003_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, fudala2003_red)

@haight_efficacy_2019

Definition: r defns_char["Haight et al., 2019"]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        haight2019_red = 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, haight2019_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, haight2019_red)

@jaffe_methadyl_1972

Definition: r defns_char["Jaffe et al., 1972"]; and missing values were imputed to the mode for each participant.

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(
        jaffe1972_red = count_matches(
            usePatternImputed,
            match_is = "-",
            mixed_results_are = "*",
            mixed_weight = 0.5,
            proportion = TRUE
        )
    ) %>% 
    select(who, jaffe1972_red) %>% 
    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(jaffe1972_red = 0))

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, jaffe1972_red)

@johnson_controlled_1992

Definitions: r defns_char["Johnson et al., 1992"]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        johnson1992_red = 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, johnson1992_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, johnson1992_red)

@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.

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(kosten1993B_red = kosten1993B_prop >= 0.7) %>% 
    select(who, kosten1993B_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, kosten1993B_red)

@ling_buprenorphine_1998 (A) and (C)

whichLing_idx <- which(
  names(defns_char) == "Ling et al., 1998"
)

There are two definitions from this paper 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]]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  # Exclude missing UDS
  mutate(
        usePatternPresent = recode_missing_visits(
            usePatternUDS,
            missing_becomes = ""
        )
    ) %>%
    mutate(
        ling1998A_red = 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, ling1998A_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, ling1998A_red)

Ling et al., 1998 (C)

Definition: r defns_char[whichLing_idx[2]]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        ling1998C_red = count_matches(
            use_pattern = usePatternUDS,
            match_is = "-",
            end = 15,
            mixed_results_are = "*",
            mixed_weight = 0.5
        )
    ) %>% 
    select(who, ling1998C_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, ling1998C_red)

@ling_buprenorphine_2010

Definition: r defns_char["Ling et al., 2010"]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        ling2010_red = 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, ling2010_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, ling2010_red)

@ling_methadyl_1976

Definition: r defns_char["Ling, Charuvastra, Kaim, & Klett, 1976"]

Original

The definition in this paper is quite complex, but very well thought out. It is one of our favorite MOUD treatment endpoints because of its flexibility.

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
        ),
        ling1976o22_abs = 120 - ling1976o22_use
    ) %>%
    select(who, ling1976o22_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, ling1976o22_abs)

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.

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
        ),
        ling1976o100_abs = 120 - ling1976o100_use
    ) %>%
    select(who, ling1976o100_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, ling1976o100_abs)

@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.

###  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(
        lofwall2018_red = 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, lofwall2018_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, lofwall2018_red)

@mattick_buprenorphine_2003 (A) and (B)

whichMattick_idx <- which(
  names(defns_char) == "Mattick et al., 2003"
)

There are also two definitions from this paper included in our library.

Mattick et al., 2003 (A)

Definition: r defns_char[whichMattick_idx[1]]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  # Find out how long the participant stayed in the study
  mutate(lastWeek_idx = measure_retention(use_pattern = usePatternUDS)) %>% 
    mutate(
        mattick2003A_red = 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, mattick2003A_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, mattick2003A_red)

Mattick et al., 2003 (B)

Definition: r defns_char[whichMattick_idx[2]]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        mattick2003B_red = 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, mattick2003B_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, mattick2003B_red)

@pani_buprenorphine_2000 (A) and (B)

whichPani_idx <- which(
  names(defns_char) == "Pani, Maremmani, Pirastu, Tagliamonte, & Gessa, 2000"
)

There are also two definitions from this paper included in our library.

Pani et al., 2000 (A)

Definition: r defns_char[whichPani_idx[1]]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  # Remove weeks where participant failed to provide UDS
  mutate(
        usePatternPresent = recode_missing_visits(
            usePatternUDS,
            missing_becomes = ""
        )
    ) %>%
    mutate(
        pani2000A_red = 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, pani2000A_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, pani2000A_red)

Pani et al., 2000 (B)

Definition: r defns_char[whichPani_idx[2]]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        pani2000B_red = 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, pani2000B_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, pani2000B_red)

@petitjean_double-blind_2001

Definition: r defns_char["Petitjean et al., 2001"]

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(
        petitjean2001_abs = 1 - petitjean2001_use
    ) %>% 
    select(who, petitjean2001_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, petitjean2001_abs)

@preston_methadone_2000

Definition: r defns_char["Preston, Umbricht, & Epstein, 2000"]

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        preston2000_red = 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, preston2000_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, preston2000_red)

@schottenfeld_methadone_2005

Definition: r defns_char["Schottenfeld et al., 2005"]; exclude missing UDS

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  # Exclude missing
  mutate(
        usePatternPresent = recode_missing_visits(
            usePatternUDS,
            missing_becomes = ""
        )
    ) %>%
  # Count negative
    mutate(
        schottenfeld2005_red = 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, schottenfeld2005_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, schottenfeld2005_red)

@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.

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
    schwartz2006_abs = count_matches(
        use_pattern = usePatternUDS,
        match_is = "-",
        start = 15, end = 15,
        mixed_results_are = "*"
    )
  ) %>% 
    ungroup() %>% 
    mutate(
        schwartz2006_isAbs = schwartz2006_abs == 1
    ) %>% 
    select(who, schwartz2006_isAbs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, schwartz2006_isAbs)

@shufman_efficacy_1994

Definition: r defns_char["Shufman et al., 1994"]; missing is ignored

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(shufman1994_absP = 1 - shufman1994_useP) %>% 
    select(who, shufman1994_absP) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, schwartz2006_isAbs)

@soyka_retention_2008

Definition: r defns_char["Soyka, Zingg, Koller, & Kuefner, 2008"]; missing is ignored

The paper is here.

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(soyka2008_abs = 1 - soyka2008_use) %>% 
    ungroup() %>% 
    select(who, soyka2008_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, soyka2008_abs)

@strain_dose-response_1993

Definition: r defns_char["Strain, Stitzer, Liebson, & Bigelow, 1993"]; missing is not defined

Paper here

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 = "*"
        )
    ) %>% 
    mutate(strain1993_abs = 1 - strain1993_use) %>% 
    select(who, strain1993_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, strain1993_abs)

@strain_comparison_1994

Definition: r defns_char["Strain, Stitzer, Liebson, & Bigelow, 1994"]; missing is ignored

Paper here

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(strain1994_abs = 1 - strain1994_use) %>% 
    select(who, strain1994_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, strain1994_abs)

@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).

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(strain1996_abs = 1 - strain1996_use) %>% 
    select(who, strain1996_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, strain1996_abs)

@strain_moderate-_1999

Definition: r defns_char["Strain, Bigelow, Liebson, & Stitzer, 1999"]

This paper 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 from analyses. Therefore, this definition will also be identical to that of Strain, Stitzer, Liebson, & Bigelow (1994).

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(strain1999_abs = 1 - strain1999_use) %>% 
    select(who, strain1999_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, strain1999_abs)

@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."

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(strang2010_hasRed = cleanProp >= 0.5) %>% 
    ungroup() %>% 
    select(who, strang2010_hasRed) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, strang2010_hasRed)

@strang_extended-release_2019

Definition: r defns_char["Strang et al., 2019"]

Paper here

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  mutate(
        strang2019_red = 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, strang2019_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, strang2019_red)

@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."

outcomesRed_df <- 
    outcomesRed_df %>%
  rowwise() %>% 
  # How long was each subject retained?
  mutate(lastWeek_idx = measure_retention(use_pattern = usePatternUDS)) %>% 
    mutate(
        tanum2017_red = 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, tanum2017_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, tanum2017_red)

@wolstein_randomized_2009

Definition: r defns_char["Wolstein et al., 2009"]

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(
        wolstein2009_red = 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, wolstein2009_red) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, wolstein2009_red)

@woody_extended_2008

Definition: r defns_char["Woody et al., 2008"]

This paper 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.

###  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(woody2008_abs = 1 - woody2008_use) %>% 
    select(who, woody2008_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, woody2008_abs)

@zaks_levomethadyl_1972

Definition: r defns_char["Zaks, Fink, & Freedman, 1972"]; missing is ignored

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 = "*"
        )
    ) %>% 
    ungroup() %>% 
  # For each participant, the "abstinent" metric is the number of total weeks
  #   of study participation - the number of positive weeks
    mutate(zaks1972_abs = str_length(udsPattern) - zaks1972_use) %>% 
    select(who, zaks1972_abs) %>% 
    left_join(outcomesRed_df, ., by = "who")

outcomesRed_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, zaks1972_abs)

---

Computing Environment

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

sessionInfo()

# write_csv(
#   outcomesRed_df,
#   file = "../inst/extdata/outcomes_reduction_20220818.csv"
# )

References

CTNote documentation built on Oct. 3, 2022, 9:08 a.m.