CTNote Library: Relapse Outcomes

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 "abstinence from substance use" or "relapse to substance use". 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 == "Relapse") %>% 
  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:

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



"Relapse to Substance Use" Endpoints

CTN-0094 Endpoints

which0094_idx <- which(
  names(defns_char) == "CTN-0094"
)

Our CTN-0094 research group 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

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

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, starts_with("ctn0094_relapse"))

CTN-0094 Dropout

Definition: r defns_char[[which0094_idx[2]]]

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

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, starts_with("ctn0094_dropout"))

@johnson_controlled_1992

Definition: r defns_char["Johnson, Jaffe, & Fudala, 1992"]; missing is positive

outcomesRel_df <- 
    outcomesRel_df %>%
  rowwise() %>% 
  mutate(
        udsPattern = recode_missing_visits(
            use_pattern = usePatternUDS,
        )
    ) %>% 
    mutate(
        udsPattern = recode_missing_visits(
            use_pattern = udsPattern,
            missing_is = "*"
        )
    ) %>% 
    mutate(
        johnson1992_hasRel = detect_subpattern(
            use_pattern = udsPattern,
            subpattern = "++",
            # Starting at 4 weeks of treatment
            start = 4L
        )
    ) %>% 
    select(who, johnson1992_hasRel) %>% 
    left_join(outcomesRel_df, ., by = "who")

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

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

outcomesRel_df <- 
    outcomesRel_df %>%
  rowwise() %>% 
  mutate(
        udsPattern = recode_missing_visits(
            use_pattern = usePatternUDS,
        )
    ) %>% 
    mutate(
        udsPattern = recode_missing_visits(
            use_pattern = udsPattern,
            missing_is = "*"
        )
    ) %>% 
    mutate(
        krupitsky2004_hasRel = detect_subpattern(
            use_pattern = udsPattern,
            subpattern = "+++"
        )
    ) %>% 
    select(who, krupitsky2004_hasRel) %>% 
    left_join(outcomesRel_df, ., by = "who")

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

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

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

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, starts_with("lee2016_rel"))

@lee_comparative_2018

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

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

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, starts_with("lee2018_rel"))

@schottenfeld_maintenance_2008

Definition: r defns_char["Schottenfeld et al., 2008"]; missing is positive

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

outcomesRel_df %>% 
  filter(who %in% examplePeople_int) %>% 
  select(who, usePatternUDS, starts_with("schottenfeld2008_rel"))


Computing Environment

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

sessionInfo()
# write_csv(
#   outcomesRel_df,
#   file = "../inst/extdata/outcomes_relapse_20220818.csv"
# )

References



Try the CTNote package in your browser

Any scripts or data that you put into this service are public.

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