Nothing
#' Make triple interaction equation
#' @param vars variable names to be interact
#' @param prefix A character
#' @param suffix A number
#' @param mode A number
#' @param addPrefix A logical
#' @importFrom utils combn
#' @export
#' @examples
#' vars=c("negemot","sex","age")
#' tripleInteraction(vars)
#' tripleInteraction(vars,mode=1)
tripleInteraction=function(vars,prefix="c",suffix=0,mode=0,addPrefix=TRUE){
if(mode){
temp=paste(vars,collapse="*")
} else{
result=vars
result=c(result,apply(combn(vars,2),2,function(x){paste(x,collapse=":")}))
result=c(result,paste0("interaction",suffix))
if(addPrefix) {
temp=paste0(prefix,1:length(result),"*",result)
} else{
temp=result
}
}
temp
}
#' Make equation with triple interaction
#' @param X Name of independent variable
#' @param M Name of mediator
#' @param Y Name of dependent variable
#' @param labels A list of variables
#' @param vars A list of variables names and sites
#' @param suffix A number
#' @param moderator A list of moderators
#' @param covar A list of covariates
#' @param mode A number
#' @param range A logical
#' @param data A data.frame
#' @param rangemode range mode
#' @param probs numeric vector of probabilities with values in [0,1]
#' @param effectsize logical If true, calculate effectsize
#' @export
#' @examples
#' X="negemot";M="ideology";Y="govact";suffix=0
#' cat(tripleEquation(X=X,M=M,Y=Y))
#' vars=list(name=list(c("sex","age")),site=list(c("a","c")))
#' vars=list(name=list(c("W","Z"),c("V","Q")),site=list(c("a","b","c"),c("a","b","c")))
#' X="negemot";Y="govact";suffix=0
#' moderator=list(name=c("W"),site=list(c("b","c")))
#' cat(tripleEquation(X=X,Y=Y,moderator=moderator))
#' covar=list(name=c("C1","C2","C3"),site=list(c("M","Y"),c("Mi","Y"),"Y"))
#' labels=list(X="negemot",M="ideology",Y="govact")
#' cat(tripleEquation(labels=labels,moderator=moderator,covar=covar))
#' cat(tripleEquation(X=X,M=M,Y=Y,moderator=moderator,covar=covar,mode=1))
#' cat(tripleEquation(X=X,M=M,Y=Y,vars=vars))
#' cat(tripleEquation(X=X,M=M,Y=Y,vars=vars,moderator=moderator,covar=covar))
#' cat(tripleEquation(X=X,M=M,Y=Y,vars=vars,mode=1))
#' cat(tripleEquation(X=X,M=M,Y=Y,vars=vars,covar=covar,mode=1))
#' X="negemot";Y="govact";suffix=0
#' vars=list(name=list(c("sex","age")),site=list(c("c")))
#' cat(tripleEquation(X=X,Y=Y,vars=vars))
tripleEquation=function(X=NULL,M=NULL,Y=NULL,labels=list(),vars=NULL,suffix=0,moderator=list(),
covar=NULL,range=TRUE,mode=0,data=NULL,rangemode=1,probs=c(0.16,0.5,0.84),
effectsize=FALSE){
# labels=list(X="frame",M="justify",Y="donate",W="skeptic")
# moderator=list(name=c("skeptic","Z"),site=list(c("a","b","c"),c("b")))
# labels=list(X="frame:skeptic",M="justify",Y="donate")
# covar=list(name=c("frame","skeptic"),site=list(c("M","Y"),c("M","Y")))
# moderator=list()
# X=NULL;M=NULL;Y=NULL;vars=NULL;suffix=0;
# range=TRUE;mode=0;data=NULL;rangemode=1;probs=c(0.16,0.5,0.84)
# cat("str(vars)\n")
# str(vars)
# cat("str(moderator)\n")
# str(moderator)
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
temp1<-temp2<-temp3<-temp4<-NULL
(XM=moderator$name[str_detect2(moderator$site,"a")])
(MY=moderator$name[str_detect2(moderator$site,"b")])
(XY=moderator$name[str_detect2(moderator$site,"c")])
res=seekNameVars(vars,"a")
if(length(res)>0) {
for(i in 1:length(res)){
newvars=c(X,vars$name[[res[i]]])
temp1=c(temp1,tripleInteraction(newvars,prefix="a",suffix=suffix,mode=mode,addPrefix=FALSE))
suffix=suffix+1
}
}
temp1
if(!is.null(M)){
XM=c(X,XM)
XMstr=interactStr(XM,addPrefix=FALSE)
temp1=union(temp1,XMstr)
if(mode==0) temp1=paste0("a",1:length(temp1),"*",temp1)
temp4=paste0(M,"~",paste(temp1,collapse="+"))
if(!is.null(covar)){
covar$site=lapply(covar$site,function(x) str_replace(x,"Mi|M",M))
if(mode){
temp4=addCovarEquation(temp4,covar,prefix=NULL)
} else{
temp4=addCovarEquation(temp4,covar,prefix="f")
}
}
}
res=seekNameVars(vars,"b")
length(res)
if(length(res)>0) {
for(i in 1:length(res)){
newvars=c(M,vars$name[[res[i]]])
temp2=c(temp2,tripleInteraction(newvars,prefix="b",suffix=suffix,mode=mode,addPrefix=FALSE))
suffix=suffix+1
}
}
temp2
MY=c(M,MY)
MYstr=interactStr(MY,addPrefix=FALSE)
MYstr
for(i in 1:length(moderator$site)){
if("c" %in% moderator$site[[i]]) MYstr=setdiff(MYstr,moderator$name[i])
}
temp2=union(temp2,MYstr)
temp2
if(mode==0) {
if(length(temp2)>0) temp2=paste0("b",1:length(temp2),"*",temp2)
}
res=seekNameVars(vars,"c")
if(length(res)>0) {
for(i in 1:length(res)){
newvars=c(X,vars$name[[res[i]]])
if("a" %in% vars$site[[res[i]]]){
newsuffix=0
if(res[i]>1){
for(j in 1:res[i]){
if("a" %in% vars$site[[j]]) newsuffix=newsuffix+1
}
}
} else{
newsuffix=suffix
}
temp3=c(temp3,tripleInteraction(newvars,suffix=newsuffix,mode=mode,addPrefix=FALSE))
suffix=suffix+1
}
}
XY=c(X,XY)
XYstr=interactStr(XY,addPrefix=FALSE)
temp3=union(temp3,XYstr)
if(mode==0) temp3=paste0("c",1:length(temp3),"*",temp3)
temp3
temp=c(temp3,temp2)
temp=paste0(Y,"~",paste(temp,collapse="+"))
if(!is.null(covar)){
covar$site=lapply(covar$site,function(x) str_replace(x,"Y",Y))
if(mode){
temp=addCovarEquation(temp,covar,prefix=NULL)
} else{
temp=addCovarEquation(temp,covar,prefix="g")
}
}
temp=c(temp4,temp)
equation=paste(temp,collapse="\n")
equation=paste0(equation,"\n")
equation
if(mode==0){
moderatorNames=union(unlist(vars$name),moderator$name)
moderatorNames
for(i in seq_along(moderatorNames)){
name=moderatorNames[i]
temp=paste0(name," ~ ",name,".mean*1\n")
temp=paste0(temp,name," ~~ ",name,".var*",name,"\n")
equation=paste0(equation,temp)
}
# cat("Y=",Y,"\n")
temp=makeIndirectEquation(X,M,temp1,temp2,temp3,moderatorNames,range=range,data=data,rangemode=rangemode,
effectsize=effectsize,Y=Y)
temp
equation=paste0(equation,temp)
}
if(mode==0) equation=deleteSingleNumber(equation)
equation
}
#'remove coefficient number of equation
#'@param equation string
deleteSingleNumber=function(equation){
for(i in c(1:3,6:7)){
if(!str_detect(equation,paste0(letters[i],"2"))){
# cat(paste0(letters[i],"2")," is not found.\n")
equation=str_replace_all(equation,paste0(letters[i],"1"),letters[i])
}
}
equation
}
#' select names of variables from list var
#' @param vars A list
#' @param site Site for look for
#' @export
#' @examples
#' vars=list(name=list(c("W","Z"),c("V","Q")),site=list(c("a","c"),c("b","c")))
#' vars=list(name=list(c("W","Z")),site=list(c("a","c")))
#' seekNameVars(vars,"a")
#' seekNameVars(vars,"b")
#' seekNameVars(vars,"c")
seekNameVars=function(vars,site="a"){
result<-c()
if(!is.null(vars)){
if(length(vars)>0){
select=which(unlist(lapply(lapply(vars$site,str_detect,site),any)))
result<-select
}
}
result
}
#'Treat moderator name with mean value
#'@param ind An equation
#'@param moderatorNames character vectors
#' @param data A data.frame
#' @param rangemode range mode
#' @param probs numeric vector of probabilities with values in [0,1]
#' @importFrom stats quantile
#'@export
#'@examples
#'ind="(a1+a4*sex+a5*age)*(b1)"
#'moderatorNames=c("age","sex")
#'treatModerator(ind,moderatorNames)
#'ind="c1+c3*hp"
#'moderatorNames="hp"
#'treatModerator(ind,moderatorNames)
treatModerator=function(ind,moderatorNames,data=NULL,rangemode=1,probs=c(0.16,0.5,0.84)){
ind.below<-ind.above<-ind
for(i in seq_along(moderatorNames)){
if(rangemode==2){
values=quantile(data[[moderatorNames[i]]],probs=probs,type=6)
temp=as.character(values[2])
ind=str_replace_all(ind,moderatorNames[i],temp)
temp=as.character(values[1])
ind.below=str_replace_all(ind.below,moderatorNames[i],temp)
temp=as.character(values[3])
ind.above=str_replace_all(ind.above,moderatorNames[i],temp)
} else{
temp=paste0(moderatorNames[i],".mean")
ind=str_replace_all(ind,moderatorNames[i],temp)
temp=paste0("(",moderatorNames[i],".mean-sqrt(",moderatorNames[i],".var))")
ind.below=str_replace_all(ind.below,moderatorNames[i],temp)
temp=paste0("(",moderatorNames[i],".mean+sqrt(",moderatorNames[i],".var))")
ind.above=str_replace_all(ind.above,moderatorNames[i],temp)
}
}
list(ind,ind.below,ind.above)
}
#'Make indirect equation
#'@param X A character string
#'@param M A character string
#'@param temp1 A character vector
#'@param temp2 A character vector
#'@param temp3 A character vector
#'@param moderatorNames A character vector
#'@param range A logical
#' @param data A data.frame
#' @param rangemode range mode
#' @param probs numeric vector of probabilities with values in [0,1]
#' @param effectsize logical If true, calculate effect size.
#'@param Y Optional character string
#' @importFrom stringr str_replace_all
#'@export
#'@examples
#'X="negemot";M="ideology"
#'temp1=c("a1*negemot","a2*sex","a4*negemot*sex","a5*negemot*age","a6*sex*age")
#'temp2="b1*ideology"
#'temp3="c1*negemot"
#'moderatorNames=c("age","sex")
#'X= "hp";M= "am"
#'temp1= c("a1*hp","a2*wt","a3*hp:wt")
#'temp2= "b1*am"
#'temp3= c("c1*hp","c2*wt","c3*hp:wt")
#'#moderatorNames=c("wt")
#'#X= c("d1","d2");M="am"
#'#temp1=c("a1*d1","a2*d2","a3*wt","a4*d1:wt","a5*d2:wt")
#'#temp2="b1*am"
#'#temp3=c("c1*d1","c2*d2","c3*wt","c4*d1:wt","c5*d2:wt")
#'cat(makeIndirectEquation(X,M,temp1,temp2,temp3,moderatorNames))
#'cat(makeIndirectEquation(X,M,temp1,temp2,temp3,moderatorNames,range=TRUE))
#'X="wt";M=NULL;temp1=NULL;temp2=NULL;temp3=c("c1*wt","c2*hp","c3*wt:hp");
#'moderatorNames="hp";range=TRUE;rangemode=1;probs=c(0.16,0.5,0.84)
#'cat(makeIndirectEquation(X,M,temp1,temp2,temp3,moderatorNames,range=TRUE))
makeIndirectEquation=function(X,M,temp1,temp2,temp3,moderatorNames,
range=FALSE,data=NULL,rangemode=1,probs=c(0.16,0.5,0.84),
effectsize=FALSE,Y=NULL){
#'X="frame:skeptic"; M="justify";temp1="a1*frame:skeptic";
#'temp2="b1*justify";temp3="c1*frame:skeptic";moderatorNames=NULL
#'range=TRUE;rangemode=1
# range=TRUE;data=NULL;rangemode=1;probs=c(0.16,0.5,0.84)
equation=""
if(!is.null(M)){
if(!str_detect(X,":")) temp1=stringr::str_replace_all(temp1,":","*")
ind1=strGrouping(temp1,X)$yes
if(!str_detect(M,":")) temp2=stringr::str_replace_all(temp2,":","*")
ind2=strGrouping(temp2,M)$yes
ind=paste0("(",str_flatten(ind1,"+"), ")*(",str_flatten(ind2,"+"),")")
ind
res=treatModerator(ind,moderatorNames,data=data,rangemode=rangemode,probs=probs)
ind<-res[[1]]
ind.below=res[[2]]
ind.above=res[[3]]
temp4=divideEquation(ind)
if(str_detect(temp4[1],"\\+")) {
equation=paste0(equation,"CE.XonM :=",temp4[1],"\n")
}
if(str_detect(temp4[2],"\\+")) {
equation=paste0(equation,"CE.MonY :=",temp4[2],"\n")
}
equation=paste0(equation,"indirect :=",ind,"\n")
if(!is.null(extractIMM(ind))) {
equation=paste0(equation,"index.mod.med :=",extractIMM(ind),"\n")
}
if(!str_detect(X,":")) temp3=stringr::str_replace_all(temp3,":","*")
direct=strGrouping(temp3,X)$yes
dir=paste0(str_flatten(direct,"+"))
dir
res=treatModerator(dir,moderatorNames,data=data,rangemode=rangemode,probs=probs)
dir<-res[[1]]
dir.below=res[[2]]
dir.above=res[[3]]
equation=paste0(equation,"direct :=",dir,"\n")
equation=paste0(equation,"total := direct + indirect\n")
equation=paste0(equation,"prop.mediated := indirect / total\n")
if(effectsize){
equation=paste0(equation,"sdy := ",sd(data[[Y]],na.rm = T) ,"\n")
equation=paste0(equation,"sdx := ",sd(data[[X]],na.rm = T) ,"\n")
equation=paste0(equation,"\n## Partially standardized effects ##\n")
equation=paste0(equation,"indirect.ps := indirect/sdy\n")
equation=paste0(equation,"direct.ps := direct/sdy\n")
equation=paste0(equation,"total.ps := direct.ps + indirect.ps\n")
equation=paste0(equation,"\n## Completely standardized effects ##\n")
equation=paste0(equation,"indirect.cs := sdx*indirect.ps\n")
equation=paste0(equation,"direct.cs := sdx* direct.ps\n")
equation=paste0(equation,"total.cs := direct.cs + indirect.cs\n")
}
if(length(moderatorNames)==0) range=FALSE
if(range){
temp4=divideEquation(ind.below)
if(str_detect(temp4[1],"\\+")) {
equation=paste0(equation,"CE.XonM.below :=",temp4[1],"\n")
}
if(str_detect(temp4[2],"\\+")) {
equation=paste0(equation,"CE.MonY.below :=",temp4[2],"\n")
}
equation=paste0(equation,"indirect.below :=",ind.below,"\n")
temp4=divideEquation(ind.above)
if(str_detect(temp4[1],"\\+")) {
equation=paste0(equation,"CE.XonM.above :=",temp4[1],"\n")
}
if(str_detect(temp4[2],"\\+")) {
equation=paste0(equation,"CE.MonY.above :=",temp4[2],"\n")
}
equation=paste0(equation,"indirect.above :=",ind.above,"\n")
equation=paste0(equation,"direct.below:=",dir.below,"\n")
equation=paste0(equation,"direct.above:=",dir.above,"\n")
equation=paste0(equation,"total.below := direct.below + indirect.below\n",
"total.above := direct.above + indirect.above\n")
equation=paste0(equation,"prop.mediated.below := indirect.below / total.below\n",
"prop.mediated.above := indirect.above / total.above\n")
if(length(moderatorNames)==1) {
temp=ind1[str_detect(ind1,fixed("*"))]
temp=unlist(str_split(temp,fixed("*")))
if(length(temp)>2){
temp[seq(1,length(temp),2)]
ind2
equation=paste0(equation,"index.mod.med := ",
temp[seq(1,length(temp),2)],"*",str_flatten(ind2,"+"),"\n")
}
}
}
} else{
direct=strGrouping(temp3,X)$yes
dir=paste0(str_flatten(direct,"+"))
dir
dir=str_replace_all(dir,":","*")
res=treatModerator(dir,moderatorNames,data=data,rangemode=rangemode,probs=probs)
dir<-res[[1]]
dir.below=res[[2]]
dir.above=res[[3]]
equation=paste0(equation,"direct :=",dir,"\n")
if(length(moderatorNames)==0) range=FALSE
if(range){
equation=paste0(equation,"direct.below:=",dir.below,"\n")
equation=paste0(equation,"direct.above:=",dir.above,"\n")
}
}
equation
}
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.