-
Notifications
You must be signed in to change notification settings - Fork 1
Expand file tree
/
Copy path22-lta-cov.Rmd
More file actions
814 lines (596 loc) · 25.9 KB
/
Copy path22-lta-cov.Rmd
File metadata and controls
814 lines (596 loc) · 25.9 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE,
warning = FALSE,
message = FALSE) #Here, I have made it so that when you knit your .rmd, warnings and messages will not show up in the html markdown.
```
# Adding Covariates
--------------------------------------------------------------------------------------
**Data Source**: The data used to illustrate these analyses include elementary school student *Science Attitude* survey items collected during 7th and 10th grades from the **Longitudinal Study of American Youth** (LSAY; Miller, 2015).
--------------------------------------------------------------------------------------
To install package {`rhdf5`}
```{r}
if (!requireNamespace("BiocManager", quietly = TRUE))
install.packages("BiocManager")
#BiocManager::install("rhdf5")
```
*Load packages*
```{r, eval=TRUE}
library(MplusAutomation)
library(rhdf5)
library(tidyverse)
library(here)
library(glue)
library(janitor)
library(gt)
library(reshape2)
library(cowplot)
library(ggrepel)
library(haven)
library(modelsummary)
library(corrplot)
library(DiagrammeR)
library(filesstrings)
library(PNWColors)
```
--------------------------------------------------------------------------------------
Read in LSAY data file, `lsay_new.csv`.
```{r, eval=TRUE}
lsay_data <- read_csv(here("data","lsay_lta.csv"), na = c("9999")) %>%
mutate(across(everything(), as.numeric))
```
--------------------------------------------------------------------------------------
```{r, echo = FALSE}
grViz(" digraph model {
graph [layout = dot, overlap = true]
node [shape=box]
ab39m ab39t ab39u ab39w ab39x
ga33a ga33h ga33i ga33k ga33l;
node [shape=circle, fixedsize = true, width = 1.5, height = 0.5]
T1 [label = '7th Grade \nScience Attitudes\n(T1)']
T2 [label = '10th Grade \nScience Attitudes\n(T2)']
edge []
T1 -> {ab39m ab39t ab39u ab39w ab39x}
T2 -> {ga33a ga33h ga33i ga33k ga33l}
T1 -> T2
{rank = same; T1; T2;}
}")
```
--------------------------------------------------------------------------------------
## Descriptive Statistics
--------------------------------------------------------------------------------------
### Data Summary
```{r}
data <- lsay_data
select_data <- data %>%
select(female, minority, ab39m:ga33l)
f <- All(select_data) ~ Mean + SD + Min + Median + Max + Histogram
datasummary(f, data, output="markdown")
```
--------------------------------------------------------------------------------------
## Adding Covariates
Continuing from the previous section \@ref(lta), we use the ML three-step method to estimate LTA models with predictors and distal outcomes). Estimate the unconditional model for each latent variable with the predictors included in the `auxiliary` option for at least one of the models.
Covariates
- `sci_issues7`: Interest in science issues (1 = Not at all interested, 2 = Moderately Interested, 3 = Very interested)
- `sci_irt7`: 7th Grade Science IRT Score (Continuous)
- `female`: Gender (0 = Male, 1 = Female)
--------------------------------------------------------------------------------------
### Step 1 - Estimate Unconditional Model w/ Auxiliary Specification
*7th Grade*
```{r, eval = FALSE}
step1 <- mplusObject(
TITLE = "Step 1 - T1",
VARIABLE =
"usevar = ab39m ab39t ab39u ab39w ab39x;
categorical = ab39m ab39t ab39u ab39w ab39x;
classes = c(4);
auxiliary = sci_issues7 sci_irt7 female;
idvariable = casenum;",
ANALYSIS =
"estimator = mlr;
type = mixture;
starts = 0;
optseed = 534483;",
SAVEDATA =
"File=3step_t1.dat;
Save=cprob;",
OUTPUT = "residual tech11 tech14 svalues",
PLOT =
"type = plot3;
series = ab39m-ab39x(*);",
usevariables = colnames(lsay_data),
rdata = lsay_data)
step1_fit <- mplusModeler(step1,
dataout=here("lta","cov_model","t1.dat"),
modelout=here("lta","cov_model","one_T1.inp") ,
check=TRUE, run = TRUE, hashfilename = FALSE)
```
------------------------------------------------------------------------
*10th Grade*
```{r, eval = FALSE}
step1 <- mplusObject(
TITLE = "Step 1 - T1",
VARIABLE =
"usevar = ga33a ga33h ga33i ga33k ga33l;
categorical = ga33a ga33h ga33i ga33k ga33l;
classes = c(4);
!auxiliary = sci_issues7 sci_irt7 female;
idvariable = casenum;",
ANALYSIS =
"estimator = mlr;
type = mixture;
starts = 0;
optseed = 392418;",
SAVEDATA =
"File=3step_t2.dat;
Save=cprob;",
OUTPUT = "residual tech11 tech14 svalues",
PLOT =
"type = plot3;
series = ga33a-ga33l(*);",
usevariables = colnames(lsay_data),
rdata = lsay_data)
step1_fit <- mplusModeler(step1,
dataout=here("lta","cov_model","t2.dat"),
modelout=here("lta","cov_model","one_T2.inp") ,
check=TRUE, run = TRUE, hashfilename = FALSE)
```
------------------------------------------------------------------------
`plot_lca_function` requires 5 arguments:
- `model_name`: name of Mplus model object (e.g., `model_t1_c4`)
- `item_num`: the number of items in LCA measurement model (e.g., `5`)
- `class_num`: the number of classes (*k*) in LCA model (e.g., `4`)
- `item_labels`: the item labels for x-axis (e.g., `c("Enjoy","Useful","Logical","Job","Adult")`)
- `plot_title`: include the title of the plot here (e.g., `"Time 1 LCA Conditional Item Probability Plot"`)
```{r, eval=TRUE}
plot_lca_function <- function(model_name,item_num,class_num,item_labels,plot_title){
mplus_model <- as.data.frame(model_name$gh5$means_and_variances_data$estimated_probs$values)
plot_t1 <- mplus_model[seq(2, 2*item_num, 2),]
c_size <- as.data.frame(model_name$class_counts$modelEstimated$proportion)
colnames(c_size) <- paste0("cs")
c_size <- c_size %>% mutate(cs = round(cs*100, 2))
colnames(plot_t1) <- paste0("C", 1:class_num, glue(" ({c_size[1:class_num,]}%)"))
plot_t1 <- cbind(Var = paste0("U", 1:item_num), plot_t1)
plot_t1$Var <- factor(plot_t1$Var,
labels = item_labels)
plot_t1$Var <- fct_inorder(plot_t1$Var)
pd_long_t1 <- melt(plot_t1, id.vars = "Var")
p <- pd_long_t1 %>%
ggplot(aes(x = as.integer(Var), y = value,
shape = variable, colour = variable, lty = variable)) +
geom_point(size = 4) + geom_line() +
scale_x_continuous("", breaks = 1:5, labels = plot_t1$Var) +
scale_colour_grey() +
labs(title = plot_title, y = "Probability") +
theme_cowplot() +
theme(legend.title = element_blank(),
legend.position = "top")
p
return(p)
}
```
Plot Time 1
```{r, eval=TRUE, fig.height=6, fig.width=10}
output_T1 <- readModels(here("lta","cov_model","one_T1.out"))
plot_lca_function(
model_name = output_T1,
item_num = 5,
class_num = 4,
item_labels = c("Enjoy","Useful","Logical","Job","Adult"),
plot_title = "Time 1 LCA Conditional Item Probability Plot"
)
```
Plot Time 2
```{r, eval=TRUE, fig.height=6, fig.width=10}
output_T2 <- readModels(here("lta","cov_model","one_T2.out"))
plot_lca_function(
model_name = output_T2,
item_num = 5,
class_num = 4,
item_labels = c("Enjoy","Useful","Logical","Job","Adult"),
plot_title = "Time 2 LCA Conditional Item Probability Plot"
)
```
------------------------------------------------------------------------
### Step 2 - Determine Measurement Error
Extract logits for the classification probabilities for the most likely latent class:
```{r, eval = FALSE}
logit_cprobs_T1 <- as.data.frame(output_T1[["class_counts"]]
[["logitProbs.mostLikely"]])
logit_cprobs_T2 <- as.data.frame(output_T2[["class_counts"]]
[["logitProbs.mostLikely"]])
```
Extract saved dataset:
```{r, eval = FALSE}
savedata_T1 <- as.data.frame(output_T1[["savedata"]])
savedata_T2 <- as.data.frame(output_T2[["savedata"]])
```
Rename the column in savedata named "C" and change to "N"
```{r, eval = FALSE}
colnames(savedata_T1)[colnames(savedata_T1)=="C"] <- "N_T1"
colnames(savedata_T2)[colnames(savedata_T2)=="C"] <- "N_T2"
savedata <- savedata_T1 %>%
full_join(savedata_T2, by = "CASENUM")
```
------------------------------------------------------------------------
### Step 3 - Add Auxiliary Variables
Here, we add covariates and distal outcomes to the overall model statement. This specifies the overall relationship between observed covariates and the latent classes at cross sectional timepoints.
```{r, eval = FALSE}
step3 <- mplusObject(
TITLE = "ML Three Step LTA Model",
VARIABLE =
"nominal=N_T1 N_T2;
usevar = N_T1 N_T2 SCI_IRT7 FEMALE;
classes = c1(4) c2(4);" ,
ANALYSIS =
"estimator = mlr;
type = mixture;
starts = 0;",
MODEL =
glue(
" %OVERALL%
c2 on c1;
c1 c2 on SCI_IRT7 FEMALE;
MODEL c1:
%c1#1%
[N_T1#1@{logit_cprobs_T1[1,1]}];
[N_T1#2@{logit_cprobs_T1[1,2]}];
[N_T1#3@{logit_cprobs_T1[1,3]}];
%c1#2%
[N_T1#1@{logit_cprobs_T1[2,1]}];
[N_T1#2@{logit_cprobs_T1[2,2]}];
[N_T1#3@{logit_cprobs_T1[2,3]}];
%c1#3%
[N_T1#1@{logit_cprobs_T1[3,1]}];
[N_T1#2@{logit_cprobs_T1[3,2]}];
[N_T1#3@{logit_cprobs_T1[3,3]}];
%c1#4%
[N_T1#1@{logit_cprobs_T1[4,1]}];
[N_T1#2@{logit_cprobs_T1[4,2]}];
[N_T1#3@{logit_cprobs_T1[4,3]}];
MODEL c2:
%c2#1%
[N_T2#1@{logit_cprobs_T2[1,1]}];
[N_T2#2@{logit_cprobs_T2[1,2]}];
[N_T2#3@{logit_cprobs_T2[1,3]}];
%c2#2%
[N_T2#1@{logit_cprobs_T2[2,1]}];
[N_T2#2@{logit_cprobs_T2[2,2]}];
[N_T2#3@{logit_cprobs_T2[2,3]}];
%c2#3%
[N_T2#1@{logit_cprobs_T2[3,1]}];
[N_T2#2@{logit_cprobs_T2[3,2]}];
[N_T2#3@{logit_cprobs_T2[3,3]}];
%c2#4%
[N_T2#1@{logit_cprobs_T2[4,1]}];
[N_T2#2@{logit_cprobs_T2[4,2]}];
[N_T2#3@{logit_cprobs_T2[4,3]}];"),
OUTPUT = "tech15;",
usevariables = colnames(savedata),
rdata = savedata)
step3_fit <- mplusModeler(step3,
dataout=here("lta","cov_model","three.dat"),
modelout=here("lta","cov_model","three.inp"),
check=TRUE, run = TRUE, hashfilename = FALSE)
```
------------------------------------------------------------------------
#### LTA Transition Plot
This code is adapted from the source code for the `plotLTA` function found in the [\textcolor{blue}{MplusAutomation package}](https://github.com/michaelhallquist/MplusAutomation/blob/995d1ecfae3656524153456ce647f86fe8c1cf1e/R/mixtures.R)
**NOTE:** The function found in `plot_transitions_function.R` is specific to a model with 2 time-points and 4-classes & must be updated to accommodate other models.
```{r,eval=TRUE, fig.height = 7, fig.width = 8}
source(here("functions","plot_transitions_function.R"))
lta_model <- readModels(here("lta","cov_model","three.out"))
plot_transitions_function(
model_name = lta_model,
color_pallete = pnw_palette("Bay", n=4, type = "discrete"),
facet_labels =c(
`1` = "Transitions to 10th Grade from the Pro-Science w/ Elevated Utility Class",
`2` = "Transitions to 10th Grade from the Ambivalent w/ Elevated Utility Class",
`3` = "Transitions to 10th Grade from the Ambivalent w/ Minimal Utility Class",
`4` = "Transitions to 10th Grade from the Anti-Science w/ Minimal Utility Class"),
timepoint_labels = c('1' = "7th Grade", '2' = "10th Grade"),
class_labels = c(
"Pro-Science",
"Amb. / Elev. Utility",
"Amb. / Min. Utility",
"Anti-Science")
)
```
Table:
Transition probability across classes can also be described using a table, or transition matrix. The table shows the 7th grade classes by 10th grade latent class, with the cells represented the overall transition.
```{r}
lta_prob <- as.data.frame(lta_model$class_counts$transitionProbs$probability)
t_matrix <- tibble(
"7th Grade" = c("Pro-Science","Amb. / Elev. Utility","Amb. / Min. Utility","Anti-Science"),
"Pro-Science" = c(lta_prob[1,1],lta_prob[2,1],lta_prob[3,1],lta_prob[4,1]),
"Amb. / Elev. Utility" = c(lta_prob[5,1],lta_prob[6,1],lta_prob[7,1],lta_prob[8,1]),
"Amb. / Min. Utility" = c(lta_prob[9,1],lta_prob[10,1],lta_prob[11,1],lta_prob[12,1]),
"Anti-Science" = c(lta_prob[13,1],lta_prob[14,1],lta_prob[15,1],lta_prob[16,1]))
t_matrix %>%
gt(rowname_col = "7th Grade") %>%
tab_stubhead(label = "7th Grade") %>%
tab_header(
title = md("**Transition Probabilities**")) %>%
fmt_number(2:5,decimals = 2) %>%
tab_spanner(label = "10th Grade",columns = 2:5)#%>%
#gtsave("matrix.docx")
```
------------------------------------------------------------------------
#### Covariate Table
The covariate table shows the relationship between covariate (gender) and distal outcome (IRT score) and latent classes for both cross sectional timepoints.
```{r}
# REFERENCE CLASS 4
cov <- as.data.frame(lta_model[["parameters"]][["unstandardized"]]) %>%
filter(param %in% c("SCI_IRT7", "FEMALE")) %>%
mutate(param = case_when(
param == "SCI_IRT7" ~ "Science IRT Score",
param == "FEMALE" ~ "Gender"),
se = paste0("(", format(round(se,2), nsmall =2), ")")) %>%
separate(paramHeader, into = c("Time", "Class"), sep = "#") %>%
mutate(Class = case_when(
Class == "1.ON" ~ "Pro-Science",
Class == "2.ON" ~ "Amb. / Elev. Utility",
Class == "3.ON" ~ "Amb. / Min. Utility"),
Time = case_when(
Time == "C1" ~ "7th Grade (T1)",
Time == "C2" ~ "10th Grade (T2)",
)
) %>%
unite(estimate, est, se, sep = " ") %>%
select(Time:pval, -est_se) %>%
mutate(pval = ifelse(pval<0.001, paste0("<.001*"),
ifelse(pval<0.05, paste0(scales::number(pval, accuracy = .001), "*"),
scales::number(pval, accuracy = .001))))
# Create table
cov_m1 <- cov %>%
group_by(param, Class) %>%
gt() %>%
tab_header(
title = "Relations Between the Covariates and Latent Class") %>%
tab_footnote(
footnote = md(
"Reference Group: Anti-Science"
),
locations = cells_title()
) %>%
cols_label(
param = md("Covariate"),
estimate = md("Estimate (*se*)"),
pval = md("*p*-value")) %>%
sub_missing(1:3,
missing_text = "") %>%
sub_values(values = c(999.000), replacement = "-") %>%
cols_align(align = "center") %>%
opt_align_table_header(align = "left") %>%
gt::tab_options(table.font.names = "serif")
cov_m1
```
------------------------------------------------------------------------
#### Manually calculate transition probabilities by covariate
Optionally, transition probabilities can be calculated for each level of the covariate. For example, transition probabilities for males or females only, depending on the research question.
```{r, eval = FALSE}
step3 <- mplusObject(
TITLE = "LTA (invariant)",
VARIABLE =
"usevar = ab39m ab39t ab39u ab39w ab39x ! 7th grade indicators
ga33a ga33h ga33i ga33k ga33l FEMALE;
categorical = ab39m-ab39x ga33a-ga33l;
classes = c1(4) c2(4);" ,
ANALYSIS =
"estimator = mlr;
type = mixture;
starts = 500 100;
processors = 10;",
MODEL =
"%overall%
c2 c1 on FEMALE;
c2#1 on c1#1 (b11);
c2#2 on c1#1 (b21);
c2#3 on c1#1 (b31);
c2#1 on c1#2 (b12);
c2#2 on c1#2 (b22);
c2#3 on c1#2 (b32);
c2#1 on c1#3 (b13);
c2#2 on c1#3 (b23);
c2#3 on c1#3 (b33);
[c2#1] (a1);
[c2#2] (a2);
[c2#3] (a3);
c2#1 ON female (b212);
c2#2 ON female (b222);
c2#3 ON female (b232);
c1#1 ON female (b112);
c1#2 ON female (b122);
c1#3 ON female (b132);
MODEL c1:
%c1#1%
[AB39M$1-AB39X$1] (1-5); !!! labels that are repeated will constrain parameters to equality !!!
%c1#2%
[AB39M$1-AB39X$1] (6-10);
%c1#3%
[AB39M$1-AB39X$1] (11-15);
%c1#4%
[AB39M$1-AB39X$1] (16-20);
MODEL c2:
%c2#1%
[GA33A$1-GA33L$1] (1-5);
%c2#2%
[GA33A$1-GA33L$1] (6-10);
%c2#3%
[GA33A$1-GA33L$1] (11-15);
%c2#4%
[GA33A$1-GA33L$1] (16-20);",
OUTPUT = "tech1 tech15 svalues;",
MODELCONSTRAINT = " ! Compute joint and marginal probabilities:
New(
t11 t12 t13 t14
t21 t22 t23 t24
t31 t32 t33 t34
t41 t42 t43 t44
t11B t12B t13B t14B
t21B t22B t23B t24B
t31B t32B t33B t34B
t41B t42B t43B t44B
diff_11_22 x
);
t11 = exp(a1 +b11)/(exp(a1+b11)+exp(a2+b21)+exp(a3+b31)+exp(0));
t12 = exp(a2 +b21)/(exp(a1+b11)+exp(a2+b21)+exp(a3+b31)+exp(0));
t13 = exp(a3 +b31)/(exp(a1+b11)+exp(a2+b21)+exp(a3+b31)+exp(0));
t14 = 1 - (t11+t12+t13);
t21 = exp(a1 +b12)/(exp(a1+b12)+exp(a2+b22)+exp(a3+b32)+exp(0));
t22 = exp(a2 +b22)/(exp(a1+b12)+exp(a2+b22)+exp(a3+b32)+exp(0));
t23 = exp(a3 +b32)/(exp(a1+b12)+exp(a2+b22)+exp(a3+b32)+exp(0));
t24 = 1 - (t21+t22+t23);
t31 = exp(a1 +b13)/(exp(a1+b13)+exp(a2+b23)+exp(a3+b33)+exp(0));
t32 = exp(a2 +b23)/(exp(a1+b13)+exp(a2+b23)+exp(a3+b33)+exp(0));
t33 = exp(a3 +b33)/(exp(a1+b13)+exp(a2+b23)+exp(a3+b33)+exp(0));
t34 = 1 - (t31+t32+t33);
t41 = exp(a1)/(exp(a1)+exp(a2)+exp(a3)+exp(0));
t42 = exp(a2)/(exp(a1)+exp(a2)+exp(a3)+exp(0));
t43 = exp(a3)/(exp(a1)+exp(a2)+exp(a3)+exp(0));
t44 = 1 - (t41+t42+t43);
!c1#3 ON female (b132);
x= 1 ; ! x=1 is female, x=0 males
t11B = exp(a1 +b11+b212*x)/(exp(a1+b11+b212*x)+exp(a2+b21+b222*x)+exp(a3+b31+b232*x)
+exp(0));
t12B = exp(a2 +b21+b222*x)/(exp(a1+b11+b212*x)+exp(a2+b21+b222*x)+exp(a3+b31+b232*x)
+exp(0));
t13B = exp(a3 +b31+b232*x)/(exp(a1+b11+b212*x)+exp(a2+b21+b222*x)+exp(a3+b31+b232*x)
+exp(0));
t14B = 1 - (t11B+t12B+t13B);
t21B = exp(a1 +b12+b212*x)/(exp(a1+b12+b212*x)+exp(a2+b22+b222*x)+exp(a3+b32+b232*x)
+exp(0));
t22B = exp(a2 +b22+b222*x)/(exp(a1+b12+b212*x)+exp(a2+b22+b222*x)+exp(a3+b32+b232*x)
+exp(0));
t23B = exp(a3 +b32+b232*x)/(exp(a1+b12+b212*x)+exp(a2+b22+b222*x)+exp(a3+b32+b232*x)
+exp(0));
t24B = 1 - (t21B+t22B+t23B);
t31B = exp(a1 +b13+b212*x)/(exp(a1+b13+b212*x)+exp(a2+b23+b222*x)+exp(a3+b33+b232*x)
+exp(0));
t32B = exp(a2 +b23+b222*x)/(exp(a1+b13+b212*x)+exp(a2+b23+b222*x)+exp(a3+b33+b232*x)
+exp(0));
t33B = exp(a3 +b33+b232*x)/(exp(a1+b13+b212*x)+exp(a2+b23+b222*x)+exp(a3+b33+b232*x)
+exp(0));
t34B = 1 - (t31B+t32B+t33B);
t41B = exp(a1+b212*x)/(exp(a1+b212*x)+exp(a2+b222*x)+exp(a3+b232*x)+exp(0));
t42B = exp(a2+b222*x)/(exp(a1+b212*x)+exp(a2+b222*x)+exp(a3+b232*x)+exp(0));
t43B = exp(a3+b232*x)/(exp(a1+b212*x)+exp(a2+b222*x)+exp(a3+b232*x)+exp(0));
t44B = 1 - (t41B+t42B+t43B);
diff_11_22= t11-t11B;",
usevariables = colnames(savedata),
rdata = savedata)
step3_fit <- mplusModeler(step3,
dataout=here("lta","cov_model","calc_tran.dat"),
modelout=here("lta","cov_model","calc_tran.inp"),
check=TRUE, run = TRUE, hashfilename = FALSE)
```
Read invariance model and extract parameters (intercepts and multinomial regression coefficients)
```{r, eval=TRUE}
lta_inv1 <- readModels(here("lta","cov_model","calc_tran.out" ), quiet = TRUE)
par <- as_tibble(lta_inv1[["parameters"]][["unstandardized"]]) %>%
select(1:3) %>%
filter(grepl('ON|Means|Intercept', paramHeader)) %>%
mutate(est = as.numeric(est),
label = c("b11", "b12", "b13", "b21", "b22", "b23", "b31", "b32", "b33", "b212", "b222", "b232", "b112", "b122", "b132", "a11", "a21", "a31", "a12", "a22", "a32"))
```
Manual method to calculate transition probabilities by covariate:
```{r, eval=TRUE}
# Name each parameter individually to make the subsequent calculations more readable
a1 <- unlist(par[19,3]);
a2 <- unlist(par[20,3]);
a3 <- unlist(par[21,3]);
b11 <- unlist(par[1,3]);
b21 <- unlist(par[4,3]);
b31 <- unlist(par[7,3]);
b12 <- unlist(par[2,3]);
b22 <- unlist(par[5,3]);
b32 <- unlist(par[8,3]);
b13 <- unlist(par[3,3]);
b23 <- unlist(par[6,3]);
b33 <- unlist(par[9,3]);
b212 <- unlist(par[10,3]);
b222 <- unlist(par[11,3]);
b232 <- unlist(par[12,3]);
b112 <- unlist(par[13,3]);
b122 <- unlist(par[14,3]);
b132 <- unlist(par[15,3]);
x <- 0 # x=1 is female, x=0 males
# Calculate transition probabilities from the logit parameters
t11B <- exp(a1 + b11 + b212*x) / (exp(a1 + b11 + b212*x) + exp(a2 + b21 + b222*x) + exp(a3 + b31 + b232*x) + exp(0))
t12B <- exp(a2 + b21 + b222*x) / (exp(a1 + b11 + b212*x) + exp(a2 + b21 + b222*x) + exp(a3 + b31 + b232*x) + exp(0))
t13B <- exp(a3 + b31 + b232*x) / (exp(a1 + b11 + b212*x) + exp(a2 + b21 + b222*x) + exp(a3 + b31 + b232*x) + exp(0))
t14B <- 1 - (t11B + t12B + t13B)
t21B <- exp(a1 + b12 + b212*x) / (exp(a1 + b12 + b212*x) + exp(a2 + b22 + b222*x) + exp(a3 + b32 + b232*x) + exp(0))
t22B <- exp(a2 + b22 + b222*x) / (exp(a1 + b12 + b212*x) + exp(a2 + b22 + b222*x) + exp(a3 + b32 + b232*x) + exp(0))
t23B <- exp(a3 + b32 + b232*x) / (exp(a1 + b12 + b212*x) + exp(a2 + b22 + b222*x) + exp(a3 + b32 + b232*x) + exp(0))
t24B <- 1 - (t21B + t22B + t23B)
t31B <- exp(a1 + b13 + b212*x) / (exp(a1 + b13 + b212*x) + exp(a2 + b23 + b222*x) + exp(a3 + b33 + b232*x) + exp(0))
t32B <- exp(a2 + b23 + b222*x) / (exp(a1 + b13 + b212*x) + exp(a2 + b23 + b222*x) + exp(a3 + b33 + b232*x) + exp(0))
t33B <- exp(a3 + b33 + b232*x) / (exp(a1 + b13 + b212*x) + exp(a2 + b23 + b222*x) + exp(a3 + b33 + b232*x) + exp(0))
t34B <- 1 - (t31B + t32B + t33B)
t41B <- exp(a1 + b212*x) / (exp(a1 + b212*x) + exp(a2 + b222*x) + exp(a3 + b232*x) + exp(0))
t42B <- exp(a2 + b222*x) / (exp(a1 + b212*x) + exp(a2 + b222*x) + exp(a3 + b232*x) + exp(0))
t43B <- exp(a3 + b232*x) / (exp(a1 + b212*x) + exp(a2 + b222*x) + exp(a3 + b232*x) + exp(0))
t44B <- 1 - (t41B + t42B + t43B)
x <- 1 # x=1 is female, x=0 males
# Calculate transition probabilities from the logit parameters
t11 <- exp(a1 + b11 + b212*x) / (exp(a1 + b11 + b212*x) + exp(a2 + b21 + b222*x) + exp(a3 + b31 + b232*x) + exp(0))
t12 <- exp(a2 + b21 + b222*x) / (exp(a1 + b11 + b212*x) + exp(a2 + b21 + b222*x) + exp(a3 + b31 + b232*x) + exp(0))
t13 <- exp(a3 + b31 + b232*x) / (exp(a1 + b11 + b212*x) + exp(a2 + b21 + b222*x) + exp(a3 + b31 + b232*x) + exp(0))
t14 <- 1 - (t11 + t12 + t13)
t21 <- exp(a1 + b12 + b212*x) / (exp(a1 + b12 + b212*x) + exp(a2 + b22 + b222*x) + exp(a3 + b32 + b232*x) + exp(0))
t22 <- exp(a2 + b22 + b222*x) / (exp(a1 + b12 + b212*x) + exp(a2 + b22 + b222*x) + exp(a3 + b32 + b232*x) + exp(0))
t23 <- exp(a3 + b32 + b232*x) / (exp(a1 + b12 + b212*x) + exp(a2 + b22 + b222*x) + exp(a3 + b32 + b232*x) + exp(0))
t24 <- 1 - (t21 + t22 + t23)
t31 <- exp(a1 + b13 + b212*x) / (exp(a1 + b13 + b212*x) + exp(a2 + b23 + b222*x) + exp(a3 + b33 + b232*x) + exp(0))
t32 <- exp(a2 + b23 + b222*x) / (exp(a1 + b13 + b212*x) + exp(a2 + b23 + b222*x) + exp(a3 + b33 + b232*x) + exp(0))
t33 <- exp(a3 + b33 + b232*x) / (exp(a1 + b13 + b212*x) + exp(a2 + b23 + b222*x) + exp(a3 + b33 + b232*x) + exp(0))
t34 <- 1 - (t31 + t32 + t33)
t41 <- exp(a1 + b212*x) / (exp(a1 + b212*x) + exp(a2 + b222*x) + exp(a3 + b232*x) + exp(0))
t42 <- exp(a2 + b222*x) / (exp(a1 + b212*x) + exp(a2 + b222*x) + exp(a3 + b232*x) + exp(0))
t43 <- exp(a3 + b232*x) / (exp(a1 + b212*x) + exp(a2 + b222*x) + exp(a3 + b232*x) + exp(0))
t44 <- 1 - (t41 + t42 + t43)
```
Create table
### Create Transition Table
The table below shows the transition probabilities estimated for girls only. These are hand calculated in Mplus using the `OVERALL` section of the model and `Model Constraints` command.
```{r, eval=TRUE}
t_matrix <- tibble(
"Time1" = c("C1=Anti-Science","C1=Amb. w/ Elevated","C1=Amb. w/ Minimal","C1=Pro-Science"),
"C2=Anti-Science" = c(t11,t21,t31,t41),
"C2=Amb. w/ Elevated" = c(t12,t22,t32,t42),
"C2=Amb. w/ Minimal" = c(t13,t23,t33,t43),
"C2=Pro-Science" = c(t14,t24,t34,t44))
t_matrix %>%
gt(rowname_col = "Time1") %>%
tab_stubhead(label = "7th grade") %>%
tab_header(
title = md("**FEMALES: Student transitions from 7th grade (rows) to 10th grade (columns)**")) %>%
fmt_number(2:5,decimals = 3) %>%
tab_spanner(label = "10th grade",columns = 2:5) %>%
tab_footnote(
footnote = md(
"*Note.* Transition matrix values are the identical to Table 5, however Table 5
has the values rearranged by class for interpretation purposes. Classes may be arranged
directly through Mplus syntax using start values."),
locations = cells_title())
t_matrix <- tibble(
"Time1" = c("C1=Anti-Science","C1=Amb. w/ Elevated","C1=Amb. w/ Minimal","C1=Pro-Science"),
"C2=Anti-Science" = c(t11B,t21B,t31B,t41B),
"C2=Amb. w/ Elevated" = c(t12B,t22B,t32B,t42B),
"C2=Amb. w/ Minimal" = c(t13B,t23B,t33B,t43B),
"C2=Pro-Science" = c(t14B,t24B,t34B,t44B))
t_matrix %>%
gt(rowname_col = "Time1") %>%
tab_stubhead(label = "7th grade") %>%
tab_header(
title = md("**MALES: Student transitions from 7th grade (rows) to 10th grade (columns)**")) %>%
fmt_number(2:5,decimals = 3) %>%
tab_spanner(label = "10th grade",columns = 2:5) %>%
tab_footnote(
footnote = md(
"*Note.* Transition matrix values are the identical to Table 5, however Table 5
has the values rearranged by class for interpretation purposes. Classes may be arranged
directly through Mplus syntax using start values."),
locations = cells_title())
```
<div style="text-align: center;"><img src="images/ucsb_logo.png" width="75%" /></div>