#' Draw a double dissociation based on regression coefficients
#'
#' Draws a double dissociation based on regression coefficients.
#'
#' Assuming a double dissociation, the function computes two regressions:
#'
#' critUpper ~ predUpper + predLower
#'
#' critLower ~ predLower + predUpper
#'
#' If covariates are givem, the function is computed as:
#'
#' critUpper ~ covUpper + predUpper + predLower
#'
#' critLower ~ covLower + predLower + predUpper
#'
#' If covResidAsDep is false, this is done as a multiple regression. If it is
#' true, this is done for the residuals of the covUpper/covLower regressions
#' as dependent variable. It works also in combination with moderators.
#'
#' If a moderator is given, the regressions are computed as:
#'
#' critUpper ~ predUpper * moderator + predLower
#'
#' critLower ~ predLower * moderator + predUpper
#'
#' If modBothPaths = TRUE, the regressions are computed as:
#'
#' critUpper ~ predUpper * moderator + predLower * moderator
#'
#' critLower ~ predLower * moderator + predUpper * moderator
#'
#' All variables are scaled before computing the regressions to cope with
#' multicolinearity in the moderated case.
#'
#' @param data A data frame containing the numeric columns predUpper,
#' predLower, critUpper, critLower, and optionally covariates and a moderator.
#' @param predUpper String with the name of the predictor of the upper double dissociation path.
#' @param predLower String with the name of the predictor of the lower double dissociation path.
#' @param critUpper String with the name of the criterion of the upper double dissociation path.
#' @param critLower String with the name of the criterion of the lower double dissociation path.
#' @param covUpper Optional string vector with the names of the covariates for the criterion of the upper double dissociation path.
#' @param covLower Optional string vector with the names of the covariates for the criterion of the lower double dissociation path.
#' @param covResidAsDep If FALSE (the default), a multiple regression is computed. If TRUE, the residuals of the covariate regression are used as dependent variable.
#' @param plotCov Include covariates in the lower part of the plot. Default is TRUE, but can be switched off (e.g., if variable names are too long)
#' @param moderator String with the name of the Moderator of the upper and lower direct path from
#' predictor to criterion
#' @param moderatorSD Defines the standard deviations for which the slope
#' lines are plotted. Default is -1 and 1. For example, for experimetal group
#' / control group design use c(0,1).
#' @param modLabSeq Moderation label sequence (1 or 2). Cope with the lm() function,
#' which puts out the labels in 2 different orders pred:mod (which is 1), or mod:pred
#' (which is 2). Default is 1.
#' @param plotRange Plot range of the square plot of a (marginally) significant interaction (only works with default of 1 SD at the moment).
#' @param modBothPaths If TRUE, a moderator effect is computed for both paths. Default is FALSE.
#' @param robust Logical value if robust parameter estimation is used (robust::lmRob() and WRS2::pbcor()). Default is FALSE.
#' @param printReg Print the summary () of the regression coefficients. Default is FALSE.
#' @param title Title of plot
#'
#' @return Returns a plot with a (moderated) (robust) double dissociation.
#'
#' @author Axel Zinkernagel \email{zinkernagel@uni-landau.de}
#'
#' @examples
#' # See vignette
#'
#' @import graphics
#' @import stats
#'
#' @export
drawDD <- function(data, predUpper, predLower, critUpper, critLower,
covUpper = NULL, covLower = NULL,
covResidAsDep = FALSE, plotCov = TRUE,
moderator = NULL, moderatorSD = c(-1,1),
modLabSeq = 1, plotRange = 1, modBothPaths = FALSE,
robust = FALSE, printReg = FALSE, title = ""){
# Define constants ####
# Colors / Symbols for sig., marginal sig. and not sig. paths in the plot
colNotSig <- "black"
colMargSig <- "darkred"
colSig <- "red"
symNotSig <- ""
symMargSig <- "+"
symSig <- "*"
# Scaling input variables, scale() function
scale = TRUE
center = TRUE
# Variable to add some additional text into the plot (e.g., robust estimation, )
addText <- NULL
# Scale input data -> full standaradized regressions, no multicolinearity in moderated regression
data[[predUpper]] <- scale(data[[predUpper]], scale = scale, center = center)
data[[predLower]] <- scale(data[[predLower]], scale = scale, center = center)
data[[critUpper]] <- scale(data[[critUpper]], scale = scale, center = center)
data[[critLower]] <- scale(data[[critLower]], scale = scale, center = center)
if (!is.null(moderator)) {
data[[moderator]] <- scale(data[[moderator]], scale = scale, center = center)
}
if (!is.null(covUpper)) {
for (i in 1:length(covUpper)) {
data[[covUpper[i]]] <- scale(data[[covUpper[i]]], scale = scale, center = center)
}
}
if (!is.null(covLower)) {
for (i in 1:length(covLower)) {
data[[covLower[i]]] <- scale(data[[covLower[i]]], scale = scale, center = center)
}
}
# Rewrite rownames of input dataframe to handle missings (N observations
# deleted due to missingness) in the output of regression computations
rownames(data) <- 1:nrow(data)
# Recompute DVs as redsiduals, if requested (covResidAsDep = TRUE) ####
if (covResidAsDep == TRUE) {
# Generate formula call for residual regressions
# Upper regression
if (!is.null(covUpper)) {
functionCall <- paste0(paste0(critUpper," ~ ", paste0(covUpper, collapse = " + ")))
if (robust == TRUE) {
covResidUpper <- eval(parse(text = paste0("robust::lmRob(",functionCall,", data = data)")))
} else {
covResidUpper <- eval(parse(text = paste0("lm(",functionCall,", data = data)")))
}
if (printReg) {
print(summary(covResidUpper))
}
# Correct missing residual computations (= check for consecutive line numbers)
# and replace original DV with residuals
rowNumbReg <- as.numeric(attr(covResidUpper$residuals, "names"))
if (length(rowNumbReg) < nrow(data)) {
rowNumbFill <- axBoost::fillVec(rowNumbReg,covResidUpper$residuals)
data[critUpper] <- as.numeric(rowNumbFill[,2])
} else {
data[critUpper] <- covResidUpper$residuals
}
# prepare regression output for plotting (round, add col and sign info)
covResidUpper <- as.data.frame(t(summary(covResidUpper)$coefficients))
covResidUpper <- covResidUpper[c(1,4),] # delete Std. Error and t value
rownames(covResidUpper) <- c("beta","pval")
covResidUpper["beta",] <- round(covResidUpper["beta",], digits = 2)
covResidUpper["pval",] <- round(covResidUpper["pval",], digits = 4)
covResidUpper <- rbind(covResidUpper, col = colNotSig, sym = symNotSig)
covResidUpper["col",] <- replace(covResidUpper["col",], covResidUpper["pval",] < .1, colMargSig)
covResidUpper["col",] <- replace(covResidUpper["col",], covResidUpper["pval",] < .05, colSig)
covResidUpper["sym",] <- replace(covResidUpper["sym",], covResidUpper["pval",] < .1, symMargSig)
covResidUpper["sym",] <- replace(covResidUpper["sym",], covResidUpper["pval",] < .05, symSig)
covResidUpper["(Intercept)"] <- NULL
# Prepare cov upper output text
covUpperText <- "Cov upper (resid. as DV): "
for (i in 1:length(covUpper)) {
covUpperText <- paste0(covUpperText, covUpper[i], " (", covResidUpper["beta",covUpper[i]], covResidUpper["sym",covUpper[i]], ")") # color does not work with mtext
if (i < length(covUpper)) {
covUpperText <- paste0(covUpperText,", ")
}
}
}
# Lower regression
if (!is.null(covLower)) {
functionCall <- paste0(paste0(critLower," ~ ", paste0(covLower, collapse = " + ")))
if (robust == TRUE) {
covResidLower <- eval(parse(text = paste0("robust::lmRob(",functionCall,", data = data)")))
} else {
covResidLower <- eval(parse(text = paste0("lm(",functionCall,", data = data)")))
}
if (printReg) {
print(summary(covResidLower))
}
# Correct missing residual computations (= check for consecutive line numbers)
# and replace original DV with residuals
rowNumbReg <- as.numeric(attr(covResidLower$residuals, "names"))
if (length(rowNumbReg) < nrow(data)) {
rowNumbFill <- axBoost::fillVec(rowNumbReg,covResidLower$residuals)
data[critLower] <- as.numeric(rowNumbFill[,2])
} else {
data[critLower] <- covResidLower$residuals
}
# prepare regression output for plotting (round, add col and sign info)
covResidLower <- as.data.frame(t(summary(covResidLower)$coefficients))
covResidLower <- covResidLower[c(1,4),] # delete Std. Error and t value
rownames(covResidLower) <- c("beta","pval")
covResidLower["beta",] <- round(covResidLower["beta",], digits = 2)
covResidLower["pval",] <- round(covResidLower["pval",], digits = 4)
covResidLower <- rbind(covResidLower, col = colNotSig, sym = symNotSig)
covResidLower["col",] <- replace(covResidLower["col",], covResidLower["pval",] < .1, colMargSig)
covResidLower["col",] <- replace(covResidLower["col",], covResidLower["pval",] < .05, colSig)
covResidLower["sym",] <- replace(covResidLower["sym",], covResidLower["pval",] < .1, symMargSig)
covResidLower["sym",] <- replace(covResidLower["sym",], covResidLower["pval",] < .05, symSig)
covResidLower["(Intercept)"] <- NULL
# Prepare cov lower output text
covLowerText <- "Cov lower (resid. as DV): "
for (i in 1:length(covLower)) {
covLowerText <- paste0(covLowerText, covLower[i], " (", covResidLower["beta",covLower[i]], covResidLower["sym",covLower[i]], ")") # color does not work with mtext
if (i < length(covLower)) {
covLowerText <- paste0(covLowerText,", ")
}
}
}
}
# Generate formula call for regressions ####
formulaCallUpper <- paste0(critUpper, " ~ ")
formulaCallLower <- paste0(critLower, " ~ ")
# Include covariates, if not requested of residuals to be DV
if (!is.null(covUpper) & covResidAsDep == FALSE) {
formulaCallUpper <- paste0(formulaCallUpper, paste0(covUpper, collapse = " + ")," + ")
}
if (!is.null(covLower) & covResidAsDep == FALSE) {
formulaCallLower <- paste0(formulaCallLower, paste0(covLower, collapse = " + ")," + ")
}
# Include predictor
formulaCallUpper <- paste0(formulaCallUpper, predUpper)
formulaCallLower <- paste0(formulaCallLower, predLower)
# Include moderator, if available
if (!is.null(moderator)) {
formulaCallUpper <- paste0(formulaCallUpper, " * ", moderator)
formulaCallLower <- paste0(formulaCallLower, " * ", moderator)
}
# Include other predictor
formulaCallUpper <- paste0(formulaCallUpper, " + ", predLower)
formulaCallLower <- paste0(formulaCallLower, " + ", predUpper)
# Include moderator, if available and both paths should be moderated
if ((!is.null(moderator)) & (modBothPaths == TRUE)) {
formulaCallUpper <- paste0(formulaCallUpper, " * ", moderator)
formulaCallLower <- paste0(formulaCallLower, " * ", moderator)
}
# Compute the regressions and correlations ####
if (robust == TRUE) {
upper <- eval(parse(text = paste0("robust::lmRob(",formulaCallUpper,", data = data)")))
lower <- eval(parse(text = paste0("robust::lmRob(",formulaCallLower,", data = data)")))
predCor <- WRS2::pbcor(cbind(data[[predUpper]], data[[predLower]]))
critCor <- WRS2::pbcor(cbind(data[[critUpper]], data[[critLower]]))
} else {
upper <- eval(parse(text = paste0("lm(",formulaCallUpper,", data = data)")))
lower <- eval(parse(text = paste0("lm(",formulaCallLower,", data = data)")))
predCor <- cor.test(data[[predUpper]], data[[predLower]], use = "pairwise")
critCor <- cor.test(data[[critUpper]], data[[critLower]], use = "pairwise")
}
# Print regressions and correlations, if requested ####
if (printReg) {
print(summary(upper))
print(summary(lower))
print(predCor)
print(critCor)
}
# prepare regression output for plotting (round, add col and sign info)
upper <- as.data.frame(t(summary(upper)$coefficients))
lower <- as.data.frame(t(summary(lower)$coefficients))
upper <- upper[c(1,4),] # delete Std. Error and t value
lower <- lower[c(1,4),] # delete Std. Error and t value
rownames(upper) <- c("beta","pval")
rownames(lower) <- c("beta","pval")
upper["beta",] <- round(upper["beta",], digits = 2)
lower["beta",] <- round(lower["beta",], digits = 2)
upper["pval",] <- round(upper["pval",], digits = 4)
lower["pval",] <- round(lower["pval",], digits = 4)
upper <- rbind(upper, col = colNotSig, sym = symNotSig)
lower <- rbind(lower, col = colNotSig, sym = symNotSig)
upper["col",] <- replace(upper["col",], as.numeric(upper["pval",]) < .1, colMargSig)
upper["col",] <- replace(upper["col",], as.numeric(upper["pval",]) < .05, colSig)
upper["sym",] <- replace(upper["sym",], as.numeric(upper["pval",]) < .1, symMargSig)
upper["sym",] <- replace(upper["sym",], as.numeric(upper["pval",]) < .05, symSig)
lower["col",] <- replace(lower["col",], as.numeric(lower["pval",]) < .1, colMargSig)
lower["col",] <- replace(lower["col",], as.numeric(lower["pval",]) < .05, colSig)
lower["sym",] <- replace(lower["sym",], as.numeric(lower["pval",]) < .1, symMargSig)
lower["sym",] <- replace(lower["sym",], as.numeric(lower["pval",]) < .05, symSig)
upper["(Intercept)"] <- NULL
lower["(Intercept)"] <- NULL
# prepare correlation output for plotting (round, add col and sign info)
if (robust == TRUE) {
predCor <- data.frame(predCor = c(round(predCor$cor, digits = 2),predCor$p.value, colNotSig, symNotSig), stringsAsFactors = FALSE)
critCor <- data.frame(critCor = c(round(critCor$cor, digits = 2),critCor$p.value, colNotSig, symNotSig), stringsAsFactors = FALSE)
} else {
predCor <- data.frame(predCor = c(round(predCor$estimate, digits = 2),predCor$p.value, colNotSig, symNotSig), stringsAsFactors = FALSE)
critCor <- data.frame(critCor = c(round(critCor$estimate, digits = 2),critCor$p.value, colNotSig, symNotSig), stringsAsFactors = FALSE)
}
rownames(predCor) <- c("r","pval","col","sym")
rownames(critCor) <- c("r","pval","col","sym")
predCor["col",] <- replace(predCor["col",], predCor["pval",] < .1, colMargSig)
predCor["col",] <- replace(predCor["col",], predCor["pval",] < .05, colSig)
predCor["sym",] <- replace(predCor["sym",], predCor["pval",] < .1, symMargSig)
predCor["sym",] <- replace(predCor["sym",], predCor["pval",] < .05, symSig)
critCor["col",] <- replace(critCor["col",], critCor["pval",] < .1, colMargSig)
critCor["col",] <- replace(critCor["col",], critCor["pval",] < .05, colSig)
critCor["sym",] <- replace(critCor["sym",], critCor["pval",] < .1, symMargSig)
critCor["sym",] <- replace(critCor["sym",], critCor["pval",] < .05, symSig)
###
# Computing is done, now plotting
###
# Plot basic plot ####
plot(NULL, main = title, type = "n", xlim = c(-10,10), ylim = c(-7,7),
xaxt = 'n', yaxt = 'n', bty = 'n', pch = '', ylab = '', xlab = '')
rect(-10, 1, -5, 4, density = 0, border = "black")
rect(-10, -1, -5, -4, density = 0, border = "black")
rect(10, 1, 5, 4, density = 0, border = "black")
rect(10, -1, 5, -4, density = 0, border = "black")
# Add variable labels
text(5, 2.5, critUpper, col = "black", cex = .7, pos = 4) # AVoben
text(5, -2.5, critLower, col = "black", cex = .7, pos = 4) # AVunten
text(-10,2.5, predUpper, col = "black", cex = .7, pos = 4) # Pred1
text(-10,-2.5, predLower, col = "black", cex = .7, pos = 4) # Pred2
# Plot correlations (equal for all regression models)
text(-10.3, 0, paste0(predCor["r",],predCor["sym",]), col = predCor["col",], cex = 1, pos = 4)
text(8.3, 0, paste0(critCor["r",],critCor["sym",]), col = critCor["col",], cex = 1, pos = 4)
# Add correlation arcs
plotrix::draw.arc(-7.5, 0, 3, deg1 = 213, deg2 = 147, col = predCor["col",])
plotrix::draw.arc(7.5, 0, 3, deg1 = 33, deg2 = 0, col = critCor["col",])
plotrix::draw.arc(7.5, 0, 3, deg1 = 360, deg2 = 327, col = critCor["col",])
# Add regression paths and colored arrows
arrows(-5,2.5,5,2.5,col = upper["col",predUpper], angle = 10) # predUpper -> critUpper
text(2.5, 3.5, paste0(upper["beta",predUpper],upper["sym",predUpper]), col = upper["col",predUpper], cex = 1, pos = 4) # PredUpper -> CritUpper
arrows(-5,-2.5,5,2.5, col = upper["col",predLower], angle = 10) # preLower -> critUpper
text(2.5, 1, paste0(upper["beta",predLower],upper["sym",predLower]), col = upper["col",predLower], cex = 1, pos = 4) # PredLower -> CritUpper
arrows(-5,-2.5,5,-2.5, col = lower["col",predLower], angle = 10) # predLower -> critLower
text(2.5,-3.5, paste0(lower["beta",predLower],lower["sym",predLower]), col = lower["col",predLower], cex = 1, pos = 4) # PredLower -> CritLower
arrows(-5,2.5,5,-2.5, col = lower["col",predUpper], angle = 10) # predUpper -> critLower
text(2.5,-1, paste0(lower["beta",predUpper],lower["sym",predUpper]), col = lower["col",predUpper], cex = 1, pos = 4) # PredUper -> CritLower
# Add moderator paths, if available (single moderator) ####
if (!is.null(moderator)) {
# Add moderator boxes
rect(-2.5, 4, 2.5, 7, density = 0, border = "black")
rect(-2.5,-4, 2.5,-7, density = 0, border = "black")
# Add moderator label
text(-2.5, 5.5, moderator, col = "black", cex = .7, pos = 4) # upper moderator
text(-2.5,-5.5, moderator, col = "black", cex = .7, pos = 4) # lower moderator
# Add colored arrows
arrows(2.5,5.5,7.5,4,col = upper["col",moderator], angle = 10) # moderator -> critUpper
text(6, 5, paste0(upper["beta", moderator], upper["sym", moderator]), col = upper["col", moderator], cex = 1, pos = 4) # moderator -> critUpper
arrows(-2,4,-2,2.5,col = upper["col", paste0(predUpper,":",moderator)], angle = 10) # moderator -> pathUpper
text(-2, 3, paste0(upper["beta", paste0(predUpper,":",moderator)], upper["sym", paste0(predUpper,":",moderator)]),
col = upper["col", paste0(predUpper,":",moderator)], cex = 1, pos = 4) # moderator -> pathUpper
arrows(2.5,-5.5,7.5,-4,col = lower["col",moderator], angle = 10) # moderator -> critLower
text(6, -5.3, paste0(lower["beta", moderator], lower["sym", moderator]), col = lower["col", moderator], cex = 1, pos = 4) # moderator -> critLower
arrows(-2,-4,-2,-2.5,col = lower["col",paste0(predLower,":",moderator)], angle = 10) # moderator -> pathLower
text(-2, -3.3, paste0(lower["beta", paste0(predLower,":",moderator)], lower["sym", paste0(predLower,":",moderator)]),
col = lower["col", paste0(predLower,":",moderator)], cex = 1, pos = 4) # moderator -> pathLower
# Add interaction diagramm if interaction is at least marg sig.
if (as.numeric(upper["pval", paste0(predUpper,":",moderator)]) < .1) {
rect(-6, 7.2, -3, 4.2, density = 0, border = "black")
segments(-4.5, 4.2,-2, 3.25,lty = "dashed", col = "black")
upperCoef <- as.numeric(upper["beta",])
names(upperCoef) <- names(upper["beta",])
intPoints <- axBoost::modRegGraph(betas = upperCoef, pred = predUpper, mod = moderator, crit = critUpper,
modRangeL = moderatorSD[1], modRangeH = moderatorSD[2],
modLabSeq = modLabSeq, plotRange = plotRange, plot = FALSE)
# scale parameters into box; box is 3x3, see as -1SD, 1SD
segments(-6, as.numeric(5.7 + 1.5 * intPoints["pred_L_mod_H"]), -3, as.numeric(5.7 + 1.5 * intPoints["pred_H_mod_H"]), lty = "dashed", col = "blue") # high moderator (1SD)
segments(-6, as.numeric(5.7 + 1.5 * intPoints["pred_L_mod_L"]), -3, as.numeric(5.7 + 1.5 * intPoints["pred_H_mod_L"]), lty = "solid", col = "black") # low moderator (-1SD)
addText <- c(addText, paste0("Int.: Dashed blue ", moderatorSD[2], "SD, solid black ", moderatorSD[1], "SD"))
}
if (as.numeric(lower["pval", paste0(predLower,":",moderator)]) < .1) {
rect(-6, -7.2, -3, -4.2, density = 0, border = "black")
segments(-4.5,-4.2,-2,-3.25,lty = "dashed", col = "black")
lowerCoef <- as.numeric(lower["beta",])
names(lowerCoef) <- names(lower["beta",])
intPoints <- axBoost::modRegGraph(betas = lowerCoef, pred = predLower, mod = moderator, crit = critLower,
modRangeL = moderatorSD[1], modRangeH = moderatorSD[2], plot = FALSE)
# scale parameters into box; box is 3x3, see as -1SD, 1SD
segments(-6, as.numeric(-5.7 + 1.5 * intPoints["pred_L_mod_H"]), -3, as.numeric(-5.7 + 1.5 * intPoints["pred_H_mod_H"]), lty = "dashed", col = "blue") # high moderator (1SD)
segments(-6, as.numeric(-5.7 + 1.5 * intPoints["pred_L_mod_L"]), -3, as.numeric(-5.7 + 1.5 * intPoints["pred_H_mod_L"]), lty = "solid", col = "black") # low moderator (-1SD)
addText <- c(addText, paste0("Int.: Dashed blue ", moderatorSD[2], "SD, solid black ", moderatorSD[1], "SD"))
}
}
# Add moderator paths (double moderator) ####
if ((!is.null(moderator)) && modBothPaths == TRUE) {
arrows(-2.3,4,-2.3,-1.1,col = upper["col",paste0(moderator,":",predLower)], angle = 10) # moderator -> path2UpperfromLower
text(-5, -1, paste0(upper["beta",paste0(moderator,":",predLower)], upper["sym",paste0(moderator,":",predLower)]),
col = upper["col",paste0(moderator,":",predLower)], cex = 1, pos = 4) # moderator -> path2UpperfromLower
arrows(-2.1,-4,-2.2,1.1,col = lower["col",paste0(moderator,":",predUpper)], angle = 10) # moderator -> path2LowerfromUpper
text(-5, 1, paste0(lower["beta",paste0(moderator,":",predUpper)], lower["sym",paste0(moderator,":",predUpper)]),
col = lower["col",paste0(moderator,":",predUpper)], cex = 1, pos = 4) # moderator -> path2LowerfromUpper
if (as.numeric(upper["pval", paste0(moderator,":",predLower)]) < .1) {
rect(-9.2, 7.2, -6.2, 4.2, density = 0, border = "black")
segments(-7.7,4.2,-2.3,1.45,lty = "dashed", col = "black")
upperCoef <- as.numeric(upper["beta",])
names(upperCoef) <- names(upper["beta",])
intPoints <- axBoost::modRegGraph(betas = upperCoef, pred = predLower, mod = moderator, crit = critUpper,
modRangeL = moderatorSD[1], modRangeH = moderatorSD[2], modLabSeq = 2,
plot = FALSE)
# scale parameters into box; box is 3x3, see as -1SD, 1SD
segments(-9.2, as.numeric(5.7 + 1.5 * intPoints["pred_L_mod_H"]), -6.2, as.numeric(5.7 + 1.5 * intPoints["pred_H_mod_H"]), lty = "dashed", col = "blue") # high moderator (1SD)
segments(-9.2, as.numeric(5.7 + 1.5 * intPoints["pred_L_mod_L"]), -6.2, as.numeric(5.7 + 1.5 * intPoints["pred_H_mod_L"]), lty = "solid", col = "black") # low moderator (-1SD)
addText <- c(addText, paste0("Int.: Dashed blue ", moderatorSD[2], "SD, solid black ", moderatorSD[1], "SD"))
}
if (as.numeric(lower["pval", paste0(moderator,":",predUpper)]) < .1) {
rect(-9.2, -7.2, -6.2, -4.2, density = 0, border = "black")
segments(-7.7,-4.2,-2.2,-1.45,lty = "dashed", col = "black")
lowerCoef <- as.numeric(lower["beta",])
names(lowerCoef) <- names(lower["beta",])
intPoints <- axBoost::modRegGraph(betas = lowerCoef, pred = predUpper, mod = moderator, crit = critLower,
modRangeL = moderatorSD[1], modRangeH = moderatorSD[2], modLabSeq = 2,
plot = FALSE)
# scale parameters into box; box is 3x3, see as -1SD, 1SD
segments(-9.2, as.numeric(-5.7 + 1.5 * intPoints["pred_L_mod_H"]), -6.2, as.numeric(-5.7 + 1.5 * intPoints["pred_H_mod_H"]), lty = "dashed", col = "blue") # high moderator (1SD)
segments(-9.2, as.numeric(-5.7 + 1.5 * intPoints["pred_L_mod_L"]), -6.2, as.numeric(-5.7 + 1.5 * intPoints["pred_H_mod_L"]), lty = "solid", col = "black") # low moderator (-1SD)
addText <- c(addText, paste0("Int.: Dashed blue ", moderatorSD[2], "SD, solid black ", moderatorSD[1], "SD"))
}
}
# Compute covariates (if covResidAsDep == FALSE)
if (covResidAsDep == FALSE) {
if (!is.null(covUpper)) {
covUpperText <- "Cov upper (multiv. regr.): "
for (i in 1:length(covUpper)) {
covUpperText <- paste0(covUpperText, covUpper[i], " (", upper["beta",covUpper[i]], upper["sym",covUpper[i]], ")") # color does not work with mtext
if (i < length(covUpper)) {
covUpperText <- paste0(covUpperText,", ")
}
}
}
if (!is.null(covLower)) {
covLowerText <- "Cov lower (multiv. regr.): "
for (i in 1:length(covLower)) {
covLowerText <- paste0(covLowerText, covLower[i], " (", lower["beta",covLower[i]], upper["sym",covLower[i]], ")") # color does not work with mtext
if (i < length(covLower)) {
covLowerText <- paste0(covLowerText,", ")
}
}
}
}
# Add covariates, if plotCov == TRUE and if available ####
if (plotCov) {
# Upper regression
if (!is.null(covUpper)) {
mtext(covUpperText, side = 1, line = 0, adj = 0, cex = 1)
}
# Lower regression
if (!is.null(covLower)) {
mtext(covLowerText, side = 1, line = 1, adj = 0, cex = 1)
}
}
if (robust == TRUE) {
addText <- c(addText,"Robust regr. and cor.")
}
# Add sampel size
addText <- c(addText, paste0("N = ", nrow(data)))
if (length(addText) > 0) {
mtext(paste0("Note: ", paste0(unique(addText), collapse = "; ")), side = 1, line = 2, adj = 0, cex = 1)
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.