Dropout Rate Meta-analysis of Substance Abuse Studies
Sara Lappan, PhD1
Code: Andrew W Brown, PhD2
Peter Hendricks, PhD3
02 June 2019
1 Information
This is the full data analysis code for the Dropout Meta-analysis.
Note: Confirming individual pieces of this code is challenging if running interactively. If the dropout.Rmd file is opened and knit in its entirety there have been no problems. When the code is run chunk by chunk, on the other hand, the call to knit_child throws an error because it is apparently not designed to be run interactively. The environment successfully stores the information needed for the child document to run, so this error can be circumvented by expanding the for loops for each variable and running the child code manually if need be.
library(xlsx) #to be able to import Excel file
library(metafor) #package for meta-analysesLoading required package: MatrixLoading 'metafor' package (version 2.0-0). For an overview
and introduction to the package please type: help(metafor).library(knitr) #combining code and markdown into HTML
library(pander) #adding text formatting to chunks
library(kableExtra) #additional table formatting
source("functions.R") #source the custom functions for this project
source("datadictionary.R") #interpretation of variables to make more readable output1.1 Session Info
R version 3.5.1 (2018-07-02)
Platform: i386-w64-mingw32/i386 (32-bit)
Running under: Windows 10 x64 (build 17134)
Matrix products: default
locale:
[1] LC_COLLATE=English_United States.1252
[2] LC_CTYPE=English_United States.1252
[3] LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C
[5] LC_TIME=English_United States.1252
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] kableExtra_0.9.0 pander_0.6.2 knitr_1.20 metafor_2.0-0
[5] Matrix_1.2-14 xlsx_0.6.1
loaded via a namespace (and not attached):
[1] hms_0.4.2 digest_0.6.17 htmltools_0.3.6
[4] R6_2.4.0 scales_1.0.0 rprojroot_1.3-2
[7] grid_3.5.1 stringr_1.3.1 httr_1.3.1
[10] rJava_0.9-10 munsell_0.5.0 pillar_1.4.0
[13] compiler_3.5.1 tibble_2.1.1 lattice_0.20-35
[16] viridisLite_0.3.0 pkgconfig_2.0.2 xml2_1.2.0
[19] rstudioapi_0.8 readr_1.1.1 stringi_1.1.7
[22] magrittr_1.5 rmarkdown_1.10 evaluate_0.11
[25] rlang_0.3.4 colorspace_1.3-2 yaml_2.2.0
[28] tools_3.5.1 nlme_3.1-137 crayon_1.3.4
[31] backports_1.1.2 xlsxjars_0.6.1 Rcpp_1.0.1
[34] rvest_0.3.2 2 Data import and cleaning
Data were imported from Excel, extraneous columns were removed, and incidental empty rows and columns removed.
#Import data from Excel
filename <- "Meta Dataset 190530.xlsx" #the filename is manually called by date
#import dropout data from file
main.df <- read.xlsx(file = filename,
sheetName = "Study-level data")
#import the substance use data from file
subx.df <- read.xlsx(file = filename,
sheetName = "Frequency and Quantity")
#import the substance use data from file
diag.df <- read.xlsx(file = filename,
sheetName = "Comorbid Diagnoses")
#clean off extraneous columns
extra.columns <- c("Income_.annual","ASI","Country")
main.df <- main.df[,-which(colnames(main.df) %in% extra.columns)]
#clean off NA rows; this assumes there is always an identifier in the first column
dataRow <- !is.na(main.df[,1])
main.df <- main.df[dataRow,]
dataRow <- !is.na(subx.df[,1])
subx.df <- subx.df[dataRow,]
dataRow <- !is.na(diag.df[,1])
diag.df <- diag.df[dataRow,]
#Fix the name of 'Arm #'
colnames(main.df)[which(colnames(main.df) == "Arm..")] <- "Arm" #rename2.1 Cleaning and checking study-level variables
After data were imported and the data frame formatted, several important checks were conducted.
First, each study should have a unique ID within a paper. If non-unique arms were detected, they were flagged for evaluation.
#Check for multiple of the same arm#
repArms <- NULL
for(i in unique(main.df$ID)){
tmp <- main.df$Arm[which(main.df$ID == i)]
if(length(unique(tmp)) != length(tmp)) #each arm ID should be unique within paper ID
repArms <- c(repArms, as.character(main.df$Author[which(main.df$ID == i)])[1])
}
if(length(repArms) > 0) warning(paste("Stud(y/ies) with repeated study arm designations:"), repArms)
#The lack of a warning indicates that all is well. Next, the proportion of participants dropping out is checked. The data were extracted as a proportion, so any value less than 0 or greater than 1 is impossible.
#any greater than 1 have to be percentages, which indicates an error in the Excel sheet
if(any(main.df$Dropout_prop > 1))
warning(paste("Some have dropout proportion > 1. Impossible. Could be entered as %. See rows",
paste(which(main.df$Dropout_prop > 1))))Because meta-analysis functions are dependent on n being an integer, the number who dropped out was calculated, but also checked for whether there were more estimated to have dropped out than were in the study arm total, which is impossible.
#calculate n dropped
nDrop <- main.df$N*main.df$Dropout_prop
#check that none somehow end up with more dropped than total
if(any(nDrop > main.df$N)) warning("Some studies have more dropped participants than total.") #should be FALSE
#check that any are less than 1 person dropped
if(any(nDrop < 1)) warning(paste("Some arms have less than 1 dropout.\n",
"See papers:", paste(unique(main.df$Author[which(nDrop < 1)]), collapse = "\n")))Warning: Some arms have less than 1 dropout.
See papers: Longabaugh et al. (2009)
Miller et al. (1980)
Hall et al. (1985)
Linehan et al. (2002)Papers returned by a warning indicated that some studies showed that less than 1 person dropped out (note that a fraction of a person could be estimated to have dropped out at this point because the number of dropouts was rounded to integers later). Papers with such low dropouts were checked and confirmed.
main.df$Dropout_n_raw <- nDrop #do not round nDrop
main.df$Dropout_n <- round(nDrop)2.2 Data inclusion/exclusion rules
Nine data inclusion/exclusion cases were identified.
| Case | Dropout | Moderator | Decision/Notes |
|---|---|---|---|
| 1 | Averaged over included and excluded arms | All cases | Exclude Study Dropout ‘tainted’ by excluded groups |
| 2 | Reported separately per arm | None | Include as arm nested in study in hierarchical analysis |
| 3 | Pooled only over included arms | None | Include as single value for study (remove replicate arms) |
| 4 | Reported separately per arm | Reported separately per arm | Include as arm nested in study in hierarchical analysis |
| 5 | Pooled only over included arms | Reported separately per arm; non-poolable (categorical) moderator | Exclude Study Cannot pool across separate categories (e.g., average over male/female) Including it in both categories separately would bias toward the null and violate the independence assumption |
| 6 | Pooled only over included arms | Reported separately per arm; Poolable (continuous) moderator | Include after pooling moderator Assumes the average ‘effect’ of two moderator values would converge on the pooled dropout(e.g., a single pooled dropout rate for multiple moderator values) Unclear if this induces regression dilution/attenuation bias |
| 7 | Reported separately per arm | Pooled across arms | Include as arm nested in study in hierarchical analysis Analogous to school being treated with an intervention and measuring the outcome on multiple classrooms. Not all studies have this structure, and in some cases very few are pooled Unclear if this inflates variance (e.g., multiple dropout rates for a single pooled moderator value) |
| 8 | Pooled only over included arms | Pooled only over included arms | Include single value for study |
| 9 | Any | Multiple values for the same comorbid diagnosis or substance class | Exclude Arm Example: a study reports proportion of participants using two different opioids or with two mental comorbid diagnoses separately. There is no way to pool the values because the proportions may refer to the same or different individuals. |
The following processing accounts for these various cases. The plo.rma.mv function also accounts for some of these pooling rules dependent on whether the moderator is continuous or categorical through the pool.cleaning function.
2.3 Processing averaged dropout rates
Some studies reported dropout rates averaged across multiple study arms. In some analyses, this can still be used. However, if a study involved study arms that were excluded from our analysis and pooled the dropout rate, then the study has to be excluded. There is no way to get the dropout rate only for arms we are interested in. This is most easily detected if an average dropout rate is reported but only one study arm is included. (See Case 1 above).
#get study IDs for studies with total dropout reported
byStudy <- unique(main.df$ID[which(main.df$Dropout_Rep == 0)])
#create new instance of main.df to pool dropouts with arms only reported by study
clean.df <- main.df
#remove single arm studies with average dropouts reported
one.arm <- NULL
for(i in byStudy){
arms <- which(clean.df$ID == i) #find arms with a given ID
if(length(arms) == 1) {
one.arm <- c(one.arm, as.character(clean.df$Author[which(clean.df$ID == i)]))
clean.df <- clean.df[-which(clean.df$ID == i),]
}
}
if(!is.null(one.arm))
warning(paste0("'Dropout averages' requires all arms to be included from paper. ",
"The following study was REMOVED: ",
one.arm))Warning: 'Dropout averages' requires all arms to be included from paper.
The following study was REMOVED: Alessi et al. (2008)clean.df <- clean.df[-which(clean.df$Author == "Stevens & Hollis (1989)"),]All studies with average dropout rates and multiple study arms were manually checked to be sure that all study arms in the original paper were eligible for inclusion for this analysis. Only Stevens & Hollis (1989) was removed for this reason.
#use the following code to get other study names for manual checking
#get all studies reported pooled dropout
tmp <- unique(main.df$Author[which(main.df$ID %in% byStudy)])
#only get studies that are not one-arm studies, which are excluded, or the "Stevens & Hollis", which is established as excluded
tmp <- tmp[-which(tmp %in% c(one.arm, "Stevens & Hollis (1989)"))]2.4 Cleaning and formatting study-arm-level substance and comorbid diagnosis data
Data from the substances and comorbid diagnoses worksheets were merged with the study-level data by first confirming that the Author (year) lists matched perfectly.
#Rename first two columns for consistency
colnames(subx.df)[c(1,2)] <- c("Author", "Arm")
colnames(diag.df)[c(1,2)] <- c("Author", "Arm")
#remove studies not in the 'clean.df' set
subx.df <- subx.df[which(subx.df$Author %in% unique(clean.df$Author)),]
diag.df <- diag.df[which(diag.df$Author %in% unique(clean.df$Author)),]
###merge###
#check that the author lists perfectly overlap
if(length(setdiff(subx.df$Author, clean.df$Author)) > 0) warning("Author (year) lists do not match between clean.df and subx.df.")
if(length(setdiff(diag.df$Author, clean.df$Author)) > 0) warning("Author (year) lists do not match between clean.df and diag.df.")
subclean.df <- merge(x = clean.df,
y = subx.df,
by = c("Author","Arm"),
all = T)
diagclean.df <- merge(x = clean.df,
y = diag.df,
by = c("Author","Arm"),
all = T)Each study arm in the merged set should have at least one substance, given that all studies were about substance abuse. On the other hand, not all studies will have reported comorbid diagnoses, so those arms were removed from the merged comorbid diagnosis data set. Typically, if one study arm reported a comorbid diagnosis the others should, too; if they did not, they were flagged for follow-up.
#Check whether all arms have a substance listed (they should)
emptysub <- which(is.na(subclean.df$Substance))
if(length(emptysub) > 0){
warning(paste("The following have no substances listed:",
paste(unique(subclean.df$Author[emptysub]), collapse = ", ")))
#remove empty substances to keep the analysis moving
subclean.df <- subclean.df[-emptysub,]
}
#Find arms with no comorbid diagnoses; it is expected some will not
emptydiag <- which(is.na(diagclean.df$DX))
emptydiag.authors <- unique(diagclean.df$Author[emptydiag]) #get authors
#check for articles where all arms do not have diagnoses; lack of diagnoses could be a problem
diag.mix <- NULL #object to hold author list for studies with only some diagnoses
for(a in emptydiag.authors){
tmp <- diagclean.df$DX[which(diagclean.df$Author == a)] #get diagnoses for each article
tmp2 <- is.na(tmp) #determine if they are NA
if(sum(tmp2) < length(tmp)) diag.mix <- c(diag.mix, a) #if there are fewer NAs than total rows, then it's mixed
}
if(length(diag.mix) > 0){
warning(paste("The following have arms with and without comorbid diagnoses:",
paste(diag.mix, collapse = ", ")))
}
if(length(emptydiag) > 0){
warning(paste("The following studies have from one to all arms without a comorbid diagnosis:\n",
paste(emptydiag.authors, collapse = "\n")))
#remove empty diagnoses; this removes the diag.mix, too
diagclean.df <- diagclean.df[-emptydiag,]
}Warning: The following studies have from one to all arms without a comorbid diagnosis:
Ames et al. (2010)
Anton et al (1999)
Asfar et al. (2008)
Asvat et al. (2014)
Ball et al. (2007)
Barrowclough et al. (2001)
Bender et al. (2006)
Berlin et al. (2012)
Bickel et al. (1997)
Bien et al. (1993)
Borrelli et al. (2005)
Borrelli et al. (2010)
Buchanan et al. (2004)
Burling et al. (1991)
Burling et al. (2001)
Campbell et al. (1995)
Carroll et al. (2009)
Chick et al. (2000)
Cooney et al. (2007)
Copeland et al. (2001)
Coviello et al. (2006)
Crits-Christoph et al. (1999)
Crits-Christoph et al. (2009)
Cropsey et al. (2008)
Curry et al. (1988)
Curtin et al. (2000)
Davis and Glaros. (1986)
Dunn et al. (2010)
Feeney et al. (2001)
Figueiro et al. (2013)
Fucito et al. (2011)
Ghitza et al. (2007)
Goldstein et al. (1989)
Grob et al. (2006)
Haasen et al. (2007)
Hall et al. (1985)
Hall et al. (1987)
Hatsukami et al. (2016)
Hawkins et al. (1986)
Heinala et al. (2001)
Hendricks et al. (2016)
Hernandez-Lopex et al. (2009)
Hovell et al. (2000)
Hymowitz et al. (1991)
Iguchi et al. (1997)
Jones et al. (2004)
Jones et al. (2011)
Kahler et al. (2008)
Kakko et al. (2003)
Kakko et al. (2007)
Kapson et al. (2012)
Kim et al. (2012)
Klesges et al. (1988)
Kranzler et al. (2000)
LaChance et al. (2015)
Lamb et al. (2010)
Lerman et al. (2004) RCT
Littlewood et al. (2015)
Longabaugh et al. (2009)
MacPherson et a. (2010)
Mariani et al. (2012)
Mason et al. (1999)
Miller et al. (1980)
Morgenstern et al. (2006)
Morgenstern et al. (2009)
Nakamura et al. (2007)
Nevid et al. (1996)
Niaura et al. (2002)
O'Malley et al. (1992)
O'Malley et al. (2006)
Ostroff et al. (2014)
Perkins et al. (2001)
Petry & Martin (2002)
Petry et al. (2005)
Petry et al. (2006)
Petry et al. (2007)
Pettinati et al. (2010)
Poldrugo (1997)
Prendergast et al. (2011)
Preston et al. (2008)
Prokhorov et al. (2008)
Rawson et al. (2001)
Reitzel et al. (2013)
Roll et al. (2006)
Rowan-Szal et al. (2005)
Schumann et al. (2008)
Secades-Villa et al. (2011)
Shanahan et al. (2010)
Shiffman et al. (2006)
Shiltz et al. (2011)
Soria et al. (2006)
Sorsdahl et al. (2015)
Supnick & Colletti (1984)
Tappin et al. (2000)
Tashkin et al. (2001)
The Marijuana Treatment Project Research Group (2004)
Vedel et al. (2008)
Volpicelli et al. (1997)
Walker et al. (1983)
Webb et al. (2010)
Williams et al. (2006)
Williams et al. (2010)Occasionally, studies will report more than one substance in the same category within a study arm, such as multiple opiates. Unfortunately, the values are not able to be included easily into models because of dependence of observations (i.e., the same subjects would be counted twice for the same substance; see Case 9 above). The overlap can also be because of a data entry error, so they were flagged and confirmed.
Similarly, multiple of the same category of comorbid diagnoses may be listed, so they were also confirmed.
##Check for the same substance being listed more than once within arm##
multisub <- NULL #object to hold info on multiple instances of a substance within arm
for(auth in unique(subclean.df$Author)){ #go through each study
tmp <- subclean.df[which(subclean.df$Author == auth),] #get all arms
test <- (length(unique(tmp$Arm)) * length(unique(tmp$Substance))) == length(tmp$Arm) #test for multisub
if(!test) multisub <- c(multisub, as.character(tmp$Author)[1]) #if so, add study to list
}
#View(subclean.df[which(subclean.df$Author %in% multisub),c(1,2,3,70,71,72,73,74,75,76)])
#NOTE: from Lappan email 01/31/18 - the following are confirmed to have multiple of same substance category, like different opiates
# "Coviello et al. (2006)"
# "Iguchi et al. (1997)"
# "Morgenstern et al. (2009)"
# Show which diagnoses in the above three papers are replicated within arms
# sapply(X = multisub, FUN = function(X) table(subclean.df$Substance[which(subclean.df$Author == X)]))
# #Coviello: substance 4
# #Iguchi: substance 4
# #Morgenstern: substance 10
##Check for the same diagnosis being listed more than once within arm##
multidiag <- NULL #object to hold info on multiple instances of a diagnosis within arm
for(auth in unique(diagclean.df$Author)){ #for each study
tmp <- diagclean.df[which(diagclean.df$Author == auth),] #get diagnoses
test <- (length(unique(tmp$Arm)) * length(unique(tmp$DX))) == length(tmp$Arm) #test for multidiag
if(!test) multidiag <- c(multidiag, as.character(tmp$Author)[1]) #if so, add study to list
}
#View(diagclean.df[which(diagclean.df$Author %in% multidiag),c(1,2,3,70,71,72,74)])
#Lappan confirms multiple diagnoses to be expected
##Ordering data sets
clean.df <- clean.df[order(clean.df$Dropout_prop),] # sort by dropout rate
subclean.df <- subclean.df[order(subclean.df$Dropout_prop),] #sort by dropout rate
diagclean.df <- diagclean.df[order(diagclean.df$Dropout_prop),] #sort by dropout rate2.5 Final counts of studies included
The PRISMA diagram has information regarding inclusion/exclusion from the point of search. Below is inclusion/exclusion summaries starting from the final data file.
- Studies in imported file: 153
- Study arms in imported file: 341
- Studies in processed data set: 151
- Study arms in processed data set: 338
- Dropout rates in processed data set: 299
- Total subjects in processed data set: 26243
NOTE:
- The difference between study arms and dropout rates is because some studies include only pooled dropout rates over multiple study arms.
- The number of included studies and dropout rates varies from analysis to analysis dependent on whether the moderator was reported in a given study. The number of included studies and dropout rates are reported for each analysis.
3 Estimating overall dropout rates
Several estimates were made of the overall dropout rate, from the simplistic to the appropriately complex. These multiple models were fit to demonstrate the variability from one method to the next, but also to demonstrate that the dropout rates among methods are not unreasonably different from each other.
3.1 Manual fixed-effects meta-analysis of proportions
The overall dropout rate was manually calculated as a fixed-effects, individual-value meta-analysis, not taking into consideration that study arms are related within study for studies that reported dropout rates for each arm independently. This was accomplished by simply looking at the proportion of dropouts summed across all studies divided by the total number of participants across all studies. This method makes three unreasonable assumptions: there is no random effect of study; that study arms are not clustered within study; and (taken together) that each individual across studies essentially is a completely random and independent sample from the population.
##OVERALL MANUAL CALCULATION
df <- pool.cleaning(clean.df, "ID") #adjust all avg dropouts
n <- sum(df$N) #get total number of participants
ns <- sum(df$Dropout_n_raw) #get total number that dropped out
nf <- n - ns #get number who did not dropout
z <- qnorm(0.975) #set z to threshold
pred <- ns/n #calculate proportion dropped out
ci <- z*sqrt((1/n)*pred*(1-pred)) #calculate the confidence interval
ci.lb <- pred - ci #calculate the lower confidence interval
ci.ub <- pred + ci #calculate the higher confidence interval
manual.raw <- c(pred, ci.lb, ci.ub) #create the output object
names(manual.raw) <- c("Dropout","Lower 95% CI","Upper 95% CI") #name the output object
manual.round <- round(manual.raw, 4) #round the object for display
manual.round <- manual.round * 100 #convert to percent
cat("\n")kable(as.data.frame(t(manual.round)))%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI |
|---|---|---|
| 33.68 | 33.1 | 34.25 |
3.2 Manual, inverse variance, fixed-effects, logit meta-analysis
The overall dropout rate was then calculated by first estimating the logit proportion and variance, followed by manual calculation of the mean effect size (proportion dropout) and its variance. This approach makes the untested assumption that there is no heterogeneity among studies, and that study arms are independent (i.e., ignores any ICC among study arms within studies).
#calculate the logit proportion dropout and its variance for each dropout rate
es <- escalc(measure = "PLO",
xi = df$Dropout_n,
ni = df$N)
es <- as.data.frame(es) #convert to data.frame for ease of use
dat <- cbind(rownames(df),as.data.frame(es), df) #add the rownames as a column and append the original df
colnames(dat)[1] <- "arm"
mean <- sum(es[1]/es[2])/sum(1/es[2]) #calculate the overall mean effect size
ci <- sqrt(1/sum(1/es[2]))*z #calculate the 95% interval on the logit scale
iv.raw <- c(mean, mean-ci, mean+ci) #create an object with the mean and 95% CI on logit scale
iv.raw <- transf.ilogit(iv.raw) #transform to proportion
names(iv.raw) <- c("Dropout", "Lower 95% CI", "Upper 95% CI") #name the columns
iv.round <- round(iv.raw, 4) #round the object for display
iv.round <- iv.round * 100 #convert to percent
kable(t(iv.round))%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI |
|---|---|---|
| 35.96 | 35.32 | 36.6 |
3.3 Overall dropout by fixed-effects meta-analysis using rma.mv
Next, the overall dropout rate was calculated using the rma.mv function of the metafor package. The same assumptions are made as in the above manual calculation.
###OVERALL RMA.MV###
#use df and dat from above to calculate fixed-effects, inverse variance meta-analysis
out <- rma.mv(yi,
vi,
data = dat)
print(out)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components: none
Test for Heterogeneity:
Q(df = 298) = 3268.2932, p-val < .0001
Model Results:
estimate se zval pval ci.lb ci.ub
-0.5771 0.0142 -40.5492 <.0001 -0.6050 -0.5492 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 rma.fe.out <- predict(out, transf=transf.ilogit) #convert to proportion
rma.fe.out <- as.numeric(unlist(rma.fe.out)[c(1,3,4)]) * 100 #convert to percent
rma.fe.out <- round(rma.fe.out,2)
names(rma.fe.out) <- c("Dropout", "Lower 95% CI", "Upper 95% CI")
kable(t(rma.fe.out))%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI |
|---|---|---|
| 35.96 | 35.32 | 36.6 |
3.4 Overall random-effects
Building onto the fixed-effects models, a random-effects model was fit using rma.mv that continues to assume each dropout rate is independent. This also applies to studies in which the dropout rate was pooled.
###OVERALL random-effects RMA.MV###
#use df and dat from above to calculate random-effects, inverse variance meta-analysis
out <- rma.mv(yi,
vi,
random = ~1 | arm,
data = dat)
print(out)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2 0.9296 0.9641 299 no arm
Test for Heterogeneity:
Q(df = 298) = 3268.2932, p-val < .0001
Model Results:
estimate se zval pval ci.lb ci.ub
-0.7730 0.0605 -12.7715 <.0001 -0.8917 -0.6544 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 rma.re.out <- predict(out, transf=transf.ilogit) #convert to proportion
rma.re.out <- as.numeric(unlist(rma.re.out)[c(1,3,4,5,6)]) * 100 #convert to percent
rma.re.out <- round(rma.re.out,2)
names(rma.re.out) <- c("Dropout", "Lower 95% CI", "Upper 95% CI", "Lower 95% PI", "Upper 95% PI")
kable(t(rma.re.out))%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI |
|---|---|---|---|---|
| 31.58 | 29.08 | 34.2 | 6.5 | 75.41 |
3.5 Overall dropout by multi-level, random-effects meta-analysis
Finally, the overall dropout rate was estimated using a multilevel random-effects meta-analysis using a logit transformed proportion. This was accomplished through the custom plo.rma.mv wrapper function for the rma.mv function of metafor (see functions.r file). This model also included the hierarchical nature of the data, with study arms being nested with studies. Note that in cases where dropout rates were pooled, the study was reported as a single entry and thus no within-study correlation could be calculated.
overall.re.out <- plo.rma.mv(clean.df
,varname = NULL
,title = "Overall",
profile = profile,
long = long)
print(overall.re.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7853 0.8862 151 no ID
sigma^2.2 0.1287 0.3587 299 no ID/arm
Test for Heterogeneity:
Q(df = 298) = 3268.2932, p-val < .0001
Model Results:
estimate se zval pval ci.lb ci.ub
-0.8273 0.0797 -10.3767 <.0001 -0.9836 -0.6711 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(overall.re.out$ICC)))
ICC: 0.8592cat(paste("\nI^2.1", fmt1(overall.re.out$I2[1])))
I^2.1 80.5cat(paste("\nI^2.2", fmt1(overall.re.out$I2[2])))
I^2.2 13.2kable(overall.re.out$prediction)%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|
| Overall | 30.42 | 27.22 | 33.83 | 6.25 | 74.14 |
if(plots){
forest(
x = overall.re.out$model$yi[order(overall.re.out$model$yi)] #sort by point estimate
,vi = overall.re.out$model$vi[order(overall.re.out$model$yi)] #sort by point estimate
,annotate = FALSE
,at=c(0,0.2,0.4,0.6,0.8,1)
,transf = transf.ilogit
,xlim = c(-0.1, 1.1)
,alim = c(0,1)
,refline = overall.re.out$prediction$Dropout/100
,slab = NA
,xlab = "Dropout (proportion)"
,cex.lab = 1
,cex.axis = 1
,psize = 10
)
#add prediction interval under diamond
lines(c(overall.re.out$prediction$`Lower 95% PI`/100,
overall.re.out$prediction$`Upper 95% PI`/100)
,c(-5,-5))
#manually add the summary diamond
addpoly(x = overall.re.out$prediction$Dropout/100
,ci.lb = overall.re.out$prediction$`Lower 95% CI`/100
,ci.ub = overall.re.out$prediction$`Upper 95% CI`/100
,rows = -5
,efac = 1
,cex=1.2
,col='red'
,annotate=FALSE
)
#Add annotation
text(x=c(0,0,0)
,y=c(25,15,5)
,labels = c(
paste0("Mean Dropout: "
,fmt2(overall.re.out$prediction$Dropout/100)
),
paste0("95% CI: "
,fmt2(overall.re.out$prediction$`Lower 95% CI`/100)
,","
,fmt2(overall.re.out$prediction$`Upper 95% CI`/100)
),
paste0("95% PI: "
,fmt2(overall.re.out$prediction$`Lower 95% PI`/100)
,","
,fmt2(overall.re.out$prediction$`Upper 95% PI`/100)
)
)
,adj=0
)
}
Figure: Overall, random-effects, hierarchical, logit meta-analysis. Each horizontal line represents the point estimate and 95% CI of each study, back-transformed from logit scale. Symbols demark the point estimate, and are not proportional to study or study-arm weight. The dashed line represents the mean proportion dropout across studies. The polygon represents the average proportion dropout and its 95% CI, with a 95% prediction interval.
3.6 Conclusion about overall dropout rate
The manual and random-effects analyses are not identical, as would be expected. Although there are differences among them, they are not large differences, giving some degree of face validity. The model with the highest theoretical support is the hierarchical random-effects model, and is considered the primary analysis for the overall dropout rate.
Importantly, there remains significant residual heterogeneity, as is expected given the wide variety of studies included. To investigate sources of this heterogeneity, a series of moderator meta-regressions (for continuous predictors) or sub-group meta-analyses (for categorical preditors) are described below.
The interpretation of the dropout rates and 95% CI are limited in the random-effects models, as indicated by the 95% Prediction Interval (PI). The sizeable heterogeneity indicates that although the average across all studies is expected to be around 30%, the expectation for any given study is much less predictable, with a 95% range of study dropout rates from about 6% to 74%.
4 Testing study-level moderators
To evaluate whether characteristics of the studies could help explain the heterogeneity scene in the overall models, moderator sub-group meta-analyses and meta-regressions were calculated. This section describes study-level moderators, which are moderator variables that were constant at the study level, meaning they did not vary from study-arm to study-arm.
4.1 Categorical study-level moderators
Sub-group meta-analyses were conducted for moderator variables that were categorical. These models used the same inverse-variance, hierarchical approach as the overall model, but included categorical, study-level variables for sub-group analyses. For each moderator analysis, profile plots may be created to evaluate the two variance components (within and between study), and the intraclass correlation (ICC) is also reported. In cases where the ICC is 0 or 1, the profile plots for one of the variance components is maxed out at 0.
###Test moderators###
#Moderators from worksheet 1 only
###categorical variables###
catvars <- c(
"Inter_degree",
"Type",
"Pregnant",
"Manualized",
"Setting",
"Pharmacotherapy",
"TX_orientation",
"Limited",
"Training.for.fidelity",
"Format",
"Eff",
"Dependence",
"Treatment.Seeking",
"Country_Dev"
)
out <- NULL
categorical.table <- NULL #instantiate table to be printed at end
for(v in catvars){
outname <- common_varname[match(v,common_varname),2] #get readable version of varname
if(is.na(outname)) outname <- v #if it does not exist, revert to variable name
cat.out <- suppressMessages(plo.rma.mv(df = clean.df,
varname = v,
continuous = FALSE,
title = outname,
profile = profile,
long = long)
)
assign(paste0(v,".out"), cat.out)
out <- c(out, knit_child('categorical.Rmd', quiet=TRUE))
categorical.table <- rbind(categorical.table, cat.table.out)
}
4.1.1 Degree
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 158; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7983 0.8935 82 no ID
sigma^2.2 0.0836 0.2891 158 no ID/arm
Test for Residual Heterogeneity:
QE(df = 153) = 1678.8840, p-val < .0001
Test of Moderators (coefficient(s) 2:5):
QM(df = 4) = 5.4466, p-val = 0.2445
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.6739 0.1545 -4.3612 <.0001 -0.9768 -0.3711
factor(get(varname))3 -0.6078 0.4341 -1.4002 0.1614 -1.4586 0.2430
factor(get(varname))4 -0.3862 0.2227 -1.7346 0.0828 -0.8227 0.0502
factor(get(varname))5 -0.1658 0.3011 -0.5507 0.5818 -0.7559 0.4243
factor(get(varname))6 -1.1610 0.8430 -1.3773 0.1684 -2.8132 0.4912
intrcpt ***
factor(get(varname))3
factor(get(varname))4 .
factor(get(varname))5
factor(get(varname))6
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.9053cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 84.4cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 8.8header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Mixed | 33.76 | 27.35 | 40.83 | 7.32 | 76.70 | 71 | 36 |
| Bachelors | 21.73 | 11.14 | 38.07 | 3.60 | 67.33 | 8 | 6 |
| Masters | 25.73 | 19.64 | 32.93 | 5.05 | 69.28 | 55 | 27 |
| Doctorate | 30.16 | 20.43 | 42.08 | 6.00 | 74.51 | 22 | 14 |
| Certificate | 13.77 | 3.05 | 44.75 | 1.35 | 65.02 | 2 | 2 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Degree’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.2 Substance Being Treated
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7030 0.8385 151 no ID
sigma^2.2 0.1319 0.3631 299 no ID/arm
Test for Residual Heterogeneity:
QE(df = 290) = 2915.3922, p-val < .0001
Test of Moderators (coefficient(s) 2:9):
QM(df = 8) = 21.9463, p-val = 0.0050
Model Results:
estimate se zval pval ci.lb
intrcpt -1.0428 0.2032 -5.1326 <.0001 -1.4411
factor(get(varname))2 -0.0292 0.2342 -0.1246 0.9009 -0.4882
factor(get(varname))3 0.9894 0.2988 3.3114 0.0009 0.4038
factor(get(varname))4 0.6060 0.3584 1.6909 0.0909 -0.0964
factor(get(varname))5 1.1832 0.9203 1.2857 0.1986 -0.6206
factor(get(varname))7 0.4198 0.4560 0.9205 0.3573 -0.4740
factor(get(varname))9 0.2214 0.2667 0.8300 0.4066 -0.3014
factor(get(varname))11 -0.0481 0.7159 -0.0672 0.9464 -1.4511
factor(get(varname))12 0.9144 0.9134 1.0010 0.3168 -0.8760
ci.ub
intrcpt -0.6446 ***
factor(get(varname))2 0.4299
factor(get(varname))3 1.5750 ***
factor(get(varname))4 1.3085 .
factor(get(varname))5 2.9870
factor(get(varname))7 1.3135
factor(get(varname))9 0.7442
factor(get(varname))11 1.3550
factor(get(varname))12 2.7047
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8421cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 78.4cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 14.7header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Alcohol | 26.06 | 19.14 | 34.42 | 5.33 | 68.82 | 47 | 21 |
| Tobacco | 25.50 | 21.41 | 30.08 | 5.33 | 67.55 | 117 | 65 |
| Cocaine | 48.66 | 38.16 | 59.29 | 13.07 | 85.67 | 42 | 18 |
| Opioid | 39.25 | 26.59 | 53.54 | 8.96 | 80.93 | 24 | 10 |
| Methamphetamine | 53.50 | 16.54 | 86.98 | 8.55 | 93.41 | 2 | 1 |
| Cannabis | 34.91 | 19.42 | 54.42 | 7.01 | 79.22 | 11 | 5 |
| Polysubstance | 30.55 | 23.86 | 38.16 | 6.64 | 73.13 | 50 | 29 |
| Heroin | 25.14 | 8.04 | 56.33 | 3.45 | 75.93 | 4 | 2 |
| Major stimulant | 46.79 | 13.31 | 83.44 | 6.73 | 91.47 | 2 | 1 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Substance Being Treated’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.3 Pregnant Participants?
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7720 0.8786 151 no ID
sigma^2.2 0.1283 0.3582 299 no ID/arm
Test for Residual Heterogeneity:
QE(df = 297) = 3255.2996, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 3.9073, p-val = 0.0481
Model Results:
estimate se zval pval ci.lb
intrcpt -0.8164 0.0793 -10.2911 <.0001 -0.9719
factor(get(varname))1 -2.3617 1.1948 -1.9767 0.0481 -4.7034
ci.ub
intrcpt -0.6609 ***
factor(get(varname))1 -0.0200 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8575cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.3cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.3header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| No or not indicated | 30.65 | 27.45 | 34.05 | 6.40 | 74.07 | 298 | 150 |
| Yes | 4.00 | 0.40 | 30.12 | 0.21 | 45.22 | 1 | 1 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Pregnant Participants?’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.4 Manualized Treatment?
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 296; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7823 0.8845 148 no ID
sigma^2.2 0.1274 0.3569 296 no ID/arm
Test for Residual Heterogeneity:
QE(df = 294) = 3183.7959, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.9614, p-val = 0.3268
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.7605 0.1068 -7.1195 <.0001 -0.9699 -0.5512
factor(get(varname))1 -0.1323 0.1349 -0.9805 0.3268 -0.3966 0.1321
intrcpt ***
factor(get(varname))1
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8600cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.5cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.1header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| No or not indicated | 31.85 | 27.49 | 36.56 | 6.65 | 75.41 | 130 | 74 |
| Yes | 29.05 | 25.07 | 33.38 | 5.88 | 72.86 | 166 | 81 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Manualized Treatment?’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.5 Setting of Trial
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7793 0.8828 151 no ID
sigma^2.2 0.1297 0.3602 299 no ID/arm
Test for Residual Heterogeneity:
QE(df = 293) = 3162.7535, p-val < .0001
Test of Moderators (coefficient(s) 2:6):
QM(df = 5) = 6.4229, p-val = 0.2672
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.5409 0.5562 -0.9725 0.3308 -1.6309 0.5492
factor(get(varname))2 -0.6790 0.6133 -1.1071 0.2682 -1.8811 0.5231
factor(get(varname))3 -0.2000 0.5637 -0.3548 0.7227 -1.3048 0.9048
factor(get(varname))4 -0.5162 0.6207 -0.8317 0.4056 -1.7327 0.7003
factor(get(varname))5 -0.9476 0.7227 -1.3111 0.1898 -2.3641 0.4690
factor(get(varname))6 -0.0596 0.7178 -0.0830 0.9339 -1.4664 1.3472
intrcpt
factor(get(varname))2
factor(get(varname))3
factor(get(varname))4
factor(get(varname))5
factor(get(varname))6
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8573cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.2cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.3header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Institution | 36.80 | 16.37 | 63.40 | 6.27 | 83.52 | 4 | 3 |
| Outpatient (hospital/medical school) | 22.80 | 15.10 | 32.89 | 4.09 | 67.18 | 28 | 15 |
| Outpatient (public) | 32.28 | 28.48 | 36.33 | 6.80 | 75.70 | 227 | 113 |
| University affiliated clinic | 25.79 | 16.84 | 37.35 | 4.73 | 70.85 | 26 | 12 |
| Inpatient | 18.42 | 8.37 | 35.81 | 2.75 | 64.28 | 8 | 5 |
| Mixed | 35.42 | 18.40 | 57.17 | 6.48 | 81.29 | 6 | 4 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Setting of Trial’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.6 Pharmacotherapy Category
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 291; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.8060 0.8978 143 no ID
sigma^2.2 0.1278 0.3574 291 no ID/arm
Test for Residual Heterogeneity:
QE(df = 287) = 3041.1501, p-val < .0001
Test of Moderators (coefficient(s) 2:4):
QM(df = 3) = 3.0625, p-val = 0.3821
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.8630 0.1117 -7.7272 <.0001 -1.0819 -0.6441
factor(get(varname))1 0.2375 0.1950 1.2180 0.2232 -0.1447 0.6197
factor(get(varname))2 0.1840 0.2030 0.9063 0.3648 -0.2139 0.5820
factor(get(varname))3 -0.0493 0.1749 -0.2818 0.7781 -0.3920 0.2935
intrcpt ***
factor(get(varname))1
factor(get(varname))2
factor(get(varname))3
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8632cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.7cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 12.8header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| No | 29.67 | 25.31 | 34.43 | 5.90 | 73.95 | 136 | 79 |
| Placebo | 34.85 | 28.06 | 42.33 | 7.27 | 78.49 | 33 | 26 |
| Not agonist | 33.65 | 26.63 | 41.47 | 6.90 | 77.63 | 41 | 24 |
| Agonist | 28.65 | 23.44 | 34.51 | 5.60 | 73.13 | 81 | 43 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Pharmacotherapy Category’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.7 Treatment Approach
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 290; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7947 0.8915 142 no ID
sigma^2.2 0.1305 0.3613 290 no ID/arm
Test for Residual Heterogeneity:
QE(df = 284) = 2969.2258, p-val < .0001
Test of Moderators (coefficient(s) 2:6):
QM(df = 5) = 5.5873, p-val = 0.3485
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.9202 0.1033 -8.9049 <.0001 -1.1227 -0.7176
factor(get(varname))2 -0.0390 0.2053 -0.1901 0.8492 -0.4415 0.3634
factor(get(varname))3 0.2028 0.1115 1.8188 0.0689 -0.0157 0.4212
factor(get(varname))4 0.0210 0.8425 0.0249 0.9802 -1.6303 1.6722
factor(get(varname))5 0.4404 0.3529 1.2480 0.2120 -0.2512 1.1321
factor(get(varname))6 0.0220 0.1793 0.1224 0.9026 -0.3295 0.3734
intrcpt ***
factor(get(varname))2
factor(get(varname))3 .
factor(get(varname))4
factor(get(varname))5
factor(get(varname))6
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8589cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.3cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.2header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Cognitive and/or behavioral | 28.49 | 24.55 | 32.79 | 5.65 | 72.63 | 121 | 72 |
| Motivational | 27.70 | 20.83 | 35.82 | 5.31 | 72.38 | 17 | 16 |
| Non-specific | 32.80 | 28.55 | 37.35 | 6.83 | 76.47 | 114 | 74 |
| Psychodynamic | 28.92 | 7.28 | 67.84 | 3.22 | 83.25 | 1 | 1 |
| 12-step | 38.23 | 23.68 | 55.26 | 7.67 | 82.17 | 4 | 3 |
| Integrative | 28.94 | 22.53 | 36.33 | 5.66 | 73.44 | 33 | 21 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Treatment Approach’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.8 Limited Treatment Time?
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7935 0.8908 151 no ID
sigma^2.2 0.1253 0.3540 299 no ID/arm
Test for Residual Heterogeneity:
QE(df = 297) = 3209.6266, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 1.2725, p-val = 0.2593
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.4625 0.3333 -1.3876 0.1653 -1.1159 0.1908
factor(get(varname))1 -0.3776 0.3347 -1.1280 0.2593 -1.0337 0.2785
intrcpt
factor(get(varname))1
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8636cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 81.0cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 12.8header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| No or not indicated | 38.64 | 24.68 | 54.76 | 7.93 | 82.15 | 10 | 6 |
| Yes | 30.15 | 26.93 | 33.58 | 6.15 | 73.99 | 289 | 147 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Limited Treatment Time?’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.9 Training for Fidelity?
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 298; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7917 0.8898 150 no ID
sigma^2.2 0.1285 0.3585 298 no ID/arm
Test for Residual Heterogeneity:
QE(df = 296) = 3232.4573, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.1424, p-val = 0.7059
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.8495 0.1092 -7.7822 <.0001 -1.0634 -0.6355
factor(get(varname))1 0.0578 0.1532 0.3774 0.7059 -0.2424 0.3580
intrcpt ***
factor(get(varname))1
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8603cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.6cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.1header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| No or not indicated | 29.95 | 25.67 | 34.63 | 6.06 | 73.94 | 155 | 78 |
| Yes | 31.18 | 26.65 | 36.11 | 6.39 | 75.05 | 143 | 75 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Training for Fidelity?’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.10 Treatment Format
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 297; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7540 0.8683 149 no ID
sigma^2.2 0.1264 0.3556 297 no ID/arm
Test for Residual Heterogeneity:
QE(df = 292) = 3164.1785, p-val < .0001
Test of Moderators (coefficient(s) 2:5):
QM(df = 4) = 10.9702, p-val = 0.0269
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.6998 0.1371 -5.1030 <.0001 -0.9686 -0.4310
factor(get(varname))2 -0.2875 0.1573 -1.8279 0.0676 -0.5958 0.0208
factor(get(varname))3 0.2514 0.2142 1.1737 0.2405 -0.1684 0.6713
factor(get(varname))4 -1.2926 1.0434 -1.2389 0.2154 -3.3375 0.7524
factor(get(varname))5 -0.1815 0.8872 -0.2046 0.8379 -1.9205 1.5574
intrcpt ***
factor(get(varname))2 .
factor(get(varname))3
factor(get(varname))4
factor(get(varname))5
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8564cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.1cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.4header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Group | 33.18 | 27.52 | 39.39 | 7.19 | 76.11 | 74 | 41 |
| Individual | 27.14 | 23.50 | 31.12 | 5.54 | 70.30 | 171 | 87 |
| Mixed | 38.97 | 31.36 | 47.17 | 8.97 | 80.55 | 50 | 28 |
| Not specified | 12.00 | 1.76 | 50.87 | 0.88 | 67.80 | 1 | 1 |
| Couple therapy | 29.29 | 6.91 | 69.80 | 3.23 | 83.70 | 1 | 1 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Treatment Format’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.11 Efficacy Study?
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7874 0.8874 151 no ID
sigma^2.2 0.1288 0.3589 299 no ID/arm
Test for Residual Heterogeneity:
QE(df = 297) = 3250.0512, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.6515, p-val = 0.4196
Model Results:
estimate se zval pval ci.lb
intrcpt -0.8503 0.0847 -10.0377 <.0001 -1.0163
factor(get(varname))2 0.2042 0.2530 0.8071 0.4196 -0.2916
ci.ub
intrcpt -0.6843 ***
factor(get(varname))2 0.7000
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8594cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.5cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.2header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Efficacy | 29.94 | 26.57 | 33.53 | 6.10 | 73.75 | 277 | 134 |
| Effectiveness | 34.39 | 24.73 | 45.54 | 7.05 | 78.37 | 22 | 17 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Efficacy Study?’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.12 Codification of Dependence
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7147 0.8454 151 no ID
sigma^2.2 0.1309 0.3618 299 no ID/arm
Test for Residual Heterogeneity:
QE(df = 297) = 3110.3733, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 11.6791, p-val = 0.0006
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.5344 0.1144 -4.6697 <.0001 -0.7586 -0.3101
factor(get(varname))2 -0.5272 0.1543 -3.4175 0.0006 -0.8296 -0.2248
intrcpt ***
factor(get(varname))2 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8452cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 78.8cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 14.4header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| DSM | 36.95 | 31.89 | 42.31 | 8.70 | 78.28 | 139 | 68 |
| Other | 25.70 | 22.02 | 29.76 | 5.34 | 67.96 | 160 | 83 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Codification of Dependence’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.13 Treatment Seeking?
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 298; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7668 0.8757 150 no ID
sigma^2.2 0.1308 0.3617 298 no ID/arm
Test for Residual Heterogeneity:
QE(df = 295) = 3205.7958, p-val < .0001
Test of Moderators (coefficient(s) 2:3):
QM(df = 2) = 4.6733, p-val = 0.0967
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.8387 0.2267 -3.6998 0.0002 -1.2831 -0.3944
factor(get(varname))1 0.0411 0.2244 0.1830 0.8548 -0.3988 0.4809
factor(get(varname))2 -1.2158 0.6199 -1.9614 0.0498 -2.4308 -0.0009
intrcpt ***
factor(get(varname))1
factor(get(varname))2 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8542cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.0cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.6header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| No or not indicated | 30.18 | 21.70 | 40.27 | 6.02 | 74.47 | 20 | 8 |
| Yes | 31.05 | 27.76 | 34.55 | 6.53 | 74.38 | 272 | 140 |
| Mixed | 11.36 | 3.97 | 28.42 | 1.44 | 52.99 | 6 | 3 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Treatment Seeking?’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.1.14 Country Classification
cat.table.out <- cat.table(cat.out, outname)
print(cat.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7893 0.8884 151 no ID
sigma^2.2 0.1292 0.3594 299 no ID/arm
Test for Residual Heterogeneity:
QE(df = 297) = 3263.5004, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.5191, p-val = 0.4712
Model Results:
estimate se zval pval ci.lb
intrcpt -0.8398 0.0817 -10.2763 <.0001 -1.0000
factor(get(varname))2 0.2810 0.3901 0.7205 0.4712 -0.4835
ci.ub
intrcpt -0.6796 ***
factor(get(varname))2 1.0455
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cat.out$ICC)))
ICC: 0.8593cat(paste("\nI^2.1", fmt1(cat.out$I2[1])))
I^2.1 80.6cat(paste("\nI^2.2", fmt1(cat.out$I2[2])))
I^2.2 13.2header <- 8
names(header) <- outname
kable(cat.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Developed | 30.16 | 26.89 | 33.63 | 6.15 | 73.99 | 289 | 144 |
| Developing | 36.38 | 21.31 | 54.70 | 7.04 | 81.20 | 10 | 7 |
if(plots) plo.forest(out = cat.out
,variable = v
)
Figure: Subgroup meta-analysis for ‘Country Classification’. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Intervals are not included.
4.2 Continuous study-level moderators
Continuous study-level moderators were evaluated using meta-regressions, again based on the inverse-variance, hierarchical, random-effects approach described above. Profile plots were also fit as described in the ‘Categorical’ section, and meta-regression plots were created.
##continuous variables##
#can add predvals, but presently just uses the six categories from summary() function
contvars <- c(
"Age",
"Gender_Male",
"Education_years",
"White",
"Hispanic",
"AA",
"Race_eth_other",
"Adjusted_income_annual",
"Marital_not_married",
"Unemployment",
"Employment_other",
"Inter_exp_years",
"Year",
"Sessions",
"Sess_length_min",
"Session_period_weeks"
)
out<-NULL
continuous.table <- NULL #instantiate table to be printed at end
for(v in contvars){
outname <- common_varname[match(v,common_varname),2] #get readable version of varname
if(is.na(outname)) outname <- v #if it does not exist, revert to variable name
cont.out <- suppressMessages(plo.rma.mv(df = clean.df,
varname = v,
continuous = TRUE,
title = outname,
profile = profile,
long = long)
)
assign(paste0(v,".out"), cont.out)
out <- c(out, knit_child('continuous.Rmd', quiet=TRUE))
continuous.table <- rbind(continuous.table, cont.table.out)
}
4.2.1 Age (mean years)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 294; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7510 0.8666 146 no ID
sigma^2.2 0.1315 0.3626 294 no ID/arm
Test for Residual Heterogeneity:
QE(df = 292) = 3187.8891, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 2.8457, p-val = 0.0916
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.1228 0.4321 -0.2841 0.7763 -0.9697 0.7242
get(varname) -0.0185 0.0110 -1.6869 0.0916 -0.0400 0.0030 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8510cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 79.5cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 13.9header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 20.5972 | 37.66 | 28.42 | 47.89 | 8.37 | 79.97 |
| 1st Qu. | 34.4000 | 31.87 | 28.07 | 35.93 | 6.85 | 74.85 |
| Median | 39.0000 | 30.06 | 26.88 | 33.43 | 6.34 | 73.17 |
| Mean | 38.5664 | 30.22 | 27.04 | 33.61 | 6.39 | 73.32 |
| 3rd Qu. | 43.0000 | 28.52 | 24.98 | 32.35 | 5.90 | 71.74 |
| Max. | 57.5000 | 23.38 | 16.52 | 31.99 | 4.40 | 66.92 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Age (mean years)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.2 Sex (proportion male)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 289; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7991 0.8939 145 no ID
sigma^2.2 0.1349 0.3674 289 no ID/arm
Test for Residual Heterogeneity:
QE(df = 287) = 3115.8747, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.1944, p-val = 0.6593
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.9104 0.2066 -4.4071 <.0001 -1.3153 -0.5055 ***
get(varname) 0.1418 0.3215 0.4409 0.6593 -0.4884 0.7719
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8555cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 80.2cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 13.5header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0000 | 28.69 | 21.16 | 37.62 | 5.48 | 73.63 |
| 1st Qu. | 0.4800 | 30.10 | 26.56 | 33.91 | 6.04 | 74.27 |
| Median | 0.6000 | 30.46 | 27.17 | 33.97 | 6.14 | 74.57 |
| Mean | 0.5926 | 30.44 | 27.15 | 33.94 | 6.14 | 74.55 |
| 3rd Qu. | 0.7400 | 30.88 | 27.05 | 35.00 | 6.24 | 74.99 |
| Max. | 1.0000 | 31.68 | 25.48 | 38.60 | 6.37 | 75.95 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Sex (proportion male)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.3 Education (mean years)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 70; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.6571 0.8106 34 no ID
sigma^2.2 0.1054 0.3247 70 no ID/arm
Test for Residual Heterogeneity:
QE(df = 68) = 758.0816, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 2.0166, p-val = 0.1556
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt 0.9800 1.1484 0.8533 0.3935 -1.2709 3.2309
get(varname) -0.1291 0.0909 -1.4201 0.1556 -0.3072 0.0491
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8618cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 79.0cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 12.7header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 8.9100 | 45.76 | 29.31 | 63.19 | 11.68 | 84.33 |
| 1st Qu. | 11.5000 | 37.66 | 29.82 | 46.20 | 9.52 | 77.61 |
| Median | 12.3500 | 35.12 | 28.57 | 42.28 | 8.69 | 75.48 |
| Mean | 12.5524 | 34.52 | 28.07 | 41.60 | 8.49 | 74.98 |
| 3rd Qu. | 13.8000 | 30.98 | 23.54 | 39.56 | 7.22 | 72.14 |
| Max. | 16.0000 | 25.26 | 14.51 | 40.22 | 5.07 | 68.13 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Education (mean years)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.4 White (proportion)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 225; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.8026 0.8959 112 no ID
sigma^2.2 0.1100 0.3316 225 no ID/arm
Test for Residual Heterogeneity:
QE(df = 223) = 2350.2549, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 3.5181, p-val = 0.0607
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.4847 0.1932 -2.5086 0.0121 -0.8634 -0.1060 *
get(varname) -0.5464 0.2913 -1.8757 0.0607 -1.1174 0.0246 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8795cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 82.4cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 11.3header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0000 | 38.11 | 29.66 | 47.35 | 8.36 | 80.62 |
| 1st Qu. | 0.3800 | 33.35 | 28.75 | 38.29 | 7.06 | 76.72 |
| Median | 0.6400 | 30.27 | 26.52 | 34.30 | 6.20 | 74.02 |
| Mean | 0.5924 | 30.82 | 27.09 | 34.83 | 6.36 | 74.51 |
| 3rd Qu. | 0.8600 | 27.80 | 23.22 | 32.88 | 5.51 | 71.77 |
| Max. | 1.0000 | 26.29 | 20.90 | 32.49 | 5.08 | 70.37 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘White (proportion)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.5 Hispanic/Latino (proportion)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 130; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.8793 0.9377 69 no ID
sigma^2.2 0.1468 0.3832 130 no ID/arm
Test for Residual Heterogeneity:
QE(df = 128) = 1654.8930, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 3.5824, p-val = 0.0584
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.6818 0.1414 -4.8203 <.0001 -0.9590 -0.4046 ***
get(varname) -1.0953 0.5787 -1.8927 0.0584 -2.2295 0.0389 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8569cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 81.2cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 13.6header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0000 | 33.59 | 27.71 | 40.02 | 6.38 | 78.97 |
| 1st Qu. | 0.0000 | 33.59 | 27.71 | 40.02 | 6.38 | 78.97 |
| Median | 0.0445 | 32.51 | 27.14 | 38.37 | 6.11 | 78.10 |
| Mean | 0.1118 | 30.91 | 25.97 | 36.33 | 5.71 | 76.78 |
| 3rd Qu. | 0.1538 | 29.94 | 25.03 | 35.35 | 5.46 | 75.96 |
| Max. | 1.0000 | 14.47 | 5.69 | 32.15 | 1.77 | 61.29 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Hispanic/Latino (proportion)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.6 African American (proportion)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 142; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.6886 0.8298 74 no ID
sigma^2.2 0.1507 0.3882 142 no ID/arm
Test for Residual Heterogeneity:
QE(df = 140) = 1454.5424, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 12.5011, p-val = 0.0004
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -1.2199 0.1593 -7.6556 <.0001 -1.5322 -0.9076 ***
get(varname) 1.3149 0.3719 3.5357 0.0004 0.5860 2.0438 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8204cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 76.5cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 16.7header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0000 | 22.80 | 17.77 | 28.75 | 4.55 | 64.63 |
| 1st Qu. | 0.0700 | 24.46 | 19.70 | 29.93 | 5.00 | 66.57 |
| Median | 0.2776 | 29.84 | 25.56 | 34.51 | 6.52 | 72.18 |
| Mean | 0.3222 | 31.08 | 26.72 | 35.81 | 6.89 | 73.34 |
| 3rd Qu. | 0.5222 | 36.98 | 31.12 | 43.24 | 8.72 | 78.27 |
| Max. | 1.0000 | 52.37 | 38.98 | 65.44 | 14.42 | 87.77 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘African American (proportion)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.7 Other Race/Ethnicity (proportion)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 142; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7856 0.8863 74 no ID
sigma^2.2 0.1464 0.3826 142 no ID/arm
Test for Residual Heterogeneity:
QE(df = 140) = 1603.6324, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 7.0827, p-val = 0.0078
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.6745 0.1278 -5.2792 <.0001 -0.9249 -0.4241 ***
get(varname) -1.3494 0.5070 -2.6613 0.0078 -2.3432 -0.3556 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8429cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 79.3cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 14.8header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0000 | 33.75 | 28.40 | 39.55 | 7.02 | 77.45 |
| 1st Qu. | 0.0000 | 33.75 | 28.40 | 39.55 | 7.02 | 77.45 |
| Median | 0.0400 | 32.55 | 27.61 | 37.91 | 6.69 | 76.46 |
| Mean | 0.1226 | 30.15 | 25.66 | 35.07 | 6.04 | 74.37 |
| 3rd Qu. | 0.0848 | 31.24 | 26.61 | 36.27 | 6.33 | 75.34 |
| Max. | 1.0000 | 11.67 | 5.06 | 24.70 | 1.59 | 51.88 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Other Race/Ethnicity (proportion)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.8 Adjusted Mean Annual Income ($)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 34; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.5481 0.7403 16 no ID
sigma^2.2 0.3726 0.6104 34 no ID/arm
Test for Residual Heterogeneity:
QE(df = 32) = 180.4242, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 4.2994, p-val = 0.0381
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.1779 0.3247 -0.5480 0.5837 -0.8142 0.4584
get(varname) -0.0000 0.0000 -2.0735 0.0381 -0.0000 -0.0000 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.5953cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 52.6cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 35.8header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 6727.000 | 42.41 | 29.65 | 56.27 | 9.38 | 83.96 |
| 1st Qu. | 9725.625 | 41.02 | 29.08 | 54.12 | 8.98 | 83.07 |
| Median | 15684.000 | 38.30 | 27.71 | 50.14 | 8.18 | 81.23 |
| Mean | 25638.691 | 33.93 | 24.59 | 44.71 | 6.91 | 78.04 |
| 3rd Qu. | 26670.250 | 33.49 | 24.21 | 44.25 | 6.78 | 77.71 |
| Max. | 121000.000 | 7.70 | 1.37 | 33.36 | 0.62 | 52.85 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Adjusted Mean Annual Income ($)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.9 Not Married (proportion)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 155; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7403 0.8604 80 no ID
sigma^2.2 0.1280 0.3577 155 no ID/arm
Test for Residual Heterogeneity:
QE(df = 153) = 1565.3776, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.5757, p-val = 0.4480
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.9743 0.3442 -2.8309 0.0046 -1.6488 -0.2997 **
get(varname) 0.3732 0.4919 0.7587 0.4480 -0.5909 1.3374
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8526cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 79.9cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 13.8header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0000 | 27.40 | 16.13 | 42.56 | 5.11 | 72.56 |
| 1st Qu. | 0.5550 | 31.71 | 26.87 | 36.98 | 6.86 | 74.54 |
| Median | 0.6850 | 32.77 | 28.34 | 37.53 | 7.20 | 75.39 |
| Mean | 0.6758 | 32.69 | 28.28 | 37.44 | 7.17 | 75.33 |
| 3rd Qu. | 0.8225 | 33.91 | 28.40 | 39.90 | 7.50 | 76.44 |
| Max. | 1.0000 | 35.41 | 27.19 | 44.59 | 7.82 | 77.99 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Not Married (proportion)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.10 Unemployed (proportion)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 141; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.8965 0.9468 71 no ID
sigma^2.2 0.1617 0.4022 141 no ID/arm
Test for Residual Heterogeneity:
QE(df = 139) = 1589.5370, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.3419, p-val = 0.5588
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.7961 0.2837 -2.8058 0.0050 -1.3522 -0.2400 **
get(varname) 0.2873 0.4914 0.5847 0.5588 -0.6758 1.2504
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8472cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 80.2cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 14.5header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0000 | 31.09 | 20.55 | 44.03 | 5.28 | 78.51 |
| 1st Qu. | 0.4100 | 33.66 | 28.05 | 39.79 | 6.23 | 79.50 |
| Median | 0.5300 | 34.44 | 29.20 | 40.08 | 6.45 | 80.01 |
| Mean | 0.5476 | 34.55 | 29.28 | 40.24 | 6.48 | 80.09 |
| 3rd Qu. | 0.7388 | 35.81 | 28.81 | 43.46 | 6.75 | 81.12 |
| Max. | 0.9630 | 37.30 | 26.70 | 49.27 | 6.95 | 82.57 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Unemployed (proportion)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.11 Not Unemployed (proportion)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 128; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7073 0.8410 61 no ID
sigma^2.2 0.1785 0.4224 128 no ID/arm
Test for Residual Heterogeneity:
QE(df = 126) = 1242.2804, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 1.1010, p-val = 0.2940
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.4076 0.2689 -1.5160 0.1295 -0.9347 0.1194
get(varname) -0.5058 0.4820 -1.0493 0.2940 -1.4506 0.4390
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.7985cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 74.8cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 18.9header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0370 | 39.50 | 28.45 | 51.74 | 8.81 | 81.51 |
| 1st Qu. | 0.2770 | 36.64 | 29.67 | 44.22 | 8.17 | 78.98 |
| Median | 0.5000 | 34.06 | 28.98 | 39.54 | 7.45 | 76.84 |
| Mean | 0.4700 | 34.40 | 29.26 | 39.94 | 7.55 | 77.11 |
| 3rd Qu. | 0.6555 | 32.32 | 26.55 | 38.68 | 6.88 | 75.52 |
| Max. | 1.0000 | 28.63 | 19.12 | 40.51 | 5.56 | 73.22 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Not Unemployed (proportion)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.12 Experience (years)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 36; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 1.0802 1.0393 21 no ID
sigma^2.2 0.0513 0.2265 36 no ID/arm
Test for Residual Heterogeneity:
QE(df = 34) = 329.8837, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 2.6664, p-val = 0.1025
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -1.2013 0.4271 -2.8129 0.0049 -2.0383 -0.3643 **
get(varname) 0.0833 0.0510 1.6329 0.1025 -0.0167 0.1833
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.9547cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 90.3cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 4.3header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.0000 | 23.12 | 11.52 | 40.99 | 3.08 | 73.99 |
| 1st Qu. | 3.3000 | 28.37 | 17.91 | 41.82 | 4.33 | 77.59 |
| Median | 6.9500 | 34.93 | 24.98 | 46.38 | 5.95 | 82.00 |
| Mean | 6.7611 | 34.57 | 24.69 | 45.99 | 5.86 | 81.77 |
| 3rd Qu. | 9.9250 | 40.75 | 28.08 | 54.78 | 7.35 | 85.64 |
| Max. | 14.0000 | 49.13 | 29.06 | 69.47 | 9.20 | 90.20 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Experience (years)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.13 Publication Year
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 299; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7919 0.8899 151 no ID
sigma^2.2 0.1288 0.3589 299 no ID/arm
Test for Residual Heterogeneity:
QE(df = 297) = 3266.5313, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.0134, p-val = 0.9080
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -3.3093 21.4704 -0.1541 0.8775 -45.3905 38.7718
get(varname) 0.0012 0.0107 0.1156 0.9080 -0.0198 0.0222
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8601cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 80.6cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 13.1header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 1980.000 | 29.79 | 19.97 | 41.91 | 5.67 | 74.96 |
| 1st Qu. | 2000.500 | 30.32 | 26.76 | 34.13 | 6.18 | 74.20 |
| Median | 2006.000 | 30.46 | 27.15 | 33.99 | 6.22 | 74.31 |
| Mean | 2004.217 | 30.42 | 27.20 | 33.83 | 6.21 | 74.26 |
| 3rd Qu. | 2009.000 | 30.54 | 26.73 | 34.64 | 6.23 | 74.43 |
| Max. | 2016.000 | 30.73 | 24.85 | 37.31 | 6.20 | 74.85 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Publication Year’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.14 Sessions (n)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 276; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7026 0.8382 138 no ID
sigma^2.2 0.1194 0.3456 276 no ID/arm
Test for Residual Heterogeneity:
QE(df = 274) = 2824.7969, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 9.9709, p-val = 0.0016
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -1.0991 0.1139 -9.6532 <.0001 -1.3222 -0.8759 ***
get(varname) 0.0188 0.0060 3.1577 0.0016 0.0071 0.0305 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8547cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 79.5cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 13.5header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 1.0000 | 25.35 | 21.50 | 29.62 | 5.36 | 67.03 |
| 1st Qu. | 7.0000 | 27.54 | 24.21 | 31.15 | 5.99 | 69.39 |
| Median | 12.0000 | 29.46 | 26.31 | 32.82 | 6.56 | 71.32 |
| Mean | 15.4881 | 30.85 | 27.60 | 34.29 | 6.97 | 72.64 |
| 3rd Qu. | 14.0000 | 30.25 | 27.07 | 33.63 | 6.79 | 72.08 |
| Max. | 75.0000 | 57.78 | 39.65 | 74.03 | 16.68 | 90.35 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Sessions (n)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.15 Session Length (min)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 145; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7335 0.8564 79 no ID
sigma^2.2 0.0428 0.2068 145 no ID/arm
Test for Residual Heterogeneity:
QE(df = 143) = 1583.3283, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 6.2834, p-val = 0.0122
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -1.2494 0.1635 -7.6423 <.0001 -1.5698 -0.9290 ***
get(varname) 0.0050 0.0020 2.5067 0.0122 0.0011 0.0090 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.9449cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 87.7cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 5.1header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 7.5000 | 22.94 | 18.10 | 28.63 | 4.91 | 63.20 |
| 1st Qu. | 45.0000 | 26.46 | 22.49 | 30.86 | 5.94 | 67.22 |
| Median | 60.0000 | 27.96 | 24.04 | 32.25 | 6.38 | 68.83 |
| Mean | 61.6578 | 28.13 | 24.20 | 32.43 | 6.43 | 69.01 |
| 3rd Qu. | 90.0000 | 31.11 | 26.39 | 36.25 | 7.33 | 72.05 |
| Max. | 240.0000 | 49.06 | 31.71 | 66.63 | 12.87 | 86.26 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Session Length (min)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
4.2.16 Duration (weeks)
cont.table.out <- cont.table(cont.out, outname)
print(cont.out$model)
Multivariate Meta-Analysis Model (k = 275; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7245 0.8511 138 no ID
sigma^2.2 0.1249 0.3535 275 no ID/arm
Test for Residual Heterogeneity:
QE(df = 273) = 2863.5481, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.1901, p-val = 0.6628
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.8212 0.1067 -7.6956 <.0001 -1.0304 -0.6121 ***
get(varname) 0.0020 0.0045 0.4360 0.6628 -0.0068 0.0107
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 cat(paste("\nICC:", fmt4(cont.out$ICC)))
ICC: 0.8529cat(paste("\nI^2.1", fmt1(cont.out$I2[1])))
I^2.1 79.6cat(paste("\nI^2.2", fmt1(cont.out$I2[2])))
I^2.2 13.7header <- 7
names(header) <- outname
kable(cont.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 1.0000 | 30.59 | 26.45 | 35.07 | 6.68 | 73.08 |
| 1st Qu. | 8.0000 | 30.88 | 27.35 | 34.66 | 6.79 | 73.28 |
| Median | 12.0000 | 31.05 | 27.71 | 34.60 | 6.84 | 73.41 |
| Mean | 16.1436 | 31.22 | 27.94 | 34.71 | 6.90 | 73.57 |
| 3rd Qu. | 14.0000 | 31.13 | 27.84 | 34.63 | 6.87 | 73.49 |
| Max. | 156.0000 | 37.37 | 14.68 | 67.43 | 6.24 | 84.25 |
if(plots) plo.reg(cont.out, v, outname)
Figure: Meta-regression for ‘Duration (weeks)’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval (PI). Points are proportional to the inverse variance of the individual dropout rates.
5 Study-arm level moderators: Substances
Data were also extracted on study-arm level moderators. This included characterizing the participants’ target substance use, off-target substance use, and comorbid diagnoses. In this section, we desscribe the substances.
Simultaneous moderation of substances is not possible with these data because of independence issues, namely that the same study arm could have reported more than one substance and would therefore be counted twice. We chose to test each substance separately, excluding arms with more than one substance in the same class (e.g., multiple different opiates). Continuous and categorical moderators were fit as described above.
out<-NULL #placeholder object for knitr output
sx.table <- NULL #placeholder object for substance tables
sub.deg.table <- NULL #placeholder object for substance degree of use tables
for(sx in sort(unique(subclean.df$Substance))){ #for each substance
substance.df <- subclean.df[which(subclean.df$Substance == sx),] #extract only ones with substance sx
##exclude arms with multiple substances per arm
exclude <- NULL #new object to get exclusion id/arm pairs; column 1 is substance, 2 is arm
for(s in unique(substance.df$ID)){ #for each study
tmp <- substance.df[which(substance.df$ID == s),] #get one study at a time
for(a in unique(tmp$Arm)){ #for each arm within study
tmp2 <- tmp[which(tmp$Arm == a),] #get a single arm in the study
if(nrow(tmp2) != 1) { #if that arm has more than one instance of a substance
exclude <- rbind(exclude, c(s,a)) #add to exclusion list
}
}
}
if(!is.null(nrow(exclude))){ #if there is an exclusion list
for(e in 1:nrow(exclude)){
substance.df <- substance.df[-which(substance.df$ID == exclude[e,1] & substance.df$Arm == exclude[e,2]),] #remove all excluded study arms
message(paste("Arm", exclude[e,2], "of ID", exclude[e,1], "removed for multiple subtances within the class of Substance", sx))
}
for(id in unique(exclude[,1])){ #re-loop through to check for now-invalid pooled dropout rates
dropout.rep <- substance.df$Dropout_Rep[which(substance.df$ID == id)] == 0 #look for pooled rates
if(length(dropout.rep)>0) #if the id is stil in the set
if(dropout.rep == TRUE) #and if the dropout rate is pooled
substance.df <- substance.df[-which(substance.df$ID == id),] #remove the id
if(long) message(paste("ID", id, "removed because of removing arms for multiple substances within the class of Substance",sx))
}
}
out <- c(out, knit_child('substances.Rmd', quiet=TRUE))
}Arm 1 of ID 58 removed for multiple subtances within the class of Substance 4ID 58 removed because of removing arms for multiple substances within the class of Substance 4Arm 1 of ID 92 removed for multiple subtances within the class of Substance 10Arm 2 of ID 92 removed for multiple subtances within the class of Substance 10ID 92 removed because of removing arms for multiple substances within the class of Substance 10substance <- Substance_dic[match(sx,Substance_dic),2] #get readable version of varname
if(is.na(substance)) {
substance <- substance <- paste0("**Substance ",sx,"**") #if it does not exist, revert to variable name
} else {
substance <- paste0("**",substance,"**")
}
pandoc.header(substance, level = 2)5.1 Alcohol
if(sx==1){ #alcohol
pandoc.header("Drinks per Day", level=3)
#run separate model for alcohol drinks per day, which is unique to alcohol
alcohol.df <- subclean.df[!is.na(subclean.df$Alcohol_drinks_per_day),]
alcohol.out <- plo.rma.mv(alcohol.df, "Alcohol_drinks_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(alcohol.out, "Drinks per Day")) #add alcohol to table
}5.1.1 Drinks per Day
if(sx==2){
pandoc.header("Cigarettes per Day", level=3)
#run separate model for tobacco frequency per day, which is unique to tobacco
tobacco.df <- subclean.df[!is.na(subclean.df$Freq_tobacco_per_day),]
tobacco.out <- plo.rma.mv(tobacco.df, "Freq_tobacco_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(tobacco.out, "Cigarettes per Day")) #add tobacco to table
}
#print the substance to the output table
if(!(sx %in% c(1,2))) sx.table <- rbind(sx.table, t(c(substance,rep("",7))))if(sx == 1){
print(alcohol.out$model)
cat(paste("\nICC:", fmt4(alcohol.out$ICC)))
cat(paste("\nI^2.1", fmt1(alcohol.out$I2[1])))
cat(paste("\nI^2.2", fmt1(alcohol.out$I2[2])))
kable(alcohol.out$prediction) %>%
add_header_above(header = c("Alcohol: Drinks per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 22; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.3068 0.5539 9 no ID
sigma^2.2 0.0000 0.0000 22 no ID/arm
Test for Residual Heterogeneity:
QE(df = 20) = 99.8243, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 3.5743, p-val = 0.0587
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt 0.1768 0.4938 0.3581 0.7203 -0.7909 1.1445
get(varname) -0.0808 0.0428 -1.8906 0.0587 -0.1646 0.0030 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 1.0000
I^2.1 77.6
I^2.2 0.0| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 1.9500 | 50.48 | 30.96 | 69.85 | 20.72 | 79.90 |
| 1st Qu. | 8.8000 | 36.95 | 27.83 | 47.10 | 15.47 | 65.23 |
| Median | 10.4000 | 33.99 | 25.81 | 43.24 | 13.97 | 62.02 |
| Mean | 10.6568 | 33.52 | 25.42 | 42.73 | 13.72 | 61.53 |
| 3rd Qu. | 13.2500 | 29.02 | 20.65 | 39.12 | 11.20 | 57.00 |
| Max. | 20.1000 | 19.03 | 8.80 | 36.41 | 5.46 | 48.90 |
if(plots & sx == 1){
plo.reg(alcohol.out, "Alcohol_drinks_per_day", "Alcohol: Drinks per Day")
cat("<p>**Figure:** Meta-regression for 'Alcohol Drinks per Day'. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.</p>")
}
Figure: Meta-regression for ‘Alcohol Drinks per Day’. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
if(sx == 2){
print(tobacco.out$model)
cat(paste("\nICC:", fmt4(tobacco.out$ICC)))
cat(paste("\nI^2.1", fmt1(tobacco.out$I2[1])))
cat(paste("\nI^2.2", fmt1(tobacco.out$I2[2])))
kable(tobacco.out$prediction) %>%
add_header_above(header = c("Tobacco: Cigarettes per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}5.1.2 Frequency of Use (% days)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Freq_._of_days_used",
continuous = TRUE,
title = paste0(substance, ": Frequency of Use (% days)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.days",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Frequency of Use (% days)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Frequency of Use (% days)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Frequency of Use (% days)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 40; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.9039 0.9507 19 no ID
sigma^2.2 0.0863 0.2937 40 no ID/arm
Test for Residual Heterogeneity:
QE(df = 38) = 385.8780, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.4399, p-val = 0.5072
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.3926 0.4796 -0.8186 0.4130 -1.3326 0.5474
get(varname) -0.0059 0.0088 -0.6632 0.5072 -0.0232 0.0115
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.9129
I^2.1 86.4
I^2.2 8.2| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 6.7000 | 39.37 | 21.89 | 60.07 | 7.21 | 84.45 |
| 1st Qu. | 25.9000 | 36.72 | 24.35 | 51.11 | 7.03 | 81.65 |
| Median | 57.2258 | 32.56 | 22.90 | 43.97 | 6.08 | 78.27 |
| Mean | 49.6107 | 33.55 | 24.23 | 44.36 | 6.38 | 78.91 |
| 3rd Qu. | 70.8250 | 30.83 | 19.51 | 45.05 | 5.46 | 77.48 |
| Max. | 86.1000 | 28.96 | 15.35 | 47.81 | 4.70 | 77.10 |
Figure: meta-regression for Alcohol Frequency of Use (% days). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.1.3 Length of Use (years)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Length_use_years",
continuous = TRUE,
title = paste0(substance, ": Length of Use (years)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.years",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Length of Use (years)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Length of Use (years)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Length of Use (years)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 27; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.4687 0.6846 13 no ID
sigma^2.2 0.1134 0.3367 27 no ID/arm
Test for Residual Heterogeneity:
QE(df = 25) = 224.8565, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.0009, p-val = 0.9762
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.3480 0.5709 -0.6096 0.5421 -1.4670 0.7710
get(varname) -0.0011 0.0353 -0.0298 0.9762 -0.0703 0.0682
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.8052
I^2.1 74.4
I^2.2 18.0| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 3.9000 | 41.29 | 22.68 | 62.76 | 11.06 | 79.90 |
| 1st Qu. | 12.4400 | 41.07 | 30.70 | 52.30 | 12.75 | 76.88 |
| Median | 15.0000 | 41.00 | 31.41 | 51.33 | 12.83 | 76.65 |
| Mean | 15.3346 | 40.99 | 31.39 | 51.34 | 12.82 | 76.65 |
| 3rd Qu. | 20.3000 | 40.87 | 28.38 | 54.65 | 12.30 | 77.31 |
| Max. | 25.9000 | 40.73 | 22.47 | 61.96 | 10.89 | 79.43 |
Figure: meta-regression for Alcohol Length of Use (years). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.1.4 Use Pattern Degree
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Use_Pat_Deg",
continuous = FALSE,
title = paste0(substance, ": Degree of use pattern"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.deg",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sub.deg.table <- rbind(sub.deg.table, c(substance,sub.out,"","","","")) #report error in table
print(sub.out)
} else {
sub.deg.table <- rbind(sub.deg.table, cat.table(sub.out, substance))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 8
names(header) <- paste0(substance, ": Degree of use pattern")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}[1] "Model not fit - only one moderator value."substance <- Substance_dic[match(sx,Substance_dic),2] #get readable version of varname
if(is.na(substance)) {
substance <- substance <- paste0("**Substance ",sx,"**") #if it does not exist, revert to variable name
} else {
substance <- paste0("**",substance,"**")
}
pandoc.header(substance, level = 2)5.2 Tobacco
if(sx==1){ #alcohol
pandoc.header("Drinks per Day", level=3)
#run separate model for alcohol drinks per day, which is unique to alcohol
alcohol.df <- subclean.df[!is.na(subclean.df$Alcohol_drinks_per_day),]
alcohol.out <- plo.rma.mv(alcohol.df, "Alcohol_drinks_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(alcohol.out, "Drinks per Day")) #add alcohol to table
}
if(sx==2){
pandoc.header("Cigarettes per Day", level=3)
#run separate model for tobacco frequency per day, which is unique to tobacco
tobacco.df <- subclean.df[!is.na(subclean.df$Freq_tobacco_per_day),]
tobacco.out <- plo.rma.mv(tobacco.df, "Freq_tobacco_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(tobacco.out, "Cigarettes per Day")) #add tobacco to table
}5.2.1 Cigarettes per Day
#print the substance to the output table
if(!(sx %in% c(1,2))) sx.table <- rbind(sx.table, t(c(substance,rep("",7))))if(sx == 1){
print(alcohol.out$model)
cat(paste("\nICC:", fmt4(alcohol.out$ICC)))
cat(paste("\nI^2.1", fmt1(alcohol.out$I2[1])))
cat(paste("\nI^2.2", fmt1(alcohol.out$I2[2])))
kable(alcohol.out$prediction) %>%
add_header_above(header = c("Alcohol: Drinks per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}if(plots & sx == 1){
plo.reg(alcohol.out, "Alcohol_drinks_per_day", "Alcohol: Drinks per Day")
cat("<p>**Figure:** Meta-regression for 'Alcohol Drinks per Day'. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.</p>")
}if(sx == 2){
print(tobacco.out$model)
cat(paste("\nICC:", fmt4(tobacco.out$ICC)))
cat(paste("\nI^2.1", fmt1(tobacco.out$I2[1])))
cat(paste("\nI^2.2", fmt1(tobacco.out$I2[2])))
kable(tobacco.out$prediction) %>%
add_header_above(header = c("Tobacco: Cigarettes per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 106; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.5920 0.7694 54 no ID
sigma^2.2 0.0674 0.2596 106 no ID/arm
Test for Residual Heterogeneity:
QE(df = 104) = 1013.0115, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 3.8763, p-val = 0.0490
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.1870 0.4806 -0.3890 0.6972 -1.1289 0.7550
get(varname) -0.0420 0.0213 -1.9688 0.0490 -0.0837 -0.0002 *
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.8978
I^2.1 82.4
I^2.2 9.4| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 10.5000 | 34.81 | 23.96 | 47.49 | 9.08 | 74.06 |
| 1st Qu. | 18.8000 | 27.37 | 22.49 | 32.86 | 6.99 | 65.41 |
| Median | 21.6000 | 25.10 | 21.06 | 29.62 | 6.29 | 62.58 |
| Mean | 22.1428 | 24.67 | 20.69 | 29.14 | 6.16 | 62.05 |
| 3rd Qu. | 26.4750 | 21.45 | 16.86 | 26.89 | 5.13 | 57.96 |
| Max. | 31.4000 | 18.17 | 12.32 | 25.99 | 4.07 | 53.78 |
5.2.2 Frequency of Use (% days)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Freq_._of_days_used",
continuous = TRUE,
title = paste0(substance, ": Frequency of Use (% days)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.days",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Frequency of Use (% days)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Frequency of Use (% days)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Frequency of Use (% days)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}[1] "Model not fit - only one study fits the criteria."5.2.3 Length of Use (years)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Length_use_years",
continuous = TRUE,
title = paste0(substance, ": Length of Use (years)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.years",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Length of Use (years)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Length of Use (years)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Length of Use (years)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 85; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.4918 0.7013 45 no ID
sigma^2.2 0.0615 0.2480 85 no ID/arm
Test for Residual Heterogeneity:
QE(df = 83) = 830.0813, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.6796, p-val = 0.4097
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -1.4013 0.3625 -3.8654 0.0001 -2.1119 -0.6908 ***
get(varname) 0.0122 0.0148 0.8244 0.4097 -0.0168 0.0411
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.8888
I^2.1 81.3
I^2.2 10.2| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 4.9000 | 20.72 | 12.79 | 31.79 | 5.17 | 55.64 |
| 1st Qu. | 20.1000 | 23.93 | 19.73 | 28.70 | 6.69 | 57.98 |
| Median | 23.6800 | 24.73 | 20.71 | 29.24 | 6.98 | 58.97 |
| Mean | 23.0532 | 24.59 | 20.59 | 29.08 | 6.94 | 58.78 |
| 3rd Qu. | 26.5000 | 25.37 | 20.97 | 30.34 | 7.19 | 59.87 |
| Max. | 42.4000 | 29.21 | 18.47 | 42.91 | 7.86 | 66.62 |
Figure: meta-regression for Tobacco Length of Use (years). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.2.4 Use Pattern Degree
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Use_Pat_Deg",
continuous = FALSE,
title = paste0(substance, ": Degree of use pattern"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.deg",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sub.deg.table <- rbind(sub.deg.table, c(substance,sub.out,"","","","")) #report error in table
print(sub.out)
} else {
sub.deg.table <- rbind(sub.deg.table, cat.table(sub.out, substance))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 8
names(header) <- paste0(substance, ": Degree of use pattern")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 108; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.6114 0.7819 55 no ID
sigma^2.2 0.0679 0.2607 108 no ID/arm
Test for Residual Heterogeneity:
QE(df = 106) = 1037.2642, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.0206, p-val = 0.8858
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.9923 0.8269 -1.2001 0.2301 -2.6129 0.6283
factor(get(varname))3 -0.1200 0.8352 -0.1437 0.8858 -1.7569 1.5169
intrcpt
factor(get(varname))3
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.9000
I^2.1 82.8
I^2.2 9.2| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Moderate | 27.05 | 6.83 | 65.21 | 3.62 | 78.52 | 2 | 1 |
| Heavy | 24.75 | 20.70 | 29.28 | 6.04 | 62.70 | 106 | 54 |
Figure: subgroup meta-analysis for Tobacco Degree of Use Pattern. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Interval are not included.
substance <- Substance_dic[match(sx,Substance_dic),2] #get readable version of varname
if(is.na(substance)) {
substance <- substance <- paste0("**Substance ",sx,"**") #if it does not exist, revert to variable name
} else {
substance <- paste0("**",substance,"**")
}
pandoc.header(substance, level = 2)5.3 Cocaine
if(sx==1){ #alcohol
pandoc.header("Drinks per Day", level=3)
#run separate model for alcohol drinks per day, which is unique to alcohol
alcohol.df <- subclean.df[!is.na(subclean.df$Alcohol_drinks_per_day),]
alcohol.out <- plo.rma.mv(alcohol.df, "Alcohol_drinks_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(alcohol.out, "Drinks per Day")) #add alcohol to table
}
if(sx==2){
pandoc.header("Cigarettes per Day", level=3)
#run separate model for tobacco frequency per day, which is unique to tobacco
tobacco.df <- subclean.df[!is.na(subclean.df$Freq_tobacco_per_day),]
tobacco.out <- plo.rma.mv(tobacco.df, "Freq_tobacco_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(tobacco.out, "Cigarettes per Day")) #add tobacco to table
}
#print the substance to the output table
if(!(sx %in% c(1,2))) sx.table <- rbind(sx.table, t(c(substance,rep("",7))))if(sx == 1){
print(alcohol.out$model)
cat(paste("\nICC:", fmt4(alcohol.out$ICC)))
cat(paste("\nI^2.1", fmt1(alcohol.out$I2[1])))
cat(paste("\nI^2.2", fmt1(alcohol.out$I2[2])))
kable(alcohol.out$prediction) %>%
add_header_above(header = c("Alcohol: Drinks per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}if(plots & sx == 1){
plo.reg(alcohol.out, "Alcohol_drinks_per_day", "Alcohol: Drinks per Day")
cat("<p>**Figure:** Meta-regression for 'Alcohol Drinks per Day'. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.</p>")
}if(sx == 2){
print(tobacco.out$model)
cat(paste("\nICC:", fmt4(tobacco.out$ICC)))
cat(paste("\nI^2.1", fmt1(tobacco.out$I2[1])))
cat(paste("\nI^2.2", fmt1(tobacco.out$I2[2])))
kable(tobacco.out$prediction) %>%
add_header_above(header = c("Tobacco: Cigarettes per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}5.3.1 Frequency of Use (% days)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Freq_._of_days_used",
continuous = TRUE,
title = paste0(substance, ": Frequency of Use (% days)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.days",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Frequency of Use (% days)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Frequency of Use (% days)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Frequency of Use (% days)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 46; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.7516 0.8670 22 no ID
sigma^2.2 0.0472 0.2172 46 no ID/arm
Test for Residual Heterogeneity:
QE(df = 44) = 458.5177, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 3.1371, p-val = 0.0765
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -1.0186 0.4347 -2.3433 0.0191 -1.8705 -0.1666 *
get(varname) 0.0176 0.0100 1.7712 0.0765 -0.0019 0.0371 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.9409
I^2.1 87.0
I^2.2 5.5| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 3.2000 | 27.64 | 14.69 | 45.87 | 5.28 | 72.36 |
| 1st Qu. | 30.9000 | 38.37 | 29.13 | 48.54 | 9.33 | 79.03 |
| Median | 44.3603 | 44.12 | 34.64 | 54.05 | 11.58 | 82.64 |
| Mean | 41.7649 | 42.99 | 33.84 | 52.66 | 11.14 | 81.94 |
| 3rd Qu. | 55.0000 | 48.78 | 36.71 | 61.00 | 13.36 | 85.47 |
| Max. | 84.0000 | 61.37 | 37.83 | 80.57 | 17.73 | 92.13 |
Figure: meta-regression for Cocaine Frequency of Use (% days). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.3.2 Length of Use (years)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Length_use_years",
continuous = TRUE,
title = paste0(substance, ": Length of Use (years)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.years",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Length of Use (years)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Length of Use (years)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Length of Use (years)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 47; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.5403 0.7351 20 no ID
sigma^2.2 0.1305 0.3613 47 no ID/arm
Test for Residual Heterogeneity:
QE(df = 45) = 390.6141, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 1.2235, p-val = 0.2687
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt 0.2175 0.4214 0.5162 0.6057 -0.6083 1.0434
get(varname) -0.0456 0.0412 -1.1061 0.2687 -0.1263 0.0352
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.8054
I^2.1 72.6
I^2.2 17.5| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 3.6000 | 51.34 | 37.17 | 65.29 | 16.07 | 85.32 |
| 1st Qu. | 6.1450 | 48.44 | 37.77 | 59.26 | 15.11 | 83.22 |
| Median | 9.3800 | 44.78 | 36.12 | 53.76 | 13.53 | 80.78 |
| Mean | 9.4739 | 44.67 | 36.01 | 53.67 | 13.48 | 80.71 |
| 3rd Qu. | 11.7000 | 42.18 | 32.56 | 52.43 | 12.21 | 79.28 |
| Max. | 19.7000 | 33.63 | 16.80 | 55.99 | 7.38 | 76.33 |
Figure: meta-regression for Cocaine Length of Use (years). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.3.3 Use Pattern Degree
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Use_Pat_Deg",
continuous = FALSE,
title = paste0(substance, ": Degree of use pattern"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.deg",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sub.deg.table <- rbind(sub.deg.table, c(substance,sub.out,"","","","")) #report error in table
print(sub.out)
} else {
sub.deg.table <- rbind(sub.deg.table, cat.table(sub.out, substance))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 8
names(header) <- paste0(substance, ": Degree of use pattern")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 9; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.0000 0.0000 4 no ID
sigma^2.2 0.2645 0.5143 9 no ID/arm
Test for Residual Heterogeneity:
QE(df = 6) = 14.9585, p-val = 0.0206
Test of Moderators (coefficient(s) 2:3):
QM(df = 2) = 8.1184, p-val = 0.0173
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -1.2432 0.5920 -2.1001 0.0357 -2.4034 -0.0829
factor(get(varname))2 1.3142 0.6780 1.9385 0.0526 -0.0146 2.6430
factor(get(varname))3 1.9360 0.6835 2.8323 0.0046 0.5963 3.2757
intrcpt *
factor(get(varname))2 .
factor(get(varname))3 **
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.0000
I^2.1 0.0
I^2.2 59.7| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Light | 22.39 | 8.29 | 47.93 | 5.84 | 57.29 | 1 | 1 |
| Moderate | 51.77 | 35.97 | 67.23 | 24.47 | 78.06 | 4 | 3 |
| Heavy | 66.66 | 50.57 | 79.62 | 37.34 | 87.02 | 4 | 3 |
Figure: subgroup meta-analysis for Cocaine Degree of Use Pattern. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Interval are not included.
substance <- Substance_dic[match(sx,Substance_dic),2] #get readable version of varname
if(is.na(substance)) {
substance <- substance <- paste0("**Substance ",sx,"**") #if it does not exist, revert to variable name
} else {
substance <- paste0("**",substance,"**")
}
pandoc.header(substance, level = 2)5.4 Opioid
if(sx==1){ #alcohol
pandoc.header("Drinks per Day", level=3)
#run separate model for alcohol drinks per day, which is unique to alcohol
alcohol.df <- subclean.df[!is.na(subclean.df$Alcohol_drinks_per_day),]
alcohol.out <- plo.rma.mv(alcohol.df, "Alcohol_drinks_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(alcohol.out, "Drinks per Day")) #add alcohol to table
}
if(sx==2){
pandoc.header("Cigarettes per Day", level=3)
#run separate model for tobacco frequency per day, which is unique to tobacco
tobacco.df <- subclean.df[!is.na(subclean.df$Freq_tobacco_per_day),]
tobacco.out <- plo.rma.mv(tobacco.df, "Freq_tobacco_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(tobacco.out, "Cigarettes per Day")) #add tobacco to table
}
#print the substance to the output table
if(!(sx %in% c(1,2))) sx.table <- rbind(sx.table, t(c(substance,rep("",7))))if(sx == 1){
print(alcohol.out$model)
cat(paste("\nICC:", fmt4(alcohol.out$ICC)))
cat(paste("\nI^2.1", fmt1(alcohol.out$I2[1])))
cat(paste("\nI^2.2", fmt1(alcohol.out$I2[2])))
kable(alcohol.out$prediction) %>%
add_header_above(header = c("Alcohol: Drinks per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}if(plots & sx == 1){
plo.reg(alcohol.out, "Alcohol_drinks_per_day", "Alcohol: Drinks per Day")
cat("<p>**Figure:** Meta-regression for 'Alcohol Drinks per Day'. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.</p>")
}if(sx == 2){
print(tobacco.out$model)
cat(paste("\nICC:", fmt4(tobacco.out$ICC)))
cat(paste("\nI^2.1", fmt1(tobacco.out$I2[1])))
cat(paste("\nI^2.2", fmt1(tobacco.out$I2[2])))
kable(tobacco.out$prediction) %>%
add_header_above(header = c("Tobacco: Cigarettes per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}5.4.1 Frequency of Use (% days)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Freq_._of_days_used",
continuous = TRUE,
title = paste0(substance, ": Frequency of Use (% days)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.days",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Frequency of Use (% days)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Frequency of Use (% days)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Frequency of Use (% days)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 16; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.0000 0.0000 6 no ID
sigma^2.2 0.2157 0.4644 16 no ID/arm
Test for Residual Heterogeneity:
QE(df = 14) = 90.2903, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 1.0051, p-val = 0.3161
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.3383 0.2400 -1.4100 0.1586 -0.8086 0.1320
get(varname) 0.0039 0.0039 1.0025 0.3161 -0.0038 0.0117
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.0000
I^2.1 0.0
I^2.2 86.8| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 3.8000 | 41.99 | 31.67 | 53.05 | 20.80 | 66.60 |
| 1st Qu. | 30.7841 | 44.60 | 37.45 | 51.97 | 23.61 | 67.70 |
| Median | 65.7000 | 48.02 | 41.38 | 54.73 | 26.34 | 70.47 |
| Mean | 52.8153 | 46.75 | 40.68 | 52.93 | 25.48 | 69.28 |
| 3rd Qu. | 80.4250 | 49.47 | 41.29 | 57.68 | 27.10 | 72.06 |
| Max. | 88.7000 | 50.29 | 40.98 | 59.57 | 27.42 | 73.03 |
Figure: meta-regression for Opioid Frequency of Use (% days). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.4.2 Length of Use (years)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Length_use_years",
continuous = TRUE,
title = paste0(substance, ": Length of Use (years)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.years",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Length of Use (years)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Length of Use (years)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Length of Use (years)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 25; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.5568 0.7462 10 no ID
sigma^2.2 0.2339 0.4836 25 no ID/arm
Test for Residual Heterogeneity:
QE(df = 23) = 171.6504, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.5031, p-val = 0.4782
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.0971 0.4786 -0.2029 0.8392 -1.0352 0.8409
get(varname) -0.0420 0.0592 -0.7093 0.4782 -0.1581 0.0741
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.7042
I^2.1 66.3
I^2.2 27.8| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.9400 | 46.59 | 27.14 | 67.13 | 11.15 | 85.85 |
| 1st Qu. | 2.2000 | 45.28 | 28.24 | 63.49 | 11.07 | 84.62 |
| Median | 9.2000 | 38.14 | 25.03 | 53.24 | 8.86 | 79.64 |
| Mean | 8.1149 | 39.22 | 26.87 | 53.12 | 9.37 | 80.12 |
| 3rd Qu. | 12.8000 | 34.64 | 17.81 | 56.46 | 6.95 | 78.99 |
| Max. | 14.4000 | 33.14 | 14.79 | 58.59 | 6.09 | 79.12 |
Figure: meta-regression for Opioid Length of Use (years). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.4.3 Use Pattern Degree
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Use_Pat_Deg",
continuous = FALSE,
title = paste0(substance, ": Degree of use pattern"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.deg",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sub.deg.table <- rbind(sub.deg.table, c(substance,sub.out,"","","","")) #report error in table
print(sub.out)
} else {
sub.deg.table <- rbind(sub.deg.table, cat.table(sub.out, substance))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 8
names(header) <- paste0(substance, ": Degree of use pattern")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}[1] "Model not fit - No studies fit the criteria."substance <- Substance_dic[match(sx,Substance_dic),2] #get readable version of varname
if(is.na(substance)) {
substance <- substance <- paste0("**Substance ",sx,"**") #if it does not exist, revert to variable name
} else {
substance <- paste0("**",substance,"**")
}
pandoc.header(substance, level = 2)5.5 Methamphetamine
if(sx==1){ #alcohol
pandoc.header("Drinks per Day", level=3)
#run separate model for alcohol drinks per day, which is unique to alcohol
alcohol.df <- subclean.df[!is.na(subclean.df$Alcohol_drinks_per_day),]
alcohol.out <- plo.rma.mv(alcohol.df, "Alcohol_drinks_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(alcohol.out, "Drinks per Day")) #add alcohol to table
}
if(sx==2){
pandoc.header("Cigarettes per Day", level=3)
#run separate model for tobacco frequency per day, which is unique to tobacco
tobacco.df <- subclean.df[!is.na(subclean.df$Freq_tobacco_per_day),]
tobacco.out <- plo.rma.mv(tobacco.df, "Freq_tobacco_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(tobacco.out, "Cigarettes per Day")) #add tobacco to table
}
#print the substance to the output table
if(!(sx %in% c(1,2))) sx.table <- rbind(sx.table, t(c(substance,rep("",7))))if(sx == 1){
print(alcohol.out$model)
cat(paste("\nICC:", fmt4(alcohol.out$ICC)))
cat(paste("\nI^2.1", fmt1(alcohol.out$I2[1])))
cat(paste("\nI^2.2", fmt1(alcohol.out$I2[2])))
kable(alcohol.out$prediction) %>%
add_header_above(header = c("Alcohol: Drinks per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}if(plots & sx == 1){
plo.reg(alcohol.out, "Alcohol_drinks_per_day", "Alcohol: Drinks per Day")
cat("<p>**Figure:** Meta-regression for 'Alcohol Drinks per Day'. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.</p>")
}if(sx == 2){
print(tobacco.out$model)
cat(paste("\nICC:", fmt4(tobacco.out$ICC)))
cat(paste("\nI^2.1", fmt1(tobacco.out$I2[1])))
cat(paste("\nI^2.2", fmt1(tobacco.out$I2[2])))
kable(tobacco.out$prediction) %>%
add_header_above(header = c("Tobacco: Cigarettes per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}5.5.1 Frequency of Use (% days)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Freq_._of_days_used",
continuous = TRUE,
title = paste0(substance, ": Frequency of Use (% days)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.days",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Frequency of Use (% days)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Frequency of Use (% days)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Frequency of Use (% days)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}[1] "Model not fit - only one study fits the criteria."5.5.2 Length of Use (years)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Length_use_years",
continuous = TRUE,
title = paste0(substance, ": Length of Use (years)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.years",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Length of Use (years)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Length of Use (years)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Length of Use (years)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}[1] "Model not fit - only one study fits the criteria."5.5.3 Use Pattern Degree
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Use_Pat_Deg",
continuous = FALSE,
title = paste0(substance, ": Degree of use pattern"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.deg",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sub.deg.table <- rbind(sub.deg.table, c(substance,sub.out,"","","","")) #report error in table
print(sub.out)
} else {
sub.deg.table <- rbind(sub.deg.table, cat.table(sub.out, substance))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 8
names(header) <- paste0(substance, ": Degree of use pattern")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}[1] "Model not fit - No studies fit the criteria."substance <- Substance_dic[match(sx,Substance_dic),2] #get readable version of varname
if(is.na(substance)) {
substance <- substance <- paste0("**Substance ",sx,"**") #if it does not exist, revert to variable name
} else {
substance <- paste0("**",substance,"**")
}
pandoc.header(substance, level = 2)5.6 Depressants
if(sx==1){ #alcohol
pandoc.header("Drinks per Day", level=3)
#run separate model for alcohol drinks per day, which is unique to alcohol
alcohol.df <- subclean.df[!is.na(subclean.df$Alcohol_drinks_per_day),]
alcohol.out <- plo.rma.mv(alcohol.df, "Alcohol_drinks_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(alcohol.out, "Drinks per Day")) #add alcohol to table
}
if(sx==2){
pandoc.header("Cigarettes per Day", level=3)
#run separate model for tobacco frequency per day, which is unique to tobacco
tobacco.df <- subclean.df[!is.na(subclean.df$Freq_tobacco_per_day),]
tobacco.out <- plo.rma.mv(tobacco.df, "Freq_tobacco_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(tobacco.out, "Cigarettes per Day")) #add tobacco to table
}
#print the substance to the output table
if(!(sx %in% c(1,2))) sx.table <- rbind(sx.table, t(c(substance,rep("",7))))if(sx == 1){
print(alcohol.out$model)
cat(paste("\nICC:", fmt4(alcohol.out$ICC)))
cat(paste("\nI^2.1", fmt1(alcohol.out$I2[1])))
cat(paste("\nI^2.2", fmt1(alcohol.out$I2[2])))
kable(alcohol.out$prediction) %>%
add_header_above(header = c("Alcohol: Drinks per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}if(plots & sx == 1){
plo.reg(alcohol.out, "Alcohol_drinks_per_day", "Alcohol: Drinks per Day")
cat("<p>**Figure:** Meta-regression for 'Alcohol Drinks per Day'. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.</p>")
}if(sx == 2){
print(tobacco.out$model)
cat(paste("\nICC:", fmt4(tobacco.out$ICC)))
cat(paste("\nI^2.1", fmt1(tobacco.out$I2[1])))
cat(paste("\nI^2.2", fmt1(tobacco.out$I2[2])))
kable(tobacco.out$prediction) %>%
add_header_above(header = c("Tobacco: Cigarettes per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}5.6.1 Frequency of Use (% days)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Freq_._of_days_used",
continuous = TRUE,
title = paste0(substance, ": Frequency of Use (% days)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.days",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Frequency of Use (% days)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Frequency of Use (% days)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Frequency of Use (% days)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 5; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.1157 0.3401 3 no ID
sigma^2.2 0.0000 0.0000 5 no ID/arm
Test for Residual Heterogeneity:
QE(df = 3) = 5.9106, p-val = 0.1160
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.0054, p-val = 0.9417
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.2067 0.3007 -0.6872 0.4920 -0.7961 0.3828
get(varname) -0.0022 0.0301 -0.0732 0.9417 -0.0613 0.0569
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 1.0000
I^2.1 52.2
I^2.2 0.0| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.700 | 44.81 | 31.61 | 58.80 | 25.33 | 66.03 |
| 1st Qu. | 1.000 | 44.80 | 31.82 | 58.53 | 25.44 | 65.87 |
| Median | 1.325 | 44.78 | 32.04 | 58.25 | 25.56 | 65.70 |
| Mean | 4.485 | 44.61 | 33.57 | 56.20 | 26.31 | 64.49 |
| 3rd Qu. | 1.700 | 44.76 | 32.28 | 57.94 | 25.69 | 65.51 |
| Max. | 17.700 | 43.89 | 25.90 | 63.64 | 21.56 | 68.99 |
Figure: meta-regression for Depressants Frequency of Use (% days). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.6.2 Length of Use (years)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Length_use_years",
continuous = TRUE,
title = paste0(substance, ": Length of Use (years)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.years",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Length of Use (years)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Length of Use (years)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Length of Use (years)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}[1] "Model not fit - only one study fits the criteria."5.6.3 Use Pattern Degree
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Use_Pat_Deg",
continuous = FALSE,
title = paste0(substance, ": Degree of use pattern"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.deg",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sub.deg.table <- rbind(sub.deg.table, c(substance,sub.out,"","","","")) #report error in table
print(sub.out)
} else {
sub.deg.table <- rbind(sub.deg.table, cat.table(sub.out, substance))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 8
names(header) <- paste0(substance, ": Degree of use pattern")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}[1] "Model not fit - No studies fit the criteria."substance <- Substance_dic[match(sx,Substance_dic),2] #get readable version of varname
if(is.na(substance)) {
substance <- substance <- paste0("**Substance ",sx,"**") #if it does not exist, revert to variable name
} else {
substance <- paste0("**",substance,"**")
}
pandoc.header(substance, level = 2)5.7 Cannabis
if(sx==1){ #alcohol
pandoc.header("Drinks per Day", level=3)
#run separate model for alcohol drinks per day, which is unique to alcohol
alcohol.df <- subclean.df[!is.na(subclean.df$Alcohol_drinks_per_day),]
alcohol.out <- plo.rma.mv(alcohol.df, "Alcohol_drinks_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(alcohol.out, "Drinks per Day")) #add alcohol to table
}
if(sx==2){
pandoc.header("Cigarettes per Day", level=3)
#run separate model for tobacco frequency per day, which is unique to tobacco
tobacco.df <- subclean.df[!is.na(subclean.df$Freq_tobacco_per_day),]
tobacco.out <- plo.rma.mv(tobacco.df, "Freq_tobacco_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(tobacco.out, "Cigarettes per Day")) #add tobacco to table
}
#print the substance to the output table
if(!(sx %in% c(1,2))) sx.table <- rbind(sx.table, t(c(substance,rep("",7))))if(sx == 1){
print(alcohol.out$model)
cat(paste("\nICC:", fmt4(alcohol.out$ICC)))
cat(paste("\nI^2.1", fmt1(alcohol.out$I2[1])))
cat(paste("\nI^2.2", fmt1(alcohol.out$I2[2])))
kable(alcohol.out$prediction) %>%
add_header_above(header = c("Alcohol: Drinks per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}if(plots & sx == 1){
plo.reg(alcohol.out, "Alcohol_drinks_per_day", "Alcohol: Drinks per Day")
cat("<p>**Figure:** Meta-regression for 'Alcohol Drinks per Day'. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.</p>")
}if(sx == 2){
print(tobacco.out$model)
cat(paste("\nICC:", fmt4(tobacco.out$ICC)))
cat(paste("\nI^2.1", fmt1(tobacco.out$I2[1])))
cat(paste("\nI^2.2", fmt1(tobacco.out$I2[2])))
kable(tobacco.out$prediction) %>%
add_header_above(header = c("Tobacco: Cigarettes per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}5.7.1 Frequency of Use (% days)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Freq_._of_days_used",
continuous = TRUE,
title = paste0(substance, ": Frequency of Use (% days)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.days",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Frequency of Use (% days)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Frequency of Use (% days)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Frequency of Use (% days)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 16; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.0000 0.0000 8 no ID
sigma^2.2 0.2265 0.4760 16 no ID/arm
Test for Residual Heterogeneity:
QE(df = 14) = 54.0228, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.5885, p-val = 0.4430
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.6631 0.2231 -2.9725 0.0030 -1.1003 -0.2259 **
get(varname) 0.0033 0.0043 0.7671 0.4430 -0.0052 0.0119
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.0000
I^2.1 0.0
I^2.2 76.9| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 0.700 | 34.06 | 25.10 | 44.32 | 15.59 | 59.09 |
| 1st Qu. | 3.600 | 34.27 | 25.63 | 44.10 | 15.82 | 59.14 |
| Median | 39.500 | 37.02 | 30.75 | 43.76 | 18.16 | 60.89 |
| Mean | 36.417 | 36.78 | 30.51 | 43.54 | 18.00 | 60.65 |
| 3rd Qu. | 49.000 | 37.76 | 31.18 | 44.83 | 18.58 | 61.72 |
| Max. | 98.600 | 41.72 | 28.67 | 56.04 | 19.29 | 68.19 |
Figure: meta-regression for Cannabis Frequency of Use (% days). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.7.2 Length of Use (years)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Length_use_years",
continuous = TRUE,
title = paste0(substance, ": Length of Use (years)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.years",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sx.table <- rbind(sx.table, t(c("Length of Use (years)",sub.out,rep("",6)))) #report error in table
print(sub.out)
} else {
sx.table <- rbind(sx.table, cont.table(sub.out, "Length of Use (years)"))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 7
names(header) <- paste0(substance, ": Length of Use (years)")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 14; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.4329 0.6579 8 no ID
sigma^2.2 0.1423 0.3773 14 no ID/arm
Test for Residual Heterogeneity:
QE(df = 12) = 99.3975, p-val < .0001
Test of Moderators (coefficient(s) 2):
QM(df = 1) = 0.5645, p-val = 0.4524
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.9316 0.7309 -1.2746 0.2025 -2.3641 0.5009
get(varname) 0.0615 0.0819 0.7514 0.4524 -0.0990 0.2221
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.7526
I^2.1 69.9
I^2.2 23.0| Moderator | Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | |
|---|---|---|---|---|---|---|
| Min. | 4.0000 | 33.51 | 17.45 | 54.56 | 8.26 | 73.81 |
| 1st Qu. | 5.2946 | 35.30 | 21.08 | 52.72 | 9.49 | 73.95 |
| Median | 7.9600 | 39.13 | 27.44 | 52.22 | 11.71 | 75.70 |
| Mean | 8.0470 | 39.26 | 27.58 | 52.32 | 11.77 | 75.79 |
| 3rd Qu. | 10.1675 | 42.41 | 28.64 | 57.48 | 12.88 | 78.58 |
| Max. | 13.9000 | 48.10 | 24.62 | 72.45 | 13.10 | 85.06 |
Figure: meta-regression for Cannabis Length of Use (years). The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.
5.7.3 Use Pattern Degree
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Use_Pat_Deg",
continuous = FALSE,
title = paste0(substance, ": Degree of use pattern"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)
assign(paste0("sub.deg",sx,".out"), sub.out)
if(class(sub.out) == "character"){
sub.deg.table <- rbind(sub.deg.table, c(substance,sub.out,"","","","")) #report error in table
print(sub.out)
} else {
sub.deg.table <- rbind(sub.deg.table, cat.table(sub.out, substance))
print(sub.out$model)
cat(paste("\nICC:", fmt4(sub.out$ICC)))
cat(paste("\nI^2.1", fmt1(sub.out$I2[1])))
cat(paste("\nI^2.2", fmt1(sub.out$I2[2])))
header <- 8
names(header) <- paste0(substance, ": Degree of use pattern")
kable(sub.out$prediction) %>%
add_header_above(header = header, align = 'l')%>%
kable_styling(full_width = F)
}
Multivariate Meta-Analysis Model (k = 17; method: REML)
Variance Components:
estim sqrt nlvls fixed factor
sigma^2.1 0.0325 0.1804 8 no ID
sigma^2.2 0.2023 0.4498 17 no ID/arm
Test for Residual Heterogeneity:
QE(df = 14) = 49.2532, p-val < .0001
Test of Moderators (coefficient(s) 2:3):
QM(df = 2) = 1.1916, p-val = 0.5511
Model Results:
estimate se zval pval ci.lb ci.ub
intrcpt -0.7184 0.3000 -2.3946 0.0166 -1.3063 -0.1304
factor(get(varname))2 0.0037 0.4032 0.0091 0.9927 -0.7867 0.7940
factor(get(varname))3 0.3431 0.3840 0.8936 0.3715 -0.4095 1.0958
intrcpt *
factor(get(varname))2
factor(get(varname))3
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
ICC: 0.1385
I^2.1 9.9
I^2.2 61.4| Dropout | Lower 95% CI | Upper 95% CI | Lower 95% PI | Upper 95% PI | Arms | Studies | |
|---|---|---|---|---|---|---|---|
| Light | 32.78 | 21.31 | 46.74 | 13.76 | 59.84 | 5 | 2 |
| Moderate | 32.86 | 22.39 | 45.35 | 14.17 | 59.20 | 6 | 3 |
| Heavy | 40.73 | 30.05 | 52.36 | 19.23 | 66.47 | 6 | 3 |
Figure: subgroup meta-analysis for Cannabis Degree of Use Pattern. The dashed line represents the mean dropout rate across all dropout rates included in this particular analysis. Because the inclusion of studies and study arms is dependent on the reporting of the moderator, the overall dropout rate in this analysis may be different than in other analyses. Red polygons represent the mean and 95% CI for the average dropout. Note that 95% Prediction Interval are not included.
substance <- Substance_dic[match(sx,Substance_dic),2] #get readable version of varname
if(is.na(substance)) {
substance <- substance <- paste0("**Substance ",sx,"**") #if it does not exist, revert to variable name
} else {
substance <- paste0("**",substance,"**")
}
pandoc.header(substance, level = 2)5.8 Polysubstance
if(sx==1){ #alcohol
pandoc.header("Drinks per Day", level=3)
#run separate model for alcohol drinks per day, which is unique to alcohol
alcohol.df <- subclean.df[!is.na(subclean.df$Alcohol_drinks_per_day),]
alcohol.out <- plo.rma.mv(alcohol.df, "Alcohol_drinks_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(alcohol.out, "Drinks per Day")) #add alcohol to table
}
if(sx==2){
pandoc.header("Cigarettes per Day", level=3)
#run separate model for tobacco frequency per day, which is unique to tobacco
tobacco.df <- subclean.df[!is.na(subclean.df$Freq_tobacco_per_day),]
tobacco.out <- plo.rma.mv(tobacco.df, "Freq_tobacco_per_day",
continuous = TRUE,
profile = profile,
long = long)
sx.table <- rbind(sx.table, t(c(substance,rep("",7)))) #print substance to table
sx.table <- rbind(sx.table, cont.table(tobacco.out, "Cigarettes per Day")) #add tobacco to table
}
#print the substance to the output table
if(!(sx %in% c(1,2))) sx.table <- rbind(sx.table, t(c(substance,rep("",7))))if(sx == 1){
print(alcohol.out$model)
cat(paste("\nICC:", fmt4(alcohol.out$ICC)))
cat(paste("\nI^2.1", fmt1(alcohol.out$I2[1])))
cat(paste("\nI^2.2", fmt1(alcohol.out$I2[2])))
kable(alcohol.out$prediction) %>%
add_header_above(header = c("Alcohol: Drinks per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}if(plots & sx == 1){
plo.reg(alcohol.out, "Alcohol_drinks_per_day", "Alcohol: Drinks per Day")
cat("<p>**Figure:** Meta-regression for 'Alcohol Drinks per Day'. The solid line represents the predicted dropout rate at the given predictor value; dashed lines represent the 95% CI; dotted lines represent the 95% Prediction Interval. Points are proportional to the inverse variance of the individual dropout rates.</p>")
}if(sx == 2){
print(tobacco.out$model)
cat(paste("\nICC:", fmt4(tobacco.out$ICC)))
cat(paste("\nI^2.1", fmt1(tobacco.out$I2[1])))
cat(paste("\nI^2.2", fmt1(tobacco.out$I2[2])))
kable(tobacco.out$prediction) %>%
add_header_above(header = c("Tobacco: Cigarettes per Day" = 7), align = 'l')%>%
kable_styling(full_width = F)
}5.8.1 Frequency of Use (% days)
sub.out <- suppressMessages(
tryCatch(plo.rma.mv(df = substance.df,
varname = "Freq_._of_days_used",
continuous = TRUE,
title = paste0(substance, ": Frequency of Use (% days)"),
profile = profile,
long = long),
warning = function(w) return(w$message),
error = function(e) e)
)