semPlot UI for Lavaan models

global.R

library("semPlot")
library("lavaan")

server.R

shinyServer(function(input, output) {
    
  # Button:
  output$button <- renderUI({
    if (input$onthefly == 'No')
    {
      submitButton(text = "Draw path diagram")
    }
  })
  
  # Plotting window:
  output$semPlot <- renderPlot({
    if (is.null(input$model) || is(try(lavaanify(input$model),silent=TRUE),'try-error')) {
      # User has not uploaded a file yet
      plot.new()
      return(NULL)
    }

    if (input$lavdef == 'cfa')
    {
      modOpts <- list(
        int.ov.free = TRUE,
        int.lv.free = FALSE,
        auto.fix.first = input$scaling == 'First factor loadings', 
        std.lv = input$scaling != 'First factor loadings', 
        auto.fix.single = TRUE, 
        auto.var = TRUE, 
        auto.cov.lv.x = TRUE, 
        auto.th = TRUE, 
        auto.delta = TRUE, 
        auto.cov.y = TRUE)
    } else if (input$lavdef == 'sem')
    {
      modOpts <- list(
        int.ov.free = TRUE, 
        int.lv.free = FALSE, 
        auto.fix.first = input$scaling == 'First factor loadings', 
        std.lv = input$scaling != 'First factor loadings', 
        auto.fix.single = TRUE, 
        auto.var = TRUE, 
        auto.cov.lv.x = TRUE, 
        auto.th = TRUE, 
        auto.delta = TRUE, 
        auto.cov.y = TRUE
      )
    } else if (input$lavdef == 'growth')
    {
      modOpts <- list(
        meanstructure = TRUE, 
        int.ov.free = FALSE, 
        int.lv.free = TRUE, 
        auto.fix.first = input$scaling == 'First factor loadings', 
        std.lv = input$scaling != 'First factor loadings', 
        auto.fix.single = TRUE, 
        auto.var = TRUE, 
        auto.cov.lv.x = TRUE, 
        auto.th = TRUE, 
        auto.delta = TRUE, 
        auto.cov.y = TRUE
      )
    } else modOpts <- list()
    
    semPaths(input$model, 'model', 'label', style = input$style, sizeMan = input$sizeMan,
             sizeLat = input$sizeLat, sizeInt = input$sizeInt, edge.label.cex = input$elcex, ask = FALSE,
             panelGroups = TRUE, modelOpts = modOpts,
             intercepts = "int"%in%input$logicals,
             residuals = "res"%in%input$logicals,
             thresholds = "thresh"%in%input$logicals,
             exoVar = "exoVar"%in%input$logicals,
             exoCov = "exoCov"%in%input$logicals,
             residScale = input$residScale,
             layout = input$layout,
             structural = input$structural,
             rotation = input$rotation
             
             )
      
  }, width = function() input$width, height = function() input$height)
  
  
  output$downloadData <- downloadHandler(
    filename = 'semPlotGraph.pdf',
    content = function(con) {
      
      if (is.null(input$model) || is(try(lavaanify(input$model),silent=TRUE),'try-error')) {
        # User has not uploaded a file yet
        return(NULL)
      }
      
      if (input$lavdef == 'cfa')
      {
        modOpts <- list(
          int.ov.free = TRUE,
          int.lv.free = FALSE,
          auto.fix.first = input$scaling == 'First factor loadings', 
          std.lv = input$scaling != 'First factor loadings', 
          auto.fix.single = TRUE, 
          auto.var = TRUE, 
          auto.cov.lv.x = TRUE, 
          auto.th = TRUE, 
          auto.delta = TRUE, 
          auto.cov.y = TRUE)
      } else if (input$lavdef == 'sem')
      {
        modOpts <- list(
          int.ov.free = TRUE, 
          int.lv.free = FALSE, 
          auto.fix.first = input$scaling == 'First factor loadings', 
          std.lv = input$scaling != 'First factor loadings', 
          auto.fix.single = TRUE, 
          auto.var = TRUE, 
          auto.cov.lv.x = TRUE, 
          auto.th = TRUE, 
          auto.delta = TRUE, 
          auto.cov.y = TRUE
        )
      } else if (input$lavdef == 'growth')
      {
        modOpts <- list(
          meanstructure = TRUE, 
          int.ov.free = FALSE, 
          int.lv.free = TRUE, 
          auto.fix.first = input$scaling == 'First factor loadings', 
          std.lv = input$scaling != 'First factor loadings', 
          auto.fix.single = TRUE, 
          auto.var = TRUE, 
          auto.cov.lv.x = TRUE, 
          auto.th = TRUE, 
          auto.delta = TRUE, 
          auto.cov.y = TRUE
        )
      } else modOpts <- list()
            
      pdf(con,width=7, height = 7 * input$height/input$width)
      semPaths(input$model, 'model', 'label', style = input$style, sizeMan = input$sizeMan,
               sizeLat = input$sizeLat, sizeInt = input$sizeInt, edge.label.cex = input$elcex, ask = FALSE,
               panelGroups = TRUE, modelOpts = modOpts,
               intercepts = "int"%in%input$logicals,
               residuals = "res"%in%input$logicals,
               thresholds = "thresh"%in%input$logicals,
               exoVar = "exoVar"%in%input$logicals,
               exoCov = "exoCov"%in%input$logicals,
               residScale = input$residScale,
               layout = input$layout,
               structural = input$structural,
               rotation = input$rotation
               
      )
      dev.off()              
    }
  )
  
  
  output$syntaxDownload <- downloadHandler(
    filename = 'semPlotSyntax.R',
    content = function(con) {

      if (is.null(input$model) || is(try(lavaanify(input$model),silent=TRUE),'try-error')) {
        # User has not uploaded a file yet
        return(NULL)
      }
      
      if (input$lavdef == 'cfa')
      {
        modOpts <- list(
          int.ov.free = TRUE,
          int.lv.free = FALSE,
          auto.fix.first = input$scaling == 'First factor loadings', 
          std.lv = input$scaling != 'First factor loadings', 
          auto.fix.single = TRUE, 
          auto.var = TRUE, 
          auto.cov.lv.x = TRUE, 
          auto.th = TRUE, 
          auto.delta = TRUE, 
          auto.cov.y = TRUE)
      } else if (input$lavdef == 'sem')
      {
        modOpts <- list(
          int.ov.free = TRUE, 
          int.lv.free = FALSE, 
          auto.fix.first = input$scaling == 'First factor loadings', 
          std.lv = input$scaling != 'First factor loadings', 
          auto.fix.single = TRUE, 
          auto.var = TRUE, 
          auto.cov.lv.x = TRUE, 
          auto.th = TRUE, 
          auto.delta = TRUE, 
          auto.cov.y = TRUE
        )
      } else if (input$lavdef == 'growth')
      {
        modOpts <- list(
          meanstructure = TRUE, 
          int.ov.free = FALSE, 
          int.lv.free = TRUE, 
          auto.fix.first = input$scaling == 'First factor loadings', 
          std.lv = input$scaling != 'First factor loadings', 
          auto.fix.single = TRUE, 
          auto.var = TRUE, 
          auto.cov.lv.x = TRUE, 
          auto.th = TRUE, 
          auto.delta = TRUE, 
          auto.cov.y = TRUE
        )
      } else modOpts <- list()
      
      Syn <- paste0("library('lavaan')\nlibrary('semPlot')\n\n\nModel <- '\n",input$model,"\n'\n\n",
                    
                    "pdf('semPlotGraph.pdf', width = 7, height = ",deparse(7*input$height/input$width),")\n\n",
                    "semPaths(Model, 'model', 'label'",
                    ",\n\t\tstyle = ",deparse(input$style),
                    ",\n\t\tintercepts = ",deparse("int"%in%input$logicals),
                    ",\n\t\tresiduals = ",deparse("res"%in%input$logicals),
                    ",\n\t\tthresholds = ",deparse("thresh"%in%input$logicals),
                    ",\n\t\texoCov = ",deparse("exoCov"%in%input$logicals),
                    ",\n\t\texoVar = ",deparse("exoVar"%in%input$logicals),
                    ",\n\t\tsizeMan = ",deparse(input$sizeMan),
                    ",\n\t\tsizeLat = ",deparse(input$sizeLat),
                    ",\n\t\tsizeInt = ",deparse(input$sizeInt),
                    ",\n\t\tresidScale = ",deparse(input$residScale),
                    ",\n\t\tedge.label.cex = ",deparse(input$elcex),
                    ",\n\t\tlayout = ",deparse(input$layout),
                    ",\n\t\tstructural = ",deparse(input$structural),
                    ",\n\t\task = FALSE",
                    ",\n\t\tpanelGroups = TRUE",
                    ",\n\t\tmodelOpts = ",paste(deparse(modOpts),collapse=""),
                    ",\n\t\trotation = ",deparse(input$rotation),
                    ")\n\ndev.off()"
      )
      
      cat(Syn, file = con)
    }
  )
  
})

