允许用户根据 Shiny 中的选择变量执行回归分析答案

【问题标题】：Allowing user to perform regression analysis based on select variables in Shiny允许用户根据 Shiny 中的选择变量执行回归分析
【发布时间】：2021-06-14 23:08:38
【问题描述】：

我正在创建一个闪亮的应用程序，以允许用户上传 CSV，选择一个因变量和自变量，然后执行回归分析。到目前为止，我已经能够上传文件，并根据this 答案选择感兴趣的列。但是该应用程序无法构造lm model。目的是首先使用summary 生成并显示lm 结果，然后生成一些绘图。如何允许用户执行简单的回归分析？示例文件可以从here下载。

用户界面

ui = navbarPage(tabPanel("Regression Analysis,
                         dataTableOutput('mytable'),
                         sidebarLayout(sidebarPanel(fileInput("file1", "Please choose a CSV file",
                                                              multiple = T,
                                                              accept = c("text/csv",
                                                                         "text/comma-separated-values,text/plain",
                                                                         ".csv")),
                                                    tags$hr(),
                                                    checkboxInput("header", "Header", TRUE),
                                                    radioButtons("sep", "Separator",
                                                                 choices = c(Comma = ",",
                                                                             Semicolon = ";",
                                                                             Tab = "\t"),
                                                                 selected = ","),
                                                    radioButtons("quote", "Quote",
                                                                 choices = c(None = "",
                                                                             "Double Quote" = '"',
                                                                             "Single Quote" = "'"),
                                                                 selected = '"'),
                                                    tags$hr(),
                                                    radioButtons("disp", "Display",
                                                                 choices = c(Head = "head",
                                                                             All = "all"),
                                                                 selected = "head")
                                                    
                         ),
                         mainPanel(
                           tableOutput("contents")),),
                         actionButton("choice", "Define Regression Variables"),
                         selectInput("dependent", "Dependent Variable:", choices = NULL, multiple = F),
                selectInput("independent1", "Independent Variable:", choices = NULL, multiple = F),
                selectInput("independent2", "Independent Variable:", choices = NULL, multiple = F),
                tableOutput("Table_selected.col"),
                textOutput("regTab")
))

服务器

# Tell the server how to assemble inputs into outputs
server = function(input, output, session) {
  
  mydf <- reactive({
    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, head of that data file by default,
    # or all rows if selected, will be shown.
    
    req(input$file1)
    
    df = read.csv(input$file1$datapath,
                  header = input$header,
                  sep = input$sep,
                  quote = input$quote)
    
    if(input$disp == "head") {
      return(head(df))
    }
    else {
      return(df)
    }
    
  })
  
  output$contents = renderTable({
    req(mydf())
    mydf()
  })
  
  # Code for allowing the user to select the variables/columns of interest 
  info <- eventReactive(input$choice, {
    req(mydf())
    f <- mydf()
    f
  })
  
  observeEvent(input$choice, {  ## to update only when you click on the actionButton
  #observe({
    req(mydf())
    updateSelectInput(session,"dependent", "Please Select a Dependent Variable:", choices = names(mydf()))
            updateSelectInput(session,"independent1", "Please Select a Independent Variable:", choices = names(mydf()))
            updateSelectInput(session,"independent2", "Please Select a Independent Variable:", choices = names(mydf()))
            
  })
  
  
  output$Table_selected.col <- renderTable({
    input$choice
    req(info(),input$columns)
    f = info()
    f = subset(f, select = input$columns) #subsetting takes place here
    head(f)
  })

output$independent1 = renderUI({
            req(mydf())
            checkboxGroupInput("independent1", "Independent Variable:",names(mydf())[!names(mydf()) %in% input$dependent],names(mydf())[!names(mydf()) %in% input$dependent])
        })
        
        output$independent2 = renderUI({
            req(mydf())
            checkboxGroupInput("independent2", "Independent Variable:",names(mydf())[!names(mydf()) %in% input$dependent],names(mydf())[!names(mydf()) %in% input$dependent])
        })
        
        runRegression = reactive({
            req(mydf())
            Model.2 = lm(as.formula(paste(input$dependent," ~ ",paste(input$independent1,collapse="+"),"+",paste(input$independent2,collapse="+"))),data=mydf())
            Model.2
            })
        
        output$regTab = renderPrint({
            if(!is.null(input$independent)){
                summary(runRegression())
            } else {
                print(data.frame(Warning="Please select Model Parameters."))
            } 
        })
}

