Nothing
#' Make mean summary table
#' @param data A data.frame
#' @param X Name of independent variable
#' @param Y Name of dependent variable
#' @param M Name of mediator variable
#' @param W Name of moderator variable
#' @param labels A list of labels
#' @param digits Integer indicating the number of decimal places
#' @param xlabels Optional string vector
#' @param maxylev maximal unique length of categorical variable
#' @param mode integer
#' @export
#' @examples
#'labels=list(X="cond",Y="reaction",M="pmi")
#'xlabels=c("Front Page","Interior Page")
#'meanSummary(data=pmi,labels=labels,xlabels=xlabels)
#'labels=list(X="frame",Y="justify",W="skeptic")
#'xlabels=c("Natural causes condition","Climate change condition")
#'meanSummary(data=disaster,labels=labels,xlabels=xlabels)
#'labels=list(X="protest",Y="liking",M="respappr")
#'meanSummary(data=protest,labels=labels)
#'meanSummary(data=protest,labels=labels,maxylev=2)
meanSummary=function(data,X=NULL,Y=NULL,M=NULL,W=NULL,labels=labels,digits=3,xlabels=NULL,maxylev=6,mode=1){
# X=NULL;Y=NULL;M=NULL;W=NULL;digits=3;xlabels=NULL
# data=disaster
if(is.null(X)) X=labels[["X"]]
if(is.null(Y)) Y=labels[["Y"]]
if(is.null(M)) M=labels[["M"]]
if(is.null(W)) W=labels[["W"]]
values=sort(unique(data[[X]]))
count=length(values)
data
y=getMeanSd(data=data,X=X,Y=Y,digits=digits)
if(!is.null(M)) {
m=getMeanSd(data=data,X=X,Y=M,digits=digits)
yhat=getYhat1(data=data,X=X,M=M,Y=Y,digits=digits,maxylev=maxylev,mode=mode)
yhat
adjY=rep("",(length(values)+1)*2)
for(i in seq_along(yhat)){
adjY[2*i-1]=yhat[i]
}
name=rep(c("Mean","SD"),count+1)
xvalues=paste0(X,"(X) = ",values)
X=rep("",(length(values)+1)*2)
if(!is.null(xlabels)){
for(i in seq_along(xvalues)){
X[2*i-1]=xlabels[i]
X[2*i]=paste0(xvalues[i])
}
} else{
for(i in seq_along(xvalues)){
X[2*i-1]=xvalues[i]
}
}
df=data.frame(X=X,name=name,Y=y,M=m,adjY=adjY,stringsAsFactors = FALSE)
df
attr(df,"M")=M
}
if(!is.null(W)) {
w=getMeanSd(data=data,X=X,Y=W,digits=digits)
name=rep(c("Mean","SD"),count+1)
xvalues=paste0(X,"(X) = ",values)
X=rep("",(length(values)+1)*2)
if(!is.null(xlabels)){
for(i in seq_along(xvalues)){
X[2*i-1]=xlabels[i]
X[2*i]=paste0(xvalues[i])
}
} else{
for(i in seq_along(xvalues)){
X[2*i-1]=xvalues[i]
}
}
data
df=data.frame(X=X,name=name,Y=y,W=w,stringsAsFactors = FALSE)
df
attr(df,"W")=W
}
attr(df,"X")=X
attr(df,"Y")=Y
class(df)=c("meanSummary","data.frame")
df
}
#'S3 method of class meanSummary
#'@param x An object of class meanSummary
#'@param ... Further arguments to be passed to print()
#'@export
print.meanSummary=function(x,...){
mode=1
if(ncol(x)>4) mode=2
width=c(20,rep(8,ncol(x)-1))
width[1]=max(20,max(nchar(x[["X"]]))+2)
width[3]=max(width[3],max(nchar(attr(x,"Y"))+2))
if(mode==1){
width[4]=max(width[4],max(nchar(attr(x,"W"))+2))
} else{
width[4]=max(width[4],max(nchar(attr(x,"M"))+2))
width[5]=max(width[4],10)
}
total=sum(width)
cat(paste(rep("=",total),collapse = ""),"\n")
temp=paste0(centerPrint("",width[1]),centerPrint("",width[2]),
centerPrint(names(x)[3],width[3]),centerPrint(names(x)[4],width[4]))
if(mode==2) {
temp=paste0(temp,centerPrint("Y",width[5]))
}
cat(temp,"\n")
if(mode==1){
temp=paste0(centerPrint("",width[1]),centerPrint("",width[2]),
centerPrint(attr(x,"Y"),width[3]),centerPrint(attr(x,"W"),width[4]))
} else{
temp=paste0(centerPrint("",width[1]),centerPrint("",width[2]),
centerPrint(attr(x,"Y"),width[3]),centerPrint(attr(x,"M"),width[4]),
centerPrint("adjusted",width[5]))
}
cat(temp,"\n")
cat(paste(rep("-",total),collapse = ""),"\n")
for(i in 1:(nrow(x)-2)){
temp=""
for(j in 1:ncol(x)){
temp=paste0(temp,centerPrint(x[i,j],width[j]))
}
cat(temp,"\n")
}
cat(paste(rep("-",total),collapse = ""),"\n")
for(i in (nrow(x)-1):nrow(x)){
temp=""
for(j in 1:ncol(x)){
temp=paste0(temp,centerPrint(x[i,j],width[j]))
}
cat(temp,"\n")
}
cat(paste(rep("=",total),collapse = ""),"\n")
}
#' Make mean summary table
#' @param ... Further arguments to be passed to meanSummary
#' @param vanilla logical
#' @importFrom rrtable df2flextable
#' @export
#' @examples
#'labels=list(X="cond",Y="reaction",M="pmi")
#'xlabels=c("Front Page","Interior Page")
#'meanSummaryTable(data=pmi,labels=labels,xlabels=xlabels)
#'labels=list(X="frame",Y="justify",W="skeptic")
#'xlabels=c("Natural causes condition","Climate change condition")
#'meanSummaryTable(data=disaster,labels=labels,xlabels=xlabels)
meanSummaryTable=function(...,vanilla=TRUE){
x=meanSummary(...)
mode=ifelse(ncol(x)==4,1,2)
ft<- rrtable::df2flextable(x,vanilla=vanilla)
if(mode==1) {
headerlabels=list(X="",name=" ",Y="Y",W="W")
headerrow=c("","",attr(x,"Y"),attr(x,"W"))
} else{
headerlabels=list(X="",name=" ",Y="Y",M="M",adjY="Y")
headerrow=c("","",attr(x,"Y"),attr(x,"M"),"adjusted")
}
ft<- ft %>% width(j=1,width=2.5) %>%
set_header_labels(values=headerlabels) %>%
add_header_row(values=headerrow,top=FALSE,colwidths=rep(1,ncol(x))) %>%
align(align="center",part="header") %>%
italic(part="header") %>%
hline(i=1,border=fp_border(color="#EDBD3E",width=0),part="header") %>%
hline(i=nrow(x)-2,j=2:ncol(x),border=fp_border(color="black",width=1),part="body") %>%
fontsize(size=12,part="all")
ft
}
#' get mean and sd
#' @param data A data.frame
#' @param X Name of independent variable
#' @param Y Name of dependent variable
#' @param digits Integer indicating the number of decimal places
getMeanSd=function(data,X,Y,digits){
values=sort(unique(data[[X]]))
y=c()
for(i in seq_along(values)) {
y=c(y,mean(data[data[[X]]==values[i],Y],na.rm=T),
sd(data[data[[X]]==values[i],Y],na.rm=T))
}
y=c(y,mean(data[[Y]],na.rm=T),sd(data[[Y]],na.rm=T))
sprintf(paste0("%0.",digits,"f"),y)
}
#' Get Yhat value from simple mediation
#' @param data A data.frame
#' @param X Name of independent variable
#' @param M Name of moderator variable
#' @param Y Name of dependant variable
#' @param labels optional list of labels
#' @param digits Integer indicating the number of decimal places
#' @param maxylev maximal unique length of categorical variable
#' @param mode Numeric. One of 1:4. 1= simple indicator coding, 2= sequential coding, 3= Helmert coding, 4= effect coding
#' @export
#' @examples
#' data=protest
#' labels=list(X="protest",M="respappr",Y="liking")
#' getYhat1(data=protest,labels=labels)
getYhat1=function(data,X=NULL,M=NULL,Y=NULL,labels,digits=3,maxylev=6,mode=1){
# digits=3; maxylev=6;mode=1
if(is.null(X)) X=labels$X
if(is.null(M)) if(!is.null(labels$M)) M=labels$M
if(is.null(Y)) Y=labels$Y
if(length(unique(data[[X]]))<=maxylev){
data=addCatVars(data,X,mode=mode)
count=length(unique(data[[X]]))-1
newX=paste0(paste0("D",1:count),collapse="+")
newX
temp=paste0("lm(",Y,"~",M,"+",newX,",data=data)")
temp
fit=eval(parse(text=temp))
summary(fit)
ratio=getRatioTable(count=count+1,mode=mode)
ratio
ratio[2,]
yhat=c()
temp=fit$coef[1]+fit$coef[2]*mean(data[[M]],na.rm=T)
for(i in 0:count){
temp1=0
for(j in 1:ncol(ratio)){
temp1=temp1+fit$coef[j+2]*ratio[i+1,j]
}
yhat=c(yhat,temp+temp1)
}
yhat
} else{
temp=paste0("lm(",Y,"~",M,"+",X,",data=data)")
fit=eval(parse(text=temp))
summary(fit)
values=sort(unique(data[[X]]))
yhat=fit$coef[1]+fit$coef[2]*mean(data[[M]],na.rm=T)+fit$coef[3]*values
}
round(yhat,digits)
}
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.