R/mediationPlot.R

In cardiomoon/semMediation: Visualize the Mediation Effect for Structural Equation Modelling

require(ggplot2)
require(lavaan)
require(plyr)

#' Make a data.frame for mediationPlot
#'
#' @param fit An object of class lavaan. Result of sem function of package lavaan
#'
#'@export
fit2df=function(fit){
   res=parameterEstimates(fit,standardized=TRUE)
   res
   ## latent variable
   res1=res[res$op!=":=",]
   res1
   text<-group<-x<-y<-latent<-c()
   count=0
   res1
   for(i in 1:nrow(res1)){
        #i=1
        temp=res1$lhs[i]
        temp
        if(!(temp %in% text)){
          text=c(text,temp)
          # whether temp is a latent varible
          tempres=any(res1[res1$lhs==temp,]$op=="=~")
          latent<-c(latent,tempres)
          # group determination #
          (tempgroup=seekGroup(temp,res1,group))

          group=c(group,tempgroup)

        }
        temp=res1$rhs[i]
        if(!(temp %in% text)){
            text=c(text,temp)
            # whether temp is a latent varible
            tempres=any(res1[res1$lhs==temp,]$op=="=~")
            latent<-c(latent,tempres)
            # group determination #
            (tempgroup=seekGroup(temp,res1,group))

            group=c(group,tempgroup)

        }
   }
   group
   df=data.frame(text,latent,group,stringsAsFactors = FALSE)
   df=addHpos(df)
   df
}


#' Add horizontal position
#'
#' @param df A data.frame made by fit2df function
addHpos=function(df){
    df1=df[substr(df$group,1,1)=="H",]
    df1
    if(nrow(df1)>0){
        for(i in 1:nrow(df1)){

            temp=unlist(strsplit(df1$group[i],",",fixed=TRUE))[2]
            temp
            pos=substr(df[df$text==temp,]$group,2,2)
            pos
            df[df$text==df1$text[i],]$group=paste0("H",pos,",",temp)
        }
    }
    df
}


#'Find group with variable name
#'
#'@param var A string to seek
#'@param  res A data.frame. Result of parameterEstimates function of package lavaan or subset.
seekGroup1=function(var,res){

  tempgroup<-""
  tofind<-var
  mode<-0

  res4<-res[res$op=='~',]

  (Left<-res4$lhs)
  (Right<-res4$rhs)


  if(any(Left==tofind)) {
     mode<-mode+1
     #print("mode<-mode+1")
   }
   if(any(Right==tofind)) {
     mode<-mode+2
     #print("mode<-mode+2")
   }
    mode
   if(mode==3) {
     tempgroup="M"
  } else if(mode==1) {
       tempgroup="Y"
  } else if(mode==2) tempgroup="X"
  tempgroup
  if(tempgroup==""){
    res5=res[res$op=='=~',]

    #if(tofind %in% res5$lhs) tempgroup="Y"
    if(tofind %in% res5$lhs) tempgroup="X"
  }

   #print(group)
   # print(mode)
   # print(tofind)
   # print(Left)
   # print(Right)
   # print(tempgroup)
   tempgroup

}


#'Find group with variable name
#'
#'@param var A string to seek
#'@param  res A data.frame. Result of parameterEstimates function of package lavaan or subset.
#'@param group A character vector
seekGroup2=function(var,res,group){

  res3=res[(res$rhs==var) & (res$op!="~~"),]
  temp=res3$lhs[1]
  if(is.na(temp)) result="X"
  else result=seekGroup1(temp,res)
  tempgroup=""
  if(result=="X") tempgroup="0"
  else if(substr(result,1,1)=="M") {
     # print("\n")
     # print(var)
     # print(temp)
     # print(result)
     # print(group)
    tempgroup="H"
  } else if(result=="Y") tempgroup="5"
  paste0(tempgroup,",",temp)
}

#' Count the group names start with "M"
#'@param group A string vectors
countM=function(group){
    result=0
    if(length(group)>0){
      for(i in 1:length(group)){
          if(substr(group[i],1,1)=="M") result=result+1
      }
    }
    result


}


#'Find group with variable name
#'
#'@param var A string to seek
#'@param  res A data.frame. Result of parameterEstimates function of package lavaan or subset.
#'@param group A string vector
seekGroup=function(var,res,group){
   # res=res1;var=temp
    (result=seekGroup1(var,res))
   if(result=="M"){
       count=countM(group)
       result=paste0(result,count+1)
   }
   if(result=="") result=seekGroup2(var,res,group)
   result
}



#' Add x and y position to data
#' @param df A data.frame. Result of fit2df function
#' @export
addpos=function(df){
  for(i in 1:nrow(df)){
  df$group1[i]=unlist(strsplit(df$group[i],",",fixed=TRUE))[1]
  df$group2[i]=ifelse(df$group[i]==df$group1[i],"",unlist(strsplit(df$group[i],",",fixed=TRUE))[2])
  }
  df
  dfM=df[substr(df$group,1,1)=="M",]
  (countM=nrow(dfM))


  df$x=0
  if(nrow(df[df$group1=="X",])>0) df[df$group1=="X",]$x=1
  if(nrow(df[df$group1=="M1",])>0) df[df$group1=="M1",]$x=2
  if(countM==2) {
      if(nrow(df[df$group1=="M2",])>0) df[df$group1=="M2",]$x=2
  } else if(countM>2){
    condition1 <- (substr(df$group1,1,1) =="M") & (as.numeric(substr(df$group1,2,2))<=(countM+1)%/%2)

    if(nrow(df[condition1,])>0) df[condition1,]$x=2+as.numeric(substr(df[condition1,]$group1,2,2))-1
    condition2 <- (substr(df$group1,1,1) =="M") & (as.numeric(substr(df$group1,2,2))>(countM+1)%/%2)
    if(countM%%2==0){
        if(nrow(df[condition2,])>0) df[condition2,]$x=2+as.numeric(substr(df[condition2,]$group1,2,2))-1-countM%/%2
    } else{
        #if(nrow(df[condition2,])>0) df[condition2,]$x=2+as.numeric(substr(df[condition2,]$group1,2,2))-(countM+1)%/%2-1+ifelse(as.numeric(substr(df[condition2,]$group1,2,2))%%2==0,0,0.5)
        if(nrow(df[condition2,])>0) df[condition2,]$x=2+as.numeric(substr(df[condition2,]$group1,2,2))-(countM+1)%/%2-0.5

    }
  }
  if(nrow(df[df$group1=="H",])>0) df[df$group1=="H",]$x=3
  if(nrow(df[df$group1=="Y",])>0) df[df$group1=="Y",]$x=3+ifelse(countM>2,(countM-1) %/% 2,0)
  if(nrow(df[df$group1=="5",])>0) df[df$group1=="5",]$x=4+ifelse(countM>2,(countM-1) %/% 2,0)



  df$y=1
  if(nrow(df>2)){
     for(i in 2:nrow(df)){
       if(substr(df$group1[i],1,1)!="H"){
          if(df$group1[i]==df$group1[i-1]) df$y[i]=df$y[i-1]+1
       } else{
          if(df$group2[i]==df$group2[i-1]) df$y[i]=df$y[i-1]+1
       }
     }
  }

  for(i in 1:countM){

      if(nrow(df[df$group1==paste0("H",i),])>0) df[df$group1==paste0("H",i),]$x= df[df$group1==paste0("M",i),]$x
  }
  if(countM>0) {
    condition=substr(df$group,1,1)=="M"
    if(nrow(df[condition,])>0) df[condition,]$y=ifelse(as.numeric(substr(df[condition,]$group1,2,2))<=(countM+1)%/%2,1,2)
  }
  if(nrow(df[substr(df$group1,1,1)=="H",])>0){
    condition=substr(df$group,1,1)=="H"
    if(nrow(df[condition,])>0) df[condition,]$y=ifelse(as.numeric(substr(df[condition,]$group1,2,2))<=(countM+1)%/%2,1,2)
  }
  df
}