shinyApp(ui, server)

更新

按照下面的答案后，我现在遇到了新的错误。

ui = navbarPage(tabPanel("Regression Analysis,
                         dataTableOutput('mytable'),
                         sidebarLayout(sidebarPanel(fileInput("file1", "Please choose a CSV file",
                                                              multiple = T,
                                                              accept = c("text/csv",
                                                                         "text/comma-separated-values,text/plain",
                                                                         ".csv")),
                                                    tags$hr(),
                                                    checkboxInput("header", "Header", TRUE),
                                                    radioButtons("sep", "Separator",
                                                                 choices = c(Comma = ",",
                                                                             Semicolon = ";",
                                                                             Tab = "\t"),
                                                                 selected = ","),
                                                    radioButtons("quote", "Quote",
                                                                 choices = c(None = "",
                                                                             "Double Quote" = '"',
                                                                             "Single Quote" = "'"),
                                                                 selected = '"'),
                                                    tags$hr(),
                                                    radioButtons("disp", "Display",
                                                                 choices = c(Head = "head",
                                                                             All = "all"),
                                                                 selected = "head")

                         ),
                         mainPanel(
                           tableOutput("contents")),),
                         actionButton("choice", "Define Regression Variables"),
                         selectInput("dependent", "Dependent Variable:", choices = NULL, multiple = F),
                selectInput("independent1", "Independent Variable:", choices = NULL, multiple = F),
                selectInput("independent2", "Independent Variable:", choices = NULL, multiple = F),
                uiOutput("dependent"),
                uiOutput("independent1"),
                uiOutput("independent2"),
                textOutput("regTab")
))

服务器

