Shiny Application for Linear Regression with dynamic variable dropdown based on user upload

问题

As the title describes, I'm simply trying to create a shiny application that allows the user to generate linear regression plots based on an imported csv file. After importing the file the dropdown for the variables of interest should be dynamically updated.

As the code below shows, I'm able to accomplish that with mtcars but I'm not able to do the same with an imported files that would have different dependent and independent variables .

Thank you for your help

data(mtcars)
cols <- sort(unique(names(mtcars)[names(mtcars) != 'mpg']))
ui <- fluidPage(
  titlePanel("Build a Linear Model for MPG"),
  sidebarPanel(
    #fluidRow(
      #column(4,
             #tags$h3('Build a Linear Model for MPG'),
              fileInput(
                inputId = "filedata",
                label = "Upload data. csv",
                accept = c(".csv")
              ),
              
              fileInput(
                inputId = "filedata1",
                label = "Upload data. csv",
                accept = c(".csv")
              ),
              
              
                        selectInput('vars',
                         'Select dependent variables',
                         choices = cols,
                         selected = cols[1:2],
                         multiple = TRUE)
              
             

    #)
  ), #sidebarpanel
  
 mainPanel( column(4, verbatimTextOutput('lmSummary')),
  column(4, plotOutput('diagnosticPlot')))
) #fluidpage


server <- function(input, output) {
  
  data <- reactive({
    req(input$filedata)
    read.csv(input$filedata$datapath) %>% rename_all(tolower)  %>%
      filter(driver_name == input$driver_name & county == input$county & model == input$model) 
    
    
  })
  
  
  lmModel <- reactive({lm(sprintf('mpg ~ %s', paste(input$vars, collapse = '+')),
                          data = mtcars)})
  
  # lmModel <- reactive({lm(sprintf('mpg ~ %s', paste(input$vars, collapse = '+')),
  #                         data = mtcars)})
  output$lmSummary <- renderPrint({
    summary(lmModel())
  })
  
  output$diagnosticPlot <- renderPlot({
    par(mfrow = c(2,2))
    plot(lmModel())
  })
}
shinyApp(ui = ui, server = server)```

回答1:

To dynamically select x and y axis variables, you can try the following

ui <- fluidPage(
  titlePanel("Build a Linear Model"),
  sidebarPanel(
    
    fileInput(
      inputId = "filedata",
      label = "Upload data. csv",
      multiple = FALSE,
      accept = c(".csv"),
      buttonLabel = "Choosing ...",
      placeholder = "No files selected yet"
    ),
    uiOutput("xvariable"),
    uiOutput("yvariable")
  ), #sidebarpanel
  
  mainPanel( #DTOutput("tb1"), 
    fluidRow(column(6, verbatimTextOutput('lmSummary')) , column(6, plotOutput('diagnosticPlot')))
  )
) #fluidpage


server <- function(input, output) {
  
  data <- reactive({
    req(input$filedata)
    inData <- input$filedata
    if (is.null(inData)){ return(NULL) }
    mydata <- read.csv(inData$datapath, header = TRUE, sep=",")
  })
  output$tb1 <- renderDT(data())
  
  output$xvariable <- renderUI({
    req(data())
    xa<-colnames(data()) 
    pickerInput(inputId = 'xvar',
                label = 'Select x-axis variable',
                choices = c(xa[1:length(xa)]), selected=xa[1],
                options = list(`style` = "btn-info"))
    
  })
  output$yvariable <- renderUI({
    req(data())
    ya<-colnames(data()) 
    pickerInput(inputId = 'yvar',
                label = 'Select y-axis variable',
                choices = c(ya[1:length(ya)]), selected=ya[2],
                options = list(`style` = "btn-info"))
    
  })
  
  lmModel <- reactive({
    req(data(),input$xvar,input$yvar)
    x <- as.numeric(data()[[as.name(input$xvar)]])
    y <- as.numeric(data()[[as.name(input$yvar)]])
    if (length(x) == length(y)){
      model <- lm(x ~ y, data = data(), na.action=na.exclude)
    }else model <- NULL
    return(model)
  })
  
  output$lmSummary <- renderPrint({
    req(lmModel())
    summary(lmModel())
  })

  output$diagnosticPlot <- renderPlot({
    req(lmModel())
    par(mfrow = c(2,2))
    plot(lmModel())
  })
}

shinyApp(ui = ui, server = server)

回答2:

Addressing the dynamic menu:

Your selectInput element must be placed in the server section for it to be reactive. Things in the ui section are basically static. Use a uiOutput in the ui section and renderUI in the server section.

• ui section (in place of selectInput block): uiOutput("var_select_ui")
• server section (add):

output$var_select_ui <- renderUI({
  cols <- colnames(data())
  selectInput(
    'vars',
    'Select dependent variables',
    choices = cols,
    selected = cols[1:2],
    multiple = TRUE
  )
})

来源：https://stackoverflow.com/questions/65397766/shiny-application-for-linear-regression-with-dynamic-variable-dropdown-based-on