R/blcs.R

In ramPATH: ramPATH

## bivariate latent change score model
## Johnny Zhang & Jack McArdle, 
## Created on May 26, 2012

ramLCS<-function(data, ## data to be used
	y, ## variables x to be used
	timey, ##
	ram.out=FALSE,
	betay, my0, mys, varey, vary0, varys, vary0ys,...){
	if (missing(data)) stop("No data was provided!")
	if (missing(y)) stop("Missing y variables!")
	if (!is.data.frame(data)) stop("The provided data set is not a data frame!")
	
	varname<-names(data)
	ny<-length(y)
	
	if (missing(timey)) timey<-1:ny
	
	My<-max(timey)
	
	## for Y	
	model<-'y0 =~ 1*y1 \n '
	
	for (i in 2:My){
		model<-paste(model, "y",i,"~1*y",(i-1),"\n ", sep="")
	}
	
	for (i in 2:My){
		model<-paste(model, "dy",i,"=~1*y",i,"\n ", sep="")
	}
	
	for (i in 2:My){
		model<-paste(model, "dy",i,"~betay*y", (i-1), sep="")
		if (!missing(betay)){
			model<-paste(model, "+start(", betay, ")*y", (i-1), "\n ", sep="")
		}else{
			model<-paste(model, "\n ")
		}
	}
	for (i in 2:My){
		model<-paste(model, "ys=~1*dy", i, "\n ", sep="")
	}
	
	model<-paste(model, "ys~~vary0ys*y0")
	if (!missing(vary0ys)){
		model<-paste(model, "+start(",vary0ys,")*y0\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "y0~~vary0*y0")
	if (!missing(vary0)){
		model<-paste(model, "+start(",vary0,")*y0\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "ys~~varys*ys")
	if (!missing(varys)){
		model<-paste(model, "+start(",varys,")*ys\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "ys~mys*1")
	if (!missing(mys)){
		model<-paste(model, "+start(",mys,")*1\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "y0~my0*1")
	if (!missing(my0)){
		model<-paste(model, "+start(",my0,")*1\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	for (i in 1:My){
		model<-paste(model, "y",i,"~0*1\n ", sep="")
	}
	for (i in 2:My){
		model<-paste(model, "dy",i,"~0*1\n ", sep="")
	}
	
	## for observed data part
	if (ny < My){
		ally<-1:My
		missy<-ally[-timey]
		for (i in 1:ny){
			model<-paste(model, "y",timey[i],"=~1*", varname[y[i]],"\n", sep="")				
		}
		for (j in missy){
			model<-paste(model, "y",j,"=~0*",varname[y[1]],"\n", sep="")	
		}
		for (i in 1:ny){
			model<-paste(model, varname[y[i]], "~0*1\n", sep="")		
		}
		for (i in 1:ny){
			model<-paste(model, varname[y[i]], "~~varey*",varname[y[i]], sep="")
			if (!missing(varey)){
				model<-paste(model, "+start(",varey,")*",varname[y[i]], "\n ", sep="")
			}else{
				model<-paste(model, "\n ")
			}		
		}
	}else{
		for (i in 1:ny){
			model<-paste(model, "y",timey[i],"=~1*", varname[y[i]],"\n", sep="")				
		}

		for (i in 1:ny){
			model<-paste(model, varname[y[i]], "~0*1\n", sep="")		
		}
		for (i in 1:ny){
			model<-paste(model, varname[y[i]], "~~varey*",varname[y[i]], sep="")
			if (!missing(varey)){
				model<-paste(model, "+start(",varey,")*",varname[y[i]], "\n ", sep="")
			}else{
				model<-paste(model, "\n ")
			}		
		}
	}
	fitModel<-lavaan(model=model, data=data, ...)
	summary(fitModel, fit.measures=TRUE)
	if (ram.out){ 
		ram=lavaan2ram(fitModel)
		invisible(return(list(model=model, lavaan=fitModel, ram=ram)))
	}else{
		invisible(return(list(model=model, lavaan=fitModel)))
	}
}


ramBLCS<-function(
	data, ## data to be used
	y, ## variables x to be used
	x, ## variables y to be used
	timey, ##
	timex, ##
	ram.out=FALSE,
	betax, betay, gammax, gammay, mx0, mxs, my0, mys, varex, varey, varx0, vary0, varxs, varys, varx0y0, varx0xs, vary0ys, varx0ys, vary0xs, varxsys,...){
	if (missing(data)) stop("No data was provided!")
	if (missing(y)) stop("Missing y variables!")
	if (!is.data.frame(data)) stop("The provided data set is not a data frame!")
	
	varname<-names(data)
	ny<-length(y)
	
	if (missing(timey)) timey<-1:ny
	
	My<-max(timey)
	
	## for Y	
	model<-'y0 =~ 1*y1 \n '
	
	for (i in 2:My){
		model<-paste(model, "y",i,"~1*y",(i-1),"\n ", sep="")
	}
	
	for (i in 2:My){
		model<-paste(model, "dy",i,"=~1*y",i,"\n ", sep="")
	}
	
	for (i in 2:My){
		model<-paste(model, "dy",i,"~betay*y", (i-1), sep="")
		if (!missing(betay)){
			model<-paste(model, "+start(", betay, ")*y", (i-1), "\n ", sep="")
		}else{
			model<-paste(model, "\n ")
		}
	}
	for (i in 2:My){
		model<-paste(model, "ys=~1*dy", i, "\n ", sep="")
	}
	
	model<-paste(model, "ys~~vary0ys*y0")
	if (!missing(vary0ys)){
		model<-paste(model, "+start(",vary0ys,")*y0\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "y0~~vary0*y0")
	if (!missing(vary0)){
		model<-paste(model, "+start(",vary0,")*y0\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "ys~~varys*ys")
	if (!missing(varys)){
		model<-paste(model, "+start(",varys,")*ys\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "ys~mys*1")
	if (!missing(mys)){
		model<-paste(model, "+start(",mys,")*1\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "y0~my0*1")
	if (!missing(my0)){
		model<-paste(model, "+start(",my0,")*1\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	for (i in 1:My){
		model<-paste(model, "y",i,"~0*1\n ", sep="")
	}
	for (i in 2:My){
		model<-paste(model, "dy",i,"~0*1\n ", sep="")
	}
	
	## for observed data part
	if (ny < My){
		ally<-1:My
		missy<-ally[-timey]
		for (i in 1:ny){
			model<-paste(model, "y",timey[i],"=~1*", varname[y[i]],"\n", sep="")				
		}
		for (j in missy){
			model<-paste(model, "y",j,"=~0*",varname[y[1]],"\n", sep="")	
		}
		for (i in 1:ny){
			model<-paste(model, varname[y[i]], "~0*1\n", sep="")		
		}
		for (i in 1:ny){
			model<-paste(model, varname[y[i]], "~~varey*",varname[y[i]], sep="")
			if (!missing(varey)){
				model<-paste(model, "+start(",varey,")*",varname[y[i]], "\n ", sep="")
			}else{
				model<-paste(model, "\n ")
			}		
		}
	}else{
		for (i in 1:ny){
			model<-paste(model, "y",timey[i],"=~1*", varname[y[i]],"\n", sep="")				
		}

		for (i in 1:ny){
			model<-paste(model, varname[y[i]], "~0*1\n", sep="")		
		}
		for (i in 1:ny){
			model<-paste(model, varname[y[i]], "~~varey*",varname[y[i]], sep="")
			if (!missing(varey)){
				model<-paste(model, "+start(",varey,")*",varname[y[i]], "\n ", sep="")
			}else{
				model<-paste(model, "\n ")
			}		
		}
	}
	
	if (missing(x)) stop("Missing x variables!")

	nx<-length(x)
	
	if (missing(timex)) timex<-1:nx
	
	Mx<-max(timex)
	
	## for x	
	model<-paste(model,'x0 =~ 1*x1 \n ')
	
	for (i in 2:Mx){
		model<-paste(model, "x",i,"~1*x",(i-1),"\n ", sep="")
	}
	
	for (i in 2:Mx){
		model<-paste(model, "dx",i,"=~1*x",i,"\n ", sep="")
	}
	
	for (i in 2:Mx){
		model<-paste(model, "dx",i,"~betax*x", (i-1), sep="")
		if (!missing(betax)){
			model<-paste(model, "+start(", betax, ")*x", (i-1), "\n ", sep="")
		}else{
			model<-paste(model, "\n ")
		}
	}
	for (i in 2:Mx){
		model<-paste(model, "xs=~1*dx", i, "\n ", sep="")
	}
	
	model<-paste(model, "xs~~varx0xs*x0")
	if (!missing(varx0xs)){
		model<-paste(model, "+start(",varx0xs,")*x0\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "x0~~varx0*x0")
	if (!missing(varx0)){
		model<-paste(model, "+start(",varx0,")*x0\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "xs~~varxs*xs")
	if (!missing(varxs)){
		model<-paste(model, "+start(",varxs,")*xs\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "xs~mxs*1")
	if (!missing(mxs)){
		model<-paste(model, "+start(",mxs,")*1\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "x0~mx0*1")
	if (!missing(mx0)){
		model<-paste(model, "+start(",mx0,")*1\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	for (i in 1:Mx){
		model<-paste(model, "x",i,"~0*1\n ", sep="")
	}
	for (i in 2:Mx){
		model<-paste(model, "dx",i,"~0*1\n ", sep="")
	}
	
	## for observed data part
	if (nx < Mx){
		allx<-1:Mx
		missx<-allx[-timex]
		for (i in 1:nx){
			model<-paste(model, "x",timex[i],"=~1*", varname[x[i]],"\n", sep="")				
		}
		for (j in missx){
			model<-paste(model, "x",j,"=~0*",varname[x[1]],"\n", sep="")	
		}
		for (i in 1:nx){
			model<-paste(model, varname[x[i]], "~0*1\n", sep="")		
		}
		for (i in 1:nx){
			model<-paste(model, varname[x[i]], "~~varex*",varname[x[i]], sep="")
			if (!missing(varex)){
				model<-paste(model, "+start(",varex,")*",varname[x[i]], "\n ", sep="")
			}else{
				model<-paste(model, "\n ")
			}		
		}
	}else{
		for (i in 1:nx){
			model<-paste(model, "x",timex[i],"=~1*", varname[x[i]],"\n", sep="")				
		}

		for (i in 1:nx){
			model<-paste(model, varname[x[i]], "~0*1\n", sep="")		
		}
		for (i in 1:nx){
			model<-paste(model, varname[x[i]], "~~varex*",varname[x[i]], sep="")
			if (!missing(varex)){
				model<-paste(model, "+start(",varex,")*",varname[x[i]], "\n ", sep="")
			}else{
				model<-paste(model, "\n ")
			}		
		}
	}
	
	## coupling effects
	for (i in 2:My){
		model<-paste(model, "dy",i,"~gammax*x",i-1, sep="")
		if (!missing(gammax)){
			model<-paste(model, "+start(",gammax,")*x",i-1, "\n ", sep="")
		}else{
			model<-paste(model, "\n ")
		}
	}
	
	for (i in 2:Mx){
		model<-paste(model, "dx",i,"~gammay*y",i-1, sep="")
		if (!missing(gammay)){
			model<-paste(model, "+start(",gammay,")*y",i-1, "\n ", sep="")
		}else{
			model<-paste(model, "\n ")
		}
	}
	
	model<-paste(model, "x0~~varx0y0*y0")
	if (!missing(varx0y0)){
		model<-paste(model, "+start(",varx0y0,")*y0\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "x0~~varx0ys*ys")
	if (!missing(varx0ys)){
		model<-paste(model, "+start(",varx0ys,")*ys\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "y0~~vary0xs*xs")
	if (!missing(vary0xs)){
		model<-paste(model, "+start(",vary0xs,")*xs\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	model<-paste(model, "xs~~varxsys*ys")
	if (!missing(varxsys)){
		model<-paste(model, "+start(",varxsys,")*ys\n ")
	}else{
		model<-paste(model, "\n ")
	}
	
	fitModel<-lavaan(model=model, data=data, ...)

	summary(fitModel, fit.measures=TRUE)
	if (ram.out){ 
		ram=lavaan2ram(fitModel)
		invisible(return(list(model=model, lavaan=fitModel, ram=ram)))
	}else{
		invisible(return(list(model=model, lavaan=fitModel)))
	}
}