Skip to content

Commit 5112990

Browse files
isaactpetersenisaactpetersen
committed
20260410 - figures from accelerated longitudinal study
1 parent 689a2f7 commit 5112990

1 file changed

Lines changed: 213 additions & 0 deletions

File tree

‎hlm.qmd‎

Lines changed: 213 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -696,6 +696,8 @@ splineGCM_re
696696

697697
Per Hoffman ([here](https://www.cilvr.umd.edu/Conference2010/CILVRposts2010/Hoffman_post.pdf), archived at <https://perma.cc/6X8R-EX44>; and [here](https://www.lesahoffman.com/PSQF7375_AdvLong/PSQF7375_AdvLong_Lecture3_AltTime.pdf), archived at <https://perma.cc/25JY-JE8P>), use age at baseline (i.e., T1; or birth year) instead of mean age to lessen bias from attrition‐related missing data.
698698

699+
#### Linear
700+
699701
```{r}
700702
acceleratedLongitudinalMixedModel_linear <- lmer(
701703
math ~ timeInStudy*sex*ageAtT1Centered + (1 + timeInStudy | id),
@@ -712,6 +714,113 @@ print(effectsize::standardize_parameters(
712714
digits = 2)
713715
```
714716

717+
```{r}
718+
#mydata %>%
719+
# ungroup() %>%
720+
# filter(timepoint == 1) %>%
721+
# mutate( # if we had date of birth, we could compute birth cohort (e.g., birth year), #if we had time of measurement, we could compute period (e.g., year) at T1
722+
# ageAtT1 = ageYears, # use age at baseline (T1) or birth year to reduce bias from #attrition-related missing data
723+
# ageAtT1Centered = ageAtT1 - min(ageAtT1, na.rm = TRUE),
724+
# ageAtT1CenteredSquared = ageAtT1Centered ^ 2) %>%
725+
# select(id, ageAtT1, ageAtT1Centered, ageAtT1CenteredSquared)
726+
```
727+
728+
##### Prototypical Growth Curve
729+
730+
```{r}
731+
newData <- unique(mydata[,c("ageYears","ageAtT1","timeInStudy")])
732+
733+
newData$ageAtT1Centered <- newData$ageAtT1 - min(mydata$ageAtT1, na.rm = TRUE)
734+
735+
newData <- tidyr::expand_grid(
736+
newData,
737+
female = c(0, 1)
738+
)
739+
740+
newData$sex <- NA
741+
newData$sex[which(newData$female == 0)] <- "male"
742+
newData$sex[which(newData$female == 1)] <- "female"
743+
newData$sex <- as.factor(newData$sex)
744+
745+
newData$predictedValue <- predict( # predict.merMod
746+
acceleratedLongitudinalMixedModel_linear,
747+
newdata = newData,
748+
re.form = NA
749+
)
750+
751+
ggplot(
752+
data = newData,
753+
mapping = aes(
754+
x = ageYears,
755+
y = predictedValue,
756+
color = sex)) +
757+
geom_smooth() + #for jagged line: geom_line()
758+
labs(
759+
x = "Age (years)",
760+
y = "Math Score",
761+
color = "Sex"
762+
) +
763+
theme_classic()
764+
```
765+
766+
##### Individuals' Growth Curves
767+
768+
```{r}
769+
mydata$predictedValue <- predict(
770+
acceleratedLongitudinalMixedModel_linear,
771+
newdata = mydata,
772+
re.form = NULL
773+
)
774+
775+
ggplot(
776+
data = mydata,
777+
mapping = aes(
778+
x = ageYears,
779+
y = predictedValue,
780+
group = id,
781+
color = sex)) +
782+
geom_line(
783+
alpha = 0.4
784+
) +
785+
labs(
786+
x = "Age (years)",
787+
y = "Math Score",
788+
color = "Sex"
789+
) +
790+
theme_classic()
791+
```
792+
793+
##### Individuals' Trajectories Overlaid with Prototypical Trajectory
794+
795+
```{r}
796+
ggplot(
797+
data = mydata,
798+
mapping = aes(
799+
x = ageYears,
800+
y = predictedValue,
801+
group = id)) +
802+
geom_line( # individuals' trajectories
803+
color = "gray",
804+
alpha = 0.5
805+
) +
806+
geom_smooth( # prototypical trajectory
807+
data = newData,
808+
mapping = aes(
809+
x = ageYears,
810+
y = predictedValue,
811+
group = sex,
812+
color = sex),
813+
linewidth = 2) +
814+
labs(
815+
x = "Age (years)",
816+
y = "Math Score",
817+
color = "Sex"
818+
) +
819+
theme_classic()
820+
```
821+
822+
#### Quadratic
823+
715824
```{r}
716825
acceleratedLongitudinalMixedModel_quadratic <- lmer(
717826
math ~ timeInStudy*sex*ageAtT1Centered + timeInStudySquared*sex*ageAtT1Centered + ageAtT1CenteredSquared + (1 + timeInStudy | id),
@@ -728,6 +837,110 @@ print(effectsize::standardize_parameters(
728837
digits = 2)
729838
```
730839

840+
##### Prototypical Growth Curve
841+
842+
```{r}
843+
newData <- unique(mydata[,c("ageYears","ageAtT1","timeInStudy")])
844+
845+
newData$ageAtT1Centered <- newData$ageAtT1 - min(mydata$ageAtT1, na.rm = TRUE)
846+
newData$timeInStudySquared <- newData$timeInStudy ^ 2
847+
newData$ageAtT1CenteredSquared <- newData$ageAtT1Centered ^2
848+
849+
newData <- tidyr::expand_grid(
850+
newData,
851+
female = c(0, 1)
852+
)
853+
854+
newData$sex <- NA
855+
newData$sex[which(newData$female == 0)] <- "male"
856+
newData$sex[which(newData$female == 1)] <- "female"
857+
newData$sex <- as.factor(newData$sex)
858+
859+
newData$predictedValue <- predict( # predict.merMod
860+
acceleratedLongitudinalMixedModel_quadratic,
861+
newdata = newData,
862+
re.form = NA
863+
)
864+
865+
ggplot(
866+
data = newData,
867+
mapping = aes(
868+
x = ageYears,
869+
y = predictedValue,
870+
color = sex)) +
871+
geom_smooth() + #for jagged line: geom_line()
872+
labs(
873+
x = "Age (years)",
874+
y = "Math Score",
875+
color = "Sex"
876+
) +
877+
theme_classic()
878+
```
879+
880+
##### Individuals' Growth Curves
881+
882+
```{r}
883+
mydata$predictedValue <- predict(
884+
acceleratedLongitudinalMixedModel_quadratic,
885+
newdata = mydata,
886+
re.form = NULL
887+
)
888+
889+
ggplot(
890+
data = mydata,
891+
mapping = aes(
892+
x = ageYears,
893+
y = predictedValue,
894+
group = id,
895+
color = sex)) +
896+
geom_smooth(
897+
method = "lm",
898+
formula = y ~ x + I(x^2),
899+
se = FALSE,
900+
linewidth = 0.5,
901+
alpha = 0.4
902+
) +
903+
labs(
904+
x = "Age (years)",
905+
y = "Math Score",
906+
color = "Sex"
907+
) +
908+
theme_classic()
909+
```
910+
911+
##### Individuals' Trajectories Overlaid with Prototypical Trajectory
912+
913+
```{r}
914+
ggplot(
915+
data = mydata,
916+
mapping = aes(
917+
x = ageYears,
918+
y = predictedValue,
919+
group = id)) +
920+
geom_smooth( # individuals' trajectories
921+
method = "lm",
922+
formula = y ~ x + I(x^2),
923+
se = FALSE,
924+
linewidth = 0.4,
925+
color = "gray",
926+
alpha = 0.5
927+
) +
928+
geom_smooth( # prototypical trajectory
929+
data = newData,
930+
mapping = aes(
931+
x = ageYears,
932+
y = predictedValue,
933+
group = sex,
934+
color = sex),
935+
linewidth = 2) +
936+
labs(
937+
x = "Age (years)",
938+
y = "Math Score",
939+
color = "Sex"
940+
) +
941+
theme_classic()
942+
```
943+
731944
# Generalized Linear Mixed Models {#sec-generalized}
732945

733946
<https://bbolker.github.io/mixedmodels-misc/glmmFAQ.html> (archived at <https://perma.cc/9RFS-BCE7>; source code: <https://github.com/bbolker/mixedmodels-misc/blob/master/glmmFAQ.rmd>)

0 commit comments

Comments
 (0)