ui.R

shinyUI(pageWithSidebar(
  
  # Header:
  headerPanel("semPlot UI for Lavaan models"),
  
  # Input in sidepanel:
  sidebarPanel(
    
    # Input:
    h3("Lavaan Model:"),
    
    tags$textarea(id="model", rows=10, cols=100, ""),
    
    br(),
    
    radioButtons('lavdef', 'Lavaan defaults set:', c('cfa','sem','growth','lavaan'), selected = 'cfa'),
    
    radioButtons('scaling', 'Scaling:', c('First factor loadings','Variance of latents'), selected = 'First factor loadings'),
    
    br(),
    
    
    h3("Graphical options"),
      
    # Style:
    radioButtons("style", "Residual Style",
                 list("LISREL" = "lisrel",
                      "RAM" = "ram")),

    selectInput("layout","Layout",c("tree","tree2","tree3","circle","circle2","circle3","spring")),
    
    checkboxInput("structural", "Show only structural model?", value = FALSE),
    
    checkboxGroupInput("logicals", "Show:",
                       c("Intercepts" = "int",
                         "Residuals" = "res",
                         "Thresholds" = "thresh",
                         "Exogenous variances" = "exoVar",
                         "Exogenous covariances" = "exoCov"),
                        c("Intercepts","Residuals","Thresholds","Exogenous covariances")),
    
    # Size modification:
    sliderInput("rotation", "Rotation", 
                min=1, max=4, value=2, step = 1),
    sliderInput("sizeMan", "Manifest size:", 
                min=0, max=20, value=5, step = 0.1),
    sliderInput("sizeLat", "Latent size:", 
                min=0, max=20, value=8, step = 0.1),  
    sliderInput("sizeInt", "Intercept size:", 
                min=0, max=20, value=2, step = 0.1),  
    sliderInput("elcex", "Edge-label size:", 
                min=0, max=2, value=0.7, step = 0.1),
    
    sliderInput("residScale", "Residual size:", 
                min=0, max=20, value=5, step = 0.1),
    
    br(),
    
    h3("Output:"),
    # Output size:
    sliderInput("width", "Width", 
                min=0, max=2000, value=1000),
    sliderInput("height", "Height", 
                min=0, max=2000, value=500),    
    
    downloadLink('downloadData', 'Download PDF'),
    
    downloadLink('syntaxDownload', 'Download Syntax')
    
    ),
  
  # Plot in main:
  mainPanel(
    # Show a plot of the generated distribution
      plotOutput("semPlot",'auto','auto')
  )
))