#' Make a positions
#'
#' @param center A number indicating the center position
#' @param step A number indicating the intervals betweeon items
#' @param count A number indicating the count of items
jitterPos=function(center,step,count){


   if(count==1) {
     result=center
   } else if(count>1){
     step=step+1
     start=center-(count-1)*step*0.5
     result=c()
     for(i in 1:count){
         result=c(result,start+step*(i-1))
     }
   }
   result
}


#' Make a positions
#'
#' @param start A number indicating the start position
#' @param end A number indicating the end position
#' @param count A number indicating the count of items
distributePos=function(start,end,count){
  if(count==1) result=(start+end)/2
  else {
    (interval=(end-start)/(count-1))
    (result=seq(start,end,interval))
    #result=result[2:(length(result)-1)]
  }
  result
}


#' Adjust position for arrows
#'
#'@param df A data.frame
#'@param maxx maximum x position
#'@param maxy maximum y position
#'@param height A number indicating height of the rectangle
#'@param width A number indicating width of the rectangle
adjustPos=function(df,maxx=80,maxy=30,height=3,width=5){

  #df=df1;maxx=60;maxy=30;height=3;width=5
  df$group3=df$y
  count<-nrow(df[df$group1=="0",])
  count<-c(count,nrow(df[df$group1=="X",]))
  count<-c(count,nrow(df[substr(df$group1,1,1)=="M",]))
  count<-c(count,nrow(df[df$group1=="Y",]))
  count<-c(count,nrow(df[df$group1=="5",]))
  countH<-nrow(df[substr(df$group1,1,1)=="H",])
  countH
  count

  ## maxrow 및 maxcol 계산
  res=plyr::ddply(df,"group1",nrow)
  res
  (maxrow=max(res[nchar(res$group1)==1,]$V1))

  res$xpos=3
  condition1<- (nchar(res$group1)==2)&(as.numeric(substr(res$group1,2,2))<=(count[3]+1)%/%2)
  if(nrow(res[condition1,])>0) res[condition1,]$xpos=2
  if(nrow(res[nchar(res$group1)==1,])>0) res[nchar(res$group1)==1,]$xpos=1

  ## maxgroup :  group count except "H"
  (maxgroup=nrow(res[substr(res$group1,1,1)!="H",]))
  upperCol=res[(substr(res$group1,1,1)=="H")&(res$xpos==2),]
  lowerCol=res[(substr(res$group1,1,1)=="H")&(res$xpos==3),]
  (maxcol=maxgroup+max(sum(upperCol$V1-1),sum(lowerCol$V1-1)))

  maxcol


  starty=25
  endy=min(starty-(height+1)*(maxrow+1),5)
  endy


  mediation=0
  if(count[3]>0) mediation=1

  minx=5
  (stepx=5*3)
  (maxx=max(maxx,(maxgroup-1)*stepx+2*minx))

  (xpos=seq(minx,maxx,stepx))

  x<-y<-text<-group<-c()

  ## group1=="X"
  if(count[2]>0) for(i in 1:count[2]){

    x=xpos[2]

    if(nrow(df[df$group1=="X",])>0){
       df[df$group1=="X",]$x=x
       df[df$group1=="X",]$y=distributePos(starty+2,endy-2,count[2])
    }
  }

  # group1=="0"
  if(count[1]>0)  for(i in 1:count[1]){

    x=xpos[1]
    if(nrow(df[df$group1=="0",])>0){
    df[df$group1=="0",]$x=x
    df[df$group1=="0",]$y=distributePos(starty,endy,count[1])
    }
  }

  # group1=="Y"

  if(count[4]>0) {


      if(nrow(df[df$group1=="Y",])>0){
    df[df$group1=="Y",]$x=df[df$group1=="Y",]$x*stepx+minx
    # df[df$group1=="Y",]$y=distributePos(starty,min(5,starty-count[4]*(height+1)),count[4])
    df[df$group1=="Y",]$y=distributePos(starty,endy,count[4])
      }
  }

  # group1=="5"

  if(count[5]>0) {
      if(nrow(df[df$group1=="5",])>0){
    df[df$group1=="5",]$x=df[df$group1=="5",]$x*stepx+minx
    df[df$group1=="5",]$y=distributePos(starty,endy,count[5])
      }
  }

  df
  # group1=="M"
  if(count[3]>0) {
      if(nrow(df[substr(df$group,1,1)=="M",])>0){
    (df[substr(df$group,1,1)=="M",]$x=df[substr(df$group,1,1)=="M",]$x*stepx+minx)
      }

    condition<-(substr(df$group,1,1)=="M")&(df$y==1)
    if(nrow(df[condition,])>0){
    df[condition,]$y=(starty+endy)/2+stepx+height/2
    }
    condition2<-(substr(df$group,1,1)=="M")&(df$y==2)
    if(nrow(df[condition2,])>0){
    df[condition2,]$y=(starty+endy)/2-stepx-height/2
    }

  }

  # group1=="H"
  if(countH>0) {

    condition<-(substr(df$group,1,1)=="H")&(df$y==1)
    tempcount=nrow(df[condition,])
    if(tempcount>0){
          df[condition,]$y=(starty+endy)/2+stepx*2+height/2
          df[condition,]$x=jitterPos(mean(unique(df[condition,]$x))*stepx+minx,width+1,tempcount)
    }
    condition2<-(substr(df$group,1,1)=="H")&(df$y==2)
    tempcount2=nrow(df[condition2,])
    if(tempcount2>0){
      df[condition2,]$y=(starty+endy)/2-stepx*2-height/2
      df[condition2,]$x=jitterPos(mean(unique(df[condition2,]$x))*stepx+minx,width+1,tempcount2)
    }


  }


  # CFA
  if(length(unique(df$group1))==2){
      if(("X" %in% unique(df$group1))&("0" %in% unique(df$group1))){
          count=nrow(df[df$group=="X",])
          for(i in 1:count){
              (temp=df[df$group=="X",]$text[i])
              if(nrow(df[df$group2==temp,])>0){
                  df[df$text==temp,]$y=mean(df[df$group2==temp,]$y)

              }

          }
          df[df$group1=="X",]$x=maxx-15
          df[df$group1=="0",]$x=15
      }
  }
  #df<-df2
  (xcount=nrow(df[df$group=="X",]))
  (ocount=nrow(df[df$group1=="0",]))
  (ycount=nrow(df[df$group1=="Y",]))
  (count5=nrow(df[df$group1=="5",]))
  (mcount=nrow(df[df$group %in% c("M1","M2"),]))
  if((xcount>1)&(mcount==1)){
      df[df$group=="M1",]$y=mean(df[df$group=="X",]$y)
  }

  # Set x position with mean of 0
  if((ocount>0)&(xcount>0)){
      for(i in 1:xcount){
          (temp=df[df$group=="X",]$text[i])
          if(nrow(df[df$group2==temp,])>0){
              df[df$text==temp,]$y=mean(df[df$group2==temp,]$y)

          }

      }
  }

  if((ocount>0)&(xcount>0)) df[df$group=="X",]$x<-df[df$group=="X",]$x+5
  if((count5>0)&(ycount>0)) df[df$group=="Y",]$x<-df[df$group=="Y",]$x-5
  if((mcount>0)&(xcount>0)&(ycount>0))
       df[df$group %in% c("M1","M2"),]$x<-(df[df$group=="X",]$x[1]+df[df$group=="Y",]$x[1])/2
  df
}


