createSyntax <- function(obj){
model <- character()
## lavaan syntax
if(obj@input@method == "sem"){
model <- createLavaanSyntax(obj)
}
## lm syntax
if(obj@input@method == "lm"){
model <- createLMSyntax(obj)
}
## syntax for main hypotheses
hypotheses <- createHypothesesSyntax(obj, type="main")
hypothesesk <- createHypothesesSyntax(obj, type="kconditional")
res <- new("syntax",
model=model,
hypotheses=hypotheses,
hypothesesk=hypothesesk
)
}
createLavaanSyntax <- function(obj) {
inp <- obj@input
parnames <- obj@parnames
## input information
y <- inp@vnames$y
z <- inp@vnames$z
ng <- inp@ng
nz <- inp@nz
nk <- inp@nk
fixed.cell <- inp@fixed.cell
fixed.z <- inp@fixed.z
sampmeanz <- inp@sampmeanz
homoscedasticity <- inp@homoscedasticity
observed.freq <- inp@observed.freq
interactions <- inp@interactions
## parnames
alphas <- parnames@alphas
betas <- parnames@betas
gammas <- parnames@gammas
constrainedgammas <- parnames@constrainedgammas
cellmeanz <- parnames@cellmeanz
relfreq <- parnames@relfreq
groupw <- parnames@groupw
meanz <- parnames@meanz
pk <- parnames@pk
px <- parnames@px
Ezk <- parnames@Ezk
Egx <- parnames@Egx
adjmeans <- parnames@adjmeans
adjmeansgk <- parnames@adjmeansgk
Pkgx <- parnames@Pkgx
Pxgk <- parnames@Pxgk
Ezgx <- parnames@Ezgx
Ezgk <- parnames@Ezgk
Ezkgx <- parnames@Ezkgx
Egxgx <- parnames@Egxgx
Egxgk <- parnames@Egxgk
Egxgxk <- parnames@Egxgxk
AveEffZ <- parnames@AveEffZ
model <- "#### lavaan Syntax for EffectLiteR Model ####"
## measurement model
if(length(inp@measurement) != 0){
model <- paste0(model, "\n\n## Measurement Model \n")
model <- paste0(model, inp@measurement)
}
## syntax intercepts
model <- paste0(model, "\n\n## Structural Model \n")
model <- paste0(model, create_syntax_intercepts(y,alphas))
## syntax regression coefficients in each cell
model <- paste0(model, create_syntax_regcoef(y,z,nz,alphas))
## mean z in each cell
model <- paste0(model, create_syntax_cellmeanz(z, nz, fixed.z, cellmeanz,
sampmeanz))
## covariances between stochastic z
model <- paste0(model, create_syntax_covz(z, nz, fixed.z))
## homoscedastic residual variances
model <- paste0(model, create_syntax_homoscedasticity(y,ng,nk,homoscedasticity))
## compute relative group frequencies
model <- paste0(model, create_syntax_group_freq(fixed.cell, relfreq,
observed.freq, groupw))
## compute betas based on alphas
model <- paste0(model, create_syntax_betas(betas, alphas, ng, nk, nz))
## compute gammas based on betas
model <- paste0(model, create_syntax_gammas(gammas, betas, ng, nk, nz))
## compute unconditional means of z
model <- paste0(model, create_syntax_ez(nz, meanz, cellmeanz, relfreq))
## compute unconditional probabilities of K*=k
model <- paste0(model, create_syntax_pk(nk, pk, relfreq))
## compute unconditional probabilities of X=x
model <- paste0(model, create_syntax_ex(px, ng, nk, relfreq))
## compute unconditional means of Z*K
model <- paste0(model, create_syntax_Ezk(ng, nk, nz, Ezk, cellmeanz, relfreq))
## compute average effects
model <- paste0(model, create_syntax_Egx(ng,nk,nz,pk,meanz,Ezk,Egx,gammas))
## compute adjusted means
model <- paste0(model, create_syntax_adjmeans(ng,nk,nz,pk,meanz,Ezk,adjmeans,gammas))
## conditional probabilities of K=k given X=x (Pkgx)
model <- paste0(model, create_syntax_Pkgx(ng, nk, relfreq, Pkgx, px))
## conditional probabilities of X=x given K=k (Pxgk)
model <- paste0(model, create_syntax_Pxgk(ng, nk, relfreq, Pxgk, pk))
## conditional expectations of Z given X=x (Ezgx)
model <- paste0(model, create_syntax_Ezgx(ng, nk, nz, Ezgx, Pkgx, cellmeanz))
## conditional expectations of Z given K=k (Ezgk)
model <- paste0(model, create_syntax_Ezgk(ng,nk,nz,cellmeanz,Ezgk,Pxgk))
## conditional expectations of Z*K given X=x (Ezkgx)
model <- paste0(model, create_syntax_Ezkgx(ng,nk,nz,Ezkgx,cellmeanz,Pkgx))
## effects given a treatment condition
model <- paste0(model, create_syntax_Egxgx(ng,nk,nz,Pkgx,Ezgx,Ezkgx,Egxgx,gammas))
## Effects given a value k of K
model <- paste0(model, create_syntax_Egxgk(ng,nk,Egxgk,Ezgk,gammas))
## Adjmeans given a value k of K
model <- paste0(model, create_syntax_adjmeansgk(ng,nk,adjmeansgk,Ezgk,gammas))
## Effects given X=x and K=k
model <- paste0(model, create_syntax_Egxgxk(ng,nk,nz,Egxgxk,gammas,cellmeanz))
## Average effects of continuous covariates
model <- paste0(model, create_syntax_AveEffZ(nz, alphas, relfreq, AveEffZ))
## Average effects of categorical covariate K
model <- paste0(model, create_syntax_AveEffK(ng,nk,nz,pk,meanz,Ezk,Egx,gammas))
## Constraints about 2 and 3 way interactions
model <- paste0(model,
create_syntax_interaction_constraints(constrainedgammas))
## additional syntax
if(length(inp@add) != 0){
model <- paste0(model, "\n\n## Additional User Defined Syntax \n")
model <- paste0(model, inp@add)
}
return(model)
}
createHypothesesSyntax <- function(obj, type="main"){
ng <- obj@input@ng
nk <- obj@input@nk
Egx <- obj@parnames@Egx
gammas <- obj@parnames@gammas
if(type=="main"){
## Hypothesis 1: No average treatment effects
hypothesis1 <- paste(Egx, "== 0", collapse="\n")
## Hypothesis 2: No covariate effects in control group
gammas_tmp <- matrix(c(gammas), ncol=ng)[-1,1]
hypothesis2 <- paste(gammas_tmp, "== 0", collapse="\n")
## Hypothesis 3: No treatment*covariate interaction
gammas_tmp <- matrix(c(gammas), ncol=ng)[-1,-1]
hypothesis3 <- paste(gammas_tmp, "== 0", collapse="\n")
## Hypothesis 4: No treatment effects
gammas_tmp <- matrix(c(gammas), ncol=ng)[,-1]
hypothesis4 <- paste(gammas_tmp, "== 0", collapse="\n")
hypotheses <- list(hypothesis1=hypothesis1,
hypothesis2=hypothesis2,
hypothesis3=hypothesis3,
hypothesis4=hypothesis4)
}else if(type=="kconditional"){
hypotheses <- vector("list",length=nk)
if(nk>1){
Egxk <- matrix(obj@parnames@Egxgk, nrow=ng-1, ncol=nk)
for(i in 1:nk){
hypotheses[[i]] <- paste(Egxk[,i], "== 0", collapse="\n")
}
names(hypotheses) <- paste0("hypothesisk", 0:(nk-1))
}
}
return(hypotheses)
}
createLMSyntax <- function(obj) {
inp <- obj@input
parnames <- obj@parnames
## input information
y <- inp@vnames$y
z <- inp@vnames$z
ng <- inp@ng
nz <- inp@nz
nk <- inp@nk
fixed.cell <- inp@fixed.cell
fixed.z <- inp@fixed.z
sampmeanz <- inp@sampmeanz
observed.freq <- inp@observed.freq
interactions <- inp@interactions
## parnames
gammas <- parnames@gammas
constrainedgammas <- parnames@constrainedgammas
unconstrainedgammas <- gammas
betas <- parnames@betas
unconstrainedbetas <- betas
if(length(constrainedgammas) != 0){
idx <- which(gammas %in% constrainedgammas)
unconstrainedgammas <- gammas[-idx]
unconstrainedbetas <- betas[-idx]
}
cellmeanz <- parnames@cellmeanz
relfreq <- parnames@relfreq
groupw <- parnames@groupw
meanz <- parnames@meanz
pk <- parnames@pk
px <- parnames@px
Ezk <- parnames@Ezk
Egx <- parnames@Egx
adjmeans <- parnames@adjmeans
adjmeansgk <- parnames@adjmeansgk
Pkgx <- parnames@Pkgx
Pxgk <- parnames@Pxgk
Ezgx <- parnames@Ezgx
Ezgk <- parnames@Ezgk
Ezkgx <- parnames@Ezkgx
Egxgx <- parnames@Egxgx
Egxgk <- parnames@Egxgk
Egxgxk <- parnames@Egxgxk
model <- "#### lm Syntax for EffectLiteR Model ####"
## regression model
model <- paste0(model, "\n\n## Regression Model \n")
tmp <- paste0("mm",1:length(unconstrainedbetas))
tmp <- paste0(unconstrainedbetas, "*", tmp, collapse=" + ")
model <- paste0(model, paste0(y, " ~ ", tmp))
## compute relative group frequencies
model <- paste0(model, create_syntax_group_freq_lm(fixed.cell, relfreq,
observed.freq, groupw))
## "compute" gammas based on betas
tmp <- paste0(unconstrainedgammas, " := ", unconstrainedbetas, collapse="\n")
model <- paste0(model, "\n\n" ,tmp)
## constraints on interactions
model <- paste0(model,
create_syntax_interaction_constraints_lm(constrainedgammas))
## mean z in each cell
model <- paste0(model, create_syntax_cellmeanz(z, nz, fixed.z, cellmeanz,
sampmeanz))
## compute unconditional means of z
model <- paste0(model, create_syntax_ez(nz, meanz, cellmeanz, relfreq))
## compute unconditional probabilities of K*=k
model <- paste0(model, create_syntax_pk(nk, pk, relfreq))
## compute unconditional probabilities of X=x
model <- paste0(model, create_syntax_ex(px, ng, nk, relfreq))
## compute unconditional means of Z*K
model <- paste0(model, create_syntax_Ezk(ng, nk, nz, Ezk, cellmeanz, relfreq))
## compute average effects
model <- paste0(model, create_syntax_Egx(ng,nk,nz,pk,meanz,Ezk,Egx,gammas))
## compute adjusted means
model <- paste0(model, create_syntax_adjmeans(ng,nk,nz,pk,meanz,Ezk,adjmeans,gammas))
## conditional probabilities of K=k given X=x (Pkgx)
model <- paste0(model, create_syntax_Pkgx(ng, nk, relfreq, Pkgx, px))
## conditional probabilities of X=x given K=k (Pxgk)
model <- paste0(model, create_syntax_Pxgk(ng, nk, relfreq, Pxgk, pk))
## conditional expectations of Z given X=x (Ezgx)
model <- paste0(model, create_syntax_Ezgx(ng, nk, nz, Ezgx, Pkgx, cellmeanz))
## conditional expectations of Z given K=k (Ezgk)
model <- paste0(model, create_syntax_Ezgk(ng,nk,nz,cellmeanz,Ezgk,Pxgk))
## conditional expectations of Z*K given X=x (Ezkgx)
model <- paste0(model, create_syntax_Ezkgx(ng,nk,nz,Ezkgx,cellmeanz,Pkgx))
## effects given a treatment condition
model <- paste0(model, create_syntax_Egxgx(ng,nk,nz,Pkgx,Ezgx,Ezkgx,Egxgx,gammas))
## Effects given a value k of K
model <- paste0(model, create_syntax_Egxgk(ng,nk,Egxgk,Ezgk,gammas))
## Effects given X=x and K=k
model <- paste0(model, create_syntax_Egxgxk(ng,nk,nz,Egxgxk,gammas,cellmeanz))
## Adjmeans given a value k of K
model <- paste0(model, create_syntax_adjmeansgk(ng,nk,adjmeansgk,Ezgk,gammas))
## additional syntax
if(length(inp@add) != 0){
model <- paste0(model, "\n\n## Additional User Defined Syntax \n")
model <- paste0(model, inp@add)
}
return(model)
}
## functions that create parts of the lavaan/methods syntax
create_syntax_intercepts <- function(y, alphas){
res <- paste0(y," ~ c(", paste(alphas[1,,],collapse=","), ")*1")
return(res)
}
create_syntax_regcoef <- function(y, z, nz, alphas){
res <- NULL
if (nz>0) {
for (i in 1:nz) {
tmp <- paste0(y," ~ c(", paste(alphas[i+1,,],collapse=","), ")*",z[i])
res <- paste0(res, "\n", tmp)
}
}
return(res)
}
create_syntax_cellmeanz <- function(z, nz, fixed.z, cellmeanz, sampmeanz){
res <- NULL
if(!fixed.z){
## stochastic z
if (nz>0) {
cellmeanz <- matrix(cellmeanz, nrow=nz)
for (i in 1:nz) {
tmp <- paste0(z[i]," ~ c(", paste(cellmeanz[i,],collapse=","), ")*1")
res <- paste0(res, "\n", tmp)
}
}
}else if(fixed.z){
## fixed z
if (nz>0) {
res <- paste0(res, "\n\n## Fixed Means of Z")
cellmeanz <- matrix(cellmeanz, nrow=nz)
tmp <- paste0(cellmeanz, " := ", sampmeanz, collapse="\n")
res <- paste0(res, "\n", tmp)
}
}
return(res)
}
create_syntax_covz <- function(z, nz, fixed.z){
## covariances between stochastic z
res <- NULL
## syntax covariances between z in each cell
if(!fixed.z){
if(nz > 1){
tmp <- combn(z,2)
res <- paste0("\n", paste0(tmp[1,], " ~~ ", tmp[2,], collapse="\n"))
}
}
return(res)
}
create_syntax_homoscedasticity <- function(y, ng, nk, homoscedasticity){
res <- NULL
if(homoscedasticity){
tmp <- paste0(y, " ~~ c(",
paste(rep("veps", times=ng*nk),collapse=","),
")*", y)
res <- paste0(res, "\n", tmp)
}
return(res)
}
create_syntax_group_freq <- function(fixed.cell, relfreq, observed.freq, groupw){
res <- "\n\n## Relative Group Frequencies \n"
if(fixed.cell){
tmp <- paste(paste0(relfreq, " := ", observed.freq), collapse="\n")
res <- paste0(res, tmp)
}else if(!fixed.cell){
## syntax group weights
tmp <- paste0("group % c(", paste(groupw, collapse=","), ")*w")
res <- paste0(res, tmp)
tmp <- paste(paste0("exp(", groupw, ")"), collapse=" + ")
tmp <- paste0("N := ",tmp)
res <- paste0(res, "\n", tmp)
tmp <- paste(paste0(relfreq, " := exp(", groupw, ")/N"), collapse="\n")
res <- paste0(res, "\n", tmp)
}
return(res)
}
create_syntax_group_freq_lm <- function(fixed.cell, relfreq, observed.freq, groupw){
res <- "\n\n## Relative Group Frequencies \n"
if(fixed.cell){
tmp <- paste(paste0(relfreq, " := ", observed.freq), collapse="\n")
res <- paste0(res, tmp)
}else if(!fixed.cell){
tmp <- paste0(relfreq, " := ", groupw, collapse="\n")
res <- paste0(res, "\n", tmp)
}
return(res)
}
create_syntax_betas <- function(betas, alphas, ng, nk, nz){
res <- "\n\n## beta Coefficients"
## create temporary beta array (to be overwritten in next step)
beta <- betas
## compute betas based on alphas
for(q in 1:(nz+1)){
for(x in 1:ng){
beta[q,1,x] <- paste(betas[q,1,x], alphas[q,1,x], sep=" := ")
if(nk>1){
for(k in 2:nk){
beta[q,k,x] <- paste0(betas[q,k,x], " := ",
alphas[q,k,x], "-", alphas[q,1,x])
}
}
}
}
res <- paste0(res, "\n", paste(beta, collapse="\n"))
return(res)
}
create_syntax_gammas <- function(gammas, betas, ng, nk, nz){
res <- "\n\n## gamma Coefficients"
## create temporary gamma array (to be overwritten in next step)
gamma <- gammas
## compute gammas based on betas
for(q in 1:(nz+1)){
for(k in 1:nk){
gamma[q,k,1] <- paste(gammas[q,k,1], betas[q,k,1], sep=" := ")
for(x in 2:ng){
gamma[q,k,x] <- paste0(gammas[q,k,x], " := ",
betas[q,k,x], "-", betas[q,k,1])
}
}
}
res <- paste0(res, "\n", paste(gamma, collapse="\n"))
return(res)
}
create_syntax_ez <- function(nz, meanz, cellmeanz, relfreq){
res <- NULL
if (nz>0) {
res <- paste0(res, "\n\n## Unconditional Expectations E(Z)")
cellmeanz <- matrix(cellmeanz, nrow=nz)
for (i in 1:nz) {
tmp <- paste0(meanz[i]," := ", paste(cellmeanz[i,], relfreq, sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
}
return(res)
}
create_syntax_pk <- function(nk, pk, relfreq){
res <- NULL
if (nk>1) {
res <- paste0(res, "\n\n## Unconditional Probabilities P(K=k)")
relfreq <- matrix(relfreq, nrow=nk)
for (i in 1:nk) {
tmp <- paste0(pk[i], " := ", paste(relfreq[i,], collapse=" + "))
res <- paste0(res, "\n", tmp)
}
}
return(res)
}
create_syntax_ex <- function(px, ng, nk, relfreq){
res <- "\n\n## Unconditional Probabilities P(X=x)"
relfreq <- matrix(relfreq, nrow=nk)
for (i in 1:ng) {
tmp <- paste0(px[i], " := ", paste(relfreq[,i], collapse=" + "))
res <- paste0(res, "\n", tmp)
}
return(res)
}
create_syntax_Ezk <- function(ng, nk, nz, Ezk, cellmeanz, relfreq){
res <- NULL
if (nk>1 & nz>0) {
res <- paste0(res, "\n\n## Unconditional Expectations E(Z*I_K=k)")
Ezk <- array(Ezk, dim=c(nk,nz))
cellmeanz <- array(cellmeanz, dim=c(nz,nk,ng))
relfreq <- array(relfreq, dim=c(nk,ng))
for(q in 1:nz){
for(k in 1:nk){
tmp <- paste0(Ezk[k,q], " := ",
paste(cellmeanz[q,k,1:ng], relfreq[k,], sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
}
}
return(res)
}
create_syntax_Egx <- function(ng,nk,nz,pk,meanz,Ezk,Egx,gammas){
res <- "\n\n## Average Effects"
## create vector of unconditional expectations of Z, K, Z*K
pk_tmp <- pk[-1]
meanz_tmp <- Ezk_tmp <- pkEzk_tmp <- character()
if(nz>0){meanz_tmp <- meanz}
if(nk>1 & nz>0){Ezk_tmp <- c(matrix(Ezk, nrow=nk)[-1,])}
if(nk>1){pkEzk_tmp <- c(matrix(c(pk_tmp,Ezk_tmp), ncol=nk-1, byrow=T))}
expectations <- c(1,meanz_tmp,pkEzk_tmp)
## average total effects
for(i in 2:ng){
tmp <- paste0(Egx[i-1]," := ",
paste(gammas[,,i],expectations, sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
return(res)
}
create_syntax_adjmeans <- function(ng,nk,nz,pk,meanz,Ezk,adjmeans,gammas){
##TODO compute adjusted means based on gammas so that it can be used in
## single group models as well
res <- "\n\n## Adjusted Means"
## create vector of unconditional expectations of Z, K, Z*K
pk_tmp <- pk[-1]
meanz_tmp <- Ezk_tmp <- pkEzk_tmp <- character()
if(nz>0){meanz_tmp <- meanz}
if(nk>1 & nz>0){Ezk_tmp <- c(matrix(Ezk, nrow=nk)[-1,])}
if(nk>1){pkEzk_tmp <- c(matrix(c(pk_tmp,Ezk_tmp), ncol=nk-1, byrow=T))}
expectations <- c(1,meanz_tmp,pkEzk_tmp)
## adjusted means
tmp <- paste0(adjmeans[1]," := ",
paste(gammas[,,1],expectations, sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
for(i in 2:ng){
tmp <- paste(c(gammas[,,1], gammas[,,i]), expectations, sep="*", collapse=" + ")
tmp <- paste0(adjmeans[i]," := ", tmp)
res <- paste0(res, "\n", tmp)
}
return(res)
}
create_syntax_Pkgx <- function(ng, nk, relfreq, Pkgx, px){
res <- "\n\n## Conditional Probabilities P(K=k|X=x)"
relfreq <- matrix(relfreq, nrow=nk)
Pkgx <- matrix(Pkgx, nrow=nk)
for(i in 1:ng){
for(k in 1:nk){
Pkgx[k,i] <- paste0(Pkgx[k,i], " := ", relfreq[k,i], "/", px[i])
}
}
res <- paste0(res, "\n", paste(Pkgx, collapse="\n"))
return(res)
}
create_syntax_Pxgk <- function(ng, nk, relfreq, Pxgk, pk){
res <- NULL
if(nk>1){
res <- paste0(res, "\n\n## Conditional Probabilities P(X=x|K=k)")
relfreq <- matrix(relfreq, nrow=nk)
Pxgk <- matrix(Pxgk, nrow=ng)
for(i in 1:ng){
for(k in 1:nk){
Pxgk[i,k] <- paste0(Pxgk[i,k], " := ", relfreq[k,i], "/", pk[k])
}
}
res <- paste0(res, "\n", paste(Pxgk, collapse="\n"))
}
return(res)
}
create_syntax_Ezgx <- function(ng,nk,nz,Ezgx,Pkgx,cellmeanz){
res <- NULL
if(nz!=0){
res <- paste0(res, "\n\n## Conditional Expectations E(Z|X=x)")
cellmeanz <- array(cellmeanz, dim=c(nz,nk,ng))
Ezgx <- matrix(Ezgx, nrow=nz)
Pkgx <- matrix(Pkgx, nrow=nk)
for(i in 1:ng){
for(q in 1:nz){
Ezgx[q,i] <- paste0(Ezgx[q,i], " := ",
paste(cellmeanz[q,1:nk,i], Pkgx[,i], sep="*", collapse=" + "))
}
}
res <- paste0(res, "\n", paste(Ezgx, collapse="\n"))
}
return(res)
}
create_syntax_Ezgk <- function(ng,nk,nz,cellmeanz,Ezgk,Pxgk){
res <- NULL
if(nz>0 & nk>1){
res <- paste0(res, "\n\n## Conditional Expectations E(Z|K=k)")
cellmeanz <- array(cellmeanz, dim=c(nz,nk,ng))
Ezgk <- matrix(Ezgk, nrow=nz)
Pxgk <- matrix(Pxgk, nrow=ng)
for(i in 1:nk){
for(q in 1:nz){
Ezgk[q,i] <- paste0(Ezgk[q,i], " := ",
paste(cellmeanz[q,i,1:ng], Pxgk[,i], sep="*", collapse=" + "))
}
}
res <- paste0(res, "\n", paste(Ezgk, collapse="\n"))
}
return(res)
}
create_syntax_Ezkgx <- function(ng,nk,nz,Ezkgx,cellmeanz,Pkgx){
res <- NULL
if(nz>0 & nk>1){
res <- paste0(res, "\n\n## Conditional Expectations E(Z*I_K=k|X=x)")
Ezkgx <- array(Ezkgx, dim=c(nz,nk,ng))
cellmeanz <- array(cellmeanz, dim=c(nz,nk,ng))
Pkgx <- array(Pkgx, dim=c(nk,ng))
for(i in 1:ng){
for(k in 1:nk){
for(q in 1:nz){
Ezkgx[q,k,i] <- paste0(Ezkgx[q,k,i], " := ", cellmeanz[[q,k,i]],
"*", Pkgx[k,i])
}
}
}
res <- paste0(res, "\n", paste(Ezkgx, collapse="\n"))
}
return(res)
}
create_syntax_Egxgx <- function(ng,nk,nz,Pkgx,Ezgx,Ezkgx,Egxgx,gammas){
## create matrix of conditional expectations of Z, K, Z*K given X=x
##TODO: maybe we can get rid of the if conditions and only use last one
expectationsgx <- character()
if(nz==0 & nk==1){
expectationsgx <- matrix("1", nrow=ng)
}
if(nz>0 & nk==1){
Ezgx <- matrix(Ezgx, nrow=ng, byrow=T)
expectationsgx <- cbind("1", Ezgx)
}
if(nz==0 & nk>1){
Pkgx <- matrix(Pkgx, nrow=ng, byrow=T)[,-1]
expectationsgx <- cbind("1", Pkgx)
}
if(nz>0 & nk>1){
Ezgx <- matrix(Ezgx, nrow=ng, byrow=T)
select <- c(matrix(Pkgx, nrow=ng, byrow=T)[,-1])
Pkgx <- matrix(select, nrow=ng)
select <- c(array(Ezkgx, dim=c(nz,nk,ng))[,-1,])
Ezkgx <- array(select, dim=c(nz,nk-1,ng))
tmp1 <- matrix(Pkgx[1,], nrow=nk-1, ncol=1)
tmp2 <- matrix(Ezkgx[,,1], nrow=nk-1, ncol=nz, byrow=TRUE)
expectationsgx <- c(1, Ezgx[1,], c(t(cbind(tmp1, tmp2))))
for(i in 2:ng){
tmp1 <- matrix(Pkgx[i,], nrow=nk-1, ncol=1)
tmp2 <- matrix(Ezkgx[,,i], nrow=nk-1, ncol=nz, byrow=TRUE)
expectationsgx <- rbind(expectationsgx,
c(1, Ezgx[i,], c(t(cbind(tmp1, tmp2)))))
}
}
## Effects given a treatment condition
res <- "\n\n## Effects given X=x"
Egxgx <- matrix(Egxgx, ncol=ng)
for(gx in 1:ng){
for(i in 2:ng){
tmp <- paste0(Egxgx[i-1,gx], " := ",
paste(c(gammas[,,i]),expectationsgx[gx,], sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
}
return(res)
}
create_syntax_Egxgk <- function(ng,nk,Egxgk,Ezgk,gammas){
res <- NULL
Egxgk <- matrix(Egxgk, nrow=ng-1)
Ezgk <- matrix(Ezgk, ncol=nk)
Ezgk <- rbind("1", Ezgk)
if(nk>1){
res <- paste0(res, "\n\n## Effects given K=k")
for(i in 2:ng){ ## effects given K=0
tmp <- paste0(Egxgk[i-1,1], " := ",
paste(gammas[,1,i], Ezgk[,1], sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
for(i in 2:ng){ ## effects given K=1,...,k
for(k in 2:nk){
gammaselect <- c(gammas[,c(1,k),i])
tmp <- paste0(Egxgk[i-1,k], " := ",
paste(gammaselect, Ezgk[,k], sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
}
}
return(res)
}
create_syntax_adjmeansgk <- function(ng,nk,adjmeansgk,Ezgk,gammas){
res <- NULL
adjmeansgk <- matrix(adjmeansgk, nrow=ng)
Ezgk <- matrix(Ezgk, ncol=nk)
Ezgk <- rbind("1", Ezgk)
if(nk>1){
res <- paste0(res, "\n\n## Adjmeans given K=k")
for(i in 1:ng){
for(k in 1:nk){
# adjmean0gk0
if(i==1 & k==1){
gammaselect <- c(gammas[,k,i])
Ezgkselect <- Ezgk[,1]
tmp <- paste0(adjmeansgk[i,k], " := ",
paste(gammaselect, Ezgkselect, sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
# adjmean0gkk
if(i==1 & k>1){
gammaselect <- c(gammas[,c(1,k),i])
Ezgkselect <- rep(Ezgk[,1], times=2)
tmp <- paste0(adjmeansgk[i,k], " := ",
paste(gammaselect, Ezgk[,k], sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
# adjmeanxgk0
if(i>1 & k==1){
gammaselect <- c(gammas[,k,c(1,i)])
Ezgkselect <- rep(Ezgk[,1], times=2)
tmp <- paste0(adjmeansgk[i,k], " := ",
paste(gammaselect, Ezgk[,k], sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
# adjmeanxgkk
if(i>1 & k>1){
gammaselect <- c(gammas[,c(1,k),c(1,i)])
Ezgkselect <- rep(Ezgk[,1], times=4)
tmp <- paste0(adjmeansgk[i,k], " := ",
paste(gammaselect, Ezgk[,k], sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
}
}}
return(res)
}
create_syntax_Egxgxk <- function(ng,nk,nz,Egxgxk,gammas,cellmeanz){
res <- NULL
if(nk>1 & nz>0){
res <- paste0(res, "\n\n## Effects given X=x, K=k")
cellmeanz <- array(cellmeanz, dim=c(nz,nk,ng))
Egxgxk <- array(Egxgxk, dim=c(ng-1,ng,nk))
for(t in 2:ng){
for(x in 1:ng){
for(k in 1:nk){
if(k==1){
rhs <- paste0(gammas[,1,t],"*", c(1,cellmeanz[,1,x]), collapse=" + ")
tmp <- paste(Egxgxk[t-1,x,k], ":=", rhs)
res <- paste0(res, "\n", tmp)
}else{
gammaselect <- c(gammas[,1,t], gammas[,k,t])
cellmeanzselect <- rep(c(1,cellmeanz[,k,x]),2)
rhs <- paste0(gammaselect,"*", cellmeanzselect, collapse=" + ")
tmp <- paste(Egxgxk[t-1,x,k], ":=", rhs)
res <- paste0(res, "\n", tmp)
}
}
}
}
}
return(res)
}
create_syntax_interaction_constraints <- function(constrainedgammas){
res <- NULL
if(length(constrainedgammas) != 0){
res <- paste0(res, "\n\n## Equality Constraints")
res <- paste0(res, "\n", paste(constrainedgammas, "== 0", collapse="\n"))
}
return(res)
}
create_syntax_interaction_constraints_lm <- function(constrainedgammas){
res <- NULL
if(length(constrainedgammas) != 0){
res <- paste0(res, "\n\n## Interaction Constraints")
res <- paste0(res, "\n", paste(constrainedgammas, ":= 0", collapse="\n"))
}
return(res)
}
create_syntax_AveEffZ <- function(nz, alphas, relfreq, AveEffZ){
res <- NULL
if(nz > 0){
res <- "\n\n## Average Effects of Continuous Covariates"
for(i in 1:nz){
tmp <- paste0(AveEffZ[i] ," := ",
paste(alphas[i+1,,],relfreq, sep="*", collapse=" + "))
res <- paste0(res, "\n", tmp)
}
}
return(res)
}
create_syntax_AveEffK <- function(ng,nk,nz,pk,meanz,Ezk,Egx,gammas){
res <- NULL
# if(nk>1){
#
# res <- "\n\n## Average Effects of Categorical Covariate K"
#
# }
#
# TODO
# - Im Prinzip muesste das genauso gehen wie bei den average effects
# - man brauch aber noch E(Z*X)
# - und bei mehreren Ks wird es schwierig
# - ein einfacher Weg das zu testen waere das Modell nochmal durchlaufen
# zu lassen mit K und X vertauscht
#
#
# ## create vector of unconditional expectations of Z, K, Z*K
# pk_tmp <- pk[-1]
# meanz_tmp <- Ezk_tmp <- pkEzk_tmp <- character()
#
# if(nz>0){meanz_tmp <- meanz}
# if(nk>1 & nz>0){Ezk_tmp <- c(matrix(Ezk, nrow=nk)[-1,])}
# if(nk>1){pkEzk_tmp <- c(matrix(c(pk_tmp,Ezk_tmp), ncol=nk-1, byrow=T))}
#
# expectations <- c(1,meanz_tmp,pkEzk_tmp)
#
# ## average total effects
# for(i in 2:ng){
# tmp <- paste0(Egx[i-1]," := ",
# paste(gammas[,,i],expectations, sep="*", collapse=" + "))
# res <- paste0(res, "\n", tmp)
# }
return(res)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.