sink()
sink("./Output/DT_EFA_1.Summary.txt")
summary(efaDT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#Based on 3-factor model we note: TLI = .903, RMSA = 0.03, RMSEA = 0.051
#What happens if we try more/less factors?
efa4DT <- fa(DT,
nfactors = 4,
fm = 'pa',
rotate = 'promax')
sink("./Output/4DT_EFA_Output.txt")  #start capture
fa.sort(efa4DT)
sink()
sink("./Output/4DT_EFA_1.Summary.txt")
summary(efa4DT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#For the 4-factor model, we note: TLI = 0.914, RMSA = 0.02, RMSEA = 0.048
efa2DT <- fa(DT,
nfactors = 2,
fm = 'pa',
rotate = 'promax')
sink("./Output/2DT_EFA_Output.txt")  #start capture
fa.sort(efa2DT)
sink()
sink("./Output/2DT_EFA_1.Summary.txt")
summary(efa2DT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#For the 2-factor model, we note: TLI = 0.861, RMSA = 0.04, RMSEA = 0.062
#After exploring a few different options, the 3-factor model described may be
#ideal, as there is no significant increase in model suitability from the 3-factor
#to 4-factor model. The original study by Jones & Paulhus (2013) noted that analyses
#conducted to determine # of factors also was either 3/4 depending on the method
model <- '
#cfa block
f1 =~ M1 + M2 + M3 + M4 + M5 + M6 + M7 + M8 + M9
f2 =~ N1 + N2 + N3 + N4 + N5 + N6 + N7 + N8 + N9
f3 =~ P1 + P2 + P3 + P4 + P5 + P6 + P7 + P8 + P9
# regressions
f3 ~ f1 + f2
f2 ~ f1 + f3
f1 ~ f2 + f3
'
fit <- sem(model = model, data = DT, rotation = "promax",
# mimic Mplus
information = "observed",
rotation.args = list(rstarts = 30, row.weights = "none",
algorithm = "gpa", std.ov = TRUE,
geomin.epsilon = 0.0001))
summary(fit)
#But is this perhaps not telling the whole story? To look further at the suitability
#of the items in capturing the Dark Triad traits, we will look at responses for each
#of the three dimensions
## Classical Test Theory Item Analysis for Machiavellianism
# Item Analysis
mAlpha <- psych::alpha(mDT)
# Response proportions, three sig figs
print(round(mAlpha$response.freq,3) )
# Item and item-total stats, three sig figs
print(round(mAlpha$item.stats, 3) )
##IRT Analysis for Machiavellianism
# ltm function for GRM model
mGRM <- grm(mDT, IRT.param = TRUE)
# Option thresholds and discriminations for each item
coefficients(mGRM)
#ICCs for each item
plot(mGRM, type="ICC", item=1, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=2, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=3, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=4, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=5, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=6, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=7, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=8, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=9, xlab = "Trait: Machiavellianism")
# Item Info
plot(mGRM, type="IIC", lty=1:5, col="black")
# Test Info
plot(mGRM, type="IIC", items = 0, lty=1:5, col="black")
# Relate to person distribution
plot(factor.scores.grm(mGRM))
DT <- read.csv("data_fixed.csv")
if (!dir.exists('./Output')) {dir.create('./Output')}
DT <- psych::scrub( DT,
min = 1, max = 5)
# Missing responses
DT <- na.omit(DT)
# Long string
lsDT <- DT %>%
mutate(ls_count = longstring(DT))
boxplot (lsDT$ls_count)
DT <- lsDT %>%
filter(ls_count < mean(lsDT$ls_count)) %>%
filtering(ls_count > 1)
DT <- read.csv("data_fixed.csv")
if (!dir.exists('./Output')) {dir.create('./Output')}
DT <- psych::scrub( DT,
min = 1, max = 5)
# Missing responses
DT <- na.omit(DT)
# Long string
lsDT <- DT %>%
mutate(ls_count = longstring(DT))
boxplot (lsDT$ls_count)
DT <- lsDT %>%
filter(ls_count < mean(lsDT$ls_count)) %>%
filter(ls_count > 1)
#Based on the boxplot, we can see that there are a few exceptions that should be
#filtered out
#A couple items need to be reverse-coded, based on info from original study
#Machiavellianism
mDT <- subset(DT, select = c("M1", "M2", "M3", "M4","M5","M6", "M7", "M8", "M9"))
#Narcissism
nDT <- subset(DT, select = c("N1", "N2", "N3", "N4","N5","N6", "N7", "N8", "N9"))
rnDT <- psychTools::recode(nDT,
where = c("N2", "N6", "N8"),
isvalue = c(1,2,3,4,5),
newvalue = c(5,4,3,2,1) )
#Psychopathy
pDT <- subset(DT, select = c("P1", "P2", "P3", "P4","P5","P6", "P7", "P8", "P9"))
rpDT <- psychTools::recode(pDT,
where = c("P2", "P7"),
isvalue = c(1,2,3,4,5),
newvalue = c(5,4,3,2,1) )
describe(rpDT)
describe(rnDT)
View(DT)
describe(mDT)
knitr::opts_chunk$set(echo = TRUE)
#We activate the libraries we will be using for IRT and CTT here
#install.packages("psych")
#install.packages("GPArotation")
#install.packages("lavaan")
#install.packages("lavaanPlot")
#install.packages("tidyverse")
#install.packages("haven")
library(psych)
library(GPArotation)
library(lavaan)
library(lavaanPlot)
library(tidyverse)
library(haven)
library(dplyr)
library(careless)
library(psychTools)
library(dplyr)
library(ltm)
# Clears all output and data objects for a fresh start
rm(list=ls())
cat("\014")
# Sets it to not display numbers in scientific notation throughout session
options(scipen = 999)
# options(scipen = 0)  # Use this to return to default
DT <- read.csv("data_fixed.csv")
if (!dir.exists('./Output')) {dir.create('./Output')}
DT <- psych::scrub( DT,
min = 1, max = 5)
# Missing responses
DT <- na.omit(DT)
# Long string
lsDT <- DT %>%
mutate(ls_count = longstring(DT))
boxplot (lsDT$ls_count)
DT <- lsDT %>%
filter(ls_count < 9) %>%
filter(ls_count > 1)
#Based on the boxplot, we can see that there are a few exceptions that should be
#filtered out
#A couple items need to be reverse-coded, based on info from original study
#Machiavellianism
mDT <- subset(DT, select = c("M1", "M2", "M3", "M4","M5","M6", "M7", "M8", "M9"))
#Narcissism
nDT <- subset(DT, select = c("N1", "N2", "N3", "N4","N5","N6", "N7", "N8", "N9"))
rnDT <- psychTools::recode(nDT,
where = c("N2", "N6", "N8"),
isvalue = c(1,2,3,4,5),
newvalue = c(5,4,3,2,1) )
#Psychopathy
pDT <- subset(DT, select = c("P1", "P2", "P3", "P4","P5","P6", "P7", "P8", "P9"))
rpDT <- psychTools::recode(pDT,
where = c("P2", "P7"),
isvalue = c(1,2,3,4,5),
newvalue = c(5,4,3,2,1) )
describe(rpDT)
describe(rnDT)
describe(mDT)
DT <- read.csv("data_fixed.csv")
if (!dir.exists('./Output')) {dir.create('./Output')}
DT <- psych::scrub( DT,
min = 1, max = 5)
# Missing responses
DT <- na.omit(DT)
# Long string
lsDT <- DT %>%
mutate(ls_count = longstring(DT))
boxplot (lsDT$ls_count)
DT <- lsDT %>%
filter(ls_count < 9) %>%
filter(ls_count > 1)
DT <- DT[, 1:27]
#Based on the boxplot, we can see that there are a few exceptions that should be
#filtered out
#A couple items need to be reverse-coded, based on info from original study
#Machiavellianism
mDT <- subset(DT, select = c("M1", "M2", "M3", "M4","M5","M6", "M7", "M8", "M9"))
#Narcissism
nDT <- subset(DT, select = c("N1", "N2", "N3", "N4","N5","N6", "N7", "N8", "N9"))
rnDT <- psychTools::recode(nDT,
where = c("N2", "N6", "N8"),
isvalue = c(1,2,3,4,5),
newvalue = c(5,4,3,2,1) )
View(DT)
#Psychopathy
pDT <- subset(DT, select = c("P1", "P2", "P3", "P4","P5","P6", "P7", "P8", "P9"))
rpDT <- psychTools::recode(pDT,
where = c("P2", "P7"),
isvalue = c(1,2,3,4,5),
newvalue = c(5,4,3,2,1) )
describe(rpDT)
describe(rnDT)
describe(mDT)
knitr::opts_chunk$set(echo = TRUE)
#We activate the libraries we will be using for IRT and CTT here
#install.packages("psych")
#install.packages("GPArotation")
#install.packages("lavaan")
#install.packages("lavaanPlot")
#install.packages("tidyverse")
#install.packages("haven")
library(psych)
library(GPArotation)
library(lavaan)
library(lavaanPlot)
library(tidyverse)
library(haven)
library(dplyr)
library(careless)
library(psychTools)
library(dplyr)
library(ltm)
# Clears all output and data objects for a fresh start
rm(list=ls())
cat("\014")
# Sets it to not display numbers in scientific notation throughout session
options(scipen = 999)
# options(scipen = 0)  # Use this to return to default
DT <- read.csv("data_fixed.csv")
if (!dir.exists('./Output')) {dir.create('./Output')}
DT <- psych::scrub( DT,
min = 1, max = 5)
# Missing responses
DT <- na.omit(DT)
# Long string
lsDT <- DT %>%
mutate(ls_count = longstring(DT))
boxplot (lsDT$ls_count)
DT <- lsDT %>%
filter(ls_count < 9)
DT <- DT[, 1:27]
#Based on the boxplot, we can see that there are a few exceptions that should be
#filtered out
#A couple items need to be reverse-coded, based on info from original study
#Machiavellianism
mDT <- subset(DT, select = c("M1", "M2", "M3", "M4","M5","M6", "M7", "M8", "M9"))
#Narcissism
nDT <- subset(DT, select = c("N1", "N2", "N3", "N4","N5","N6", "N7", "N8", "N9"))
rnDT <- psychTools::recode(nDT,
where = c("N2", "N6", "N8"),
isvalue = c(1,2,3,4,5),
newvalue = c(5,4,3,2,1) )
View(DT)
#Psychopathy
pDT <- subset(DT, select = c("P1", "P2", "P3", "P4","P5","P6", "P7", "P8", "P9"))
rpDT <- psychTools::recode(pDT,
where = c("P2", "P7"),
isvalue = c(1,2,3,4,5),
newvalue = c(5,4,3,2,1) )
describe(rpDT)
describe(rnDT)
describe(mDT)
#First, we'll conduct an EFA on the dataset
efaDT <- fa(DT,
nfactors = 3,
fm = 'pa',
rotate = 'promax')
sink("./Output/DT_EFA_Output.txt")  #start capture
fa.sort(efaDT)
sink()
sink("./Output/DT_EFA_1.Summary.txt")
summary(efaDT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#Based on 3-factor model we note: TLI = .903, RMSA = 0.03, RMSEA = 0.051
#What happens if we try more/less factors?
efa4DT <- fa(DT,
nfactors = 4,
fm = 'pa',
rotate = 'promax')
sink("./Output/4DT_EFA_Output.txt")  #start capture
fa.sort(efa4DT)
sink()
sink("./Output/4DT_EFA_1.Summary.txt")
summary(efa4DT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#For the 4-factor model, we note: TLI = 0.914, RMSA = 0.02, RMSEA = 0.048
efa2DT <- fa(DT,
nfactors = 2,
fm = 'pa',
rotate = 'promax')
sink("./Output/2DT_EFA_Output.txt")  #start capture
fa.sort(efa2DT)
sink()
sink("./Output/2DT_EFA_1.Summary.txt")
summary(efa2DT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#For the 2-factor model, we note: TLI = 0.861, RMSA = 0.04, RMSEA = 0.062
#After exploring a few different options, the 3-factor model described may be
#ideal, as there is no significant increase in model suitability from the 3-factor
#to 4-factor model. The original study by Jones & Paulhus (2013) noted that analyses
#conducted to determine # of factors also was either 3/4 depending on the method
model <- '
#cfa block
f1 =~ M1 + M2 + M3 + M4 + M5 + M6 + M7 + M8 + M9
f2 =~ N1 + N2 + N3 + N4 + N5 + N6 + N7 + N8 + N9
f3 =~ P1 + P2 + P3 + P4 + P5 + P6 + P7 + P8 + P9
# regressions
f3 ~ f1 + f2
f2 ~ f1 + f3
f1 ~ f2 + f3
'
fit <- sem(model = model, data = DT, rotation = "promax",
# mimic Mplus
information = "observed",
rotation.args = list(rstarts = 30, row.weights = "none",
algorithm = "gpa", std.ov = TRUE,
geomin.epsilon = 0.0001))
summary(fit)
#But is this perhaps not telling the whole story? To look further at the suitability
#of the items in capturing the Dark Triad traits, we will look at responses for each
#of the three dimensions
#First, we'll conduct an EFA on the dataset
efaDT <- fa(DT,
nfactors = 3,
fm = 'pa',
rotate = 'promax')
sink("./Output/DT_EFA_Output.txt")  #start capture
fa.sort(efaDT)
sink()
sink("./Output/DT_EFA_1.Summary.txt")
summary(efaDT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#Based on 3-factor model we note: TLI = .903, RMSA = 0.03, RMSEA = 0.051
#What happens if we try more/less factors?
efa4DT <- fa(DT,
nfactors = 4,
fm = 'pa',
rotate = 'promax')
sink("./Output/4DT_EFA_Output.txt")  #start capture
fa.sort(efa4DT)
sink()
sink("./Output/4DT_EFA_1.Summary.txt")
summary(efa4DT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#For the 4-factor model, we note: TLI = 0.914, RMSA = 0.02, RMSEA = 0.048
efa2DT <- fa(DT,
nfactors = 2,
fm = 'pa',
rotate = 'promax')
sink("./Output/2DT_EFA_Output.txt")  #start capture
fa.sort(efa2DT)
sink()
sink("./Output/2DT_EFA_1.Summary.txt")
summary(efa2DT, standardized = TRUE, fit.measures = TRUE, rsquare = TRUE)
sink()
#For the 2-factor model, we note: TLI = 0.861, RMSA = 0.04, RMSEA = 0.062
#After exploring a few different options, the 3-factor model described may be
#ideal, as there is no significant increase in model suitability from the 3-factor
#to 4-factor model. The original study by Jones & Paulhus (2013) noted that analyses
#conducted to determine # of factors also was either 3/4 depending on the method
model <- '
#cfa block
f1 =~ M1 + M2 + M3 + M4 + M5 + M6 + M7 + M8 + M9
f2 =~ N1 + N2 + N3 + N4 + N5 + N6 + N7 + N8 + N9
f3 =~ P1 + P2 + P3 + P4 + P5 + P6 + P7 + P8 + P9
# regressions
f3 ~ f1 + f2
f2 ~ f1 + f3
f1 ~ f2 + f3
'
fit <- sem(model = model, data = DT, rotation = "promax",
# mimic Mplus
information = "observed",
rotation.args = list(rstarts = 30, row.weights = "none",
algorithm = "gpa", std.ov = TRUE,
geomin.epsilon = 0.0001))
summary(fit,
fit.measures = TRUE,
standardized = TRUE,
rsquare = TRUE)
#But is this perhaps not telling the whole story? To look further at the suitability
#of the items in capturing the Dark Triad traits, we will look at responses for each
#of the three dimensions
## Classical Test Theory Item Analysis for Machiavellianism
# Item Analysis
mAlpha <- psych::alpha(mDT)
# Response proportions, three sig figs
print(round(mAlpha$response.freq,3) )
# Item and item-total stats, three sig figs
print(round(mAlpha$item.stats, 3) )
##IRT Analysis for Machiavellianism
# ltm function for GRM model
mGRM <- grm(mDT, IRT.param = TRUE)
# Option thresholds and discriminations for each item
coefficients(mGRM)
#ICCs for each item
plot(mGRM, type="ICC", item=1, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=2, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=3, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=4, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=5, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=6, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=7, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=8, xlab = "Trait: Machiavellianism")
plot(mGRM, type="ICC", item=9, xlab = "Trait: Machiavellianism")
# Item Info
plot(mGRM, type="IIC", lty=1:5, col="black")
# Test Info
plot(mGRM, type="IIC", items = 0, lty=1:5, col="black")
# Relate to person distribution
plot(factor.scores.grm(mGRM))
## Classical Test Theory Item Analysis for Narcissism
# Item Analysis
nAlpha <- psych::alpha(rnDT)
# Response proportions, three sig figs
print(round(nAlpha$response.freq,3) )
# Item and item-total stats, three sig figs
print(round(nAlpha$item.stats, 3) )
##IRT Analysis for Narcissism
# ltm function for GRM model
nGRM <- grm(rnDT, IRT.param = TRUE)
# Option thresholds and discriminations for each item
coefficients(nGRM)
#ICCs for each item
plot(nGRM, type="ICC", item=1, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=2, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=3, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=4, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=5, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=6, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=7, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=8, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=9, xlab = "Trait: Narcissism")
# Item Info
plot(nGRM, type="IIC", lty=1:5, col="black")
# Test Info
plot(nGRM, type="IIC", items = 0, lty=1:5, col="black")
# Relate to person distribution
plot(factor.scores.grm(nGRM))
## Classical Test Theory Item Analysis for Psychopathy
# Item Analysis
pAlpha <- psych::alpha(rpDT)
# Response proportions, three sig figs
print(round(pAlpha$response.freq,3) )
# Item and item-total stats, three sig figs
print(round(pAlpha$item.stats, 3) )
##IRT Analysis for Psychopathy
# ltm function for GRM model
pGRM <- grm(rpDT, IRT.param = TRUE)
# Option thresholds and discriminations for each item
coefficients(pGRM)
#ICCs for each item
plot(pGRM, type="ICC", item=1, xlab = "Trait: Psychopathy")
plot(pGRM, type="ICC", item=2, xlab = "Trait: Psychopathy")
plot(pGRM, type="ICC", item=3, xlab = "Trait: Psychopathy")
plot(pGRM, type="ICC", item=4, xlab = "Trait: Psychopathy")
plot(pGRM, type="ICC", item=5, xlab = "Trait: Psychopathy")
plot(pGRM, type="ICC", item=6, xlab = "Trait: Psychopathy")
plot(pGRM, type="ICC", item=7, xlab = "Trait: Psychopathy")
plot(pGRM, type="ICC", item=8, xlab = "Trait: Psychopathy")
plot(pGRM, type="ICC", item=9, xlab = "Trait: Psychopathy")
# Item Info
plot(pGRM, type="IIC", lty=1:5, col="black")
# Test Info
plot(pGRM, type="IIC", items = 0, lty=1:5, col="black")
# Relate to person distribution
plot(factor.scores.grm(pGRM))
## Classical Test Theory Item Analysis for Narcissism
# Item Analysis
nAlpha <- psych::alpha(rnDT)
# Response proportions, three sig figs
print(round(nAlpha$response.freq,3) )
# Item and item-total stats, three sig figs
print(round(nAlpha$item.stats, 3) )
##IRT Analysis for Narcissism
# ltm function for GRM model
nGRM <- grm(rnDT, IRT.param = TRUE)
# Option thresholds and discriminations for each item
coefficients(nGRM)
#ICCs for each item
plot(nGRM, type="ICC", item=1, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=2, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=3, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=4, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=5, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=6, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=7, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=8, xlab = "Trait: Narcissism")
plot(nGRM, type="ICC", item=9, xlab = "Trait: Narcissism")
# Item Info
plot(nGRM, type="IIC", lty=1:5, col="black")
# Test Info
plot(nGRM, type="IIC", items = 0, lty=1:5, col="black")
# Relate to person distribution
plot(factor.scores.grm(nGRM))