#' Make a data.frame fof ellipse
#' @param hlaxa An integer
#' @param hlaxb An integer
#' @param theta An integer
#' @param xc An integer indicating center of x position
#' @param yc An integer indicating center of y position
#' @param npoints An integer
ellipse=function (hlaxa = 1, hlaxb = 1, theta = 0, xc = 0, yc = 0,
                  npoints = 100)
{
  a <- seq(0, 2 * pi, length = npoints + 1)
  x <- hlaxa * cos(a)
  y <- hlaxb * sin(a)
  alpha <- angle(x, y)
  rad <- sqrt(x^2 + y^2)
  xp <- rad * cos(alpha + theta) + xc
  yp <- rad * sin(alpha + theta) + yc
  #if (newplot)
  #    plot(xp, yp, type = "l", ...)
  #else lines(xp, yp, ...)
  #invisible()
  df=data.frame(x=xp,y=yp)
  df
}


#' Calculate angle
#'
#' @param x An integer
#' @param y An integer
angle=function (x, y)
{
  angle2 <- function(xy) {
    x <- xy[1]
    y <- xy[2]
    if (x > 0) {
      atan(y/x)
    }
    else {
      if (x < 0 & y != 0) {
        atan(y/x) + sign(y) * pi
      }
      else {
        if (x < 0 & y == 0) {
          pi
        }
        else {
          if (y != 0) {
            (sign(y) * pi)/2
          }
          else {
            NA
          }
        }
      }
    }
  }
  apply(cbind(x, y), 1, angle2)
}


#' Make an ellipse
#' @param x An integer indicating x position
#' @param y An integer indicating y position
#' @param theta An integer
#' @param height An integer
#' @param width An integer
#' @param npoints An integer
#' @param color A string indicating color
#' @param fill A string indicating color
#' @param ... further arguments to be passed to geom_polygon
#'
#' @importFrom ggplot2 geom_polygon aes
add_ellipse=function(x=0,y=0, theta = 0, height=height,width=width,
                     npoints = 100,color="black",fill="white",...){
  ## xr=4
  xr=4*width/5
  ## yr=1.5
  yr=height/2
  df1=ellipse(xr,yr,theta=theta,xc=x,yc=y,npoints=npoints)
  geom_polygon(data=df1,aes(x=x,y=y),color=color,fill=fill,...)

}


