tests/testthat/test-implied_scores_single_no_intercepts.R

In semfindr: Influential Cases in Structural Equation Modeling

library(testthat)
library(lavaan)
library(semfindr)

#context("Test implied_scores with x variables free")

mod <- 
'
iv1 ~~ iv2
m1 ~ iv1 + iv2
dv ~ m1
'

dat <- pa_dat
y_names <- c("m1", "dv")
fit0 <- lavaan::sem(mod, dat, meanstructure = FALSE)
implied_scores0 <- implied_scores(fit0)
implied_means0 <- colMeans(implied_scores0)
implied_means_lavaan <- fitted(fit0)$mean[y_names]
class(implied_means_lavaan) <- "numeric"

fit_rsquare_raw <- lavaan::parameterEstimates(fit0, rsquare = TRUE)
fit_rsquare_raw <- fit_rsquare_raw[fit_rsquare_raw$op == "r2", ]
fit_rsquare <- fit_rsquare_raw$est
names(fit_rsquare) <- fit_rsquare_raw$lhs

dat_y <- dat[, y_names]
p <- length(y_names)
y_hat_rsquare <- rep(NA, p)
names(y_hat_rsquare) <- y_names
for (i in y_names) {
    y_hat_rsquare[i] <- 
        suppressWarnings(cor(dat[, i], implied_scores0[, i], use = "pairwise.complete.obs")^2)
}
y_hat_rsquare <- y_hat_rsquare[!is.na(y_hat_rsquare)]

test_that("Can implied R-squares be reproduced?", {
    expect_equal(ignore_attr = TRUE,
        y_hat_rsquare, fit_rsquare,
        tolerance = .00001
      )
  })

#context("Test implied_scores with x variables fixed")

mod <- 
'
m1 ~ iv1 + iv2
dv ~ m1
'

dat <- pa_dat
y_names <- c("m1", "dv")
fit0 <- lavaan::sem(mod, dat, fixed.x = TRUE)
implied_scores0 <- implied_scores(fit0)
implied_means0 <- colMeans(implied_scores0)
implied_means_lavaan <- fitted(fit0)$mean[y_names]
class(implied_means_lavaan) <- "numeric"

fit_rsquare_raw <- lavaan::parameterEstimates(fit0, rsquare = TRUE)
fit_rsquare_raw <- fit_rsquare_raw[fit_rsquare_raw$op == "r2", ]
fit_rsquare <- fit_rsquare_raw$est
names(fit_rsquare) <- fit_rsquare_raw$lhs

dat_y <- dat[, y_names]
p <- length(y_names)
y_hat_rsquare <- rep(NA, p)
names(y_hat_rsquare) <- y_names
for (i in y_names) {
    y_hat_rsquare[i] <- 
        suppressWarnings(cor(dat[, i], implied_scores0[, i], use = "pairwise.complete.obs")^2)
}
y_hat_rsquare <- y_hat_rsquare[!is.na(y_hat_rsquare)]

test_that("Can implied R-squares be reproduced?", {
    expect_equal(ignore_attr = TRUE,
        y_hat_rsquare, fit_rsquare,
        tolerance = .00001
      )
  })