Nothing
setMethod("show", "effectlite", function(object) {
ng <- object@input@ng
nk <- object@input@nk
nz <- object@input@nz
vnames <- object@input@vnames
vlevels <- object@input@vlevels
gammas <- object@parnames@gammas
gammalabels <- object@parnames@gammalabels
label.g.function <- object@parnames@label.g.function
label.covs <- object@parnames@label.covs
label.Egx <- object@parnames@label.Egx
if(object@input@method == "sem"){
if(!lavInspect(object@results@lavresults, "converged")){
cat("\n\n------------------------------------------------------\n")
cat("---------------------- Warning ----------------------\n")
cat("------------------------------------------------------ \n\n")
cat("lavaan model has not converged \n\n")
}else if(lavInspect(object@results@lavresults, "converged")){
cat("\n\n--------------------- Message --------------------- \n\n")
cat(" -- model converged succesfully -- \n")
}
}
cat("\n\n--------------------- Variables --------------------- \n\n")
cat("Outcome variable Y: ", paste0(vnames$y), "\n")
cat("Treatment variable X: ", paste0(vnames$x), " (Reference group: ",
paste0(object@input@control, ")\n"))
if(!is.null(vnames$k)){
cat("Categorical covariates K: ", paste0(vnames$k), "\n")
}
if(!is.null(vnames$z)){
tmp <- "Continuous covariates in Z=("
tmp <- paste0(tmp, paste0("Z",1:nz, collapse=","), "): ")
tmp <- paste0(tmp, paste0(paste0("Z", 1:nz, "="), vnames$z, collapse=" "))
cat(tmp, "\n")
}
if(!is.null(vnames$propscore)){
v <- vnames$propscore
if(is(v, "formula")){v <- all.vars(v[[3]])}
cat("Covariates for propensity score V: ", paste0(v), "\n")
}
cat("\nLevels of Treatment Variable X \n")
tmp <- data.frame(vlevels$x,
vlevels$levels.x.original,
paste0("I_X=",vlevels$x))
names(tmp) <- c("X",
paste0(vnames$x, " (original)"),
"Indicator")
print(tmp, row.names=F, print.gap=3)
if(nk>1){
cat("\nLevels of Unfolded Categorical Covariate K \n")
tmp <- vlevels$levels.k.original
tmp <- tmp[length(tmp):1]
tmp <- expand.grid(tmp)
tmp$K <- vlevels$kstar
tmp <- tmp[,ncol(tmp):1]
tmp$Indicator <- paste0("I_K=", vlevels$kstar)
print(tmp, row.names=F, print.gap=3)
}
if(nk>1){
cat("\nCells \n")
tmp <- expand.grid(K=vlevels$kstar, X=vlevels$levels.x.original)[,2:1]
names(tmp)[1] <- paste0(vnames$x, " (original)")
tmp$Cell <- vlevels$cell
print(tmp, print.gap=3)
}
cat("\n\n --------------------- Regression Model --------------------- \n")
tmp <- paste0("E(Y|X",label.covs,") = ")
tmp <- paste0(tmp, "g0",label.g.function," + ")
tmp <- paste0(tmp, paste0("g",1:(ng-1),label.g.function,"*I_X=",1:(ng-1),
collapse=" + "))
cat("\n",tmp, "\n")
gammalabels2 <- gammalabels[,,1]
gammalabels2[1] <- ""
for(i in 1:ng){
tmp <- paste0(" g",i-1,label.g.function," = ")
tmp <- paste0(tmp, paste(gammas[,,i], gammalabels2, sep=" * ", collapse=" + "))
tmp <- gsub("* ", "", tmp, fixed=TRUE)
if(length(gammalabels2)==1){tmp <- gsub("*", "", tmp, fixed=TRUE)}
if(nchar(tmp) > 80){
## split g function over several lines
tmp <- unlist(strsplit(tmp, " + ", fixed=TRUE))
tmp <- capture.output(cat(tmp, sep=" + ", fill=80))
tmp[2:length(tmp)] <- paste0(" + ",tmp[2:length(tmp)])
cat(tmp, sep="\n")
} else{
cat(tmp, "\n")
}
}
## print coefficients of g-Functions
for(i in 1:ng){
if(i==1){
tmp <- paste0("Intercept Function g",i-1,label.g.function,
" [Reference group: ",
paste0(object@input@control), "]")
cat("\n",tmp, "\n\n")
}else{
tmp <- paste0("Effect Function g",i-1,label.g.function)
tmp <- paste0(tmp, " [", object@input@vnames$x,
": ", object@input@vlevels$levels.x.original[i],
" vs. ",object@input@vlevels$levels.x.original[1], "]")
cat("\n",tmp, "\n\n")
}
tmp <- object@results@gx[[i]]
tmp[,2:5] <- round(tmp[,2:5], digits=3)
print(tmp, print.gap=3, row.names=FALSE)
}
cat("\n\n--------------------- Cell Counts --------------------- \n\n")
cat("\n")
cat("Cell Counts \n\n")
cat("This table shows cell counts including missings. \n")
cat("See also output under lavaan results for number of observations \n")
cat("actually used in the analysis. \n\n")
if(nk==1){
print(ftable(object@input@data[vnames$x]), print.gap=3)
}else{
cellcounts <- as.formula(paste0(paste(vnames$k, collapse="+"),
"~", vnames$x))
print(ftable(cellcounts, data=object@input@data), print.gap=3)
}
cat("\n\n--------------------- Main Hypotheses --------------------- \n\n")
if(nrow(object@results@hypotheses)==0){
cat("Wald tests for main hypotheses are currently not available for models with \n non-standard SEs and for models with (in-)equality constraints (e.g., on interactions).")
}else{
rowname1 <- paste0(label.Egx, collapse=" = ")
rowname1 <- paste0("H0: No average effects: ", rowname1, " = 0")
rowname2 <- paste0("H0: No covariate effects in control group: g0", label.g.function, " = constant")
rowname3 <- paste0("g", 1:(ng-1), label.g.function, collapse=", ")
rowname3 <- paste0("H0: No treatment*covariate interaction: ", rowname3, " = constant")
rowname4 <- paste0("g", 1:(ng-1), label.g.function, collapse=" = ")
rowname4 <- paste0("H0: No treatment effects: ", rowname4, " = 0")
if(nz==0 & nk==1){
cat(rowname1)
}else{
cat(paste0(c(rowname1, rowname2, rowname3, rowname4), collapse="\n"))
}
cat("\n\n")
hypotheses <- object@results@hypotheses
print(hypotheses, digits=3, print.gap=3)
}
cat("\n\n --------------------- Adjusted Means --------------------- \n\n")
namesadjmeans <- paste0("Adj.Mean",0:(ng-1))
adjmeans <- object@results@adjmeans
row.names(adjmeans) <- namesadjmeans
print(adjmeans, digits=3, print.gap=3)
cat("\n\n --------------------- Average Effects --------------------- \n\n")
Egx <- object@results@Egx
row.names(Egx) <- label.Egx
print(Egx, digits=3, print.gap=3)
if(!(nz==0 & nk==1)){
cat("\n\n --------------------- Effects given a Treatment Condition --------------------- \n\n")
tmp <- expand.grid(g=1:(ng-1), x=0:(ng-1))
namesEgxgx <- paste0("E[g",tmp$g,label.g.function,"|X=",tmp$x, "]")
Egxgx <- object@results@Egxgx
row.names(Egxgx) <- namesEgxgx
print(Egxgx, digits=3, print.gap=3)
}
if(nk>1){
cat("\n\n --------------------- Effects given K=k --------------------- \n\n")
tmp <- expand.grid(g=1:(ng-1), k=0:(nk-1))
namesEgxgk <- paste0("E[g",tmp$g,label.g.function,"|K=",tmp$k,"]")
Egxgk <- object@results@Egxgk
row.names(Egxgk) <- namesEgxgk
print(Egxgk, digits=3, print.gap=3)
}
if(nk>1 & nz>0){
cat("\n\n --------------------- Effects given X=x, K=k --------------------- \n\n")
Egxgxk <- paste0("Eg",tmp$g,"gx",tmp$x,"k",tmp$k)
tmp <- expand.grid(g=1:(ng-1), x=0:(ng-1), k=0:(nk-1))
namesEgxgxk <- paste0("E[g",tmp$g,label.g.function,"|X=",tmp$x,", K=",tmp$k,"]")
Egxgxk <- object@results@Egxgxk
row.names(Egxgxk) <- namesEgxgxk
print(Egxgxk, digits=3, print.gap=3)
}
if(nk>1){
cat("\n\n--------------------- Hypotheses given K=k --------------------- \n\n")
if(nrow(object@results@hypothesesk)==0){
cat("Wald tests for these hypotheses are currently not available for models with \n non-standard SEs and for models with (in-)equality constraints (e.g., on interactions).")
}else{
for(i in 1:nk){
tmp <- paste0("E[g",1:(ng-1),label.g.function,"|K=",i-1,"]")
tmp <- paste0(tmp, collapse=" = ")
tmp <- paste0("H0: No average effects given K=", i-1,": ", tmp, " = 0")
cat(tmp, "\n")
}
cat("\n")
hypothesesk <- object@results@hypothesesk
print(hypothesesk, digits=3, print.gap=3)
}
}
# ## currently not printed
# if(nz>0){
# cat("\n\n --------------------- Average Effects of Continuous Covariates --------------------- \n\n")
# AveEffZ <- object@results@AveEffZ
# print(AveEffZ, digits=3, print.gap=3)
#
# }
if(length(object@input@add > 0)){
if(grepl(":=", object@input@add)){
cat("\n\n --------------------- User Defined Parameters/Effects --------------------- \n\n")
AdditionalEffects <- object@results@AdditionalEffects
print(AdditionalEffects, digits=3, print.gap=3)
}}
propscore <- object@input@vnames$propscore
if(!is.null(propscore)){
cat("\n\n --------------------- Propensity Score Model --------------------- \n\n")
cat("Model equation: log[P(X=1|V)/P(X=0|V)] = h1(V)", "\n")
if(ng > 2){
for(i in 3:ng){
tmp <- paste0(" ",
"log[P(X=", (i-1), "|V)/P(X=0|V)] = h",(i-1),"(V)",
"\n")
cat(tmp)
}
}
cat("R formula for nnet::multinom: ", object@input@outprop$formula, "\n")
cat("\nEstimate\n")
print(object@input@outprop$coef, digits=3, print.gap=3)
cat("\nStandard Error\n")
print(object@input@outprop$se, digits=3, print.gap=3)
cat("\nEst./SE\n")
print(object@input@outprop$tval, digits=3, print.gap=3)
}
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.