#' Merge Data with position
#' @param res A data.frame. Result of parameterEstimates function of package lavaan or subset.
#' @param df2 A data.grame
#' @param whatLabels What should the edge labels indicate in the path diagram? Choices are c("est","std","name").
#'@param width A number indicating width of the rectangle
#'@param height A number indicating height of the rectangle
mergeDataPos=function(res,df2,whatLabels="est",width=5,height=3){
  #  res<-resCor;whatLabels="est";width=5;height=3
  x<-y<-xend<-yend<-label<-curvature<-group<-position1<-c()
  x1<-y1<-x2<-y2<-start<-end<-c()
  res
  xonly=-1
  if(length(unique(df2$group1))==2) xonly=1
  for(i in 1:nrow(res)){
    tempcurvature=-0.3
    tempx=df2[df2$text==res$rhs[i],]$x
    tempy=df2[df2$text==res$rhs[i],]$y
    tempxend=df2[df2$text==res$lhs[i],]$x
    tempyend=df2[df2$text==res$lhs[i],]$y
    latent=df2[df2$text==res$lhs[i],]$latent
    x1=c(x1,df2[df2$text==res$lhs[i],]$x)
    y1=c(y1,df2[df2$text==res$lhs[i],]$y)
    x2=c(x2,df2[df2$text==res$rhs[i],]$x)
    y2=c(y2,df2[df2$text==res$rhs[i],]$y)
    start=c(start,ifelse(df2[df2$text==res$lhs[i],]$latent,"ellipse","rect"))
    end=c(end,ifelse(df2[df2$text==res$rhs[i],]$latent,"ellipse","rect"))

    ## Correlation
    if(res$lhs[i]==res$rhs[i]) {
      margin=height/3
      tempcurvature=-2
      tempgroup=df2[df2$text==res$lhs[i],]$group1
      (H1group=df2[(substr(df2$group1,1,1)=="H")&(df2$group3==1),]$group1)
      (H2group=df2[(substr(df2$group1,1,1)=="H")&(df2$group3==2),]$group1)
      (M1group=df2[(substr(df2$group1,1,1)=="M")&(df2$group3==1),]$group1)
      (M2group=df2[(substr(df2$group1,1,1)=="M")&(df2$group3==2),]$group1)

      if(tempgroup %in% c("0",M1group,M2group)) {
        tempx=tempx-width/2-ifelse(latent,width/10,0)
        tempy=tempy-height/3
        tempxend=tempxend-width/2-ifelse(latent,width/10,0)
        tempyend=tempyend+height/3
        position=1
      }
      if(tempgroup %in% H1group){
        tempx=tempx-margin
        tempy=tempy+height/2
        tempxend=tempxend+margin
        tempyend=tempyend+height/2
        position=2
      }
      if(tempgroup=="5"){
        tempcurvature=2
        tempx=tempx+width/2
        tempy=tempy-margin
        tempxend=tempxend+width/2
        tempyend=tempyend+margin
        position=3
      }


      if(tempgroup %in% c("X","Y")) {
          tempcurvature=2
          tempx=tempx-margin
          tempy=tempy-height/2
          tempxend=tempxend+margin
          tempyend=tempyend-height/2
          position=4
      }
      if(tempgroup %in% H2group) {
        tempcurvature=2
        tempx=tempx-margin
        tempy=tempy-height/2
        tempxend=tempxend+margin
        tempyend=tempyend-height/2
        position=4
      }



    } else if(res$op[i]=="=~") {
      tempgroup1=df2[df2$text==res$rhs[i],]$group1
      if(length(tempgroup1)>0){
      if(tempgroup1=="0") tempx=tempx+width/2

      (H1group=df2[(substr(df2$group1,1,1)=="H")&(df2$group3==1),]$group1)
      (H2group=df2[(substr(df2$group1,1,1)=="H")&(df2$group3==2),]$group1)
      (M1group=df2[(substr(df2$group1,1,1)=="M")&(df2$group3==1),]$group1)
      (M2group=df2[(substr(df2$group1,1,1)=="M")&(df2$group3==2),]$group1)
      if(tempgroup1 %in% H1group) tempy=tempy-height/2
      if(tempgroup1 %in% H2group) tempy=tempy+height/2
      if(tempgroup1=="5") tempx=tempx-width/2
      }
      tempgroup=df2[df2$text==res$lhs[i],]$group1
      if(length(tempgroup)>0){
      if(tempgroup %in% M1group) tempyend=tempyend+height/2
      if(tempgroup %in% M2group) tempyend=tempyend-height/2
      if(tempgroup=="Y") tempxend=tempxend+width/2+ifelse(latent,width*3/10,0)
      if(tempgroup=="X") tempxend=tempxend-width/2-ifelse(latent,width*3/10,0)
      }
    } else if(res$op[i] %in% c("~","~~")) {
      position=1
      tempgroup1=df2[df2$text==res$rhs[i],]$group1
      if(length(tempgroup1)>0){
      (H1group=df2[(substr(df2$group1,1,1)=="H")&(df2$group3==1),]$group1)
      (H2group=df2[(substr(df2$group1,1,1)=="H")&(df2$group3==2),]$group1)
      (M1group=df2[(substr(df2$group1,1,1)=="M")&(df2$group3==1),]$group1)
      (M2group=df2[(substr(df2$group1,1,1)=="M")&(df2$group3==2),]$group1)
      latent=df2[df2$text==res$rhs[i],]$latent
      if(tempgroup1=="0") tempx=tempx+width/2
      if(tempgroup1 %in% H1group) tempy=tempy-height/2
      if(tempgroup1 %in% H2group) tempy=tempy+height/2
      if(tempgroup1=="5") tempx=tempx-width/2
      if(tempgroup1 %in% M1group) tempy=tempy-height/2
      if(tempgroup1 %in% M2group) tempy=tempy+height/2
      if(tempgroup1=="Y") tempx=tempx-width/2-ifelse(latent,width*3/10,0)
      if(tempgroup1=="X") tempx=tempx+width/2+ifelse(latent,width*3/10,0)
      }
      tempgroup=df2[df2$text==res$lhs[i],]$group1
      if(length(tempgroup)>0){
      latent=df2[df2$text==res$lhs[i],]$latent
      if(tempgroup=="0") tempxend=tempxend+width/2
      if(tempgroup %in% H1group) tempyend=tempyend-height/2
      if(tempgroup %in% H2group) tempyend=tempyend+height/2
      if(tempgroup=="5") tempxend=tempxend-width/2
      if(tempgroup %in% M1group) tempyend=tempyend-height/2
      if(tempgroup %in% M2group) tempyend=tempyend+height/2

      if(tempgroup=="Y") {
        tempxend=tempxend-width/2-ifelse(latent,width*3/10,0)
        position=1
      }
      if(tempgroup=="X") tempxend=tempxend+width/2+ifelse(latent,width*3/10,0)

      }
    }
    x=c(x,tempx)
    y=c(y,tempy)
    xend=c(xend,tempxend)
    yend=c(yend,tempyend)
    #df2
    if(res$op[i]=="~~") {
      curvature=c(curvature,tempcurvature)
      group=c(group,tempgroup)
      position1=c(position1,position)
    }
  }
  res$x=x
  res$y=y
  res$xend=xend
  res$yend=yend
  res$x1=x1
  res$y1=y1
  res$x2=x2
  res$y2=y2
  res$start=start
  res$end=end

  if(res$op[i]=="~~") {
    res$curvature=curvature
    res$group=group
    res$position=position1

  }
  if(whatLabels=="std") res$text=res[["std.all"]]
  else if(whatLabels=="name") res$text=res$label
  else res$text=res$est
  if(is.numeric(res$text)) res$text=sprintf("%0.2f",res$text)
  select=((res$op=="~~")&(res$lhs!=res$rhs)&(res$group=="X"))
  #res[select,]
  if(sum(select)>0){
      res[select,]$x= res[select,]$x1+xonly*width/2+xonly*ifelse(res[select,]$start=="rect",0,width*3/10)
      res[select,]$xend= res[select,]$x2+xonly*width/2+xonly*ifelse(res[select,]$start=="rect",0,width*3/10)
      res[select,]$curvature=0.3*xonly
      if(xonly) res[select,]$position=3
      else res[select,]$position=1
  }
  select=((res$op=="~~")&(res$lhs!=res$rhs)&(res$group=="Y"))
  if(sum(select)>0){
      res[select,]$x= res[select,]$x1+width/2+ifelse(res[select,]$start=="rect",0,width*3/10)
      res[select,]$xend= res[select,]$x2+width/2+ifelse(res[select,]$start=="rect",0,width*3/10)
      res[select,]$curvature=0.3
      res[select,]$position=3
  }
  select=((res$op=="~~")&(res$lhs!=res$rhs)&(res$group=="H1"))
  if(sum(select)>0){
      res[select,]$x= res[select,]$x1
      res[select,]$xend = res[select,]$x2
      res[select,]$y = res[select,]$y1+height/2
      res[select,]$yend = res[select,]$y2+height/2
      res[select,]$curvature=-0.3
      res[select,]$position=2
      #print(res[select,])
  }
  select=((res$op=="~~")&(res$lhs!=res$rhs)&(res$group=="5"))
  if(sum(select)>0){
      res[select,]$x= res[select,]$x1+width/2
      res[select,]$xend = res[select,]$x2+width/2
      res[select,]$y = res[select,]$y1
      res[select,]$yend = res[select,]$y2
      res[select,]$curvature=-0.3
      res[select,]$position=3
      #print(res[select,])
  }
  res

}

