具有动态变量选择的 shinyApp 中的回归

Posted 2023-02-14

【中文标题】具有动态变量选择的 shinyApp 中的回归

【英文标题】：Regression in shinyApp with dynamic variable selection

【发布时间】：2022-01-10 09:38:42

【问题描述】：

我想执行 Feature_A 的线性回归，并且我希望用户动态选择其他变量。我还想显示关于我的整体预测模型拟合调整后的 R2、每个模型估计的参数系数和系数 p 值的统计信息。

以下是我能想到的。不用说它不起作用。我一直在努力解决它，任何帮助将不胜感激

library(shiny)
library(ggplot2)
library(dplyr)
library(purrr)
       
Feature_A <- c(1, 2,1, 4,2)
Feature_B <- c(4,5,6,6,6)
Feature_C <- c(22,4,3,1,5)
df<- data.frame(Feature_A ,Feature_B ,Feature_C)
                           
 # Define UI for application
 ui= fluidPage(
                  
 # Header or Title Panel 
   titlePanel(title = h4("Regression")),
      sidebarLayout(
       # Sidebar panel
         sidebarPanel(
          selectInput('ip', 'Select an Explanatory Variable', names(df)),
          actionButton(inputId = "btn1",label="Regression Plot"),
          actionButton(inputId = "btn2",label="Show Stats")),
                    
                    
                    
      # Main Panel
      mainPanel("main panel", regOutput("regplot"),
                              verbatimTextOutput("summary"))
                      
                    ))
     server = function(input, output,session) 
                  
     #code for regression
    lm_fit <- lm(Feature_A ~ input$ip, data=df)
                  
  summary_stats <- eventReactive(input$btn2,summary(lm_fit)
                  )

                  
regression_plot<- eventReactive(input$btn1,ggplot(data = df, aes(x = input$ip, y = Feature_A)) + 
                      geom_point(color='blue') +
                      geom_smooth(method = "lm", se = FALSE)
                    
                  )
                  #end of regression code
                  
                  
          
                  output$regplot <- renderPlot(
                    regression_plot()
                  )
                  output$summary <- renderPrint(
                    summary_stats()
                  )
                  
                
                
shinyApp(ui,server)

【参考方案1】：

这里有几件事是错误的：

regOutput 不是现有命令，您需要 plotOutput 代替。 lm_fit <- lm(Feature_A ~ input$ip, data=df) 应该处于响应状态，因为它使用 input$ip。这意味着您需要lm_fit() 才能获得结果，而不是lm_fit。 另外，input$ip 是一个字符，lm() 需要一个 formula。因此，您需要将整个公式包装在as.formula 中。

现在应该可以了，情节有点奇怪，但我认为这是由于您的简化示例：

library(shiny)
library(ggplot2)
library(dplyr)
library(purrr)

Feature_A <- c(1, 2,1, 4,2)
Feature_B <- c(4,5,6,6,6)
Feature_C <- c(22,4,3,1,5)
df<- data.frame(Feature_A ,Feature_B ,Feature_C)


# Define UI for application
ui= fluidPage(
  
  # Header or Title Panel 
  titlePanel(title = h4("Regression")),
  sidebarLayout(
    # Sidebar panel
    sidebarPanel(
      selectInput('ip', 'Select an Explanatory Variable', names(df)),
      actionButton(inputId = "btn1",label="Regression Plot"),
      actionButton(inputId = "btn2",label="Show Stats")),
    
    
    
    # Main Panel
    mainPanel("main panel", plotOutput("regplot"),
              verbatimTextOutput("summary"))
    
  ))
server = function(input, output,session) 
  
  #code for regression
  lm_fit <- reactive(
    lm(as.formula(paste0("Feature_A ~ ", input$ip)), data=df)
  )
  
  summary_stats <- eventReactive(input$btn2,
    summary(lm_fit())
  )
  
  
  regression_plot<- eventReactive(input$btn1, 
    ggplot(data = df, aes(x = input$ip, y = Feature_A)) + 
      geom_point(color='blue') +
      geom_smooth(method = "lm", se = FALSE)
    
  )
  #end of regression code
  
  
  
  output$regplot <- renderPlot(
    regression_plot()
  )
  output$summary <- renderPrint(
    summary_stats()
  )
  


shinyApp(ui,server)