.Rhistory

leave Phi = NULL")
} else {
Phi <- x$Phi
}
} else if(all(class(x) == c("psych", "fa"))) {
L1 <- unclass(x$loadings)
n_first_fac <- ncol(x$loadings)
if(!is.null(Phi)){
warning("Phi argument is specified. Specified factor intercorrelations are
taken. To take factor intercorrelations from the psych fa output,
leave Phi = NULL")
} else {
Phi <- x$Phi
}
} else {
L1 <- x
n_first_fac <- ncol(x)
}
# perform a factor analysis on the intercorrelation matrix of the first order
# factors
paf_phi <- PAF(Phi, n_factors = 1, cors = TRUE, max_iter = 300,
type = type, init_comm = init_comm, criterion = criterion,
criterion_type = criterion_type, abs_eigen = abs_eigen,
signed_loadings = TRUE)
# extract second order loadings
L2 <- paf_phi$loadings
# Schmid-Leiman solution, direct loadings of second order factor
L_sls_2 <- L1 %*% L2
# compute uniqueness of higher order factor
u2_h <- sqrt(1 - diag(L2 %*% t(L2)))
# Schmid-Leiman solution, residualized first order factor loadings
L_sls_1 <- L1 %*% diag(u2_h)
# Combine the Schmid-Leiman loadings in a data frame
sl_load <- data.frame(L_sls_2, L_sls_1)
# Compute communalities and uniquenesses of the Schmid-Leiman solution
h2_sl <- rowSums(sl_load^2)
u2_sl <- 1 - h2_sl
# Finalize output object
sl <- cbind(sl_load, h2_sl, u2_sl)
colnames(sl) <- c("g", 1:n_first_fac, "h2", "u2")
output <- list(
sl = sl,
L2 = L2)
class(output) <- "SL"
}
SL(temp_psych_Pr)
z <- SL(temp_psych_Pr)
z
SL <- function(x, Phi = NULL, cors = TRUE, max_iter = 300, type = "EFAdiff",
init_comm = NULL, criterion = NULL,
criterion_type = NULL, abs_eigen = NULL,
signed_loadings = TRUE) {
if(all(class(x) == "PROMAX")) {
L1 <- x$loadings
n_first_fac <- ncol(x$loadings)
if(!is.null(Phi)){
warning("Phi argument is specified. Specified factor intercorrelations are
taken. To take factor intercorrelations from the PROMAX output,
leave Phi = NULL")
} else {
Phi <- x$Phi
}
} else if(all(class(x) == c("psych", "fa"))) {
L1 <- unclass(x$loadings)
n_first_fac <- ncol(x$loadings)
if(!is.null(Phi)){
warning("Phi argument is specified. Specified factor intercorrelations are
taken. To take factor intercorrelations from the psych fa output,
leave Phi = NULL")
} else {
Phi <- x$Phi
}
} else {
L1 <- x
n_first_fac <- ncol(x)
}
# perform a factor analysis on the intercorrelation matrix of the first order
# factors
paf_phi <- PAF(Phi, n_factors = 1, cors = TRUE, max_iter = 300,
type = type, init_comm = init_comm, criterion = criterion,
criterion_type = criterion_type, abs_eigen = abs_eigen,
signed_loadings = TRUE)
# extract second order loadings
L2 <- paf_phi$loadings
# Schmid-Leiman solution, direct loadings of second order factor
L_sls_2 <- L1 %*% L2
# compute uniqueness of higher order factor
u2_h <- sqrt(1 - diag(L2 %*% t(L2)))
# Schmid-Leiman solution, residualized first order factor loadings
L_sls_1 <- L1 %*% diag(u2_h)
# Combine the Schmid-Leiman loadings in a data frame
sl_load <- data.frame(L_sls_2, L_sls_1)
# Compute communalities and uniquenesses of the Schmid-Leiman solution
h2_sl <- rowSums(sl_load^2)
u2_sl <- 1 - h2_sl
# Finalize output object
sl <- cbind(sl_load, h2_sl, u2_sl)
colnames(sl) <- c("g", 1:n_first_fac, "h2", "u2")
output <- list(
sl = sl,
L2 = L2)
class(output) <- "SL"
output
}
z <- SL(temp_psych_Pr)
z
matrix(L_sls_2, L_sls_1)
L_sls_2
L_sls_1
matrix(L_sls_2, L_sls_1)
SL <- function(x, Phi = NULL, type = "EFA_diff", ...) {
if(all(class(x) == "PROMAX")) {
L1 <- x$loadings
n_first_fac <- ncol(x$loadings)
if(!is.null(Phi)){
warning("Phi argument is specified. Specified factor intercorrelations are
taken. To take factor intercorrelations from the PROMAX output,
leave Phi = NULL")
} else {
Phi <- x$Phi
}
} else if(all(class(x) == c("psych", "fa"))) {
L1 <- unclass(x$loadings)
n_first_fac <- ncol(x$loadings)
if(!is.null(Phi)){
warning("Phi argument is specified. Specified factor intercorrelations are
taken. To take factor intercorrelations from the psych fa output,
leave Phi = NULL")
} else {
Phi <- x$Phi
}
} else {
L1 <- x
n_first_fac <- ncol(x)
}
# perform a factor analysis on the intercorrelation matrix of the first order
# factors
paf_phi <- PAF(Phi, n_factors = 1, cors = TRUE, max_iter = 300,
type = type, init_comm = init_comm, criterion = criterion,
criterion_type = criterion_type, abs_eigen = abs_eigen,
signed_loadings = TRUE)
# extract second order loadings
L2 <- paf_phi$loadings
# Schmid-Leiman solution, direct loadings of second order factor
L_sls_2 <- L1 %*% L2
# compute uniqueness of higher order factor
u2_h <- sqrt(1 - diag(L2 %*% t(L2)))
# Schmid-Leiman solution, residualized first order factor loadings
L_sls_1 <- L1 %*% diag(u2_h)
# Combine the Schmid-Leiman loadings in a data frame
sl_load <- cbind(L_sls_2, L_sls_1)
# Compute communalities and uniquenesses of the Schmid-Leiman solution
h2_sl <- rowSums(sl_load^2)
u2_sl <- 1 - h2_sl
# Finalize output object
sl <- cbind(sl_load, h2_sl, u2_sl)
colnames(sl) <- c("g", 1:n_first_fac, "h2", "u2")
output <- list(
sl = sl,
L2 = L2)
class(output) <- "SL"
output
}
z <- SL(temp_psych_Pr)
SL <- function(x, Phi = NULL, type = "EFAdiff", ...) {
if(all(class(x) == "PROMAX")) {
L1 <- x$loadings
n_first_fac <- ncol(x$loadings)
if(!is.null(Phi)){
warning("Phi argument is specified. Specified factor intercorrelations are
taken. To take factor intercorrelations from the PROMAX output,
leave Phi = NULL")
} else {
Phi <- x$Phi
}
} else if(all(class(x) == c("psych", "fa"))) {
L1 <- unclass(x$loadings)
n_first_fac <- ncol(x$loadings)
if(!is.null(Phi)){
warning("Phi argument is specified. Specified factor intercorrelations are
taken. To take factor intercorrelations from the psych fa output,
leave Phi = NULL")
} else {
Phi <- x$Phi
}
} else {
L1 <- x
n_first_fac <- ncol(x)
}
# perform a factor analysis on the intercorrelation matrix of the first order
# factors
paf_phi <- PAF(Phi, n_factors = 1, cors = TRUE, max_iter = 300,
type = type, init_comm = init_comm, criterion = criterion,
criterion_type = criterion_type, abs_eigen = abs_eigen,
signed_loadings = TRUE)
# extract second order loadings
L2 <- paf_phi$loadings
# Schmid-Leiman solution, direct loadings of second order factor
L_sls_2 <- L1 %*% L2
# compute uniqueness of higher order factor
u2_h <- sqrt(1 - diag(L2 %*% t(L2)))
# Schmid-Leiman solution, residualized first order factor loadings
L_sls_1 <- L1 %*% diag(u2_h)
# Combine the Schmid-Leiman loadings in a data frame
sl_load <- cbind(L_sls_2, L_sls_1)
# Compute communalities and uniquenesses of the Schmid-Leiman solution
h2_sl <- rowSums(sl_load^2)
u2_sl <- 1 - h2_sl
# Finalize output object
sl <- cbind(sl_load, h2_sl, u2_sl)
colnames(sl) <- c("g", 1:n_first_fac, "h2", "u2")
output <- list(
sl = sl,
L2 = L2)
class(output) <- "SL"
output
}
z <- SL(temp_psych_Pr)
class(z$sl)
devtools::install_local()
library(devtools)
devtools::install_local()
devtools::install_local()
devtools::install_local()
getwd()
install.packages("devtools")
install.packages("devtools")
devtools::install_local()
# Flexible omega function (e.g. to use with loadings obtained by MacOrtho)-------
OMEGA_FLEX <- function(model = NULL, var_names, fac_names = NULL, factor_corres = NULL,
g_load, s_load, u2 = NULL, Phi = NULL, pattern = NULL,
type = "EFAdiff"){
if(all(class(model) == c("psych", "schmid"))){
model <-  model$sl
n_factors <- ncol(model) - 4
factor_names <- c("g", 1:n_factors)
var_names <- rownames(model)
g_load <- model$sl[, 1]
s_load <- model$sl[, 2:(n_factors + 1)]
if(type != "Watkins"){
u2 <- model[, ncol(model) - 1]
}
} else if(all(class(model) == c("SL"))){
model <-  model$sl
n_factors <- ncol(model) - 3
factor_names <- c("g", 1:n_factors)
var_names <- rownames(model)
g_load <- model$sl[, 1]
s_load <- model$sl[, 2:(n_factors + 1)]
if(type != "Watkins"){
u2 <- model[, ncol(model)]
}
} else {
factor_names <- c("g", 1:ncol(s_load))
}
# Create an input dataframe
input <- data.frame(g_load, s_load)
colnames(input) <- factor_names
rownames(input) <- var_names
if(type != "psych" & is.null(factor_corres)){
stop("Either specify the factor_corres argument or set type = 'psych'")
}
if(type != "Watkins" & is.null(u2)){
stop("Either specify the u2 argument or set type = 'Watkins'")
}
if(type == "psych"){
if(is.null(Phi) | is.null(pattern)){
stop("Please specify the Phi and pattern arguments")
} else {
# Create the correlation matrix from the pattern coefficients and factor
# intercorrelations
cormat <- factor.model(f = pattern, Phi = Phi, U2 = FALSE)
}
if(is.null(factor_corres)){
factor_corres <- apply(input, 1,
function(x) which.max(abs(x[2:(ncol(s_load) + 1)])))
} else {
warning("Argument factor_corres is specified. Specified variable-to-factor
correspondences are taken. To compute factor correspondences as done
in psych, leave factor_corres = NULL.")
}
}
input <- cbind(factor_corres, input)
names(input)[1] <- "factor"
if(type == "Watkins"){
if(is.null(u2)) {
# Set all "non-relevant" group factor loadings to 0
Watkins_data <- matrix(ncol = ncol(s_load), nrow = length(var_names))
for(i in 1:ncol(s_load)){
temp <- ifelse(input$factor == i,
input[input$factor == i, colnames(input)[i + 2]], 0)
Watkins_data[, i] <- temp
}
input[, 1:ncol(s_load) + 2] <- Watkins_data
# Calculate uniquenesses based only on the relevant group factor loadings
u2_Wat <- 1 - rowSums(input[, c(2, 1:ncol(s_load) + 2)]^2)
u2 <- u2_Wat
} else {
warning("Argument u2 is specified. Specified uniquenesses are taken.
To compute uniquenesses as done in Watkins' program, leave u2
= NULL")
}
}
input$u2 <- u2
# Create all sums of factor loadings for each factor
# Sums of all group factor loadings for each group factor
sums_s <- colSums(input[, 3:(ncol(s_load) + 2)])
# Sum of all g loadings
sum_g <- sum(input$g)
# Sum of all error variances
sum_e <- sum(input$u2)
# Compute sums of error variances and g-loadings for group factors
sums_e_s <- NULL
sums_g_s <- NULL
sums_s_s <- NULL
for (i in 1:ncol(s_load)){
sums_e_s[i] <- sum(input[input$factor == i, "u2"])
sums_g_s[i] <- sum(input[input$factor == i, "g"])
sums_s_s[i] <- sum(input[input$factor == i, i + 2])
}
if(type == "psych"){
# Compute omega total, hierarchical, and subscale for g-factor
omega_tot <- (sum(cormat) - sum(input$u2)) / sum(cormat)
omega_h_g <- sum_g^2 / sum(cormat)
omega_sub_g <- sum(sums_s_s^2) / sum(cormat)
# Compute omega total, hierarchical, and subscale for group factors
omega_tot_sub <- NULL
omega_h_sub <- NULL
omega_sub_sub <- NULL
for (i in 1:ncol(s_load)) {
subf <- which(factor_corres == i)
Vgr <- sum(cormat[subf, subf])
omega_sub_sub[i] <- sums_s_s[i]^2 / Vgr
omega_h_sub[i] <- sums_g_s[i]^2 / Vgr
omega_tot_sub[i] <- (sums_s_s[i]^2 + sums_g_s[i]^2) / Vgr
}
} else {
# Compute omega total, hierarchical, and subscale for g-factor
omega_tot_g <- (sum_g^2 + sum(sums_s^2)) / (sum_g^2 + sum(sums_s^2) + sum_e)
omega_h_g <- sum_g^2 / (sum_g^2 + sum(sums_s^2) + sum_e)
omega_sub_g <- sum(sums_s_s^2) / (sum_g^2 + sum(sums_s^2) + sum_e)
# Compute omega total, hierarchical, and subscale for group factors
omega_tot_sub <- NULL
omega_h_sub <- NULL
omega_sub_sub <- NULL
omega_tot_sub <- (sums_s_s^2 + sums_g_s^2) / (sums_g_s^2 + sums_s_s^2 + sums_e_s)
omega_h_sub <- sums_g_s^2 / (sums_g_s^2 + sums_s_s^2 + sums_e_s)
omega_sub_sub <- sums_s_s^2 / (sums_g_s^2 + sums_s_s^2 + sums_e_s)
}
# Combine and display results in a table
omega_tot <- c(omega_tot_g, omega_tot_sub)
omega_h <- c(omega_h_g, omega_h_sub)
omega_sub <- c(omega_sub_g, omega_sub_sub)
omegas <- data.frame(omega_tot, omega_h, omega_sub)
if(!is.null(fac_names)){
rownames(omegas) <- c("g", fac_names)
} else {
rownames(omegas) <- c("g", 1:ncol(s_load))
}
omegas
}
load("~/GitHub/EFAdiff/data/IDS2_R.RData")
View()
View(IDS2_R)
load("~/GitHub/EFAdiff/data/omega_wat.RData")
omega_wat
IDS2_R
devtools::install_local(force = TRUE)
devtools::check()
devtools::use_package("lavaan")
library(EFAdiff)
# With loadings from Morgan et al. (2015) -----
first_Morgan <- read.csv("data/pattern_Morgan.csv", sep = ";", header = FALSE)
second_Morgan <- c(.86, .93, .71, .64)
cor_Morgan <- sim.hierarchical(second_Morgan, first_Morgan)
psych_paf_Morgan <- PAF(cor_Morgan, type = "psych", n_factors = 4)
psych_prom_Morgan <- PROMAX(psych_paf_Morgan, type = "psych")
SPSS_paf_Morgan <- PAF(x = cor_Morgan, type = "SPSS", n_factors = 4)
SPSS_prom_Morgan <- PROMAX(SPSS_paf_Morgan, type = "SPSS")
round(SPSS_prom_Morgan$loadings, 3)
round(unclass(psych_prom_Morgan$loadings), 3)
schmid_SPSS_Morgan <- SL(SPSS_prom_Morgan, type = "SPSS")
schmid_SPSS_Morgan
devtools::check()
devtools::check()
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::check()
devtools::install_local(force = TRUE)
devtools::check()
devtools::check()
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::check()
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
model = NULL, var_names = NULL, fac_names = NULL,
factor_corres = NULL, g_load = NULL,
s_load = NULL, u2 = NULL, Phi = NULL, pattern = NULL,
cormat = NULL, type = "EFAdiff"
var_names = NULL
g_load = NULL
u2 = NULL
s_load = NULL
(!is.null(var_names) || !is.null(g_load) || !is.null(s_load)
|| !is.null(u2))
!is.null(model)
model = NULL
!is.null(model)
!is.null(model) & (!is.null(var_names) || !is.null(g_load) || !is.null(s_load)
|| !is.null(u2))
model = a
model = 2
var_names = "b"
!is.null(model)
(!is.null(var_names) || !is.null(g_load) || !is.null(s_load)
|| !is.null(u2))
!is.null(model) & (!is.null(var_names) || !is.null(g_load) || !is.null(s_load)
|| !is.null(u2))
model = NULL
!is.null(model) & (!is.null(var_names) || !is.null(g_load) || !is.null(s_load)
|| !is.null(u2))
devtools::install_lod
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
load("~/GitHub/EFAdiff/data/WISCV_age_10.RData")
View(WISCV_age_10)
WISCV_age_10[["cormat"]]
load("~/GitHub/EFAdiff/data/WJIV_ages_3_5.Rdata")
View(WJIV_ages_3_5)
load("~/GitHub/EFAdiff/data/WJIV_ages_6_8.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_9_13.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_14_19.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_20_39.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_40_90.Rdata")
load("~/GitHub/EFAdiff/data/dospert.Rdata")
View(dospert)
is.matrix(dospert$cormat)
WJIV_ages_3_5$cormat <- as.matrix(WJIV_ages_3_5$cormat)
WJIV_ages_3_5
is.matrix(WJIV_ages_3_5$cormat)
save(WJIV_ages_3_5, file = "data/WJIV_ages_3_5.RData")
load("~/GitHub/EFAdiff/data/WJIV_ages_3_5.Rdata")
View(WJIV_ages_3_5)
View(WJIV_ages_3_5)
View(WJIV_ages_3_5)
WJIV_ages_3_5
is.matrix(WJIV_ages_3_5$cormat)
load("~/GitHub/EFAdiff/data/WJIV_ages_3_5.Rdata")
is.matrix(WJIV_ages_3_5$cormat)
rm(WJIV_ages_3_5)
load("~/GitHub/EFAdiff/data/WJIV_ages_3_5.Rdata")
is.matrix(WJIV_ages_3_5$cormat)
WJIV_ages_6_8$cormat <- as.matrix(WJIV_ages_6_8$cormat)
is.matrix(WJIV_ages_6_8$cormat)
save(WJIV_ages_6_8, file = "data/WJIV_ages_6_8.RData")
WJIV_ages_9_13$cormat <- as.matrix(WJIV_ages_9_13$cormat)
is.matrix(WJIV_ages_9_13$cormat)
save(WJIV_ages_9_13, file = "data/WJIV_ages_6_8.RData")
save(WJIV_ages_9_13, file = "data/WJIV_ages_9_13.RData")
WJIV_ages_6_8
save(WJIV_ages_6_8, file = "data/WJIV_ages_6_8.RData")
WJIV_ages_14_19$cormat <- as.matrix(WJIV_ages_14_19$cormat)
is.matrix(WJIV_ages_14_19$cormat)
save(WJIV_ages_14_19, file = "data/WJIV_ages_14_19.RData")
WJIV_ages_20_39$cormat <- as.matrix(WJIV_ages_20_39$cormat)
is.matrix(WJIV_ages_20_39$cormat)
save(WJIV_ages_20_39, file = "data/WJIV_ages_20_39.RData")
WJIV_ages_40_90$cormat <- as.matrix(WJIV_ages_40_90$cormat)
is.matrix(WJIV_ages_40_90$cormat)
save(WJIV_ages_40_90, file = "data/WJIV_ages_40_90.RData")
load("~/GitHub/EFAdiff/data/WJIV_ages_14_19.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_20_39.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_3_5.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_40_90.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_6_8.Rdata")
load("~/GitHub/EFAdiff/data/WJIV_ages_9_13.Rdata")
str(WJIV_ages_3_5)
str(WJIV_ages_3_5$cormat)
class(WJIV_ages_3_5$cormat)
class(WJIV_ages_6_8$cormat)
WJIV_ages_6_8
class(WJIV_ages_9_13$cormat)
class(WJIV_ages_14_19$cormat)
class(WJIV_ages_20_39$cormat)
class(WJIV_ages_40_90$cormat)
WJIV_ages_3_5 == WJIV_ages_6_8
WJIV_ages_6_8 == WJIV_ages_9_13
WJIV_ages_6_8$cormat == WJIV_ages_9_13$cormat
WJIV_ages_3_5$cormat == WJIV_ages_6_8$cormat
WJIV_ages_9_13$cormat == WJIV_ages_14_19$cormat
load("~/GitHub/EFAdiff/data/dospert.Rdata")
View(dospert)
dospert[["cormat"]]
rownames(dospert)
rownames(dospert$cormat)
load("~/GitHub/EFAdiff/data/WJIV_ages_3_5.Rdata")
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)
devtools::check
devtools::check()
devtools::check()
devtools::install_local(force = TRUE)
devtools::install_local(force = TRUE)