#' Merge Data with position for the indirect effect
#' @param resInd A data.frame.A subset of result of parameterEstimates function of package lavaan
#' @param res A data.frame. Result of parameterEstimates function of package lavaan or subset.
#' @param df2 A data.grame
#' @param whatLabels What should the edge labels indicate in the path diagram? Choices are c("est","std","name").
#'@param width A number indicating width of the rectangle
#'@param height A number indicating height of the rectangle
mergeDataPosInd=function(resInd,res,df2,whatLabels="est",width=5,height=3){
  x<-y<-latent<-label<-c()

  for(i in 1:nrow(resInd)){
    label=unlist(strsplit(resInd$rhs[i],"+",fixed=TRUE))
    label1=unlist(strsplit(label,"*",fixed=TRUE))[1]
    (lhs=res[res$label==label1,]$lhs)
    df2
    (tempx=df2[df2$text==lhs,]$x)
    (tempy=df2[df2$text==lhs,]$y)

    if(df2[df2$text==lhs,]$group3==1) {
      tempy=tempy-height*3/2
    } else tempy=tempy+height*3/2
    (templatent=df2[df2$text==lhs,]$latent)
    x=c(x,tempx)
    y=c(y,tempy)
    latent=c(latent,templatent)
  }
  resInd$x=x
  resInd$y=y
  resInd$latent=latent
  if(whatLabels=="std") resInd$text=resInd[["std.all"]]
  else if(whatLabels=="name") resInd$text=resInd$label
  else resInd$text=resInd$est
  if(is.numeric(resInd$text)) resInd$text=sprintf("%0.2f",resInd$text)
  resInd
}

#' Merge Data with position for the 2nd indirect effect
#' @param res2Ind A data.frame.A subset of result of parameterEstimates function of package lavaan
#' @param res A data.frame. Result of parameterEstimates function of package lavaan or subset.
#' @param df2 A data.grame
#' @param whatLabels What should the edge labels indicate in the path diagram? Choices are c("est","std","name").
#'@param width A number indicating width of the rectangle
#'@param height A number indicating height of the rectangle
mergeDataPos2Ind=function(res2Ind,res,df2,whatLabels="est",width=5,height=3){
  x<-y<-latent<-label<-c()

  resInd=res2Ind
  resInd
  for(i in 1:nrow(resInd)){

    (label1=unlist(strsplit(resInd$rhs[i],"*",fixed=TRUE))[1])
    (lhs=res[res$label==label1,]$lhs)
    (tempx=df2[df2$text==lhs,]$x)
    (tempy=df2[df2$text==lhs,]$y)
    (label2=unlist(strsplit(resInd$rhs[i],"*",fixed=TRUE))[2])
    (lhs2=res[res$label==label2,]$lhs)
    (tempy2=df2[df2$text==lhs2,]$y)
    tempy=(tempy+tempy2)/2
    (templatent=df2[df2$text==lhs,]$latent)
    x=c(x,tempx)
    y=c(y,tempy)
    latent=c(latent,templatent)
  }
  resInd$x=x
  resInd$y=y
  resInd$latent=latent
  if(whatLabels=="std") resInd$text=resInd[["std.all"]]
  else if(whatLabels=="name") resInd$text=resInd$label
  else resInd$text=resInd$est
  if(is.numeric(resInd$text)) resInd$text=sprintf("%0.2f",resInd$text)
  resInd
}


#' Add line type
#' @param res A data.frame. Result of parameterEstimates function of package lavaan or subset.
addLinetype=function(res){
  res$linetype="solid"
  if(nrow(res[is.na(res$pvalue),])>0) res[is.na(res$pvalue),]$linetype="dotted"
  if(nrow(res[(res$linetype=="solid")&(res$pvalue>0.05),])>0) {
    res[(res$linetype=="solid")&(res$pvalue>0.05),]$linetype="dotted"
  }
  res
}


#' Make a clean theme for ggplot
#' @param base_size An integer indicating base font size
#' @param base_family A character indicating base font family
#'
#' @importFrom ggplot2 theme_grey element_blank %+replace%
theme_clean=function(base_size=12,base_family="NanumGothic"){
    theme_grey(base_size,base_family=base_family) %+replace%
        theme(
            axis.title=element_blank(),
            axis.text=element_blank(),
            panel.background=element_blank(),
            panel.grid=element_blank(),
            axis.ticks.length=unit(0,"cm"),
            #axis.ticks.margin=unit(0,"cm"),
            panel.spacing=unit(0,"lines"),
            plot.margin=unit(c(0,0,0,0),"lines"),
            complete=TRUE
        )
}


