qgraph shiny test

server.R

library("shiny")
library("foreign")
library('qgraph')

shinyServer(function(input, output) {
  #   
  #   # Data import:
  #   output$data <- reactiveTable(function() {
  #     if (is.null(input$files)) {
  #       # User has not uploaded a file yet
  #       return(data.frame())
  #     }
  #     
  #     Dataset <- read.spss(input$files$datapath, to.data.frame =TRUE)
  #     return(Dataset)
  #   })
  
  
  # Select variables:
  output$varselect <- renderUI({
    if (is.null(input$files)) {
      # User has not uploaded a file yet
      return(data.frame())
    }      
    Dataset <- read.spss(input$files$datapath, to.data.frame =TRUE)
    
    # Variable selection:
    selectInput("vars", "Use variables:",
                names(Dataset), names(Dataset)[which(sapply(Dataset, mode)=='numeric')], TRUE)            
  })
  
  
  
  # Group specification:
  output$groupsselect <- renderUI({
    if (is.null(input$files)) {
      # User has not uploaded a file yet
      return(data.frame())
    }      
    Dataset <- read.spss(input$files$datapath, to.data.frame =TRUE)
    
    g <- input$nGroup
    
    # Variable selection:
    if (g==1)
    {
      return(selectInput(paste0("group",g), paste0("Variables in group ",g,':'),
                         input$vars, input$vars, multiple = TRUE))
    } else {
      return(selectInput(paste0("group",g), paste0("Variables in group ",g,':'),
                         input$vars, multiple = TRUE)) 
    }
    
  })
  
  
  # Plotting window:
  output$plot <- renderPlot({
    if (is.null(input$files)) {
      # User has not uploaded a file yet
      return(data.frame())
    }      
    Dataset <- read.spss(input$files$datapath, to.data.frame =TRUE)
    
    if (length(input$vars)==0)
    {
      plot.new()
      return(NULL)
    } else if (length(input$vars)==1)
    {
      corMat <- matrix(1,1,1)
    } else {
      corMat <- cor(Dataset[,input$vars])
    }
    
    Groups <- grep('group\\d+',names(input),value=TRUE)
    Groups <- lapply(Groups, function(g) match(input[[g]],input$vars)  )
    if (length(Groups)==1 && length(Groups[[1]]) == length(input$vars)) Groups <- NULL
    
    args <- gsub(',+$','',gsub('\n',',',input$args))
    Args <- eval(parse(text=paste('list(',args,')')))
    class(Args) <- 'qgraph'
      
    qgraph(corMat, weighted = TRUE, maximum = 1, groups = Groups, layout = input$layout, Args)
    
  }, width = 1000, height = 1000)
  
  
  
  ## Download data:
  output$downloadData <- downloadHandler(
    filename = 'qgraph.pdf',
    content = function(con) {
      if (is.null(input$files)) {
        # User has not uploaded a file yet
        return(data.frame())
      }      
      Dataset <- read.spss(input$files$datapath, to.data.frame =TRUE)
      
      if (length(input$vars)==0)
      {
        plot.new()
        return(NULL)
      } else if (length(input$vars)==1)
      {
        corMat <- matrix(1,1,1)
      } else {
        corMat <- cor(Dataset[,input$vars])
      }
      
      Groups <- grep('group\\d+',names(input),value=TRUE)
      Groups <- lapply(Groups, function(g) match(input[[g]],input$vars)  )
      if (length(Groups)==1 && length(Groups[[1]]) == length(input$vars)) Groups <- NULL
      
      args <- gsub(',+$','',gsub('\n',',',input$args))
      Args <- eval(parse(text=paste('list(',args,')')))
      class(Args) <- 'qgraph'
      
      pdf(con)
      qgraph(corMat, weighted = TRUE, maximum = 1, groups = Groups, layout = input$layout, Args)
      dev.off()
    })
  
})

ui.R

library("shiny")
library("foreign")
library('qgraph')

shinyUI(pageWithSidebar(
  
  # Header:
  headerPanel("SPSS demo"),
  
  # Input in sidepanel:
  sidebarPanel(
    # Input:
    fileInput("files", "Upload SPSS file:"),
    
    # Variable selection:
    htmlOutput("varselect"),
    
    # Groups:
    numericInput('nGroup','Specify variables in group:',1,min=1,step=1),
    
    htmlOutput("groupsselect"),
    
    br(),
    
    # What to portray?
    radioButtons("layout", "Layout",
                 list("Circular" = "circular",
                      "Circle" = "circle",
                      "Fruchterman-Reingold" = "spring"
                 )
    ),
    br(),
    p( 'Other arguments:' ),
    tags$textarea(id="args", rows=3, cols=40, ""),
    
    br(),
    
    downloadLink('downloadData', 'Download PDF')
  ),
  
  # Main:
  mainPanel(
    plotOutput("plot",'auto','auto')
  )
))