Skip to contents

Using Contrasts

Mark Lai

2024-09-27

Source: vignettes/contrast.rmd
contrast.rmd
library(lavaan)
#> This is lavaan 0.6-19
#> lavaan is FREE software! Please report any bugs.
library(pinsearch)

This vignette demonstrates the use of contrasts in the pinSearch() function based on a real data set.

Load Data 

data(lui_sim)

Descriptive Statistics 

summary(lui_sim)
#>      class1          class2          class3          class4     
#>  Min.   :1.000   Min.   :1.000   Min.   :1.000   Min.   :1.000  
#>  1st Qu.:2.000   1st Qu.:1.000   1st Qu.:1.000   1st Qu.:1.000  
#>  Median :2.000   Median :2.000   Median :2.000   Median :1.000  
#>  Mean   :1.779   Mean   :1.577   Mean   :1.703   Mean   :1.432  
#>  3rd Qu.:2.000   3rd Qu.:2.000   3rd Qu.:2.000   3rd Qu.:2.000  
#>  Max.   :2.000   Max.   :2.000   Max.   :2.000   Max.   :2.000  
#>      class5          class6          class7          class8         class9     
#>  Min.   :1.000   Min.   :1.000   Min.   :1.000   Min.   :1.00   Min.   :1.000  
#>  1st Qu.:1.000   1st Qu.:1.000   1st Qu.:1.000   1st Qu.:1.00   1st Qu.:1.000  
#>  Median :1.000   Median :1.000   Median :2.000   Median :2.00   Median :2.000  
#>  Mean   :1.379   Mean   :1.223   Mean   :1.655   Mean   :1.58   Mean   :1.638  
#>  3rd Qu.:2.000   3rd Qu.:1.000   3rd Qu.:2.000   3rd Qu.:2.00   3rd Qu.:2.000  
#>  Max.   :2.000   Max.   :2.000   Max.   :2.000   Max.   :2.00   Max.   :2.000  
#>     class10         class11         class12         class13     
#>  Min.   :1.000   Min.   :1.000   Min.   :1.000   Min.   :1.000  
#>  1st Qu.:1.000   1st Qu.:1.000   1st Qu.:1.000   1st Qu.:1.000  
#>  Median :2.000   Median :2.000   Median :2.000   Median :1.000  
#>  Mean   :1.513   Mean   :1.722   Mean   :1.653   Mean   :1.356  
#>  3rd Qu.:2.000   3rd Qu.:2.000   3rd Qu.:2.000   3rd Qu.:2.000  
#>  Max.   :2.000   Max.   :2.000   Max.   :2.000   Max.   :2.000  
#>     class14         class15          group      
#>  Min.   :1.000   Min.   :1.000   Min.   :1.000  
#>  1st Qu.:1.000   1st Qu.:1.000   1st Qu.:2.000  
#>  Median :2.000   Median :1.000   Median :4.000  
#>  Mean   :1.742   Mean   :1.436   Mean   :3.615  
#>  3rd Qu.:2.000   3rd Qu.:2.000   3rd Qu.:5.000  
#>  Max.   :2.000   Max.   :2.000   Max.   :6.000

Configural invariance 

config_mod <- "
f1 =~ class1 + class2 + class3 + class4 + class5 + class6 + 
      class7 + class8 + class9 + class10 + class11 + class12 + 
      class13 + class14 + class15
"
config_fit <- cfa(config_mod, data = lui_sim, group = "group", ordered = TRUE)
# Release covariance between class1 and class2
config_fit2 <- update(config_fit, c(config_mod, "class1 ~~ class2"))
anova(config_fit, config_fit2)
#> 
#> Scaled Chi-Squared Difference Test (method = "satorra.2000")
#> 
#> lavaan->lavTestLRT():  
#>    lavaan NOTE: The "Chisq" column contains standard test statistics, not the 
#>    robust test that should be reported per model. A robust difference test is 
#>    a function of two standard (not robust) statistics.
#>              Df AIC BIC  Chisq Chisq diff Df diff Pr(>Chisq)    
#> config_fit2 534         354.80                                  
#> config_fit  540         411.35     36.784       6   1.94e-06 ***
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Forward search

knitr::kable(ps[[2]])
group lhs rhs type
6 f1 class3 loadings
6 f1 class6 loadings
2 f1 class15 loadings
6 f1 class8 loadings
1 f1 class13 loadings
2 f1 class11 loadings
4 f1 class7 loadings
4 f1 class4 loadings
5 f1 class5 loadings
2 f1 class14 loadings
1 f1 class3 loadings
3 f1 class9 loadings
2 f1 class5 loadings
5 f1 class6 loadings
5 f1 class15 loadings
4 f1 class8 loadings
1 f1 class12 loadings
2 f1 class8 loadings
4 class14 t1 thresholds
3 class3 t1 thresholds
2 class9 t1 thresholds
5 class8 t1 thresholds
2 class10 t1 thresholds
2 class12 t1 thresholds
1 class10 t1 thresholds
4 class1 t1 thresholds
1 class15 t1 thresholds
4 class2 t1 thresholds
3 class8 t1 thresholds

