## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = TRUE)

## ---- load-packages, include=FALSE--------------------------------------------
library(CTNote)
library(readxl)
library(kableExtra)
library(tidyverse)

## ---- import-table-one, include=FALSE-----------------------------------------
pathToTable1_char <- system.file(
  "suppl_docs", "definitions_20220405.xlsx", package = "CTNote", mustWork = TRUE
)
tab1_df <- readxl::read_xlsx(pathToTable1_char) 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

## -----------------------------------------------------------------------------
sessionInfo()

## ---- include=FALSE, eval=FALSE-----------------------------------------------
#  # write_csv(
#  #   outcomesRed_df,
#  #   file = "../inst/extdata/outcomes_reduction_20220818.csv"
#  # )