/
scriptCFM.R
400 lines (371 loc) · 19.5 KB
/
scriptCFM.R
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
#' A Function That Writes, Saves, and Exports Syntax for
#' Fitting Latent Common Fate Models (CFMs)
#'
#' This function takes the outputted object from scrapeVarCross()
#' and automatically writes, returns, and exports (.txt) lavaan() syntax
#' for specifying Common Fate Models (CFMs). Users can
#' also invoke configural, loading, and/or intercept invariant
#' measurement models, and particular types of structural comparisons.
#' @param dvn input dvn list from scrapeVarCross
#' @param scaleset input character to specify how to set the scale of the latent variable(s). Default is
#' "FF" (fixed-factor; see Details for rationale), but user can specify "MV" (Marker Variable)
#' @param lvxname input character to (arbitrarily) name LV X in lavaan syntax
#' @param lvyname input character to (arbitrarily) name LV Y in lavaan syntax
#' @param constr_dy_x_meas input character vector detailing which measurement model parameters to constrain across dyad members for latent X.
#' Default is c("loadings", "intercepts", "residuals"),
#' but user can specify any combination of "loadings", "intercepts", and "residuals",
#' #or "none" to specify an otherwise unconstrained dyadic configural invariance model
#' @param constr_dy_x_struct input character vector detailing which structural model parameters to constrain across dyad members for latent X.
#' Default is c("variances", "means"),
#' but user can specify any combination of "variances" and "means", or "none".
#' @param constr_dy_y_meas input character vector detailing which measurement model parameters to constrain across dyad members for latent X.
#' Default is c("loadings", "intercepts", "residuals"),
#' but user can specify any combination of "loadings", "intercepts", and "residuals",
#' #or "none" to specify an otherwise unconstrained dyadic configural invariance model
#' @param constr_dy_y_struct input character vector detailing which structural model parameters to constrain across dyad members for latent X.
#' Default is c("variances", "means"),
#' but user can specify any combination of "variances" and "means", or "none".
#' @param constr_dy_xy_struct input character vector detailing which structural model parameters to constrain for modeling the predictive association(s) between
#' partners' latent x and y. Defaults to "none". Options include "p1_zero" or "p2_zero" (to constrain within-person latent residual covariances between X and Y to zero), or
#' "covar_zero" (to constrain both within-person latent residual correlations to zero), and/or "dyadic_zero" (to constrain the dyadic effect to zero).
#' @param model Deprecated input character used to specify which level of invariance is
#' modeled. Users should rely upon constr_dy_x_meas/constr_dy_y_meas and
#' constr_dy_x_struct/constr_dy_y_struct instead, for making constraints to the measurement and/or structural portions of the model for latent x and y.
#' @param writeTo A character string specifying a directory path to where a .txt file of the resulting lavaan script should be written.
#' If set to “.”, the .txt file will be written to the current working directory.
#' The default is NULL, and examples use a temporary directory created by tempdir().
#' @param fileName A character string specifying a desired base name for the .txt output file.
#' The default is NULL. The specified name will be automatically appended with the .txt file extension.
#' If a file with the same name already exists in the user's chosen directory, it will be overwritten.
#' @return character object of lavaan script that can be passed immediately to
#' lavaan functions. Users will receive message if structural comparisons are specified
#' when the recommended level of invariance is not also specified. If user supplies dvn
#' with containing X or Y variables, they are alerted to respecify the dvn object.
#' @seealso \code{\link{scrapeVarCross}} which this function relies on
#' @family script-writing functions
#' @export
#' @examples
#' dvn <- scrapeVarCross(dat = commitmentQ, x_order = "spi", x_stem = "sat.g", x_delim1 = ".",
#' x_delim2="_", distinguish_1="1", distinguish_2="2",
#' y_order="spi", y_stem="com", y_delim1 = ".", y_delim2="_")
#' cfm.script.indist <- scriptCFM(dvn, lvxname = "Sat", lvyname = "Com",
#' writeTo = tempdir(),
#' fileName = "CFM_indist")
scriptCFM <- function(dvn, scaleset = "FF",
lvxname, lvyname,
constr_dy_x_meas = c("loadings", "intercepts", "residuals"),
constr_dy_x_struct = c("variances", "means"),
constr_dy_y_meas = c("loadings", "intercepts", "residuals"),
constr_dy_y_struct = c("variances", "means"),
constr_dy_xy_struct = "none",
model = lifecycle::deprecated(),
writeTo = NULL,
fileName = NULL){
#stop if model is provided
if (lifecycle::is_present(model)) {
lifecycle::deprecate_stop(
when = "1.0.0",
what = I('The argument "scriptCFM(model)"'),
with = I('"scriptCFM(constr_dy_x_meas) and/or scriptCFM(constr_dy_y_meas)"')
)
}
#check for valid inputs
if(length(dvn)!=9){
stop("You must supply a dvn object containing information for both X and Y")
}
if(!any(constr_dy_x_meas %in% c("loadings", "intercepts", "residuals", "none"))){
stop("constr_dy_meas must be a character vector containing any combination of 'loadings', 'intercepts', 'residuals', or 'none'")
}
if(!any(constr_dy_x_struct %in% c("variances", "means", "none"))){
stop("constr_dy_struct must be a character vector containing any combination of 'variances', 'means', or 'none'")
}
if(!any(constr_dy_y_meas %in% c("loadings", "intercepts", "residuals", "none"))){
stop("constr_dy_meas must be a character vector containing any combination of 'loadings', 'intercepts', 'residuals', or 'none'")
}
if(!any(constr_dy_y_struct %in% c("variances", "means", "none"))){
stop("constr_dy_struct must be a character vector containing any combination of 'variances', 'means', or 'none'")
}
if(!any(constr_dy_xy_struct %in% c("p1_zero", "p2_zero", "cov_zero", "dyadic_zero", "none"))){
stop("constr_dy_xy_struct must be a character vector containing any combination of 'p1_zero', 'p2_zero', 'cov_zero', 'dyadic_zero', or 'none'")
}
if(!scaleset %in% c("FF", "MV")){
stop("scaleset must be either 'FF' (fixed-factor) or 'MV' (marker variable)")
}
#loadings for X
if(any(constr_dy_x_meas == "loadings")){
if(scaleset == "FF"){
xloads1 <- loads(dvn, lvar = "X", lvname = lvxname, partner="1", type = "equated")
xloads2 <- loads(dvn, lvar = "X", lvname = lvxname, partner="2", type = "equated")
}
else if(scaleset == "MV"){
xloads1 <- loads(dvn, lvar = "X", lvname = lvxname, partner="1", type = "equated_mv")
xloads2 <- loads(dvn, lvar = "X", lvname = lvxname, partner="2", type = "equated")
}
}else{
if(scaleset == "FF"){
xloads1 <- loads(dvn, lvar = "X", lvname = lvxname, partner="1", type = "free")
xloads2 <- loads(dvn, lvar = "X", lvname = lvxname, partner="2", type = "free")
}
else if(scaleset == "MV"){
xloads1 <- loads(dvn, lvar = "X", lvname = lvxname, partner="1", type = "fixed")
xloads2 <- loads(dvn, lvar = "X", lvname = lvxname, partner="2", type = "fixed")
}
}
#loadings for Y
if(any(constr_dy_y_meas == "loadings")){
if(scaleset == "FF"){
yloads1 <- loads(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "equated")
yloads2 <- loads(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "equated")
}
else if(scaleset == "MV"){
yloads1 <- loads(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "equated_mv")
yloads2 <- loads(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "equated")
}
}else{
if(scaleset == "FF"){
yloads1 <- loads(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "free")
yloads2 <- loads(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "free")
}
else if(scaleset == "MV"){
yloads1 <- loads(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "fixed")
yloads2 <- loads(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "fixed")
}
}
#Common Fate Loadings
if(scaleset == "FF"){
hierloads <- cfloads(dvn, lvxname = lvxname, lvyname = lvyname, type = "equated")
}else if(scaleset == "MV"){
hierloads <- cfloads(dvn, lvxname = lvxname, lvyname = lvyname, type = "fixed")
}
#intercepts for X
if(any(constr_dy_x_meas == "intercepts")){
if(scaleset == "FF"){
xints1 = intercepts(dvn, lvar = "X", partner="1", type = "equated")
xints2 = intercepts(dvn, lvar = "X", partner="2", type = "equated")
}else if(scaleset == "MV"){
xints1 = intercepts(dvn, lvar = "X", partner="1", type = "equated_mv")
xints2 = intercepts(dvn, lvar = "X", partner="2", type = "equated")
}
}else{
if(scaleset == "FF"){
xints1 <- intercepts(dvn, lvar = "X", partner="1", type = "free")
xints2 <- intercepts(dvn, lvar = "X", partner="2", type = "free")
}
else if(scaleset == "MV"){
xints1 <- intercepts(dvn, lvar = "X", partner="1", type = "fixed")
xints2 <- intercepts(dvn, lvar = "X", partner="2", type = "fixed")
}
}
#intercepts for Y
if(any(constr_dy_y_meas == "intercepts")){
if(scaleset == "FF"){
yints1 = intercepts(dvn, lvar = "Y", partner="1", type = "equated")
yints2 = intercepts(dvn, lvar = "Y", partner="2", type = "equated")
}else if(scaleset == "MV"){
yints1 = intercepts(dvn, lvar = "Y", partner="1", type = "equated_mv")
yints2 = intercepts(dvn, lvar = "Y", partner="2", type = "equated")
}
}else{
if(scaleset == "FF"){
yints1 <- intercepts(dvn, lvar = "Y", partner="1", type = "free")
yints2 <- intercepts(dvn, lvar = "Y", partner="2", type = "free")
}
else if(scaleset == "MV"){
yints1 <- intercepts(dvn, lvar = "Y", partner="1", type = "fixed")
yints2 <- intercepts(dvn, lvar = "Y", partner="2", type = "fixed")
}
}
#residuals for X
if(any(constr_dy_x_meas == "residuals")){
xres1 <- resids(dvn, lvar = "X", partner="1", type = "equated")
xres2 <- resids(dvn, lvar = "X", partner="2", type = "equated")
}else{
xres1 <- resids(dvn, lvar = "X", partner="1", type = "free")
xres2 <- resids(dvn, lvar = "X", partner="2", type = "free")
}
#residuals for Y
if(any(constr_dy_y_meas == "residuals")){
yres1 <- resids(dvn, lvar = "Y", partner="1", type = "equated")
yres2 <- resids(dvn, lvar = "Y", partner="2", type = "equated")
}else{
yres1 <- resids(dvn, lvar = "Y", partner="1", type = "free")
yres2 <- resids(dvn, lvar = "Y", partner="2", type = "free")
}
#correlated residuals for X
xcoresids <- coresids(dvn, lvar = "X", "free")
#correlated residuals for Y
ycoresids <- coresids(dvn, lvar = "Y", "free")
#latent variances for X
if(any(constr_dy_x_struct == "variances")){
if(scaleset == "FF"){
hierxvar <- cfvars(lvname = lvxname, type = "fixed")
xvar1 <- lvars(dvn, lvar = "X", lvname = lvxname, partner = "1", type = "equated")
xvar2 <- lvars(dvn, lvar = "X", lvname = lvxname, partner = "2", type = "equated")
}else if(scaleset == "MV"){
hierxvar <- cfvars(lvname = lvxname, type = "free")
xvar1 <- lvars(dvn, lvar = "X", lvname = lvxname, partner = "1", type = "equated")
xvar2 <- lvars(dvn, lvar = "X", lvname = lvxname, partner = "2", type = "equated")
}
}else if(!any(constr_dy_x_struct == "variances") & any(constr_dy_x_meas == "loadings") & scaleset == "FF"){
hierxvar <- cfvars(lvname = lvxname, type = "fixed")
xvar1 = lvars(dvn, lvar = "X", lvname = lvxname, partner = "1", type = "fixed")
xvar2 = lvars(dvn, lvar = "X", lvname = lvxname, partner = "2", type = "free")
}else{
if(scaleset == "FF"){
hierxvar <- cfvars(lvname = lvxname, type = "fixed")
xvar1 <- lvars(dvn, lvar = "X", lvname = lvxname, partner = "1", type = "fixed")
xvar2 <- lvars(dvn, lvar = "X", lvname = lvxname, partner = "2", type = "fixed")
}else if(scaleset == "MV"){
hierxvar <- cfvars(lvname = lvxname, type = "free")
xvar1 <- lvars(dvn, lvar = "X", lvname = lvxname, partner = "1", type = "free")
xvar2 <- lvars(dvn, lvar = "X", lvname = lvxname, partner = "2", type = "free")
}
}
#latent variances for Y
if(any(constr_dy_y_struct == "variances")){
if(scaleset == "FF"){
hieryvar <- cfvars(lvname = lvyname, type = "fixed")
yvar1 <- lvars(dvn, lvar = "Y", lvname = lvyname, partner = "1", type = "equated")
yvar2 <- lvars(dvn, lvar = "Y", lvname = lvyname, partner = "2", type = "equated")
}else if(scaleset == "MV"){
hieryvar <- cfvars(lvname = lvyname, type = "free")
yvar1 <- lvars(dvn, lvar = "Y", lvname = lvyname, partner = "1", type = "equated")
yvar2 <- lvars(dvn, lvar = "Y", lvname = lvyname, partner = "2", type = "equated")
}
}else if(!any(constr_dy_y_struct == "variances") & any(constr_dy_y_meas == "loadings") & scaleset == "FF"){
hieryvar <- cfvars(lvname = lvyname, type = "fixed")
yvar1 = lvars(dvn, lvar = "Y", lvname = lvyname, partner = "1", type = "fixed")
yvar2 = lvars(dvn, lvar = "Y", lvname = lvyname, partner = "2", type = "free")
}else{
if(scaleset == "FF"){
hieryvar <- cfvars(lvname = lvyname, type = "fixed")
yvar1 <- lvars(dvn, lvar = "Y", lvname = lvyname, partner = "1", type = "fixed")
yvar2 <- lvars(dvn, lvar = "Y", lvname = lvyname, partner = "2", type = "fixed")
}else if(scaleset == "MV"){
hieryvar <- cfvars(lvname = lvyname, type = "free")
yvar1 <- lvars(dvn, lvar = "Y", lvname = lvyname, partner = "1", type = "free")
yvar2 <- lvars(dvn, lvar = "Y", lvname = lvyname, partner = "2", type = "free")
}
}
#hierarchical means
if(scaleset == "FF"){
xmean <- cfmeans(lvname = lvxname, type = "fixed")
ymean <- cfmeans(lvname = lvyname, type = "fixed")
}else if(scaleset == "MV"){
xmean <- cfmeans(lvname = lvxname, type = "free")
ymean <- cfmeans(lvname = lvyname, type = "free")
}
#latent means for X
if(any(constr_dy_x_struct == "means")){
if(scaleset == "FF"){
xmean1 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="1", type = "equated_ff")
xmean2 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="2", type = "equated")
}else if(scaleset == "MV"){
xmean1 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="1", type = "equated_ff")
xmean2 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="2", type = "equated")
}
}else if(!any(constr_dy_x_struct == "means") & any(constr_dy_x_meas == "intercepts") & scaleset == "FF"){
xmean1 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="1", type = "fixed")
xmean2 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="2", type = "free")
}else{
if(scaleset == "FF"){
xmean1 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="1", type = "fixed")
xmean2 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="2", type = "fixed")
}
else if(scaleset == "MV"){
xmean1 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="1", type = "fixed")
xmean2 <- lmeans(dvn, lvar = "X", lvname = lvxname, partner="2", type = "free")
}
}
#latent means for Y
if(any(constr_dy_y_struct == "means")){
if(scaleset == "FF"){
ymean1 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "equated_ff")
ymean2 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "equated")
}else if(scaleset == "MV"){
ymean1 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "equated_ff")
ymean2 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "equated")
}
}else if(!any(constr_dy_y_struct == "means") & any(constr_dy_y_meas == "intercepts") & scaleset == "FF"){
ymean1 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "fixed")
ymean2 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "free")
}else{
if(scaleset == "FF"){
ymean1 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "fixed")
ymean2 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "fixed")
}
else if(scaleset == "MV"){
ymean1 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="1", type = "fixed")
ymean2 <- lmeans(dvn, lvar = "Y", lvname = lvyname, partner="2", type = "free")
}
}
#Latent Covariances
if(any(constr_dy_xy_struct == "p1_zero")){
p1covar = sprintf("%s%s ~~ 0*%s%s",lvxname, dvn[["dist1"]],lvyname, dvn[["dist1"]])
p2covar = sprintf("%s%s ~~ %s%s",lvxname, dvn[["dist2"]],lvyname, dvn[["dist2"]])
}else{
p1covar = sprintf("%s%s ~~ %s%s",lvxname, dvn[["dist1"]],lvyname, dvn[["dist1"]])
p2covar = sprintf("%s%s ~~ %s%s",lvxname, dvn[["dist2"]],lvyname, dvn[["dist2"]])
}
if(any(constr_dy_xy_struct == "p2_zero")){
p1covar = sprintf("%s%s ~~ %s%s",lvxname, dvn[["dist1"]],lvyname, dvn[["dist1"]])
p2covar = sprintf("%s%s ~~ 0*%s%s",lvxname, dvn[["dist2"]],lvyname, dvn[["dist2"]])
}else{
p1covar = sprintf("%s%s ~~ %s%s",lvxname, dvn[["dist1"]],lvyname, dvn[["dist1"]])
p2covar = sprintf("%s%s ~~ %s%s",lvxname, dvn[["dist2"]],lvyname, dvn[["dist2"]])
}
if(any(constr_dy_xy_struct == "cov_zero")){
p1covar = sprintf("%s%s ~~ 0*%s%s",lvxname, dvn[["dist1"]],lvyname, dvn[["dist1"]])
p2covar = sprintf("%s%s ~~ 0*%s%s",lvxname, dvn[["dist2"]],lvyname, dvn[["dist2"]])
}else{
p1covar = sprintf("%s%s ~~ %s%s",lvxname, dvn[["dist1"]],lvyname, dvn[["dist1"]])
p2covar = sprintf("%s%s ~~ %s%s",lvxname, dvn[["dist2"]],lvyname, dvn[["dist2"]])
}
if(any(constr_dy_xy_struct == "dyadic_zero")){
dyadic <- paste0(lvyname, " ~ 0*", lvxname)
}else{
dyadic <- paste(lvyname, "~", lvxname)
}
#write script
script <- sprintf("#Measurement Model\n\n#Loadings\n%s\n%s\n\n%s\n%s\n\n%s\n\n#Intercepts\n%s\n\n%s\n\n%s\n\n%s\n\n#Residual Variances\n%s\n\n%s\n\n%s\n\n%s\n\n#Residual Covariances\n%s\n\n%s\n\n#Structural Model\n\n#Latent (Co)Variances\n%s\n%s\n%s\n\n%s\n%s\n%s\n\n%s\n%s\n\n#Latent Means\n%s\n%s\n%s\n\n%s\n%s\n%s\n\n#Latent Dyadic Effect\n%s",
xloads1, xloads2,
yloads1, yloads2,
hierloads,
xints1, xints2,
yints1, yints2,
xres1, xres2,
yres1, yres2,
xcoresids, ycoresids,
hierxvar, xvar1, xvar2,
hieryvar, yvar1, yvar2,
p1covar, p2covar,
xmean, xmean1, xmean2,
ymean, ymean1, ymean2,
dyadic)
#Write script to file if requested
if(!is.null(writeTo) | !is.null(fileName) ){
#if there is a path or file name,
#check for valid input,
#and if valid, write script
# checking for valid directory path and fileName
if (!is.character(writeTo)){
stop("The `writeout` argument must be a character string. \n Use writeTo = '.' to save script in the current working directory, for example.")
}
if (!dir.exists(writeTo)){
stop("The specified directory does not exist. \n Use writeTo = '.' to save script in the current working directory, for example.")
}
if (!is.character(fileName)){
stop("The `fileName` argument must be a character string.")
}
#write file
cat(script, "\n",
file = sprintf("%s/%s.txt",
writeTo,
fileName))
return(script)
}
else if(is.null(writeTo) & is.null(fileName)){
#otherwise just return script
return(script)
}
}