具有多个自变量选择的线性回归 R Shiny 应用

Question

我无法修改下面的脚本以使其与多个自变量一起使用。 它仅在选择单个自变量时有效。 我在脚本中添加了“multiple = TRUE”以允许同时选择多个变量。 但这并不会真正影响生成的图表和统计数据。 关于如何解决这个问题的任何建议？

任何具有数字和非数字数据的 csv 文件都可以用来测试脚本。 将 iris 或 mtcars r 数据集保存为 csv 文件可以测试脚本。

谢谢您的帮助。

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)

Answer 1

您的代码中有 2 个问题：

• 命名约定错误； y通常是因变量， x通常是自变量
• 通过从 data.frame 中提取选定的列作为向量，您会失去 R 的非标准评估的良好特性，特别是对于 model 的名称。 我认为这也是它不适用于多个自变量的问题

我没有提取数据，而是使用选定的变量来定义可在lm调用中使用的公式：

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)