#' Make a data.frame for mediationPlot
#'
#'@param fit A data.frame. Result of parameterEstimates function of package lavaan
#'@param maxx An integer indicating maximum x position
#'@param maxy An integer indicating maximum y position
#'@param height A number indicating height of the rectangle
#'@param width A number indicating width of the rectangle
#'@param whatLabels What should the edge labels indicate in the path diagram? Choices are c("est","std","name").
#'@param useLabel Whether use geom_label instead of geom_text. Default value is FALSE.
#'@param usecolor Whether use colors for variables. Default value is TRUE.
#'@param clean Whether use theme_clean. Default value is TRUE.
#'@param base_size An integer indicating the font size.
#'@param base_family A character indicating base font family
#'@param mediationOnly Whether or not draw mediation effect only. Default value is FALSE.
#'@param residuals Whether or not draw residuals(and variance). Default value is TRUE.
#'@param regression Whether or not draw regression. Default value is TRUE.
#'@param indirect Whether or not draw indirect effects. Default value is FALSE.
#'@param secondIndirect Whether or not draw 2nd indirect effects. Default value is FALSE.
#'@param total Whether or not draw total effect. Default value is FALSE.
#'@param mode  plot mode. 1 or 2.
#'
#'@importFrom lavaan parameterEstimates
#'@importFrom ggplot2 ggplot geom_rect geom_text theme_gray theme geom_label geom_segment geom_curve geom_text xlim ylim aes_string coord_fixed
#'
#'@export
mediationPlot=function(fit,maxx=80,maxy=30,height=5,width=5,whatLabels="std",useLabel=FALSE,usecolor=TRUE,
                       clean=TRUE,base_size=5,base_family="NanumGothic",
                       mediationOnly=FALSE,residuals=FALSE,regression=TRUE,
                       indirect=FALSE,secondIndirect=FALSE,total=FALSE,mode=1){

   # maxx=80;maxy=30;height=5;width=5;whatLabels="name";useLabel=TRUE;usecolor=TRUE
   # clean=TRUE;base_size=5;base_family="Arial"
   # mediationOnly=FALSE;residuals=TRUE;regression=TRUE
   #  indirect=FALSE;secondIndirect=FALSE;mode=1

  res=parameterEstimates(fit,standardized=TRUE)
  res
  #str(res)
  df=fit2df(fit)
  df
  df=df[df$text!="",]
  #str(df)
  df1=addpos(df)
  df1

  if(mediationOnly) {
    Mgroup=df1[substr(df1$group1,1,1)=="M",]$group1
    Mgroup
    df1=df1[df1$group1 %in% c("X","Y",Mgroup),]
    res=res[(res$label!="")|((res$lhs %in% df1$text)&(res$rhs %in% df1$text)),]
    res
  }
  #str(df1)

  df2=adjustPos(df1,maxx=maxx,maxy=maxy,height=height,width=width)
  df2
  #cat("df2")
  #str(df2)
  df3=df2[df2$latent==FALSE,]
  df3
  df4=df2[df2$latent==TRUE,]
  df4


  p<-ggplot(data=df2,aes_string(x="x",y="y"))+
    xlim(min(df2$x)-12,max(df2$x)+12)+ylim(min(df2$y)-8,max(df2$y)+8)
  p
  if(nrow(df3)>0){
      if(usecolor) {
          p<-p+ geom_rect( data = df3,aes_string(fill="group1"),xmin=df3$x-width/2,xmax=df3$x+width/2,
                          ymin=df3$y-height/2,ymax=df3$y+height/2,colour="black",alpha=0.5)
      } else {
          p<-p+ geom_rect(data=df3,xmin=df3$x-width/2,xmax=df3$x+width/2,
                          ymin=df3$y-height/2,ymax=df3$y+height/2,color="black",fill="white",alpha=0.5)
      }
  }

  if(nrow(df4)>0){
      for(i in 1:nrow(df4)) p<-p+add_ellipse(df4$x[i],df4$y[i],height=height,width=width,fill=ifelse(usecolor,"yellow","white"))
  }
  p<-p+  geom_text(aes_string(label="text"),size=base_size,family=base_family)

  p
   #geom_point(data=df4,aes(fill=group1),size=30,shape=21)+

  if(clean) {
    p<-p+theme_clean(base_size=base_size,base_family=base_family)
  } else  p<-p+theme_grey(base_size=base_size,base_family=base_family)

  p<-p+theme(legend.position="none")

  p
  ## Measure
  p2<-p
  p<-p2
  #whatLabels="est"
  resMeasure=res[res$op=="=~",]
  resMeasure
  df2
  if(nrow(resMeasure)>0){
  resMeasure=mergeDataPos(resMeasure,df2,whatLabels,height=height,width=width)
  resMeasure=addLinetype(resMeasure)
  resMeasure
  if(mode==1){
        for(i in 1:nrow(resMeasure)){
            p<-p+addline(x1=resMeasure$x1[i],y1=resMeasure$y1[i],x2=resMeasure$x2[i],y2=resMeasure$y2[i],
               start=resMeasure$start[i],end=resMeasure$end[i],linetype=resMeasure$linetype[i],height=height,width=width)
            if(whatLabels!="name")
            p<-p+addlabel(x1=resMeasure$x1[i],y1=resMeasure$y1[i],x2=resMeasure$x2[i],y2=resMeasure$y2[i],
                          start=resMeasure$start[i],end=resMeasure$end[i],label=resMeasure$text[i],
                          useLabel=useLabel,size=base_size-1)
        }
        p
  } else{

        p<-p+geom_segment(data=resMeasure,aes_string(x="x",y="y",xend="xend",yend="yend"),
                    linetype=resMeasure$linetype,
                    arrow=arrow(angle=20,length=unit(0.3,"cm"),ends="first",type="closed"))
        if(whatLabels!="name"){
        if(useLabel) p<-p+geom_label(data=resMeasure,aes_string(x="(x+xend)/2",y="(y+yend)/2",label="text"),size=base_size-1)
        else p<-p+geom_label(data=resMeasure,aes_string(x="(x+xend)/2",y="(y+yend)/2",label="text"),label.size=0,size=base_size-1)
        }

  }

  }
  p
  p2<-p
  p<-p2

  ## Regressions

  if(regression){
  resReg=res[res$op=="~",]
  resReg
  if(nrow(resReg)>0){
  resReg=mergeDataPos(resReg,df2,whatLabels,height=height,width=width)
  resReg=addLinetype(resReg)
  resReg
  if(mode==1){
      for(i in 1:nrow(resReg)){
          #if(resReg$linetype[i]=="dotted") next
          #i=10
          if(whatLabels=="name"){
              p<-p+addline(x1=resReg$x2[i],y1=resReg$y2[i],x2=resReg$x1[i],y2=resReg$y1[i],
                           start=resReg$end[i],end=resReg$start[i],height=height,width=width)
          } else{
             p<-p+addline(x1=resReg$x2[i],y1=resReg$y2[i],x2=resReg$x1[i],y2=resReg$y1[i],
                       start=resReg$end[i],end=resReg$start[i],linetype=resReg$linetype[i],height=height,width=width)
          }
          p

      }
      for(i in 1:nrow(resReg)){

          p<-p+addlabel(x1=resReg$x2[i],y1=resReg$y2[i],x2=resReg$x1[i],y2=resReg$y1[i],
                        start=resReg$end[i],end=resReg$start[i],label=resReg$text[i],
                        useLabel=useLabel,size=base_size-1)
      }
      p

  } else {
  p<-p+geom_segment(data=resReg[substr(resReg$label,1,1)!="c",],aes_string(x="x",y="y",xend="xend",yend="yend"),
                    linetype=resReg[substr(resReg$label,1,1)!="c",]$linetype,
                    arrow=arrow(angle=20,length=unit(0.3,"cm"),type="closed"))
  p<-p+geom_curve(data=resReg[substr(resReg$label,1,1)=="c",],aes_string(x="x",y="y",xend="xend",yend="yend"),
                  linetype=resReg[substr(resReg$label,1,1)=="c",]$linetype,curvature = 0.1,
                  arrow=arrow(angle=20,length=unit(0.3,"cm"),type="closed"))

  if(useLabel) {
      p<-p+geom_label(data=resReg[substr(resReg$label,1,1)!="c",],aes_string(x="(x+xend)/2",y="(y+yend)/2",label="text"),size=base_size-1)
      p<-p+geom_label(data=resReg[substr(resReg$label,1,1)=="c",],aes_string(x="(x+xend)/2",y="(y+yend)/2-2",label="text"),size=base_size-1)
  }else {
      p<-p+geom_label(data=resReg[substr(resReg$label,1,1)!="c",],aes_string(x="(x+xend)/2",y="(y+yend)/2",label="text"),label.size=0,size=base_size-1)
      p<-p+geom_label(data=resReg[substr(resReg$label,1,1)=="c",],aes_string(x="(x+xend)/2",y="(y+yend)/2-2",label="text"),label.size=0,size=base_size-1)
  }

  p
  }

  }

  }



    ##  Correlation
    resCor=res[res$op=="~~",]
    if(!residuals) resCor=resCor[resCor$lhs!=resCor$rhs,]
    resCor
    df2
    if(nrow(resCor)>0){
      #height=3;width=5;whatLabels="est"
      resCor=mergeDataPos(resCor,df2,whatLabels,height=height,width=width)
      resCor=addLinetype(resCor)
      resCor
      #str(resCor)

      if(nrow(resCor[resCor$curvature==2,])>0)
        p<-p+geom_curve(data=resCor[resCor$curvature==2,],aes_string(x="x",y="y",xend="xend",yend="yend"),curvature=2.5,
                        #linetype=resCor[resCor$curvature==2,]$linetype,
                        arrow=arrow(angle=20,length=unit(0.2,"cm"),ends="both",type="closed"))
      if(nrow(resCor[resCor$curvature==-2,])>0)
        p<-p+geom_curve(data=resCor[resCor$curvature==-2,],aes_string(x="x",y="y",xend="xend",yend="yend"),curvature=-2.5,
                        #linetype=resCor[resCor$curvature==-2,]$linetype,
                        arrow=arrow(angle=20,length=unit(0.2,"cm"),ends="both",type="closed"))
      if(nrow(resCor[resCor$curvature==-0.3,])>0)
        p<-p+geom_curve(data=resCor[resCor$curvature==-0.3,],aes_string(x="x",y="y",xend="xend",yend="yend"),
                        #linetype=resCor[resCor$curvature==-0.3,]$linetype,
                        curvature=-0.2,
                        arrow=arrow(angle=20,length=unit(0.2,"cm"),ends="both",type="closed"))
      if(nrow(resCor[resCor$curvature==0.3,])>0)
          p<-p+geom_curve(data=resCor[resCor$curvature==0.3,],aes_string(x="x",y="y",xend="xend",yend="yend"),
                          #linetype=resCor[resCor$curvature==-0.3,]$linetype,
                          curvature=0.2,
                          arrow=arrow(angle=20,length=unit(0.2,"cm"),ends="both",type="closed"))

      if(whatLabels!="name"){
      if(useLabel) {
        #p<-p+geom_text(data=resCor[resCor$group %in% c("X","Y","H2"),],aes(x=(x+xend)/2,y=(y+yend)/2,label=label))
        if(nrow(resCor[resCor$position==4,])>0)
          p<-p+geom_label(data=resCor[resCor$position==4,],aes_string(x="(x+xend)/2",y="(y+yend)/2-height*3/4",label="text"),vjust=1.5)
        if(nrow(resCor[resCor$position==3,])>0)
          p<-p+geom_label(data=resCor[resCor$position==3,],aes_string(x="(x+xend)/2+width*1/2",y="(y+yend)/2",label="text"),hjust=-0.1)
        if(nrow(resCor[resCor$position==2,])>0)
          p<-p+geom_label(data=resCor[resCor$position==2,],aes_string(x="(x+xend)/2",y="(y+yend)/2+height*3/4",label="text"),vjust=-0.5)
        if(nrow(resCor[resCor$position==1,])>0)
          p<-p+geom_label(data=resCor[resCor$position==1,],aes_string(x="(x+xend)/2-width*1/2",y="(y+yend)/2",label="text"),hjust=1.1)
      }
      else {
        if(nrow(resCor[resCor$position==4,])>0)
          p<-p+geom_text(data=resCor[resCor$position==4,],aes_string(x="(x+xend)/2",y="(y+yend)/2-height*3/4",label="text"),vjust=1.5)
        if(nrow(resCor[resCor$position==3,])>0)
          p<-p+geom_text(data=resCor[resCor$position==3,],aes_string(x="(x+xend)/2+width*1/2",y="(y+yend)/2",label="text"),hjust=-0.1)
        if(nrow(resCor[resCor$position==2,])>0)
          p<-p+geom_text(data=resCor[resCor$position==2,],aes_string(x="(x+xend)/2",y="(y+yend)/2+height*3/4",label="text"),vjust=-0.5)
        if(nrow(resCor[resCor$position==1,])>0)
          p<-p+geom_text(data=resCor[resCor$position==1,],aes_string(x="(x+xend)/2-width*1/2",y="(y+yend)/2",label="text"),hjust=1.1)
      }
         }
    }


 p
  ## 2nd Indirect Effect
  if(secondIndirect){
  res2Ind=res[substr(res$label,1,6)=="second",]
  res2Ind
  if(nrow(res2Ind)>0){
    res2Ind=mergeDataPos2Ind(res2Ind,res,df2,whatLabels,height=height,width=width)
    res2Ind=addLinetype(res2Ind)
    res2Ind
    for(i in 1:nrow(res2Ind)){
      #i=1
      Reglist=unlist(strsplit(res2Ind$rhs[i],c("+"),fixed=TRUE))
      Reglist=unlist(strsplit(Reglist,c("*"),fixed=TRUE))
      Reglist
      resReglist=res[res$label %in% Reglist,]
      resReglist
      resReglist=mergeDataPos(resReglist,df2,whatLabels,height=height,width=width)
      resReglist$linetype=res2Ind$linetype[i]
      resReglist

      maxx=which.max(resReglist$xend)
      #p<-p+geom_segment(data=resReglist,aes(x=x,y=y,xend=xend,yend=yend),linetype=resReglist$linetype,
      #                  arrow=arrow(angle=20,length=unit(0.3,"cm"),type="closed"),color="blue",alpha=0.5,size=2)

      p<-p+geom_segment(data=resReglist[-maxx,],aes_string(x="x",y="y",xend="xend",yend="yend"),
                        linetype=resReglist[-maxx,]$linetype,
                        color="blue",alpha=0.5,size=1)
      p<-p+geom_segment(data=resReglist[maxx,],aes_string(x="x",y="y",xend="xend",yend="yend"),
                        linetype=resReglist[maxx,]$linetype,
                        arrow=arrow(angle=20,length=unit(0.3,"cm"),type="closed"),color="blue",alpha=0.5,size=1)
    p
    }
    if(whatLabels!="name") p<-p+geom_label(data=res2Ind,aes_string(x="x",y="y",label="text"),color="blue")

  }
  }
 p
 ## Indirect Effect
  if(indirect){

    resInd=res[substr(res$label,1,3)=="ind",]
    resInd
    if(nrow(resInd)>0){
      #height=3;width=5;whatLabels="est"
      resInd=mergeDataPosInd(resInd,res,df2,whatLabels,height=height,width=width)
      resInd=addLinetype(resInd)
      resInd
      for(i in 1:nrow(resInd)){

        Reglist=unlist(strsplit(resInd$rhs[i],"*",fixed=TRUE))
        resReglist=res[res$label %in% Reglist,]
        resReglist=mergeDataPos(resReglist,df2,whatLabels,height=height,width=width)
        resReglist$linetype=resInd$linetype[i]
        resReglist
        maxx=which.max(resReglist$xend)
        p<-p+geom_segment(data=resReglist[-maxx,],aes_string(x="x",y="y",xend="xend",yend="yend"),
                          linetype=resReglist[-maxx,]$linetype,
                          color="red",alpha=0.5,size=1)
        p<-p+geom_segment(data=resReglist[maxx,],aes_string(x="x",y="y",xend="xend",yend="yend"),
                          linetype=resReglist[maxx,]$linetype,
                          arrow=arrow(angle=20,length=unit(0.3,"cm"),type="closed"),color="red",alpha=0.5,size=1)


      }
      if(whatLabels!="name") p<-p+geom_label(data=resInd,aes_string(x="x",y="y",label="text"),color="red")

    }
  }
 if(total){
     res
     resTotal=res[substr(res$label,1,5)=="total",]
     resTotal
     if(nrow(resTotal)>0){
         #height=3;width=5;whatLabels="est"
         resTotal=mergeDataPosInd(resTotal,res,df2,whatLabels,height=height,width=width)
         resTotal=addLinetype(resTotal)
         resTotal
         for(i in 1:nrow(resTotal)){
             #i=1
             Reglist=unlist(strsplit(resTotal$rhs[i],"+",fixed=TRUE))
             Reglist=unlist(strsplit(Reglist,"*",fixed=TRUE))
             Reglist
             (resReglist=res[res$label %in% Reglist,])

             resReglist=mergeDataPos(resReglist,df2,whatLabels,height=height,width=width)
             #resReglist$linetype=resTotal$linetype[i]
             resReglist$effect="indirect"
             resReglist[substr(resReglist$label,1,1)=="c",]$effect="direct"
             resReglist=addLinetype(resReglist)
             resReglist
             select=resReglist$xend<max(resReglist$xend)
             resReglist[select,]
             resReglist[!select,]
             resReglist
             #p<-p2
             p<-p+geom_segment(data=resReglist[select,],aes_string(x="x",y="y",xend="xend",yend="yend",color="effect"),
                               linetype=resReglist[select,]$linetype,
                               alpha=0.5,size=1)
             p
             p<-p+geom_segment(data=resReglist[!select,],aes_string(x="x",y="y",xend="xend",yend="yend",color="effect"),
                               linetype=resReglist[!select,]$linetype,
                               arrow=arrow(angle=20,length=unit(0.3,"cm"),type="closed"),alpha=0.5,size=1)


         }
         select=(substr(res$label,1,1)=="c")
         (resTotal2=res[select,])
         resTotal2=mergeDataPos(resTotal2,df2,whatLabels,height=height,width=width)
         resTotal2$effect="direct"
         resTotal2$label=round(ifelse(whatLabels=="est",resTotal2$est,resTotal2$std.all),2)
         resTotal2$x=(resTotal2$x1+resTotal2$x2)/2
         resTotal2$y=(resTotal2$y1+resTotal2$y2)/2
         resTotal2=resTotal2[c("x","y","label","effect")]
         resTotal2
         select=(substr(res$label,1,3)=="ind")
         (resTotal3=res[select,])
         resTotal3=mergeDataPosInd(resTotal3,res,df2,whatLabels,height=height,width=width)
         resTotal3$effect="indirect"
         resTotal3$label=round(ifelse(whatLabels=="est",resTotal3$est,resTotal3$std.all),2)
         resTotal3=resTotal3[c("x","y","label","effect")]
         resTotal=rbind(resTotal2,resTotal3)
         if(whatLabels!="name"){
         if(useLabel) p<-p+geom_label(data=resTotal,aes_string(x="x",y="y",label="label",color="effect"))
         else p<-p+geom_label(data=resTotal,aes_string(x="x",y="y",label="label",color="effect"),label.size=0)
         }

     }
 }
  p<-p+coord_fixed()
  p

}