inst/doc/measurement-models.R

In specr: Conducting and Visualizing Specification Curve Analyses

## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  #fig.path = "man/figures/README-",
  out.width = "100%",
  fig.retina = 2
)

## ---- message=F, warning = F--------------------------------------------------
# Load packages
library(tidyverse)
library(specr)
library(lavaan)

## ---- message=F, warning = F--------------------------------------------------
# Load data and recode
d <- HolzingerSwineford1939 %>% 
  mutate(sex = as.character(sex),
         school = as.character(school)) %>%
  as_tibble

# Check data
head(d)

## -----------------------------------------------------------------------------
# Model syntax
model <- "
  # measures
  visual  =~ x1 + x2 + x3

  # regressions
  visual ~ ageyr + grade
"

fit <- sem(model, d)
broom::tidy(fit)

## -----------------------------------------------------------------------------
sem_custom <- function(formula, data) {
  
  require(lavaan)
  
  # 1) Define latent variables as a named list
  latent <- list(visual =  "visual  =~ x1 + x2 + x3",
                 textual = "textual =~ x4 + x5 + x6",
                 speed =   "speed   =~ x7 + x8 + x9")
  
  # 2) Remove placeholder for no covariates (lavaan does not like "+ 1")
  formula <- str_remove_all(formula, "\\+ 1")
  
  # 3) Check which of the additional measurement models are actually used in the formula
  valid <- purrr::keep(names(latent), 
                       ~ stringr::str_detect(formula, .x))
  
  # 4) Include measurement models in the formula using lavaan syntax
  formula <- paste(formula, "\n",
                   paste(latent[valid], 
                         collapse = " \n "))
  
  # 5) Run SEM with sem function
  sem(formula, data)
}

# In short:
sem_custom <- function(formula, data) {
  require(lavaan)
  latent <- list(visual =  "visual  =~ x1 + x2 + x3",
                 textual = "textual =~ x4 + x5 + x6",
                 speed =   "speed   =~ x7 + x8 + x9")
  formula <- stringr::str_remove_all(formula, "\\+ 1")
  valid <- purrr::keep(names(latent), ~ stringr::str_detect(formula, .x))
  formula <- paste(formula, "\n", paste(latent[valid], collapse = " \n "))
  sem(formula, data)
}


## -----------------------------------------------------------------------------
# Setup specs
specs <- setup(data = d,
               y = c("textual", "visual", "speed"),
               x = c("ageyr"),
               model = c("sem_custom"),
               controls = c("grade"),
               subsets = list(sex = unique(d$sex),
                              school = unique(d$school)))

# Summarize specifications
summary(specs, row = 10)

## ---- fig.height=8, fig.width=8, message=F, warning = F-----------------------
results <- specr(specs)
plot(results, choices = c("y", "controls", "model", "subsets"))

## ---- fig.height=9, fig.width=9, message=F, warning = F-----------------------
# Create curve with standardized coefficients
plot_a <- plot(results, "curve") + 
    geom_point(aes(y = std.all, alpha = .1, size = 1.25)) +
    geom_hline(yintercept = 0, linetype = "dashed")

# Choice panel
plot_b <- plot(results, "choices",
               choices = c("y", "controls", "subsets"))

# Combine plots
plot_grid(plot_a, plot_b,
          ncol = 1,           
          align = "v",            
          axis = "rbl",            
          rel_heights = c(1.5, 2))  

## ---- fig.height=8, fig.width=8, message=F, warning = F-----------------------
# Looking at included fit indices
results %>%
  as_tibble %>%
  select(x, y, model, controls, subsets, 
         fit_cfi, fit_tli, fit_rmsea) %>%
  head

# Create curve plot
p1 <- plot(results, "curve", var = fit_cfi, ci = FALSE) +
  geom_line(aes(x = specifications, y = fit_cfi), color = "grey") +
  geom_point(size = 2, shape = 18) + # increasing size of points
  geom_line(aes(x = specifications, y = fit_rmsea), color = "grey") +
  geom_point(aes(x = specifications, y = fit_rmsea), shape = 20, size = 2) +
  ylim(0, 1) +
  labs(y = "cfi & rmsea")

# Create choice panel with chisq arrangement
p2 <- plot(results, "choices", var = fit_cfi, 
           choices = c("y", "controls", "subsets"))

# Bind together
plot_grid(p1, p2,
          ncol = 1,           
          align = "v",            
          axis = "rbl",            
          rel_heights = c(1.5, 2))