基于用户上传的动态变量下拉线性回归的闪亮应用

如何解决基于用户上传的动态变量下拉线性回归的闪亮应用

正如标题所描述的，我只是想创建一个闪亮的应用程序，允许用户根据导入的 csv 文件生成线性回归图。导入文件后，感兴趣的变量的下拉列表应该会动态更新。

如下面的代码所示，我可以使用 mtcars 来实现这一点，但是对于具有不同因变量和自变量的导入文件，我无法做到这一点。

感谢您的帮助

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",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',#                         data = mtcars)})
  output$lmSummary <- renderPrint({
    summary(lmModel())
  })
  
  output$diagnosticPlot <- renderPlot({
    par(mfrow = c(2,2))
    plot(lmModel())
  })
}
shinyApp(ui = ui,server = server)```

解决方法

解决动态菜单：

您的 selectInput 元素必须放置在服务器部分中才能使其具有反应性。 ui 部分中的内容基本上是静态的。在 uiOutput 部分使用 ui，在 renderUI 部分使用 server。

• ui 部分（代替 selectInput 块）：uiOutput("var_select_ui")
• 服务器部分（添加）：

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

,

动态选择x轴和y轴变量，可以试试下面的

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)