Effect Size 

# Obtain fmacs effect size
(f_omni <- pin_effsize(ps[[1]]))
#>       class1-f1 class2-f1 class3-f1  class4-f1 class5-f1 class6-f1  class7-f1
#> fmacs 0.1199449 0.1105255  0.238074 0.09092291 0.0495783 0.1858896 0.09463213
#>       class8-f1 class9-f1 class10-f1 class11-f1 class12-f1 class13-f1
#> fmacs 0.1744843 0.1149672  0.1268064 0.03537658   0.108777 0.07085813
#>       class14-f1 class15-f1
#> fmacs   0.186054   0.142585
# fmacs by gender
(f_gender <- pin_effsize(ps[[1]], group_factor = c(1, 1, 1, 2, 2, 2)))
#>        class1-f1  class2-f1 class3-f1 class4-f1  class5-f1  class6-f1
#> fmacs 0.03579684 0.03298566 0.1443419 0.0271354 0.03031563 0.04858562
#>        class7-f1  class8-f1  class9-f1 class10-f1 class11-f1 class12-f1
#> fmacs 0.02824239 0.03521752 0.08328992 0.04836614 0.01813995 0.01888032
#>       class13-f1 class14-f1 class15-f1
#> fmacs 0.02702651   0.031373 0.04375972
# fmacs by ethnicity
(f_eth <- pin_effsize(ps[[1]], group_factor = c(1, 2, 3, 1, 2, 3)))
#>        class1-f1  class2-f1 class3-f1  class4-f1  class5-f1 class6-f1
#> fmacs 0.05810994 0.05354648 0.1249765 0.04404959 0.01246573 0.1131984
#>        class7-f1  class8-f1  class9-f1 class10-f1 class11-f1 class12-f1
#> fmacs 0.04584661 0.08974653 0.07569014 0.07851401 0.02558757 0.08674763
#>       class13-f1 class14-f1 class15-f1
#> fmacs 0.04387283 0.07597534  0.1148142
# interaction (using contrast matrix)
contr <- local({
    gen <- factor(c("F", "M"))
    contrasts(gen) <- contr.sum(length(gen))
    eth <- factor(1:3)
    contrasts(eth) <- contr.sum(length(eth))
    model.matrix(~ gen * eth, data = expand.grid(eth = eth, gen = gen))
})
(f_int <- pin_effsize(ps[[1]], contrast = contr[, 5:6, drop = FALSE]))
#>        class1-f1  class2-f1 class3-f1  class4-f1  class5-f1 class6-f1
#> fmacs 0.05810994 0.05354648 0.1641631 0.04404959 0.04276347 0.1131984
#>        class7-f1 class8-f1  class9-f1 class10-f1 class11-f1 class12-f1
#> fmacs 0.04584661 0.1309964 0.07569014 0.07851401 0.02558757 0.08674763
#>       class13-f1 class14-f1 class15-f1
#> fmacs 0.04387283  0.1208214 0.07983449
# Render as table
item_names <- gsub("class", replacement = "Item ", colnames(f_omni)) |>
    gsub(pattern = "-f1", replacement = "")
t(rbind(f_omni, f_gender, f_eth, f_int)) |>
    as.data.frame() |>
    `dimnames<-`(list(
        item_names,
        c("Overall", "Gender", "Ethnicity", "Gender x Ethnicity")
    )) |>
    knitr::kable(digits = 2, caption = "$f_\\text{MACS}$ effect sizes")
fMACSf_\text{MACS} effect sizes
Overall Gender Ethnicity Gender x Ethnicity
Item 1 0.12 0.04 0.06 0.06
Item 2 0.11 0.03 0.05 0.05
Item 3 0.24 0.14 0.12 0.16
Item 4 0.09 0.03 0.04 0.04
Item 5 0.05 0.03 0.01 0.04
Item 6 0.19 0.05 0.11 0.11
Item 7 0.09 0.03 0.05 0.05
Item 8 0.17 0.04 0.09 0.13
Item 9 0.11 0.08 0.08 0.08
Item 10 0.13 0.05 0.08 0.08
Item 11 0.04 0.02 0.03 0.03
Item 12 0.11 0.02 0.09 0.09
Item 13 0.07 0.03 0.04 0.04
Item 14 0.19 0.03 0.08 0.12
Item 15 0.14 0.04 0.11 0.08