knitr::opts_chunk$set(echo = TRUE)
library(CTNote) library(readxl) library(kableExtra) library(tidyverse)
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-
).
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]]]
.
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"))
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"))
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)
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)
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"))
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"))
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"))
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" # )
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.