Linear Regression R Shiny application with multiple independent variable selection

问题

I'm not able to modify the script below to make it work with multiple independent variables. It only works when a single independent variable is selected. I've added "multiple = TRUE" in the script to allow the selection of multiple variable at the same time. But that doesn't really affect the plots and stats generated. Any suggestion of how this can be resolved?

Any csv file with numeric and non numeric data would work to test the script. Saving the iris or mtcars r datasets as csv files would work to test the script.

Thank you for your help.

library(shiny) 
library(DT)
library(shinyWidgets) 

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"),
                multiple = TRUE)
    
  })
  
  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)

回答1:

You have 2 issues in your code:

• the naming convention is wrong; y is usually the dependent variable and x the independent
• by extracting the selected columns as vectors out of the data.frame, you loose the nice features of the non-standard evaluation of R, especially for the names of your model. I think this is also the problem that it doesn't work with multiple independent variables

Instead of extracting the data, I use the selected variables to define the formula that can be used in the lm call:

library(shiny) 
library(DT)
library(shinyWidgets) 

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[2],
                options = list(`style` = "btn-info"),
                multiple = TRUE)
    
  })
  output$yvariable <- renderUI({
    req(data())
    ya<-colnames(data()) 
    pickerInput(inputId = 'yvar',
                label = 'Select y-axis variable',
                choices = c(ya[1:length(ya)]), selected=ya[1],
                options = list(`style` = "btn-info"),
                multiple = FALSE)
    
  })
  
  lmModel <- reactive({
    req(data(),input$xvar,input$yvar)
    x <- as.numeric(data()[[as.name(input$xvar)]])
    y <- as.numeric(data()[[as.name(input$yvar)]])
    current_formula <- paste0(input$yvar, " ~ ", paste0(input$xvar, collapse = " + "))
    current_formula <- as.formula(current_formula)
    model <- lm(current_formula, data = data(), na.action=na.exclude)
    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)

来源：https://stackoverflow.com/questions/65415824/linear-regression-r-shiny-application-with-multiple-independent-variable-selecti