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:
Group | Endpoint | Class | Reference | Definition | Missing is |
---|---|---|---|---|---|
Abstinence | Abstinence weeks | integer | Fiellin et al., 2006 | Weeks of confirmed opioid abstinence | Positive |
Abstinence | Continuous abstinence | logical | Kosten et al., 1993 | attaining at least 3 weeks of consecutive negative UOS | Missing/not imputed |
Abstinence | Complete Abstinence | logical | Krupitsky et al., 2011 | Confirmed opioid abstinence during weeks 5‐24 based on UOS | Positive |
Abstinence | Abstinence weeks | integer | Krupitsky et al., 2011 | Weeks of confirmed opioid abstinence | Positive |
Abstinence | Continuous abstinence | logical | Ling et al., 1998 | % of participants who maintained 13 consecutive negative UOS (1 month) | Missing/not imputed |
Abstinence | Complete Abstinence | logical | Lofwall et al., 2018 | No evidence of opioid use based on UOS (NOTE: minimal evidence of opioid use from UOS, not none) | Positive |
Abstinence | Length of Initial Abstinence | survival | Mokri, Chawarski, Taherinakhost, & Schottenfeld, 2016 | Days to 1st positive UOS | Positive |
Abstinence | Longest period of abstinence | integer | Schottenfeld et al., 2005 | Max. number of consecutive weeks of negative UOS | Missing |
Abstinence | Longest period of abstinence | integer | Schottenfeld et al., 2008 | Longest period of negative UOS | Positive |
Abstinence | Length of Initial Abstinence | survival | Schottenfeld, Chawarski, & Mazlan, 2008 | Days to 1st positive UOS after randomization | Positive |
Abstinence | Length of Initial Abstinence | survival | Shufman et al., 1994 | Weeks between 1st day of NTX administration and 1st positive UOS | Missing |
Abstinence | Abstinence period | logical | Weiss et al., 2011 CTN-0030 | Negative UOS during the last week AND for at least 2 of the previous 3 weeks of the third month of BUP/NX treatment | Positive |
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
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)
## # A tibble: 10 × 2
## who usePatternUDS
## <dbl> <chr>
## 1 1 ooooooooooooooo
## 2 4 -------------------o-o-o
## 3 13 ------------o-oooooooooo
## 4 17 --++*++++++-++++++-+++-
## 5 163 -o---o---o--o+----------
## 6 210 -++++++++-+++-----------
## 7 233 *+++++++++++o++++++++++o
## 8 242 -----------------------
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o
## 10 2089 ++++---+--------------o-
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-
).
Our CTN-0094 research group 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.
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_ctnNinetyFour_2023
## <dbl> <chr> <lgl>
## 1 1 ooooooooooooooo FALSE
## 2 4 -------------------o-o-o TRUE
## 3 13 ------------o-oooooooooo FALSE
## 4 17 --++*++++++-++++++-+++- FALSE
## 5 163 -o---o---o--o+---------- FALSE
## 6 210 -++++++++-+++----------- FALSE
## 7 233 *+++++++++++o++++++++++o FALSE
## 8 242 ----------------------- TRUE
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o FALSE
## 10 2089 ++++---+--------------o- TRUE
Definition: Weeks of confirmed opioid abstinence; missing is positive
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_fiellin_2006
## <dbl> <chr> <int>
## 1 1 ooooooooooooooo 0
## 2 4 -------------------o-o-o 21
## 3 13 ------------o-oooooooooo 13
## 4 17 --++*++++++-++++++-+++- 5
## 5 163 -o---o---o--o+---------- 19
## 6 210 -++++++++-+++----------- 13
## 7 233 *+++++++++++o++++++++++o 0
## 8 242 ----------------------- 23
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o 20
## 10 2089 ++++---+--------------o- 18
Definition: attaining at least 3 weeks of consecutive negative UOS
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_kosten_1993
## <dbl> <chr> <lgl>
## 1 1 ooooooooooooooo FALSE
## 2 4 -------------------o-o-o TRUE
## 3 13 ------------o-oooooooooo TRUE
## 4 17 --++*++++++-++++++-+++- FALSE
## 5 163 -o---o---o--o+---------- TRUE
## 6 210 -++++++++-+++----------- TRUE
## 7 233 *+++++++++++o++++++++++o FALSE
## 8 242 ----------------------- TRUE
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o TRUE
## 10 2089 ++++---+--------------o- TRUE
There are two definitions from this paper which we include in the reduction section our library: Confirmed opioid abstinence during weeks 5‐24 based on UOS and Weeks of confirmed opioid abstinence.
Definition: Confirmed opioid abstinence during weeks 5‐24 based on UOS
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%.
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_krupitskyA_2011
## <dbl> <chr> <lgl>
## 1 1 ooooooooooooooo FALSE
## 2 4 -------------------o-o-o TRUE
## 3 13 ------------o-oooooooooo FALSE
## 4 17 --++*++++++-++++++-+++- FALSE
## 5 163 -o---o---o--o+---------- FALSE
## 6 210 -++++++++-+++----------- FALSE
## 7 233 *+++++++++++o++++++++++o FALSE
## 8 242 ----------------------- TRUE
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o FALSE
## 10 2089 ++++---+--------------o- FALSE
Definition: Weeks of confirmed opioid abstinence
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_krupitskyB_2011
## <dbl> <chr> <int>
## 1 1 ooooooooooooooo 0
## 2 4 -------------------o-o-o 11
## 3 13 ------------o-oooooooooo 9
## 4 17 --++*++++++-++++++-+++- 1
## 5 163 -o---o---o--o+---------- 7
## 6 210 -++++++++-+++----------- 3
## 7 233 *+++++++++++o++++++++++o 0
## 8 242 ----------------------- 11
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o 6
## 10 2089 ++++---+--------------o- 10
Definition: % of participants who maintained 13 consecutive negative UOS (1 month); urine was screened 3 times per week
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_ling_1998
## <dbl> <chr> <lgl>
## 1 1 ooooooooooooooo FALSE
## 2 4 -------------------o-o-o TRUE
## 3 13 ------------o-oooooooooo TRUE
## 4 17 --++*++++++-++++++-+++- FALSE
## 5 163 -o---o---o--o+---------- TRUE
## 6 210 -++++++++-+++----------- TRUE
## 7 233 *+++++++++++o++++++++++o FALSE
## 8 242 ----------------------- TRUE
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o TRUE
## 10 2089 ++++---+--------------o- TRUE
Definition: No evidence of opioid use based on UOS (NOTE: minimal evidence of opioid use from UOS, not none)
In their paper, 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.
### 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
## [1] "ooooooo_o_o_o_o"
### 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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_lofwall_2018
## <dbl> <chr> <lgl>
## 1 1 ooooooooooooooo FALSE
## 2 4 -------------------o-o-o TRUE
## 3 13 ------------o-oooooooooo FALSE
## 4 17 --++*++++++-++++++-+++- FALSE
## 5 163 -o---o---o--o+---------- FALSE
## 6 210 -++++++++-+++----------- FALSE
## 7 233 *+++++++++++o++++++++++o FALSE
## 8 242 ----------------------- TRUE
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o FALSE
## 10 2089 ++++---+--------------o- TRUE
Definition: Days to 1st positive UOS; missing is positive
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"))
## # A tibble: 10 × 4
## who usePatternUDS AbT_mokri_2016 AbE_mokri_2016
## <dbl> <chr> <int> <int>
## 1 1 ooooooooooooooo 1 1
## 2 4 -------------------o-o-o 20 1
## 3 13 ------------o-oooooooooo 13 1
## 4 17 --++*++++++-++++++-+++- 3 1
## 5 163 -o---o---o--o+---------- 2 1
## 6 210 -++++++++-+++----------- 2 1
## 7 233 *+++++++++++o++++++++++o 1 1
## 8 242 ----------------------- 23 0
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o 1 1
## 10 2089 ++++---+--------------o- 1 1
If you are more comfortable using “survival” or “time-to-event” data structures, then the above definition can be modified by the following code:
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)
## # A tibble: 10 × 3
## who usePatternUDS mokri2016_wksAbst
## <dbl> <chr> <chr>
## 1 1 ooooooooooooooo " 1"
## 2 4 -------------------o-o-o "20"
## 3 13 ------------o-oooooooooo "13"
## 4 17 --++*++++++-++++++-+++- " 3"
## 5 163 -o---o---o--o+---------- " 2"
## 6 210 -++++++++-+++----------- " 2"
## 7 233 *+++++++++++o++++++++++o " 1"
## 8 242 ----------------------- "23+"
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o " 1"
## 10 2089 ++++---+--------------o- " 1"
Definition: Max. number of consecutive weeks of negative UOS, missing is ignored
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_schottenfeld_2005
## <dbl> <chr> <int>
## 1 1 ooooooooooooooo 0
## 2 4 -------------------o-o-o 21
## 3 13 ------------o-oooooooooo 13
## 4 17 --++*++++++-++++++-+++- 2
## 5 163 -o---o---o--o+---------- 10
## 6 210 -++++++++-+++----------- 11
## 7 233 *+++++++++++o++++++++++o 0
## 8 242 ----------------------- 23
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o 14
## 10 2089 ++++---+--------------o- 15
There are two definitions from this paper which we include in the reduction section our library: Longest period of negative UOS and Days to 1st positive UOS after randomization.
Definition: Days to 1st positive UOS after randomization, missing is positive
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"))
## # A tibble: 10 × 4
## who usePatternUDS AbT_schottenfeldA_2008 AbE_schottenfeldA_2008
## <dbl> <chr> <int> <int>
## 1 1 ooooooooooooooo 1 1
## 2 4 -------------------o-o-o 20 1
## 3 13 ------------o-oooooooooo 13 1
## 4 17 --++*++++++-++++++-+++- 3 1
## 5 163 -o---o---o--o+---------- 2 1
## 6 210 -++++++++-+++----------- 2 1
## 7 233 *+++++++++++o++++++++++o 1 1
## 8 242 ----------------------- 23 0
## 9 1103 ++--oo--o-+-+--o--------… 1 1
## 10 2089 ++++---+--------------o- 1 1
Definition: Longest period of negative UOS, missing is positive
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_schottenfeldB_2008
## <dbl> <chr> <int>
## 1 1 ooooooooooooooo 0
## 2 4 -------------------o-o-o 19
## 3 13 ------------o-oooooooooo 12
## 4 17 --++*++++++-++++++-+++- 2
## 5 163 -o---o---o--o+---------- 10
## 6 210 -++++++++-+++----------- 11
## 7 233 *+++++++++++o++++++++++o 0
## 8 242 ----------------------- 23
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o 10
## 10 2089 ++++---+--------------o- 14
Definition: Weeks between 1st day of NTX administration and 1st positive UOS, missing is ignored (but treated as negative in order to count the weeks properly)
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"))
## # A tibble: 10 × 4
## who usePatternUDS AbT_shufman_1994 AbE_shufman_1994
## <dbl> <chr> <int> <int>
## 1 1 ooooooooooooooo 15 0
## 2 4 -------------------o-o-o 24 0
## 3 13 ------------o-oooooooooo 24 0
## 4 17 --++*++++++-++++++-+++- 3 1
## 5 163 -o---o---o--o+---------- 14 1
## 6 210 -++++++++-+++----------- 2 1
## 7 233 *+++++++++++o++++++++++o 1 1
## 8 242 ----------------------- 23 0
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o 1 1
## 10 2089 ++++---+--------------o- 1 1
Definition: Negative UOS during the last week AND for at least 2 of the previous 3 weeks of the third month of BUP/NX treatment, 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"
).
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)
## # A tibble: 10 × 3
## who usePatternUDS Ab_ctnThirty_2011
## <dbl> <chr> <lgl>
## 1 1 ooooooooooooooo FALSE
## 2 4 -------------------o-o-o FALSE
## 3 13 ------------o-oooooooooo FALSE
## 4 17 --++*++++++-++++++-+++- FALSE
## 5 163 -o---o---o--o+---------- TRUE
## 6 210 -++++++++-+++----------- TRUE
## 7 233 *+++++++++++o++++++++++o FALSE
## 8 242 ----------------------- TRUE
## 9 1103 ++--oo--o-+-+--o----------o-o-oo++o FALSE
## 10 2089 ++++---+--------------o- TRUE
Here is the information concerning the system configuration, packages, and their versions used in this computation:
## R version 4.4.2 (2024-10-31)
## Platform: x86_64-pc-linux-gnu
## Running under: Ubuntu 24.04.1 LTS
##
## Matrix products: default
## BLAS: /usr/lib/x86_64-linux-gnu/openblas-pthread/libblas.so.3
## LAPACK: /usr/lib/x86_64-linux-gnu/openblas-pthread/libopenblasp-r0.3.26.so; LAPACK version 3.12.0
##
## locale:
## [1] LC_CTYPE=en_US.UTF-8 LC_NUMERIC=C
## [3] LC_TIME=en_US.UTF-8 LC_COLLATE=C
## [5] LC_MONETARY=en_US.UTF-8 LC_MESSAGES=en_US.UTF-8
## [7] LC_PAPER=en_US.UTF-8 LC_NAME=C
## [9] LC_ADDRESS=C LC_TELEPHONE=C
## [11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C
##
## time zone: Etc/UTC
## tzcode source: system (glibc)
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4
## [5] purrr_1.0.2 readr_2.1.5 tidyr_1.3.1 tibble_3.2.1
## [9] ggplot2_3.5.1 tidyverse_2.0.0 kableExtra_1.4.0 readxl_1.4.3
## [13] CTNote_0.1.3 rmarkdown_2.29
##
## loaded via a namespace (and not attached):
## [1] sass_0.4.9 utf8_1.2.4 generics_0.1.3 xml2_1.3.6
## [5] lattice_0.22-6 stringi_1.8.4 hms_1.1.3 digest_0.6.37
## [9] magrittr_2.0.3 timechange_0.3.0 evaluate_1.0.1 grid_4.4.2
## [13] fastmap_1.2.0 Matrix_1.7-1 cellranger_1.1.0 jsonlite_1.8.9
## [17] survival_3.7-0 fansi_1.0.6 viridisLite_0.4.2 scales_1.3.0
## [21] jquerylib_0.1.4 cli_3.6.3 rlang_1.1.4 splines_4.4.2
## [25] munsell_0.5.1 withr_3.0.2 cachem_1.1.0 yaml_2.3.10
## [29] tools_4.4.2 tzdb_0.4.0 colorspace_2.1-1 buildtools_1.0.0
## [33] vctrs_0.6.5 R6_2.5.1 lifecycle_1.0.4 pkgconfig_2.0.3
## [37] bslib_0.8.0 pillar_1.9.0 gtable_0.3.6 glue_1.8.0
## [41] systemfonts_1.1.0 xfun_0.49 tidyselect_1.2.1 rstudioapi_0.17.1
## [45] sys_3.4.3 knitr_1.49 htmltools_0.5.8.1 svglite_2.1.3
## [49] maketools_1.3.1 compiler_4.4.2