knitr::opts_chunk$set(echo = TRUE)
library(tidyverse)
library(knitr)
library(lavaan)
library(psych)
library(MBESS)
library(xtable)
library(semPlot)
require(car)
library(dplyr)
library(lattice)
library(lavaanPlot)

Clean Up Data

Here we test the moderating effect of gender on the the relationship between PTS and EXT.

pts_vex <- read.csv("/media/barbozag/easystore/Research/
  Mediation-Moderation Models/Data/test7.csv")


analysis_vars <- c("tra1", "bcext1",  "GENDER",  "EV_W1")
pts_vex <- pts_vex[analysis_vars]
pts_vex <- pts_vex[complete.cases(pts_vex),]

names(pts_vex)[1]<-"M"
names(pts_vex)[2]<-"Y"
names(pts_vex)[3]<-"W"
names(pts_vex)[4]<-"X"

pts_vex  %>%
  headTail() %>%
  kable()


M Y W X 1 34 63 0 0 2 42 58 0 0 3 54 48 0 0 4 45 54 0 0 … … … … … 2061 56 82 1 3 2062 51 86 1 2 2063 53 75 1 6 2064 43 82 1 0

pts_vex$W[pts_vex$W==1] <- -0.5
pts_vex$W[pts_vex$W==0] <- 0.5

Including Plots

You can also embed plots, for example:

pts_vex <- pts_vex %>% mutate(X_c = X - mean(X),
                            M_c = M - mean(M))

pts_vex %>%
  dplyr::select(X, M, Y, X_c, M_c) %>%
  pairs.panels()

img1

pts_vex <- pts_vex %>%
  mutate(X_W = X_c * W,
         M_W = M_c * W)

pts_vex %>%
  headTail() %>%
  kable()

M   Y   W   X   X_c M_c X_W M_W

1 34 63 0.5 0 -1.07 -16.33 -0.54 -8.16 2 42 58 0.5 0 -1.07 -8.33 -0.54 -4.16 3 54 48 0.5 0 -1.07 3.67 -0.54 1.84 4 45 54 0.5 0 -1.07 -5.33 -0.54 -2.66 … … … … … … … … … 1862 56 82 -0.5 3 1.93 5.67 -0.96 -2.84 1863 51 86 -0.5 2 0.93 0.67 -0.46 -0.34 1864 53 75 -0.5 6 4.93 2.67 -2.46 -1.34 1865 43 82 -0.5 0 -1.07 -7.33 0.54 3.66

mod7 <- "# a path
         M_c ~ 1 + a1 * X_c
         M_c ~ a2 * W
         M_c ~ a3 * X_W

         # b paths
         Y ~ b1 * M_c

         # c prime path
         Y ~ 1 + cp * X_c

         # index of moderated mediation and conditional indirect effects
         b1a3 := b1 * a3
         normss := a1 + a3 * -0.5
         fitss := a1 + a3 * 0.5
         norm := a1 * b1 + b1a3 * -0.5
         fit := a1 * b1 + b1a3 * 0.5"

set.seed(1234)

sem.fit1 <- sem(mod7, data = pts_vex, se = "bootstrap", 
            bootstrap = 10000, likelihood = "wishart")
summary(sem.fit1, standardized = TRUE, fit.measures = TRUE)

Regressions: Estimate Std.Err z-value P(>|z|) Std.lv Std.all M_c ~
X_c (a1) 2.142 0.206 10.417 0.000 2.142 0.259 W (a2) -0.865 0.504 -1.716 0.086 -0.865 -0.039 X_W (a3) -0.020 0.411 -0.048 0.962 -0.020 -0.001 Y ~
M_c (b1) 0.131 0.027 4.834 0.000 0.131 0.117 X_c (cp) 0.811 0.215 3.780 0.000 0.811 0.087

Intercepts: Estimate Std.Err z-value P(>|z|) Std.lv Std.all .M_c 0.041 0.255 0.161 0.872 0.041 0.004 .Y 59.351 0.285 208.358 0.000 59.351 4.773

Variances: Estimate Std.Err z-value P(>|z|) Std.lv Std.all .M_c 115.122 3.962 29.053 0.000 115.122 0.933 .Y 150.508 4.154 36.230 0.000 150.508 0.973

Defined Parameters: Estimate Std.Err z-value P(>|z|) Std.lv Std.all b1a3 -0.003 0.055 -0.047 0.963 -0.003 -0.000 normss 2.152 0.329 6.546 0.000 2.152 0.259 fitss 2.132 0.247 8.631 0.000 2.132 0.258 norm 0.282 0.073 3.859 0.000 0.282 0.030 fit 0.280 0.066 4.218 0.000 0.280 0.030

parameterestimates(sem.fit1, boot.ci.type = "bca.simple", standardized = TRUE) %>%
  kable()
semPaths(sem.fit1, style="lisrel",
         whatLabels = "std", edge.label.cex = .8,
         label.prop=0.8, edge.label.color = "black", rotation = 2,
         equalizeManifests = FALSE,  node.width = 1.5,
         edge.width = 0.5, shapeMan = "rectangle",
         shapeInt = "triangle", sizeMan = 6, sizeInt = 2, sizeLat = 4,
         curve=1, unCol = "#070b8c")

img2

labels <- list(X_c = "VEX", W = "Gender", X_W = "VEX * Gender",
               M_c = "PTS", Y = "EXT")
lavaanPlot(model = sem.fit1, labels=labels, node_options = 
          list(shape = "box", fontname = "Helvetica"),
          edge_options = list(color = "grey"), coefs = T, sig = 1, stars = TRUE)

img3

estVals <- parameterEstimates(sem.fit1)


xtab2 <-
  estVals %>%
  filter(estVals$op=='~' | estVals$op==':=') %>%
  select(lhs, rhs, est, ci.lower, ci.upper) %>%
  mutate_if(is.numeric, round, 3)

print(xtab2, include.rownames = FALSE)

img4

xtable(xtab2, caption="Mediation Effect of Post-Traumatic Stress Symptoms")

\begin{table}[ht] \centering \begin{tabular}{rllrrr} \hline & lhs & rhs & est & ci.lower & ci.upper \ \hline 1 & M_c & X_c & 2.14 & 1.75 & 2.55 \ 2 & M_c & W & -0.86 & -1.85 & 0.13 \ 3 & M_c & X_W & -0.02 & -0.83 & 0.78 \ 4 & Y & M_c & 0.13 & 0.08 & 0.18 \ 5 & Y & X_c & 0.81 & 0.40 & 1.23 \ 6 & b1a3 & b1a3 & -0.00 & -0.11 & 0.11 \ 7 & normss & a1+a3-0.5 & 2.15 & 1.51 & 2.81 \ 8 & fitss & a1+a3*0.5 & 2.13 & 1.64 & 2.62 \ 9 & norm & a1b1+b1a3-0.5 & 0.28 & 0.15 & 0.44 \ 10 & fit & a1*b1+b1a3*0.5 & 0.28 & 0.16 & 0.42 \ \hline \end{tabular} \caption{Mediation Effect of Post-Traumatic Stress Symptoms} \end{table}

Avatar
Gia Elise Barboza-Salerno
Assistant Professor in the School of Criminal Justice and Public Administration

My research interests include applied spatial policy and analysis, child welfare and criminal justice system reform, victimization by bullying, domestic abuse.