Skip to content

Commit 205fdbb

Browse files
isaactpetersenisaactpetersen
committed
20250726 - quadratic GCM
1 parent ea61140 commit 205fdbb

1 file changed

Lines changed: 304 additions & 2 deletions

File tree

‎sem.Rmd‎

Lines changed: 304 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -647,18 +647,320 @@ ggplot(
647647
ggplot() +
648648
geom_line( # individuals' model-implied trajectories
649649
data = individual_trajectories,
650-
aes(x = time, y = value, group = id),
650+
aes(
651+
x = time,
652+
y = value,
653+
group = id),
651654
) +
652655
geom_line( # prototypical trajectory
653656
data = newData,
654-
aes(x = time, y = predictedValue),
657+
aes(
658+
x = time,
659+
y = predictedValue),
655660
color = "blue",
656661
linewidth = 2
657662
)
658663
```
659664

660665
## Quadratic Growth Curve Model {#quadraticLGCM}
661666

667+
When using higher-order polynomials, we could specify contrast codes for time to reduce multicollinearity between the linear and quadratic growth factors: https://tdjorgensen.github.io/SEM-in-Ed-compendium/ch27.html#saturated-growth-model
668+
669+
```{r}
670+
factorLoadings <- poly(
671+
x = c(0,1,2,3), # times (can allow unequal spacing)
672+
degree = 2)
673+
674+
factorLoadings
675+
676+
linearLoadings <- factorLoadings[,1]
677+
quadraticLoadings <- factorLoadings[,2]
678+
679+
linearLoadings
680+
quadraticLoadings
681+
```
682+
683+
### Model Syntax
684+
685+
#### Abbreviated
686+
687+
```{r}
688+
quadraticGCM1_syntax <- '
689+
# Intercept and slope
690+
intercept =~ 1*t1 + 1*t2 + 1*t3 + 1*t4
691+
linear =~ 0*t1 + 1*t2 + 2*t3 + 3*t4
692+
quadratic =~ 0*t1 + 1*t2 + 4*t3 + 9*t4
693+
694+
# Regression paths
695+
intercept ~ x1 + x2
696+
linear ~ x1 + x2
697+
quadratic ~ x1 + x2
698+
699+
# Time-varying covariates
700+
t1 ~ c1
701+
t2 ~ c2
702+
t3 ~ c3
703+
t4 ~ c4
704+
'
705+
```
706+
707+
#### Full
708+
709+
```{r}
710+
quadraticGCM2_syntax <- '
711+
# Intercept and slope
712+
intercept =~ 1*t1 + 1*t2 + 1*t3 + 1*t4
713+
linear =~ 0*t1 + 1*t2 + 2*t3 + 3*t4
714+
quadratic =~ 0*t1 + 1*t2 + 4*t3 + 9*t4
715+
716+
# Regression paths
717+
intercept ~ x1 + x2
718+
linear ~ x1 + x2
719+
quadratic ~ x1 + x2
720+
721+
# Time-varying covariates
722+
t1 ~ c1
723+
t2 ~ c2
724+
t3 ~ c3
725+
t4 ~ c4
726+
727+
# Constrain observed intercepts to zero
728+
t1 ~ 0
729+
t2 ~ 0
730+
t3 ~ 0
731+
t4 ~ 0
732+
733+
# Estimate mean of intercept and slope
734+
intercept ~ 1
735+
linear ~ 1
736+
quadratic ~ 1
737+
'
738+
```
739+
740+
### Fit the Model
741+
742+
#### Abbreviated
743+
744+
```{r}
745+
quadraticGCM1_fit <- growth(
746+
quadraticGCM1_syntax,
747+
data = Demo.growth,
748+
missing = "ML",
749+
estimator = "MLR",
750+
meanstructure = TRUE,
751+
int.ov.free = FALSE,
752+
int.lv.free = TRUE,
753+
fixed.x = FALSE,
754+
em.h1.iter.max = 100000)
755+
```
756+
757+
#### Full
758+
759+
```{r}
760+
quadraticGCM2_fit <- sem(
761+
quadraticGCM2_syntax,
762+
data = Demo.growth,
763+
missing = "ML",
764+
estimator = "MLR",
765+
meanstructure = TRUE,
766+
fixed.x = FALSE,
767+
em.h1.iter.max = 100000)
768+
```
769+
770+
### Summary Output
771+
772+
#### Abbreviated
773+
774+
```{r}
775+
summary(
776+
quadraticGCM1_fit,
777+
fit.measures = TRUE,
778+
standardized = TRUE,
779+
rsquare = TRUE)
780+
```
781+
782+
#### Full
783+
784+
```{r}
785+
summary(
786+
quadraticGCM2_fit,
787+
fit.measures = TRUE,
788+
standardized = TRUE,
789+
rsquare = TRUE)
790+
```
791+
792+
### Estimates of Model Fit
793+
794+
```{r}
795+
fitMeasures(
796+
quadraticGCM1_fit,
797+
fit.measures = c(
798+
"chisq", "df", "pvalue",
799+
"chisq.scaled", "df.scaled", "pvalue.scaled",
800+
"chisq.scaling.factor",
801+
"baseline.chisq","baseline.df","baseline.pvalue",
802+
"rmsea", "cfi", "tli", "srmr",
803+
"rmsea.robust", "cfi.robust", "tli.robust"))
804+
```
805+
806+
### Residuals of Observed vs. Model-Implied Correlation Matrix
807+
808+
```{r}
809+
residuals(
810+
quadraticGCM1_fit,
811+
type = "cor")
812+
```
813+
814+
### Modification Indices
815+
816+
```{r}
817+
modificationindices(
818+
quadraticGCM1_fit,
819+
sort. = TRUE)
820+
```
821+
822+
### Internal Consistency Reliability
823+
824+
```{r}
825+
compRelSEM(quadraticGCM1_fit)
826+
```
827+
828+
### Path Diagram
829+
830+
```{r}
831+
semPlot::semPaths(
832+
quadraticGCM1_fit,
833+
what = "Std.all",
834+
layout = "tree2",
835+
edge.label.cex = 1.5)
836+
837+
lavaanPlot::lavaanPlot(
838+
quadraticGCM1_fit,
839+
coefs = TRUE,
840+
#covs = TRUE,
841+
stand = TRUE)
842+
843+
lavaanPlot::lavaanPlot2(
844+
quadraticGCM1_fit,
845+
#stand = TRUE, # currently throws error; uncomment out when fixed: https://github.com/alishinski/lavaanPlot/issues/52
846+
coef_labels = TRUE)
847+
```
848+
849+
To generate an interactive/modifiable path diagram, you can use the following syntax:
850+
851+
```{r, eval = FALSE}
852+
lavaangui::plot_lavaan(quadraticGCM1_fit)
853+
```
854+
855+
### Plot Trajectories
856+
857+
#### Protoypical Growth Curve
858+
859+
Calculated from intercept and slope parameters:
860+
861+
```{r}
862+
quadraticGCM1_intercept <- coef(quadraticGCM1_fit)["intercept~1"]
863+
quadraticGCM1_linear <- coef(quadraticGCM1_fit)["linear~1"]
864+
quadraticGCM1_quadratic <- coef(quadraticGCM1_fit)["quadratic~1"]
865+
866+
#ggplot() +
867+
# xlab("Timepoint") +
868+
# ylab("Score") +
869+
# scale_x_continuous(
870+
# limits = c(0, 3),
871+
# labels = 1:4) +
872+
# scale_y_continuous(
873+
# limits = c(0, 5)) +
874+
# geom_abline(
875+
# mapping = aes(
876+
# slope = lgcm1_slope,
877+
# intercept = lgcm1_intercept))
878+
879+
timepoints <- 4
880+
881+
newData <- data.frame(
882+
time = 1:4,
883+
linearLoading = c(0, 1, 2, 3),
884+
quadraticLoading = c(0, 1, 4, 9)
885+
)
886+
887+
newData$predictedValue <- NA
888+
newData$predictedValue <- quadraticGCM1_intercept + (quadraticGCM1_linear * newData$linearLoading) + (quadraticGCM1_quadratic * newData$quadraticLoading)
889+
890+
ggplot(
891+
data = newData,
892+
mapping = aes(
893+
x = time,
894+
y = predictedValue)) +
895+
xlab("Timepoint") +
896+
ylab("Score") +
897+
scale_y_continuous(
898+
limits = c(0, 5)) +
899+
geom_line()
900+
```
901+
902+
#### Individuals' Growth Curves
903+
904+
```{r}
905+
person_factors <- as.data.frame(predict(quadraticGCM1_fit))
906+
person_factors$id <- rownames(person_factors)
907+
908+
linear_loadings <- c(0, 1, 2, 3)
909+
quadratic_loadings <- c(0, 1, 4, 9)
910+
911+
# Compute model-implied values for each person at each time point
912+
individual_trajectories <- person_factors %>%
913+
rowwise() %>%
914+
mutate(
915+
t1 = intercept + (linear * linear_loadings[1]) + (quadratic * quadratic_loadings[1]),
916+
t2 = intercept + (linear * linear_loadings[2]) + (quadratic * quadratic_loadings[2]),
917+
t3 = intercept + (linear * linear_loadings[3]) + (quadratic * quadratic_loadings[3]),
918+
t4 = intercept + (linear * linear_loadings[4]) + (quadratic * quadratic_loadings[4])
919+
) %>%
920+
ungroup() %>%
921+
select(id, t1, t2, t3, t4) %>%
922+
pivot_longer(
923+
cols = starts_with("t"),
924+
names_to = "timepoint",
925+
values_to = "value") %>%
926+
mutate(
927+
time = as.integer(substr(timepoint, 2, 2)) # extract number from "t1", "t2", etc.
928+
)
929+
930+
ggplot(
931+
data = individual_trajectories,
932+
mapping = aes(
933+
x = time,
934+
y = value,
935+
group = factor(id))) +
936+
xlab("Timepoint") +
937+
ylab("Score") +
938+
scale_y_continuous(
939+
limits = c(-10, 20)) +
940+
geom_line()
941+
```
942+
943+
#### Individuals' Trajectories Overlaid with Prototypical Trajectory
944+
945+
```{r}
946+
ggplot() +
947+
geom_line( # individuals' model-implied trajectories
948+
data = individual_trajectories,
949+
aes(
950+
x = time,
951+
y = value,
952+
group = id),
953+
) +
954+
geom_line( # prototypical trajectory
955+
data = newData,
956+
aes(
957+
x = time,
958+
y = predictedValue),
959+
color = "blue",
960+
linewidth = 2
961+
)
962+
```
963+
662964
## Spline Growth Curve Model {#splineLGCM}
663965

664966
## Saturated Growth Curve Model {#saturatedGCM}

0 commit comments

Comments
 (0)