# Tell the server how to assemble inputs into outputs
    server = function(input, output, session) {
        mydf = reactive({
            
            # input$file1 will be NULL initially. After the user selects
            # and uploads a file, head of that data file by default,
            # or all rows if selected, will be shown.
            
            req(input$file1)
            
            df = read.csv(input$file1$datapath,
                           header = input$header,
                           sep = input$sep,
                           quote = input$quote)
            
            if(input$disp == "head") {
                return(head(df))
            }
            else {
                return(df)
            }
            
        })
        
        output$contents = renderTable({
            req(mydf())
            mydf()
        })
        
        # Code for allowing the user to select the variables/columns of interest 
        info = eventReactive(input$choice, {
           req(mydf())
           f = mydf()
        })
        
        observeEvent(input$choice, { ## to update only when you click on the actionButton 
            req(mydf())
            updateSelectInput(session,"dependent", "Please Select a Dependent Variable:", choices = names(mydf()))
            updateSelectInput(session,"independent1", "Please Select an Independent Variable:", choices = names(mydf()))
            updateSelectInput(session,"independent2", "Please Select an Independent Variable:", choices = names(mydf()))
            
            })
        output$Table_selected.col = renderTable({
            input$choice
            req(info(), input$columns)
            f = info()
            f = subset(f, select = input$columns) #subsetting takes place here
            head(f)
        })
        
        output$dependent = renderUI({
            req(mydf(), input$independent1)
            radioButtons("dependent", "Dependent Variable:",choices=names(mydf())[!names(mydf()) %in% as.character(input$independent)])
        })
        
        output$independent1 = renderUI({
            req(mydf(),input$independent1)
            radioButtons("independent1", "Independent Variable:",names(mydf())[!names(mydf()) %in% input$dependent],names(mydf())[!names(mydf()) %in% input$dependent])
        })
        
        output$independent2 = renderUI({
            req(mydf(),input$independent1,input$independent2, input$dependent)
            radioButtons("independent2", "Independent Variable:",names(mydf())[!names(mydf()) %in% input$dependent],names(mydf())[!names(mydf()) %in% input$dependent])
        })
        
        runRegression = reactive({
            req(mydf(), input$independent1, input$independent2, input$dependent)
            Model.2 = lm(reformulate(input$dependent,input$independent1, input$independent2),data=mydf())
            })
        
        output$regTab = renderPrint({
            req(runRegression())
            if(!is.null(input$independent)){
                summary(runRegression())
            } else {
                print(data.frame(Warning="Please select Model Parameters."))
            }

错误

output$independent1 和 output#independent2 的最后两个 actionbButton 正在返回：

Warning: Error in radioButtons: The 'selected' argument must be of length 1

lm(reformulate) 行和renderPrint 是

Warning: Error in !: invalid argument type

【问题讨论】：

标签： r shiny

【解决方案1】：

试试这个

library(nnet)

ui = navbarPage(tabPanel("Regression Analysis",
                         dataTableOutput('mytable'),
                         sidebarLayout(
                           sidebarPanel(width=3, fileInput("file1", "Please choose a CSV file",
                                                              multiple = T,
                                                              accept = c("text/csv",
                                                                         "text/comma-separated-values,text/plain",
                                                                         ".csv")),
                                                    tags$hr(),
                                                    checkboxInput("header", "Header", TRUE),
                                                    radioButtons("sep", "Separator",
                                                                 choices = c(Comma = ",",
                                                                             Semicolon = ";",
                                                                             Tab = "\t"),
                                                                 selected = ","),
                                                    radioButtons("quote", "Quote",
                                                                 choices = c(None = "",
                                                                             "Double Quote" = '"',
                                                                             "Single Quote" = "'"),
                                                                 selected = '"'),
                                                    tags$hr(),
                                                    radioButtons("disp", "Display",
                                                                 choices = c(Head = "head",
                                                                             All = "all"),
                                                                 selected = "head")

                           ),

                           mainPanel(
                             tableOutput("contents"),
                             actionButton("choice", "Define Regression Variables"),
                             selectInput("independent", "Independent Variables:", choices = NULL, multiple = T),
                             uiOutput("dependent1"),
                             #tableOutput("Table_selected.col"),
                             verbatimTextOutput("regTab")
                           )
                         ),

))

server = function(input, output, session) {

  mydf <- reactive({
    # input$file1 will be NULL initially. After the user selects
    # and uploads a file, head of that data file by default,
    # or all rows if selected, will be shown.

    req(input$file1)

    df = read.csv(input$file1$datapath,
                  header = input$header,
                  sep = input$sep,
                  quote = input$quote)

    if(input$disp == "head") {
      return(head(df))
    }
    else {
      return(df)
    }

  })

  output$contents = renderTable({
    req(mydf())
    mydf()
  })

  # Code for allowing the user to select the variables/columns of interest
  info <- eventReactive(input$choice, {
    req(mydf())
    f <- mydf()
    f
  })

  observeEvent(input$choice, {  ## to update only when you click on the actionButton
    req(info())
    updateSelectInput(session,"independent", "Please Select independent Variable(s):", choices = names(info()) )
  })


  # output$Table_selected.col <- renderTable({
  #   input$choice
  #   req(info(),input$columns)
  #   f = info()
  #   f = subset(f, select = input$columns) #subsetting takes place here
  #   head(f)
  # })

  output$dependent1 = renderUI({
    req(mydf(),input$independent)
    radioButtons("dependent1", "Select a dependent Variable:",choices=names(mydf())[!names(mydf()) %in% input$independent])
  })

  ###  need to build your formuila correctly; It will work with multiple independent variables
  ###  model <- reactive({lm(reformulate(input$IndVar, input$DepVar), data = RegData)})

  runRegression <- reactive({
    req(mydf(),input$independent,input$dependent1)
    lm(reformulate(input$independent, input$dependent1), data=mydf())
    # multinom(reformulate(input$independent, input$dependent1), data=mydf())  ### mulitnomial from nnet package
  })

  output$regTab = renderPrint({
    req(runRegression())
    if(!is.null(input$independent)){
      summary(runRegression())
    } else {
      print(data.frame(Warning="Please select Model Parameters."))
    }
  })

}

shinyApp(ui, server)

【讨论】：

为什么代码中有两个依赖（依赖1和依赖2）变量？实际上，我使用的 lm 公式类似于 lm(dependent ~ Independent1 + Independent2)。如果我的问题不清楚，我很抱歉。
我现在遇到了新的错误，所以我正在更新问题以包含这些错误。
我还上传了一个示例文件以使代码可重现。
请尝试更新后的代码。已调整为选择多个自变量。
是的，您可以更改公式或使用 nnet 包或其他包中的 mulitnom。另外，请确保您查看的是整个数据集，而不仅仅是头部（前 6 条记录）。